From gitlab at gitlab.haskell.org Tue Dec 1 00:18:03 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 30 Nov 2020 19:18:03 -0500 Subject: [Git][ghc/ghc][wip/tsan-ghc-8.10] 81 commits: 8.10 - dirty MVAR after mutating TSO queue head Message-ID: <5fc58bbb9715a_86cfd752bc10752f5@gitlab.mail> Ben Gamari pushed to branch wip/tsan-ghc-8.10 at Glasgow Haskell Compiler / GHC Commits: d0a18f89 by Viktor Dukhovni at 2020-11-29T21:53:30-05:00 8.10 - dirty MVAR after mutating TSO queue head While the original head and tail of the TSO queue may be in the same generation as the MVAR, interior elements of the queue could be younger after a GC run and may then be exposed by putMVar operation that updates the queue head. Resolves #18919 (cherry picked from commit 699facec0bc8dd7d5b82cc537fbf131b74f5bd2c) - - - - - 92c9bed7 by Ömer Sinan Ağacan at 2020-11-29T21:53:30-05:00 Fix and enable object unloading in GHCi Fixes #16525 by tracking dependencies between object file symbols and marking symbol liveness during garbage collection See Note [Object unloading] in CheckUnload.c for details. (cherry picked from commit c34a4b98b1f09ea3096d39a839a86f2d7185c796) - - - - - 2d72607e by Ben Gamari at 2020-11-29T21:53:30-05:00 gitlab-ci: Add VERBOSE environment variable And change the make build system's default behavior to V=0, greatly reducing build log sizes. (cherry picked from commit 802e9180dd9a9a88c4e8869f0de1048e1edd6343) - - - - - b7a1e016 by Ben Gamari at 2020-11-30T19:16:58-05:00 SMP.h: Add C11-style atomic operations - - - - - 023e414e by Ben Gamari at 2020-11-30T19:16:58-05:00 rts: Infrastructure for testing with ThreadSanitizer - - - - - 631e1b83 by Ben Gamari at 2020-11-30T19:16:58-05:00 rts/CNF: Initialize all bdescrs in group It seems wise and cheap to ensure that the whole bdescr of all blocks of a compact group is valid, even if most cases only look at the flags field. - - - - - 111afe5a by Ben Gamari at 2020-11-30T19:16:58-05:00 rts/Capability: Intialize interrupt field Previously this was left uninitialized. Also clarify some comments. - - - - - 109affa5 by Ben Gamari at 2020-11-30T19:16:58-05:00 rts/Task: Make comments proper Notes - - - - - b67647ba by Ben Gamari at 2020-11-30T19:16:59-05:00 rts/SpinLock: Move to proper atomics This is fairly straightforward; we just needed to use relaxed operations for the PROF_SPIN counters and a release store instead of a write barrier. - - - - - b69a1ebb by Ben Gamari at 2020-11-30T19:16:59-05:00 rts/OSThreads: Fix data race Previously we would race on the cached processor count. Avoiding this is straightforward; just use relaxed operations. - - - - - a20a219e by Ben Gamari at 2020-11-30T19:16:59-05:00 rts/ClosureMaros: Use relaxed atomics - - - - - 73d31171 by Ben Gamari at 2020-11-30T19:16:59-05:00 testsuite: Fix thread leak in hs_try_putmvar00[13] - - - - - efec08d1 by Ben Gamari at 2020-11-30T19:16:59-05:00 rts: Introduce SET_HDR_RELEASE Also ensure that we also store the info table pointer last to ensure that the synchronization covers all stores. - - - - - 1a16a637 by Ben Gamari at 2020-11-30T19:16:59-05:00 rts: Factor out logic to identify a good capability for running a task Not only does this make the control flow a bit clearer but it also allows us to add a TSAN suppression on this logic, which requires (harmless) data races. - - - - - 34e8fc56 by Ben Gamari at 2020-11-30T19:16:59-05:00 rts: Annotate benign race in waitForCapability - - - - - 7f59fb10 by Ben Gamari at 2020-11-30T19:16:59-05:00 rts: Clarify locking behavior of releaseCapability_ - - - - - 2497d63e by Ben Gamari at 2020-11-30T19:16:59-05:00 rts: Add assertions for task ownership of capabilities - - - - - 32b7a3f7 by Ben Gamari at 2020-11-30T19:16:59-05:00 rts: Use relaxed atomics on n_returning_tasks This mitigates the warning of a benign race on n_returning_tasks in shouldYieldCapability. See #17261. - - - - - 18c60ee8 by Ben Gamari at 2020-11-30T19:16:59-05:00 rts: Mitigate races in capability interruption logic - - - - - b87ffbe7 by Ben Gamari at 2020-11-30T19:16:59-05:00 rts/Capability: Use relaxed operations for last_free_capability - - - - - a5e0c4e7 by Ben Gamari at 2020-11-30T19:16:59-05:00 rts: Use relaxed operations for cap->running_task (TODO) This shouldn't be necessary since only the owning thread of the capability should be touching this. - - - - - d462b091 by Ben Gamari at 2020-11-30T19:16:59-05:00 rts/Schedule: Use relaxed operations for sched_state - - - - - be4440e6 by Ben Gamari at 2020-11-30T19:16:59-05:00 rts: Accept data race in work-stealing implementation This race is okay since the task is owned by the capability pushing it. By Note [Ownership of Task] this means that the capability is free to write to `task->cap` without taking `task->lock`. Fixes #17276. - - - - - 7a4a2215 by Ben Gamari at 2020-11-30T19:16:59-05:00 rts: Eliminate data races on pending_sync - - - - - 6ca008dd by Ben Gamari at 2020-11-30T19:16:59-05:00 rts/Schedule: Eliminate data races on recent_activity We cannot safely use relaxed atomics here. - - - - - 39634509 by Ben Gamari at 2020-11-30T19:16:59-05:00 rts: Avoid data races in message handling - - - - - 70f51d2b by Ben Gamari at 2020-11-30T19:16:59-05:00 rts/Messages: Drop incredibly fishy write barrier executeMessage previously had a write barrier at the beginning of its loop apparently in an attempt to synchronize with another thread's writes to the Message. I would guess that the author had intended to use a load barrier here given that there are no globally-visible writes done in executeMessage. I've removed the redundant barrier since the necessary load barrier is now provided by the ACQUIRE_LOAD. - - - - - 03301a27 by Ben Gamari at 2020-11-30T19:16:59-05:00 rts/ThreadPaused: Avoid data races - - - - - f3a3abf8 by Ben Gamari at 2020-11-30T19:16:59-05:00 rts/Schedule: Eliminate data races in run queue management - - - - - 3d7a9776 by Ben Gamari at 2020-11-30T19:16:59-05:00 rts: Eliminate shutdown data race on task counters - - - - - 14a7df42 by Ben Gamari at 2020-11-30T19:16:59-05:00 rts/Threads: Avoid data races (TODO) Replace barriers with appropriate ordering. Drop redundant barrier in tryWakeupThread (the RELEASE barrier will be provided by sendMessage's mutex release). We use relaxed operations on why_blocked and the stack although it's not clear to me why this is necessary. - - - - - 064625cb by Ben Gamari at 2020-11-30T19:16:59-05:00 rts/Messages: Annotate benign race - - - - - 4149887d by Ben Gamari at 2020-11-30T19:17:00-05:00 rts/RaiseAsync: Synchronize what_next read - - - - - 4b187707 by Ben Gamari at 2020-11-30T19:17:00-05:00 rts/Task: Move debugTrace to avoid data race Specifically, we need to hold all_tasks_mutex to read taskCount. - - - - - cf52442a by Ben Gamari at 2020-11-30T19:17:00-05:00 Disable flawed assertion - - - - - 115cb724 by Ben Gamari at 2020-11-30T19:17:00-05:00 Document schedulePushWork race - - - - - 9d53cff8 by Ben Gamari at 2020-11-30T19:17:00-05:00 Capabiliity: Properly fix data race on n_returning_tasks There is a real data race but can be made safe by using proper atomic (but relaxed) accesses. - - - - - c0947071 by Ben Gamari at 2020-11-30T19:17:00-05:00 rts: Make write of to_cap->inbox atomic This is necessary since emptyInbox may read from to_cap->inbox without taking cap->lock. - - - - - 0b41ab72 by Ben Gamari at 2020-11-30T19:17:00-05:00 gitlab-ci: Add nightly-x86_64-linux-deb9-tsan job - - - - - 9076f5c4 by GHC GitLab CI at 2020-11-30T19:17:00-05:00 testsuite: Mark setnumcapabilities001 as broken with TSAN Due to #18808. - - - - - fe840ece by GHC GitLab CI at 2020-11-30T19:17:00-05:00 testsuite: Skip divbyzero and derefnull under TSAN ThreadSanitizer changes the output of these tests. - - - - - 5650808a by Ben Gamari at 2020-11-30T19:17:00-05:00 testsuite: Skip high memory usage tests with TSAN ThreadSanitizer significantly increases the memory footprint of tests, so much so that it can send machines into OOM. - - - - - a07163dd by Ben Gamari at 2020-11-30T19:17:00-05:00 testsuite: Mark hie002 as high_memory_usage This test has a peak residency of 1GByte; this is large enough to classify as "high" in my book. - - - - - 04b2d5a7 by Ben Gamari at 2020-11-30T19:17:00-05:00 testsuite: Mark T9872[abc] as high_memory_usage These all have a maximum residency of over 2 GB. - - - - - c8c0c2dc by Ben Gamari at 2020-11-30T19:17:00-05:00 gitlab-ci: Disable documentation in TSAN build Haddock chews through enough memory to cause the CI builders to OOM and there's frankly no reason to build documentation in this job anyways. - - - - - e420db52 by Ben Gamari at 2020-11-30T19:17:00-05:00 TSANUtils: Ensure that C11 atomics are supported - - - - - 823408fd by Ben Gamari at 2020-11-30T19:17:00-05:00 testsuite: Mark T3807 as broken with TSAN Due to #18883. - - - - - 54e7da1c by Ben Gamari at 2020-11-30T19:17:00-05:00 testsuite: Mark T13702 as broken with TSAN due to #18884 - - - - - 1e9e797c by Ben Gamari at 2020-11-30T19:17:00-05:00 rts/BlockAlloc: Use relaxed operations - - - - - 2333e636 by Ben Gamari at 2020-11-30T19:17:00-05:00 rts: Rework handling of mutlist scavenging statistics - - - - - 2e7699fa by Ben Gamari at 2020-11-30T19:17:00-05:00 rts: Avoid data races in StablePtr implementation This fixes two potentially problematic data races in the StablePtr implementation: * We would fail to RELEASE the stable pointer table when enlarging it, causing other cores to potentially see uninitialized memory. * We would fail to ACQUIRE when dereferencing a stable pointer. - - - - - 73802c70 by Ben Gamari at 2020-11-30T19:17:00-05:00 rts/Storage: Use atomics - - - - - 971af95f by Ben Gamari at 2020-11-30T19:17:00-05:00 rts/Updates: Use proper atomic operations - - - - - 57697340 by Ben Gamari at 2020-11-30T19:17:00-05:00 rts/Weak: Eliminate data races By taking all_tasks_mutex in stat_exit. Also better-document the fact that the task statistics are protected by all_tasks_mutex. - - - - - d7567dea by Ben Gamari at 2020-11-30T19:17:01-05:00 rts/GC: Use atomics - - - - - d0d61a61 by Ben Gamari at 2020-11-30T19:17:01-05:00 rts: Use RELEASE ordering in unlockClosure - - - - - 43b55267 by Ben Gamari at 2020-11-30T19:17:01-05:00 rts/Storage: Accept races on heap size counters - - - - - e3d2418d by Ben Gamari at 2020-11-30T19:17:01-05:00 rts: Join to concurrent mark thread during shutdown Previously we would take all capabilities but fail to join on the thread itself, potentially resulting in a leaked thread. - - - - - 0da89a35 by GHC GitLab CI at 2020-11-30T19:17:01-05:00 rts: Fix race in GC CPU time accounting Ensure that the GC leader synchronizes with workers before calling stat_endGC. - - - - - 0a55e0db by Ben Gamari at 2020-11-30T19:17:01-05:00 rts/SpinLock: Separate out slow path Not only is this in general a good idea, but it turns out that GCC unrolls the retry loop, resulting is massive code bloat in critical parts of the RTS (e.g. `evacuate`). - - - - - 2aae02dd by Ben Gamari at 2020-11-30T19:17:01-05:00 rts: Use relaxed ordering on spinlock counters - - - - - c2527bcd by Ben Gamari at 2020-11-30T19:17:01-05:00 rts: Annotate hopefully "benign" races in freeGroup - - - - - d2649d6e by Ben Gamari at 2020-11-30T19:17:01-05:00 Strengthen ordering in releaseGCThreads - - - - - 854884e1 by Ben Gamari at 2020-11-30T19:17:01-05:00 rts/WSDeque: Rewrite with proper atomics After a few attempts at shoring up the previous implementation, I ended up turning to the literature and now use the proven implementation, > N.M. Lê, A. Pop, A.Cohen, and F.Z. Nardelli. "Correct and Efficient > Work-Stealing for Weak Memory Models". PPoPP'13, February 2013, > ACM 978-1-4503-1922/13/02. Note only is this approach formally proven correct under C11 semantics but it is also proved to be a bit faster in practice. - - - - - 405c4e04 by Ben Gamari at 2020-11-30T19:17:01-05:00 rts: Use relaxed atomics for whitehole spin stats - - - - - d6f250fd by Ben Gamari at 2020-11-30T19:17:01-05:00 rts: Avoid lock order inversion during fork Fixes #17275. - - - - - 2fff334f by GHC GitLab CI at 2020-11-30T19:17:01-05:00 rts: Use proper relaxe operations in getCurrentThreadCPUTime Here we are doing lazy initialization; it's okay if we do the check more than once, hence relaxed operation is fine. - - - - - 9e58ed8a by Ben Gamari at 2020-11-30T19:17:01-05:00 rts/STM: Use atomics This fixes a potentially harmful race where we failed to synchronize before looking at a TVar's current_value. Also did a bit of refactoring to avoid abstract over management of max_commits. - - - - - c0fe81b1 by Ben Gamari at 2020-11-30T19:17:01-05:00 rts/stm: Strengthen orderings to SEQ_CST instead of volatile Previously the `current_value`, `first_watch_queue_entry`, and `num_updates` fields of `StgTVar` were marked as `volatile` in an attempt to provide strong ordering. Of course, this isn't sufficient. We now use proper atomic operations. In most of these cases I strengthen the ordering all the way to SEQ_CST although it's possible that some could be weakened with some thought. - - - - - fb378955 by Ben Gamari at 2020-11-30T19:17:01-05:00 Mitigate data races in event manager startup/shutdown - - - - - 7852d6b8 by Ben Gamari at 2020-11-30T19:17:01-05:00 Suppress data race due to close This suppresses the other side of a race during shutdown. - - - - - 377d742a by Ben Gamari at 2020-11-30T19:17:01-05:00 rts: Accept benign races in Proftimer - - - - - 2d099438 by Ben Gamari at 2020-11-30T19:17:01-05:00 rts: Pause timer while changing capability count This avoids #17289. - - - - - 6e48304c by Ben Gamari at 2020-11-30T19:17:01-05:00 Fix #17289 - - - - - 759ea696 by Ben Gamari at 2020-11-30T19:17:01-05:00 suppress #17289 (ticker) race - - - - - 44cb606b by Ben Gamari at 2020-11-30T19:17:02-05:00 rts: Fix timer initialization Previously `initScheduler` would attempt to pause the ticker and in so doing acquire the ticker mutex. However, initTicker, which is responsible for initializing said mutex, hadn't been called yet. - - - - - b780bf48 by Ben Gamari at 2020-11-30T19:17:02-05:00 rts: Fix races in Pthread timer backend shudown We can generally be pretty relaxed in the barriers here since the timer thread is a loop. - - - - - 636bde86 by Ben Gamari at 2020-11-30T19:17:02-05:00 rts/Stats: Hide a few unused unnecessarily global functions - - - - - 232dc488 by Ben Gamari at 2020-11-30T19:17:02-05:00 rts/Stats: Protect with mutex While on face value this seems a bit heavy, I think it's far better than enforcing ordering on every access. - - - - - 40860e41 by Ben Gamari at 2020-11-30T19:17:47-05:00 rts: Tear down stats_mutex after exitHeapProfiling Since the latter wants to call getRTSStats. - - - - - 383bb46f by Ben Gamari at 2020-11-30T19:17:49-05:00 rts/Stats: Reintroduce mut_user_time Fix the previous backport; this function was dead code in master but is still needed due to ProfHeap.c in ghc-8.10. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - compiler/ghci/Linker.hs - hadrian/hadrian.cabal - hadrian/src/Flavour.hs - hadrian/src/Settings.hs - + hadrian/src/Settings/Flavours/ThreadSanitizer.hs - includes/Rts.h - includes/rts/OSThreads.h - includes/rts/SpinLock.h - includes/rts/StablePtr.h - + includes/rts/TSANUtils.h - includes/rts/storage/ClosureMacros.h - includes/rts/storage/Closures.h - includes/rts/storage/GC.h - includes/stg/SMP.h - libraries/base/GHC/Event/Control.hs - + rts/.tsan-suppressions - rts/Capability.c - rts/Capability.h - rts/CheckUnload.c - rts/CheckUnload.h - rts/Hash.c - rts/Hash.h - rts/Linker.c - rts/LinkerInternals.h - rts/Messages.c - rts/PrimOps.cmm - rts/Proftimer.c - rts/RaiseAsync.c The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f6f0343bd8dc1ea5d8085ed551bcb3400b72b694...383bb46f9de2e5943ac7d5bc5722af9d36ede017 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f6f0343bd8dc1ea5d8085ed551bcb3400b72b694...383bb46f9de2e5943ac7d5bc5722af9d36ede017 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 1 00:22:03 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 30 Nov 2020 19:22:03 -0500 Subject: [Git][ghc/ghc][wip/backports-9.0] ThreadPaused: Don't zero slop until free vars are pushed Message-ID: <5fc58cab88640_86c3fc677e4686c107891@gitlab.mail> Ben Gamari pushed to branch wip/backports-9.0 at Glasgow Haskell Compiler / GHC Commits: f72f27a3 by GHC GitLab CI at 2020-11-30T19:21:56-05:00 ThreadPaused: Don't zero slop until free vars are pushed When threadPaused blackholes a thunk it calls `OVERWRITING_CLOSURE` to zero the slop for the benefit of the sanity checker. Previously this was done *before* pushing the thunk's free variables to the update remembered set. Consequently we would pull zero'd pointers to the update remembered set. (cherry picked from commit 3e75b0dbaca5fbd8abc529d70c1df159f5bfbaa4) - - - - - 2 changed files: - includes/rts/storage/ClosureMacros.h - rts/ThreadPaused.c Changes: ===================================== includes/rts/storage/ClosureMacros.h ===================================== @@ -520,11 +520,15 @@ INLINE_HEADER StgWord8 *mutArrPtrsCard (StgMutArrPtrs *a, W_ n) #if defined(PROFILING) || defined(DEBUG) #define OVERWRITING_CLOSURE(c) \ overwritingClosure(c) +#define OVERWRITING_CLOSURE_SIZE(c, size) \ + overwritingClosureSize(c, size) #define OVERWRITING_CLOSURE_MUTABLE(c, off) \ overwritingMutableClosureOfs(c, off) #else #define OVERWRITING_CLOSURE(c) \ do { (void) sizeof(c); } while(0) +#define OVERWRITING_CLOSURE_SIZE(c, size) \ + do { (void) sizeof(c); (void) sizeof(size); } while(0) #define OVERWRITING_CLOSURE_MUTABLE(c, off) \ do { (void) sizeof(c); (void) sizeof(off); } while(0) #endif ===================================== rts/ThreadPaused.c ===================================== @@ -314,10 +314,6 @@ threadPaused(Capability *cap, StgTSO *tso) continue; } - // zero out the slop so that the sanity checker can tell - // where the next closure is. - OVERWRITING_CLOSURE(bh); - // an EAGER_BLACKHOLE or CAF_BLACKHOLE gets turned into a // BLACKHOLE here. #if defined(THREADED_RTS) @@ -345,11 +341,16 @@ threadPaused(Capability *cap, StgTSO *tso) // overwrite to the update remembered set. // N.B. We caught the WHITEHOLE case above. updateRemembSetPushThunkEager(cap, - THUNK_INFO_PTR_TO_STRUCT(bh_info), - (StgThunk *) bh); + THUNK_INFO_PTR_TO_STRUCT(bh_info), + (StgThunk *) bh); } } + // zero out the slop so that the sanity checker can tell + // where the next closure is. N.B. We mustn't do this until we have + // pushed the free variables to the update remembered set above. + OVERWRITING_CLOSURE_SIZE(bh, closure_sizeW_(bh, INFO_PTR_TO_STRUCT(bh_info))); + // The payload of the BLACKHOLE points to the TSO RELAXED_STORE(&((StgInd *)bh)->indirectee, (StgClosure *)tso); SET_INFO_RELEASE(bh,&stg_BLACKHOLE_info); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f72f27a325c16bf2975ee2a8a49c439b46ee8498 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f72f27a325c16bf2975ee2a8a49c439b46ee8498 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 1 00:47:47 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 30 Nov 2020 19:47:47 -0500 Subject: [Git][ghc/ghc][master] 3 commits: Optimisations in Data.Foldable (T17867) Message-ID: <5fc592b31fcfe_86c15c5d388108492b@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 49ebe369 by chessai at 2020-11-30T19:47:40-05:00 Optimisations in Data.Foldable (T17867) This PR concerns the following functions from `Data.Foldable`: * minimum * maximum * sum * product * minimumBy * maximumBy - Default implementations of these functions now use `foldl'` or `foldMap'`. - All have been marked with INLINEABLE to make room for further optimisations. - - - - - 4d79ef65 by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - 6af074ce by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - 1 changed file: - libraries/base/Data/Foldable.hs Changes: ===================================== libraries/base/Data/Foldable.hs ===================================== @@ -507,7 +507,8 @@ class Foldable t where -- @since 4.8.0.0 maximum :: forall a . Ord a => t a -> a maximum = fromMaybe (errorWithoutStackTrace "maximum: empty structure") . - getMax . foldMap (Max #. (Just :: a -> Maybe a)) + getMax . foldMap' (Max #. (Just :: a -> Maybe a)) + {-# INLINEABLE maximum #-} -- | The least element of a non-empty structure. -- @@ -529,7 +530,8 @@ class Foldable t where -- @since 4.8.0.0 minimum :: forall a . Ord a => t a -> a minimum = fromMaybe (errorWithoutStackTrace "minimum: empty structure") . - getMin . foldMap (Min #. (Just :: a -> Maybe a)) + getMin . foldMap' (Min #. (Just :: a -> Maybe a)) + {-# INLINEABLE minimum #-} -- | The 'sum' function computes the sum of the numbers of a structure. -- @@ -554,7 +556,8 @@ class Foldable t where -- -- @since 4.8.0.0 sum :: Num a => t a -> a - sum = getSum #. foldMap Sum + sum = getSum #. foldMap' Sum + {-# INLINEABLE sum #-} -- | The 'product' function computes the product of the numbers of a -- structure. @@ -580,7 +583,8 @@ class Foldable t where -- -- @since 4.8.0.0 product :: Num a => t a -> a - product = getProduct #. foldMap Product + product = getProduct #. foldMap' Product + {-# INLINEABLE product #-} -- instances for Prelude types @@ -1111,10 +1115,15 @@ all p = getAll #. foldMap (All #. p) -- See Note [maximumBy/minimumBy space usage] maximumBy :: Foldable t => (a -> a -> Ordering) -> t a -> a -maximumBy cmp = foldl1 max' - where max' x y = case cmp x y of - GT -> x - _ -> y +maximumBy cmp = fromMaybe (errorWithoutStackTrace "maximumBy: empty structure") + . foldl' max' Nothing + where + max' mx y = Just $! case mx of + Nothing -> y + Just x -> case cmp x y of + GT -> x + _ -> y +{-# INLINEABLE maximumBy #-} -- | The least element of a non-empty structure with respect to the -- given comparison function. @@ -1128,10 +1137,15 @@ maximumBy cmp = foldl1 max' -- See Note [maximumBy/minimumBy space usage] minimumBy :: Foldable t => (a -> a -> Ordering) -> t a -> a -minimumBy cmp = foldl1 min' - where min' x y = case cmp x y of - GT -> y - _ -> x +minimumBy cmp = fromMaybe (errorWithoutStackTrace "minimumBy: empty structure") + . foldl' min' Nothing + where + min' mx y = Just $! case mx of + Nothing -> y + Just x -> case cmp x y of + GT -> y + _ -> x +{-# INLINEABLE minimumBy #-} -- | 'notElem' is the negation of 'elem'. -- @@ -1268,12 +1282,6 @@ proportional to the size of the data structure. For the common case of lists, this could be particularly bad (see #10830). For the common case of lists, switching the implementations of maximumBy and -minimumBy to foldl1 solves the issue, as GHC's strictness analysis can then -make these functions only use O(1) stack space. It is perhaps not the optimal -way to fix this problem, as there are other conceivable data structures -(besides lists) which might benefit from specialized implementations for -maximumBy and minimumBy (see -https://gitlab.haskell.org/ghc/ghc/issues/10830#note_129843 for a further -discussion). But using foldl1 is at least always better than using foldr1, so -GHC has chosen to adopt that approach for now. +minimumBy to foldl1 solves the issue, assuming GHC's strictness analysis can then +make these functions only use O(1) stack space. As of base 4.16, we have switched to employing foldl' over foldl1, not relying on GHC's optimiser. See https://gitlab.haskell.org/ghc/ghc/-/issues/17867 for more context. -} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0f8a4655e39bed1ca39820abdd3df9db5706b036...6af074cecdee533791943af1191541f82abc34c4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0f8a4655e39bed1ca39820abdd3df9db5706b036...6af074cecdee533791943af1191541f82abc34c4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 1 00:48:25 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 30 Nov 2020 19:48:25 -0500 Subject: [Git][ghc/ghc][master] dirty MVAR after mutating TSO queue head Message-ID: <5fc592d9e5561_86c15c5d38810919ce@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: ab334262 by Viktor Dukhovni at 2020-11-30T19:48:17-05:00 dirty MVAR after mutating TSO queue head While the original head and tail of the TSO queue may be in the same generation as the MVAR, interior elements of the queue could be younger after a GC run and may then be exposed by putMVar operation that updates the queue head. Resolves #18919 - - - - - 2 changed files: - rts/PrimOps.cmm - rts/Threads.c Changes: ===================================== rts/PrimOps.cmm ===================================== @@ -1827,9 +1827,16 @@ loop: // There are readMVar/takeMVar(s) waiting: wake up the first one tso = StgMVarTSOQueue_tso(q); - StgMVar_head(mvar) = StgMVarTSOQueue_link(q); - if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) { + q = StgMVarTSOQueue_link(q); + StgMVar_head(mvar) = q; + if (q == stg_END_TSO_QUEUE_closure) { StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure; + } else { + if (info == stg_MVAR_CLEAN_info) { + // Resolve #18919. + ccall dirty_MVAR(BaseReg "ptr", mvar "ptr", + StgMVar_value(mvar) "ptr"); + } } ASSERT(StgTSO_block_info(tso) == mvar); @@ -1854,10 +1861,8 @@ loop: // If it was a readMVar, then we can still do work, // so loop back. (XXX: This could take a while) - if (why_blocked == BlockedOnMVarRead) { - q = StgMVarTSOQueue_link(q); + if (why_blocked == BlockedOnMVarRead) goto loop; - } ASSERT(why_blocked == BlockedOnMVar); @@ -1912,9 +1917,16 @@ loop: // There are takeMVar(s) waiting: wake up the first one tso = StgMVarTSOQueue_tso(q); - StgMVar_head(mvar) = StgMVarTSOQueue_link(q); - if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) { + q = StgMVarTSOQueue_link(q); + StgMVar_head(mvar) = q; + if (q == stg_END_TSO_QUEUE_closure) { StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure; + } else { + if (info == stg_MVAR_CLEAN_info) { + // Resolve #18919. + ccall dirty_MVAR(BaseReg "ptr", mvar "ptr", + StgMVar_value(mvar) "ptr"); + } } ASSERT(StgTSO_block_info(tso) == mvar); @@ -1939,10 +1951,8 @@ loop: // If it was a readMVar, then we can still do work, // so loop back. (XXX: This could take a while) - if (why_blocked == BlockedOnMVarRead) { - q = StgMVarTSOQueue_link(q); + if (why_blocked == BlockedOnMVarRead) goto loop; - } ASSERT(why_blocked == BlockedOnMVar); ===================================== rts/Threads.c ===================================== @@ -803,9 +803,14 @@ loop: // There are takeMVar(s) waiting: wake up the first one tso = q->tso; - mvar->head = q->link; - if (mvar->head == (StgMVarTSOQueue*)&stg_END_TSO_QUEUE_closure) { + mvar->head = q = q->link; + if (q == (StgMVarTSOQueue*)&stg_END_TSO_QUEUE_closure) { mvar->tail = (StgMVarTSOQueue*)&stg_END_TSO_QUEUE_closure; + } else { + if (info == &stg_MVAR_CLEAN_info) { + // Resolve #18919. + dirty_MVAR(&cap->r, (StgClosure*)mvar, mvar->value); + } } ASSERT(tso->block_info.closure == (StgClosure*)mvar); @@ -829,10 +834,8 @@ loop: // If it was a readMVar, then we can still do work, // so loop back. (XXX: This could take a while) - if (why_blocked == BlockedOnMVarRead) { - q = ((StgMVarTSOQueue*)q)->link; + if (why_blocked == BlockedOnMVarRead) goto loop; - } ASSERT(why_blocked == BlockedOnMVar); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ab334262a605b0ebc228096d8af88a55aa5ea6b8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ab334262a605b0ebc228096d8af88a55aa5ea6b8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 1 00:49:00 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 30 Nov 2020 19:49:00 -0500 Subject: [Git][ghc/ghc][master] 4 commits: rts/linker: Don't allow shared libraries to be loaded multiple times Message-ID: <5fc592fce6fca_86cfd752bc1094678@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 5eb163f3 by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Don't allow shared libraries to be loaded multiple times - - - - - 490aa14d by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Initialise CCSs from native shared objects - - - - - 6ac3db5f by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Move shared library loading logic into Elf.c - - - - - b6698d73 by GHC GitLab CI at 2020-11-30T19:48:53-05:00 rts/linker: Don't declare dynamic objects with image_mapped This previously resulted in warnings due to spurious unmap failures. - - - - - 6 changed files: - rts/Linker.c - rts/LinkerInternals.h - rts/Profiling.c - rts/linker/Elf.c - rts/linker/Elf.h - rts/linker/PEi386Types.h Changes: ===================================== rts/Linker.c ===================================== @@ -63,7 +63,6 @@ # include "linker/Elf.h" # include // regex is already used by dlopen() so this is OK // to use here without requiring an additional lib -# include #elif defined(OBJFORMAT_PEi386) # include "linker/PEi386.h" # include @@ -170,8 +169,6 @@ Mutex linker_mutex; /* Generic wrapper function to try and Resolve and RunInit oc files */ int ocTryLoad( ObjectCode* oc ); -static void freeNativeCode_ELF (ObjectCode *nc); - /* Link objects into the lower 2Gb on x86_64 and AArch64. GHC assumes the * small memory model on this architecture (see gcc docs, * -mcmodel=small). @@ -398,7 +395,7 @@ static void *dl_prog_handle; static regex_t re_invalid; static regex_t re_realso; #if defined(THREADED_RTS) -static Mutex dl_mutex; // mutex to protect dlopen/dlerror critical section +Mutex dl_mutex; // mutex to protect dlopen/dlerror critical section #endif #endif @@ -1869,7 +1866,7 @@ HsInt purgeObj (pathchar *path) return r; } -static OStatus getObjectLoadStatus_ (pathchar *path) +OStatus getObjectLoadStatus_ (pathchar *path) { for (ObjectCode *o = objects; o; o = o->next) { if (0 == pathcmp(o->fileName, path)) { @@ -1959,126 +1956,6 @@ addSection (Section *s, SectionKind kind, SectionAlloc alloc, size, kind )); } - -# if defined(OBJFORMAT_ELF) -static int loadNativeObjCb_(struct dl_phdr_info *info, - size_t _size GNUC3_ATTRIBUTE(__unused__), void *data) { - ObjectCode* nc = (ObjectCode*) data; - - // This logic mimicks _dl_addr_inside_object from glibc - // For reference: - // int - // internal_function - // _dl_addr_inside_object (struct link_map *l, const ElfW(Addr) addr) - // { - // int n = l->l_phnum; - // const ElfW(Addr) reladdr = addr - l->l_addr; - // - // while (--n >= 0) - // if (l->l_phdr[n].p_type == PT_LOAD - // && reladdr - l->l_phdr[n].p_vaddr >= 0 - // && reladdr - l->l_phdr[n].p_vaddr < l->l_phdr[n].p_memsz) - // return 1; - // return 0; - // } - - if ((void*) info->dlpi_addr == nc->l_addr) { - int n = info->dlpi_phnum; - while (--n >= 0) { - if (info->dlpi_phdr[n].p_type == PT_LOAD) { - NativeCodeRange* ncr = - stgMallocBytes(sizeof(NativeCodeRange), "loadNativeObjCb_"); - ncr->start = (void*) ((char*) nc->l_addr + info->dlpi_phdr[n].p_vaddr); - ncr->end = (void*) ((char*) ncr->start + info->dlpi_phdr[n].p_memsz); - - ncr->next = nc->nc_ranges; - nc->nc_ranges = ncr; - } - } - } - return 0; -} - -static void copyErrmsg(char** errmsg_dest, char* errmsg) { - if (errmsg == NULL) errmsg = "loadNativeObj_ELF: unknown error"; - *errmsg_dest = stgMallocBytes(strlen(errmsg)+1, "loadNativeObj_ELF"); - strcpy(*errmsg_dest, errmsg); -} - -// need dl_mutex -static void freeNativeCode_ELF (ObjectCode *nc) { - dlclose(nc->dlopen_handle); - - NativeCodeRange *ncr = nc->nc_ranges; - while (ncr) { - NativeCodeRange* last_ncr = ncr; - ncr = ncr->next; - stgFree(last_ncr); - } -} - -static void * loadNativeObj_ELF (pathchar *path, char **errmsg) -{ - ObjectCode* nc; - void *hdl, *retval; - - IF_DEBUG(linker, debugBelch("loadNativeObj_ELF %" PATH_FMT "\n", path)); - - retval = NULL; - ACQUIRE_LOCK(&dl_mutex); - - nc = mkOc(DYNAMIC_OBJECT, path, NULL, 0, true, NULL, 0); - - foreignExportsLoadingObject(nc); - hdl = dlopen(path, RTLD_NOW|RTLD_LOCAL); - foreignExportsFinishedLoadingObject(); - if (hdl == NULL) { - /* dlopen failed; save the message in errmsg */ - copyErrmsg(errmsg, dlerror()); - goto dlopen_fail; - } - - struct link_map *map; - if (dlinfo(hdl, RTLD_DI_LINKMAP, &map) == -1) { - /* dlinfo failed; save the message in errmsg */ - copyErrmsg(errmsg, dlerror()); - goto dlinfo_fail; - } - - nc->l_addr = (void*) map->l_addr; - nc->dlopen_handle = hdl; - hdl = NULL; // pass handle ownership to nc - - dl_iterate_phdr(loadNativeObjCb_, nc); - if (!nc->nc_ranges) { - copyErrmsg(errmsg, "dl_iterate_phdr failed to find obj"); - goto dl_iterate_phdr_fail; - } - - insertOCSectionIndices(nc); - - nc->next_loaded_object = loaded_objects; - loaded_objects = nc; - - retval = nc->dlopen_handle; - goto success; - -dl_iterate_phdr_fail: - // already have dl_mutex - freeNativeCode_ELF(nc); -dlinfo_fail: - if (hdl) dlclose(hdl); -dlopen_fail: -success: - - RELEASE_LOCK(&dl_mutex); - IF_DEBUG(linker, debugBelch("loadNativeObj_ELF result=%p\n", retval)); - - return retval; -} - -# endif - #define UNUSED(x) (void)(x) void * loadNativeObj (pathchar *path, char **errmsg) ===================================== rts/LinkerInternals.h ===================================== @@ -20,8 +20,34 @@ void printLoadedObjects(void); #include "BeginPrivate.h" +/* Which object file format are we targeting? */ +#if defined(linux_HOST_OS) || defined(solaris2_HOST_OS) \ +|| defined(linux_android_HOST_OS) \ +|| defined(freebsd_HOST_OS) || defined(kfreebsdgnu_HOST_OS) \ +|| defined(dragonfly_HOST_OS) || defined(netbsd_HOST_OS) \ +|| defined(openbsd_HOST_OS) || defined(gnu_HOST_OS) +# define OBJFORMAT_ELF +#elif defined(mingw32_HOST_OS) +# define OBJFORMAT_PEi386 +#elif defined(darwin_HOST_OS) || defined(ios_HOST_OS) +# define OBJFORMAT_MACHO +#endif + typedef void SymbolAddr; typedef char SymbolName; +typedef struct _ObjectCode ObjectCode; +typedef struct _Section Section; + +#if defined(OBJFORMAT_ELF) +# include "linker/ElfTypes.h" +#elif defined(OBJFORMAT_PEi386) +# include "linker/PEi386Types.h" +#elif defined(OBJFORMAT_MACHO) +# include "linker/MachOTypes.h" +#else +# error "Unknown OBJECT_FORMAT for HOST_OS" +#endif + /* Hold extended information about a symbol in case we need to resolve it at a late stage. */ @@ -102,26 +128,24 @@ typedef enum { * and always refer to it with the 'struct' qualifier. */ -typedef - struct _Section { - void* start; /* actual start of section in memory */ - StgWord size; /* actual size of section in memory */ - SectionKind kind; - SectionAlloc alloc; - - /* - * The following fields are relevant for SECTION_MMAP sections only - */ - StgWord mapped_offset; /* offset from the image of mapped_start */ - void* mapped_start; /* start of mmap() block */ - StgWord mapped_size; /* size of mmap() block */ - - /* A customizable type to augment the Section type. - * See Note [No typedefs for customizable types] - */ - struct SectionFormatInfo* info; - } - Section; +struct _Section { + void* start; /* actual start of section in memory */ + StgWord size; /* actual size of section in memory */ + SectionKind kind; + SectionAlloc alloc; + + /* + * The following fields are relevant for SECTION_MMAP sections only + */ + StgWord mapped_offset; /* offset from the image of mapped_start */ + void* mapped_start; /* start of mmap() block */ + StgWord mapped_size; /* size of mmap() block */ + + /* A customizable type to augment the Section type. + * See Note [No typedefs for customizable types] + */ + struct SectionFormatInfo* info; +}; typedef struct _ProddableBlock { @@ -175,7 +199,7 @@ typedef enum { /* Top-level structure for an object module. One of these is allocated * for each object file in use. */ -typedef struct _ObjectCode { +struct _ObjectCode { OStatus status; pathchar *fileName; int fileSize; /* also mapped image size when using mmap() */ @@ -295,7 +319,7 @@ typedef struct _ObjectCode { /* virtual memory ranges of loaded code */ NativeCodeRange *nc_ranges; -} ObjectCode; +}; #define OC_INFORMATIVE_FILENAME(OC) \ ( (OC)->archiveMemberName ? \ @@ -306,6 +330,10 @@ typedef struct _ObjectCode { #if defined(THREADED_RTS) extern Mutex linker_mutex; + +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) +extern Mutex dl_mutex; +#endif #endif /* Type of the initializer */ @@ -388,6 +416,7 @@ resolveSymbolAddr (pathchar* buffer, int size, #endif HsInt isAlreadyLoaded( pathchar *path ); +OStatus getObjectLoadStatus_ (pathchar *path); HsInt loadOc( ObjectCode* oc ); ObjectCode* mkOc( ObjectType type, pathchar *path, char *image, int imageSize, bool mapped, pathchar *archiveMemberName, @@ -403,24 +432,6 @@ void freeSegments(ObjectCode *oc); #define MAP_ANONYMOUS MAP_ANON #endif -/* Which object file format are we targeting? */ -#if defined(linux_HOST_OS) || defined(solaris2_HOST_OS) \ -|| defined(linux_android_HOST_OS) \ -|| defined(freebsd_HOST_OS) || defined(kfreebsdgnu_HOST_OS) \ -|| defined(dragonfly_HOST_OS) || defined(netbsd_HOST_OS) \ -|| defined(openbsd_HOST_OS) || defined(gnu_HOST_OS) -# define OBJFORMAT_ELF -# include "linker/ElfTypes.h" -#elif defined(mingw32_HOST_OS) -# define OBJFORMAT_PEi386 -# include "linker/PEi386Types.h" -#elif defined(darwin_HOST_OS) || defined(ios_HOST_OS) -# define OBJFORMAT_MACHO -# include "linker/MachOTypes.h" -#else -#error "Unknown OBJECT_FORMAT for HOST_OS" -#endif - /* In order to simplify control flow a bit, some references to mmap-related definitions are blocked off by a C-level if statement rather than a CPP-level #if statement. Since those are dead branches when !RTS_LINKER_USE_MMAP, we ===================================== rts/Profiling.c ===================================== @@ -54,7 +54,7 @@ FILE *prof_file; // List of all cost centres. Used for reporting. CostCentre *CC_LIST = NULL; // All cost centre stacks temporarily appear here, to be able to make CCS_MAIN a -// parent of all cost centres stacks (done in initProfiling2()). +// parent of all cost centres stacks (done in refreshProfilingCCSs()). static CostCentreStack *CCS_LIST = NULL; #if defined(THREADED_RTS) ===================================== rts/linker/Elf.c ===================================== @@ -15,15 +15,20 @@ #include "RtsUtils.h" #include "RtsSymbolInfo.h" +#include "CheckUnload.h" +#include "LinkerInternals.h" #include "linker/Elf.h" #include "linker/CacheFlush.h" #include "linker/M32Alloc.h" #include "linker/SymbolExtras.h" +#include "ForeignExports.h" +#include "Profiling.h" #include "sm/OSMem.h" #include "GetEnv.h" #include "linker/util.h" #include "linker/elf_util.h" +#include #include #include #if defined(HAVE_SYS_STAT_H) @@ -1969,6 +1974,143 @@ int ocRunInit_ELF( ObjectCode *oc ) return 1; } +/* + * Shared object loading + */ + +static int loadNativeObjCb_(struct dl_phdr_info *info, + size_t _size GNUC3_ATTRIBUTE(__unused__), void *data) { + ObjectCode* nc = (ObjectCode*) data; + + // This logic mimicks _dl_addr_inside_object from glibc + // For reference: + // int + // internal_function + // _dl_addr_inside_object (struct link_map *l, const ElfW(Addr) addr) + // { + // int n = l->l_phnum; + // const ElfW(Addr) reladdr = addr - l->l_addr; + // + // while (--n >= 0) + // if (l->l_phdr[n].p_type == PT_LOAD + // && reladdr - l->l_phdr[n].p_vaddr >= 0 + // && reladdr - l->l_phdr[n].p_vaddr < l->l_phdr[n].p_memsz) + // return 1; + // return 0; + // } + + if ((void*) info->dlpi_addr == nc->l_addr) { + int n = info->dlpi_phnum; + while (--n >= 0) { + if (info->dlpi_phdr[n].p_type == PT_LOAD) { + NativeCodeRange* ncr = + stgMallocBytes(sizeof(NativeCodeRange), "loadNativeObjCb_"); + ncr->start = (void*) ((char*) nc->l_addr + info->dlpi_phdr[n].p_vaddr); + ncr->end = (void*) ((char*) ncr->start + info->dlpi_phdr[n].p_memsz); + + ncr->next = nc->nc_ranges; + nc->nc_ranges = ncr; + } + } + } + return 0; +} + +static void copyErrmsg(char** errmsg_dest, char* errmsg) { + if (errmsg == NULL) errmsg = "loadNativeObj_ELF: unknown error"; + *errmsg_dest = stgMallocBytes(strlen(errmsg)+1, "loadNativeObj_ELF"); + strcpy(*errmsg_dest, errmsg); +} + +// need dl_mutex +void freeNativeCode_ELF (ObjectCode *nc) { + dlclose(nc->dlopen_handle); + + NativeCodeRange *ncr = nc->nc_ranges; + while (ncr) { + NativeCodeRange* last_ncr = ncr; + ncr = ncr->next; + stgFree(last_ncr); + } +} + +void * loadNativeObj_ELF (pathchar *path, char **errmsg) +{ + ObjectCode* nc; + void *hdl, *retval; + + IF_DEBUG(linker, debugBelch("loadNativeObj_ELF %" PATH_FMT "\n", path)); + + retval = NULL; + ACQUIRE_LOCK(&dl_mutex); + + /* Loading the same object multiple times will lead to chaos + * as we will have two ObjectCodes but one underlying dlopen + * handle. Fail if this happens. + */ + if (getObjectLoadStatus_(path) != OBJECT_NOT_LOADED) { + copyErrmsg(errmsg, "loadNativeObj_ELF: Already loaded"); + goto dlopen_fail; + } + + nc = mkOc(DYNAMIC_OBJECT, path, NULL, 0, false, NULL, 0); + + foreignExportsLoadingObject(nc); + hdl = dlopen(path, RTLD_NOW|RTLD_LOCAL); + foreignExportsFinishedLoadingObject(); + if (hdl == NULL) { + /* dlopen failed; save the message in errmsg */ + copyErrmsg(errmsg, dlerror()); + goto dlopen_fail; + } + + struct link_map *map; + if (dlinfo(hdl, RTLD_DI_LINKMAP, &map) == -1) { + /* dlinfo failed; save the message in errmsg */ + copyErrmsg(errmsg, dlerror()); + goto dlinfo_fail; + } + + nc->l_addr = (void*) map->l_addr; + nc->dlopen_handle = hdl; + hdl = NULL; // pass handle ownership to nc + + dl_iterate_phdr(loadNativeObjCb_, nc); + if (!nc->nc_ranges) { + copyErrmsg(errmsg, "dl_iterate_phdr failed to find obj"); + goto dl_iterate_phdr_fail; + } + + insertOCSectionIndices(nc); + + nc->next_loaded_object = loaded_objects; + loaded_objects = nc; + + retval = nc->dlopen_handle; + +#if defined(PROFILING) + // collect any new cost centres that were defined in the loaded object. + refreshProfilingCCSs(); +#endif + + goto success; + +dl_iterate_phdr_fail: + // already have dl_mutex + freeNativeCode_ELF(nc); +dlinfo_fail: + if (hdl) dlclose(hdl); +dlopen_fail: +success: + + RELEASE_LOCK(&dl_mutex); + + IF_DEBUG(linker, debugBelch("loadNativeObj_ELF result=%p\n", retval)); + + return retval; +} + + /* * PowerPC & X86_64 ELF specifics */ ===================================== rts/linker/Elf.h ===================================== @@ -14,5 +14,7 @@ int ocGetNames_ELF ( ObjectCode* oc ); int ocResolve_ELF ( ObjectCode* oc ); int ocRunInit_ELF ( ObjectCode* oc ); int ocAllocateExtras_ELF ( ObjectCode *oc ); +void freeNativeCode_ELF ( ObjectCode *nc ); +void *loadNativeObj_ELF ( pathchar *path, char **errmsg ); #include "EndPrivate.h" ===================================== rts/linker/PEi386Types.h ===================================== @@ -7,10 +7,6 @@ #include #include -/* Some forward declares. */ -struct Section; - - struct SectionFormatInfo { char* name; size_t alignment; View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ab334262a605b0ebc228096d8af88a55aa5ea6b8...b6698d73fa9811795ca37ba0b704aa430c390345 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ab334262a605b0ebc228096d8af88a55aa5ea6b8...b6698d73fa9811795ca37ba0b704aa430c390345 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 1 00:49:38 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 30 Nov 2020 19:49:38 -0500 Subject: [Git][ghc/ghc][master] Include tried paths in findToolDir error Message-ID: <5fc59322b40e1_86c15c5d3881097549@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: b94a65af by jneira at 2020-11-30T19:49:31-05:00 Include tried paths in findToolDir error - - - - - 1 changed file: - compiler/GHC/SysTools/BaseDir.hs Changes: ===================================== compiler/GHC/SysTools/BaseDir.hs ===================================== @@ -185,17 +185,19 @@ findToolDir :: FilePath -- ^ topdir -> IO (Maybe FilePath) #if defined(mingw32_HOST_OS) && !defined(USE_INPLACE_MINGW_TOOLCHAIN) -findToolDir top_dir = go 0 (top_dir "..") +findToolDir top_dir = go 0 (top_dir "..") [] where maxDepth = 3 - go :: Int -> FilePath -> IO (Maybe FilePath) - go k path + go :: Int -> FilePath -> [FilePath] -> IO (Maybe FilePath) + go k path tried | k == maxDepth = throwGhcExceptionIO $ - InstallationError "could not detect mingw toolchain" + InstallationError $ "could not detect mingw toolchain in the following paths: " ++ show tried | otherwise = do - oneLevel <- doesDirectoryExist (path "mingw") + let try = path "mingw" + let tried = tried ++ [try] + oneLevel <- doesDirectoryExist try if oneLevel then return (Just path) - else go (k+1) (path "..") + else go (k+1) (path "..") tried #else findToolDir _ = return Nothing #endif View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b94a65afe1e270245cd5b9fe03d59b726dfba8c4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b94a65afe1e270245cd5b9fe03d59b726dfba8c4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 1 01:18:07 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 30 Nov 2020 20:18:07 -0500 Subject: [Git][ghc/ghc][wip/win32-m32] 14 commits: Optimisations in Data.Foldable (T17867) Message-ID: <5fc599cf204cc_86c879fa9c11009e4@gitlab.mail> Ben Gamari pushed to branch wip/win32-m32 at Glasgow Haskell Compiler / GHC Commits: 49ebe369 by chessai at 2020-11-30T19:47:40-05:00 Optimisations in Data.Foldable (T17867) This PR concerns the following functions from `Data.Foldable`: * minimum * maximum * sum * product * minimumBy * maximumBy - Default implementations of these functions now use `foldl'` or `foldMap'`. - All have been marked with INLINEABLE to make room for further optimisations. - - - - - 4d79ef65 by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - 6af074ce by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - ab334262 by Viktor Dukhovni at 2020-11-30T19:48:17-05:00 dirty MVAR after mutating TSO queue head While the original head and tail of the TSO queue may be in the same generation as the MVAR, interior elements of the queue could be younger after a GC run and may then be exposed by putMVar operation that updates the queue head. Resolves #18919 - - - - - 5eb163f3 by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Don't allow shared libraries to be loaded multiple times - - - - - 490aa14d by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Initialise CCSs from native shared objects - - - - - 6ac3db5f by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Move shared library loading logic into Elf.c - - - - - b6698d73 by GHC GitLab CI at 2020-11-30T19:48:53-05:00 rts/linker: Don't declare dynamic objects with image_mapped This previously resulted in warnings due to spurious unmap failures. - - - - - b94a65af by jneira at 2020-11-30T19:49:31-05:00 Include tried paths in findToolDir error - - - - - 5f343e52 by Ben Gamari at 2020-11-30T20:18:01-05:00 rts: Introduce mmapAnonForLinker Previously most of the uses of mmapForLinker were mapping anonymous memory, resulting in a great deal of unnecessary repetition. Factor this out into a new helper. Also fixes a few places where error checking was missing or suboptimal. - - - - - 5cec6c99 by Ben Gamari at 2020-11-30T20:18:01-05:00 rts/linker: Introduce munmapForLinker Consolidates munmap calls to ensure consistent error handling. - - - - - af713c50 by Ben Gamari at 2020-11-30T20:18:01-05:00 rts/Linker: Introduce Windows implementations for mmapForLinker, et al. - - - - - 52d40ae1 by Ben Gamari at 2020-11-30T20:18:01-05:00 rts/m32: Introduce NEEDS_M32 macro Instead of relying on RTS_LINKER_USE_MMAP - - - - - ac2c9225 by Ben Gamari at 2020-11-30T20:18:01-05:00 rts/linker: Use m32 to allocate symbol extras in PEi386 - - - - - 17 changed files: - compiler/GHC/SysTools/BaseDir.hs - libraries/base/Data/Foldable.hs - rts/Linker.c - rts/LinkerInternals.h - rts/PrimOps.cmm - rts/Profiling.c - rts/Threads.c - rts/linker/Elf.c - rts/linker/Elf.h - rts/linker/LoadArchive.c - rts/linker/M32Alloc.c - rts/linker/M32Alloc.h - rts/linker/MachO.c - rts/linker/PEi386.c - rts/linker/PEi386Types.h - rts/linker/SymbolExtras.c - rts/linker/elf_got.c Changes: ===================================== compiler/GHC/SysTools/BaseDir.hs ===================================== @@ -185,17 +185,19 @@ findToolDir :: FilePath -- ^ topdir -> IO (Maybe FilePath) #if defined(mingw32_HOST_OS) && !defined(USE_INPLACE_MINGW_TOOLCHAIN) -findToolDir top_dir = go 0 (top_dir "..") +findToolDir top_dir = go 0 (top_dir "..") [] where maxDepth = 3 - go :: Int -> FilePath -> IO (Maybe FilePath) - go k path + go :: Int -> FilePath -> [FilePath] -> IO (Maybe FilePath) + go k path tried | k == maxDepth = throwGhcExceptionIO $ - InstallationError "could not detect mingw toolchain" + InstallationError $ "could not detect mingw toolchain in the following paths: " ++ show tried | otherwise = do - oneLevel <- doesDirectoryExist (path "mingw") + let try = path "mingw" + let tried = tried ++ [try] + oneLevel <- doesDirectoryExist try if oneLevel then return (Just path) - else go (k+1) (path "..") + else go (k+1) (path "..") tried #else findToolDir _ = return Nothing #endif ===================================== libraries/base/Data/Foldable.hs ===================================== @@ -507,7 +507,8 @@ class Foldable t where -- @since 4.8.0.0 maximum :: forall a . Ord a => t a -> a maximum = fromMaybe (errorWithoutStackTrace "maximum: empty structure") . - getMax . foldMap (Max #. (Just :: a -> Maybe a)) + getMax . foldMap' (Max #. (Just :: a -> Maybe a)) + {-# INLINEABLE maximum #-} -- | The least element of a non-empty structure. -- @@ -529,7 +530,8 @@ class Foldable t where -- @since 4.8.0.0 minimum :: forall a . Ord a => t a -> a minimum = fromMaybe (errorWithoutStackTrace "minimum: empty structure") . - getMin . foldMap (Min #. (Just :: a -> Maybe a)) + getMin . foldMap' (Min #. (Just :: a -> Maybe a)) + {-# INLINEABLE minimum #-} -- | The 'sum' function computes the sum of the numbers of a structure. -- @@ -554,7 +556,8 @@ class Foldable t where -- -- @since 4.8.0.0 sum :: Num a => t a -> a - sum = getSum #. foldMap Sum + sum = getSum #. foldMap' Sum + {-# INLINEABLE sum #-} -- | The 'product' function computes the product of the numbers of a -- structure. @@ -580,7 +583,8 @@ class Foldable t where -- -- @since 4.8.0.0 product :: Num a => t a -> a - product = getProduct #. foldMap Product + product = getProduct #. foldMap' Product + {-# INLINEABLE product #-} -- instances for Prelude types @@ -1111,10 +1115,15 @@ all p = getAll #. foldMap (All #. p) -- See Note [maximumBy/minimumBy space usage] maximumBy :: Foldable t => (a -> a -> Ordering) -> t a -> a -maximumBy cmp = foldl1 max' - where max' x y = case cmp x y of - GT -> x - _ -> y +maximumBy cmp = fromMaybe (errorWithoutStackTrace "maximumBy: empty structure") + . foldl' max' Nothing + where + max' mx y = Just $! case mx of + Nothing -> y + Just x -> case cmp x y of + GT -> x + _ -> y +{-# INLINEABLE maximumBy #-} -- | The least element of a non-empty structure with respect to the -- given comparison function. @@ -1128,10 +1137,15 @@ maximumBy cmp = foldl1 max' -- See Note [maximumBy/minimumBy space usage] minimumBy :: Foldable t => (a -> a -> Ordering) -> t a -> a -minimumBy cmp = foldl1 min' - where min' x y = case cmp x y of - GT -> y - _ -> x +minimumBy cmp = fromMaybe (errorWithoutStackTrace "minimumBy: empty structure") + . foldl' min' Nothing + where + min' mx y = Just $! case mx of + Nothing -> y + Just x -> case cmp x y of + GT -> y + _ -> x +{-# INLINEABLE minimumBy #-} -- | 'notElem' is the negation of 'elem'. -- @@ -1268,12 +1282,6 @@ proportional to the size of the data structure. For the common case of lists, this could be particularly bad (see #10830). For the common case of lists, switching the implementations of maximumBy and -minimumBy to foldl1 solves the issue, as GHC's strictness analysis can then -make these functions only use O(1) stack space. It is perhaps not the optimal -way to fix this problem, as there are other conceivable data structures -(besides lists) which might benefit from specialized implementations for -maximumBy and minimumBy (see -https://gitlab.haskell.org/ghc/ghc/issues/10830#note_129843 for a further -discussion). But using foldl1 is at least always better than using foldr1, so -GHC has chosen to adopt that approach for now. +minimumBy to foldl1 solves the issue, assuming GHC's strictness analysis can then +make these functions only use O(1) stack space. As of base 4.16, we have switched to employing foldl' over foldl1, not relying on GHC's optimiser. See https://gitlab.haskell.org/ghc/ghc/-/issues/17867 for more context. -} ===================================== rts/Linker.c ===================================== @@ -45,6 +45,8 @@ #include #endif +#include +#include #include #include #include @@ -63,7 +65,6 @@ # include "linker/Elf.h" # include // regex is already used by dlopen() so this is OK // to use here without requiring an additional lib -# include #elif defined(OBJFORMAT_PEi386) # include "linker/PEi386.h" # include @@ -170,8 +171,6 @@ Mutex linker_mutex; /* Generic wrapper function to try and Resolve and RunInit oc files */ int ocTryLoad( ObjectCode* oc ); -static void freeNativeCode_ELF (ObjectCode *nc); - /* Link objects into the lower 2Gb on x86_64 and AArch64. GHC assumes the * small memory model on this architecture (see gcc docs, * -mcmodel=small). @@ -398,7 +397,7 @@ static void *dl_prog_handle; static regex_t re_invalid; static regex_t re_realso; #if defined(THREADED_RTS) -static Mutex dl_mutex; // mutex to protect dlopen/dlerror critical section +Mutex dl_mutex; // mutex to protect dlopen/dlerror critical section #endif #endif @@ -1024,7 +1023,38 @@ resolveSymbolAddr (pathchar* buffer, int size, #endif /* OBJFORMAT_PEi386 */ } -#if RTS_LINKER_USE_MMAP +#if defined(mingw32_HOST_OS) + +// +// Returns NULL on failure. +// +void * +mmapAnonForLinker (size_t bytes) +{ + return VirtualAlloc(NULL, bytes, MEM_COMMIT | MEM_RESERVE, PAGE_READWRITE); +} + +void +munmapForLinker (void *addr, size_t bytes, const char *caller) +{ + if (VirtualFree(addr, 0, MEM_RELEASE) == 0) { + sysErrorBelch("munmapForLinker: %s: Failed to unmap %zd bytes at %p", + caller, bytes, addr); + } +} + +void +mmapForLinkerMarkExecutable(void *start, size_t len) +{ + DWORD old; + if (VirtualProtect(start, len, PAGE_EXECUTE_READ, &old) == 0) { + sysErrorBelch("mmapForLinkerMarkExecutable: failed to protect %zd bytes at %p", + len, start); + ASSERT(false); + } +} + +#elif RTS_LINKER_USE_MMAP // // Returns NULL on failure. // @@ -1083,7 +1113,7 @@ mmap_again: fixed = MAP_FIXED; goto mmap_again; #else - errorBelch("loadObj: failed to mmap() memory below 2Gb; " + errorBelch("mmapForLinker: failed to mmap() memory below 2Gb; " "asked for %lu bytes at %p. " "Try specifying an address with +RTS -xm -RTS", size, map_addr); @@ -1143,6 +1173,24 @@ mmap_again: return result; } +/* + * Map read/write pages in low memory. Returns NULL on failure. + */ +void * +mmapAnonForLinker (size_t bytes) +{ + return mmapForLinker (bytes, PROT_READ|PROT_WRITE, MAP_ANONYMOUS, -1, 0); +} + +void munmapForLinker (void *addr, size_t bytes, const char *caller) +{ + int r = munmap(addr, bytes); + if (r == -1) { + // Should we abort here? + sysErrorBelch("munmap: %s", caller); + } +} + /* Note [Memory protection in the linker] * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ * For many years the linker would simply map all of its memory @@ -1158,8 +1206,9 @@ mmap_again: * Note that the m32 allocator handles protection of its allocations. For this * reason the caller to m32_alloc() must tell the allocator whether the * allocation needs to be executable. The caller must then ensure that they - * call m32_flush() after they are finished filling the region, which will - * cause the allocator to change the protection bits to PROT_READ|PROT_EXEC. + * call m32_allocator_flush() after they are finished filling the region, which + * will cause the allocator to change the protection bits to + * PROT_READ|PROT_EXEC. * */ @@ -1228,7 +1277,7 @@ freePreloadObjectFile (ObjectCode *oc) #else if (RTS_LINKER_USE_MMAP && oc->imageMapped) { - munmap(oc->image, oc->fileSize); + munmapForLinker(oc->image, oc->fileSize, "freePreloadObjectFile"); } else { stgFree(oc->image); @@ -1276,13 +1325,15 @@ void freeObjectCode (ObjectCode *oc) switch(oc->sections[i].alloc){ #if RTS_LINKER_USE_MMAP case SECTION_MMAP: - munmap(oc->sections[i].mapped_start, - oc->sections[i].mapped_size); + munmapForLinker( + oc->sections[i].mapped_start, + oc->sections[i].mapped_size, + "freeObjectCode"); break; +#endif case SECTION_M32: // Freed by m32_allocator_free break; -#endif case SECTION_MALLOC: IF_DEBUG(zero_on_gc, memset(oc->sections[i].start, @@ -1325,7 +1376,7 @@ void freeObjectCode (ObjectCode *oc) ocDeinit_ELF(oc); #endif -#if RTS_LINKER_USE_MMAP == 1 +#if defined(NEED_M32) m32_allocator_free(oc->rx_m32); m32_allocator_free(oc->rw_m32); #endif @@ -1403,7 +1454,7 @@ mkOc( ObjectType type, pathchar *path, char *image, int imageSize, oc->mark = object_code_mark_bit; oc->dependencies = allocHashSet(); -#if RTS_LINKER_USE_MMAP +#if defined(NEED_M32) oc->rw_m32 = m32_allocator_new(false); oc->rx_m32 = m32_allocator_new(true); #endif @@ -1740,7 +1791,7 @@ int ocTryLoad (ObjectCode* oc) { // We have finished loading and relocating; flush the m32 allocators to // setup page protections. -#if RTS_LINKER_USE_MMAP +#if defined(NEED_M32) m32_allocator_flush(oc->rx_m32); m32_allocator_flush(oc->rw_m32); #endif @@ -1869,7 +1920,7 @@ HsInt purgeObj (pathchar *path) return r; } -static OStatus getObjectLoadStatus_ (pathchar *path) +OStatus getObjectLoadStatus_ (pathchar *path) { for (ObjectCode *o = objects; o; o = o->next) { if (0 == pathcmp(o->fileName, path)) { @@ -1959,126 +2010,6 @@ addSection (Section *s, SectionKind kind, SectionAlloc alloc, size, kind )); } - -# if defined(OBJFORMAT_ELF) -static int loadNativeObjCb_(struct dl_phdr_info *info, - size_t _size GNUC3_ATTRIBUTE(__unused__), void *data) { - ObjectCode* nc = (ObjectCode*) data; - - // This logic mimicks _dl_addr_inside_object from glibc - // For reference: - // int - // internal_function - // _dl_addr_inside_object (struct link_map *l, const ElfW(Addr) addr) - // { - // int n = l->l_phnum; - // const ElfW(Addr) reladdr = addr - l->l_addr; - // - // while (--n >= 0) - // if (l->l_phdr[n].p_type == PT_LOAD - // && reladdr - l->l_phdr[n].p_vaddr >= 0 - // && reladdr - l->l_phdr[n].p_vaddr < l->l_phdr[n].p_memsz) - // return 1; - // return 0; - // } - - if ((void*) info->dlpi_addr == nc->l_addr) { - int n = info->dlpi_phnum; - while (--n >= 0) { - if (info->dlpi_phdr[n].p_type == PT_LOAD) { - NativeCodeRange* ncr = - stgMallocBytes(sizeof(NativeCodeRange), "loadNativeObjCb_"); - ncr->start = (void*) ((char*) nc->l_addr + info->dlpi_phdr[n].p_vaddr); - ncr->end = (void*) ((char*) ncr->start + info->dlpi_phdr[n].p_memsz); - - ncr->next = nc->nc_ranges; - nc->nc_ranges = ncr; - } - } - } - return 0; -} - -static void copyErrmsg(char** errmsg_dest, char* errmsg) { - if (errmsg == NULL) errmsg = "loadNativeObj_ELF: unknown error"; - *errmsg_dest = stgMallocBytes(strlen(errmsg)+1, "loadNativeObj_ELF"); - strcpy(*errmsg_dest, errmsg); -} - -// need dl_mutex -static void freeNativeCode_ELF (ObjectCode *nc) { - dlclose(nc->dlopen_handle); - - NativeCodeRange *ncr = nc->nc_ranges; - while (ncr) { - NativeCodeRange* last_ncr = ncr; - ncr = ncr->next; - stgFree(last_ncr); - } -} - -static void * loadNativeObj_ELF (pathchar *path, char **errmsg) -{ - ObjectCode* nc; - void *hdl, *retval; - - IF_DEBUG(linker, debugBelch("loadNativeObj_ELF %" PATH_FMT "\n", path)); - - retval = NULL; - ACQUIRE_LOCK(&dl_mutex); - - nc = mkOc(DYNAMIC_OBJECT, path, NULL, 0, true, NULL, 0); - - foreignExportsLoadingObject(nc); - hdl = dlopen(path, RTLD_NOW|RTLD_LOCAL); - foreignExportsFinishedLoadingObject(); - if (hdl == NULL) { - /* dlopen failed; save the message in errmsg */ - copyErrmsg(errmsg, dlerror()); - goto dlopen_fail; - } - - struct link_map *map; - if (dlinfo(hdl, RTLD_DI_LINKMAP, &map) == -1) { - /* dlinfo failed; save the message in errmsg */ - copyErrmsg(errmsg, dlerror()); - goto dlinfo_fail; - } - - nc->l_addr = (void*) map->l_addr; - nc->dlopen_handle = hdl; - hdl = NULL; // pass handle ownership to nc - - dl_iterate_phdr(loadNativeObjCb_, nc); - if (!nc->nc_ranges) { - copyErrmsg(errmsg, "dl_iterate_phdr failed to find obj"); - goto dl_iterate_phdr_fail; - } - - insertOCSectionIndices(nc); - - nc->next_loaded_object = loaded_objects; - loaded_objects = nc; - - retval = nc->dlopen_handle; - goto success; - -dl_iterate_phdr_fail: - // already have dl_mutex - freeNativeCode_ELF(nc); -dlinfo_fail: - if (hdl) dlclose(hdl); -dlopen_fail: -success: - - RELEASE_LOCK(&dl_mutex); - IF_DEBUG(linker, debugBelch("loadNativeObj_ELF result=%p\n", retval)); - - return retval; -} - -# endif - #define UNUSED(x) (void)(x) void * loadNativeObj (pathchar *path, char **errmsg) @@ -2166,7 +2097,7 @@ void freeSegments (ObjectCode *oc) continue; } else { #if RTS_LINKER_USE_MMAP - CHECKM(0 == munmap(s->start, s->size), "freeSegments: failed to unmap memory"); + munmapForLinker(s->start, s->size, "freeSegments"); #else stgFree(s->start); #endif ===================================== rts/LinkerInternals.h ===================================== @@ -20,8 +20,34 @@ void printLoadedObjects(void); #include "BeginPrivate.h" +/* Which object file format are we targeting? */ +#if defined(linux_HOST_OS) || defined(solaris2_HOST_OS) \ +|| defined(linux_android_HOST_OS) \ +|| defined(freebsd_HOST_OS) || defined(kfreebsdgnu_HOST_OS) \ +|| defined(dragonfly_HOST_OS) || defined(netbsd_HOST_OS) \ +|| defined(openbsd_HOST_OS) || defined(gnu_HOST_OS) +# define OBJFORMAT_ELF +#elif defined(mingw32_HOST_OS) +# define OBJFORMAT_PEi386 +#elif defined(darwin_HOST_OS) || defined(ios_HOST_OS) +# define OBJFORMAT_MACHO +#endif + typedef void SymbolAddr; typedef char SymbolName; +typedef struct _ObjectCode ObjectCode; +typedef struct _Section Section; + +#if defined(OBJFORMAT_ELF) +# include "linker/ElfTypes.h" +#elif defined(OBJFORMAT_PEi386) +# include "linker/PEi386Types.h" +#elif defined(OBJFORMAT_MACHO) +# include "linker/MachOTypes.h" +#else +# error "Unknown OBJECT_FORMAT for HOST_OS" +#endif + /* Hold extended information about a symbol in case we need to resolve it at a late stage. */ @@ -102,26 +128,24 @@ typedef enum { * and always refer to it with the 'struct' qualifier. */ -typedef - struct _Section { - void* start; /* actual start of section in memory */ - StgWord size; /* actual size of section in memory */ - SectionKind kind; - SectionAlloc alloc; - - /* - * The following fields are relevant for SECTION_MMAP sections only - */ - StgWord mapped_offset; /* offset from the image of mapped_start */ - void* mapped_start; /* start of mmap() block */ - StgWord mapped_size; /* size of mmap() block */ - - /* A customizable type to augment the Section type. - * See Note [No typedefs for customizable types] - */ - struct SectionFormatInfo* info; - } - Section; +struct _Section { + void* start; /* actual start of section in memory */ + StgWord size; /* actual size of section in memory */ + SectionKind kind; + SectionAlloc alloc; + + /* + * The following fields are relevant for SECTION_MMAP sections only + */ + StgWord mapped_offset; /* offset from the image of mapped_start */ + void* mapped_start; /* start of mmap() block */ + StgWord mapped_size; /* size of mmap() block */ + + /* A customizable type to augment the Section type. + * See Note [No typedefs for customizable types] + */ + struct SectionFormatInfo* info; +}; typedef struct _ProddableBlock { @@ -145,6 +169,14 @@ typedef struct _Segment { #define NEED_SYMBOL_EXTRAS 1 #endif +/* + * We use the m32 allocator for symbol extras on Windows and other mmap-using + * platforms. + */ +#if RTS_LINKER_USE_MMAP || defined(mingw32_HOST_ARCH) +#define NEED_M32 1 +#endif + /* Jump Islands are sniplets of machine code required for relative * address relocations on the PowerPC, x86_64 and ARM. */ @@ -175,7 +207,7 @@ typedef enum { /* Top-level structure for an object module. One of these is allocated * for each object file in use. */ -typedef struct _ObjectCode { +struct _ObjectCode { OStatus status; pathchar *fileName; int fileSize; /* also mapped image size when using mmap() */ @@ -276,7 +308,7 @@ typedef struct _ObjectCode { require extra information.*/ StrHashTable *extraInfos; -#if RTS_LINKER_USE_MMAP == 1 +#if defined(NEED_M32) /* The m32 allocators used for allocating small sections and symbol extras * during loading. We have two: one for (writeable) data and one for * (read-only/executable) code. */ @@ -295,7 +327,7 @@ typedef struct _ObjectCode { /* virtual memory ranges of loaded code */ NativeCodeRange *nc_ranges; -} ObjectCode; +}; #define OC_INFORMATIVE_FILENAME(OC) \ ( (OC)->archiveMemberName ? \ @@ -306,6 +338,10 @@ typedef struct _ObjectCode { #if defined(THREADED_RTS) extern Mutex linker_mutex; + +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) +extern Mutex dl_mutex; +#endif #endif /* Type of the initializer */ @@ -334,8 +370,10 @@ void exitLinker( void ); void freeObjectCode (ObjectCode *oc); SymbolAddr* loadSymbol(SymbolName *lbl, RtsSymbolInfo *pinfo); +void *mmapAnonForLinker (size_t bytes); void *mmapForLinker (size_t bytes, uint32_t prot, uint32_t flags, int fd, int offset); void mmapForLinkerMarkExecutable (void *start, size_t len); +void munmapForLinker (void *addr, size_t bytes, const char *caller); void addProddableBlock ( ObjectCode* oc, void* start, int size ); void checkProddableBlock (ObjectCode *oc, void *addr, size_t size ); @@ -388,6 +426,7 @@ resolveSymbolAddr (pathchar* buffer, int size, #endif HsInt isAlreadyLoaded( pathchar *path ); +OStatus getObjectLoadStatus_ (pathchar *path); HsInt loadOc( ObjectCode* oc ); ObjectCode* mkOc( ObjectType type, pathchar *path, char *image, int imageSize, bool mapped, pathchar *archiveMemberName, @@ -403,24 +442,6 @@ void freeSegments(ObjectCode *oc); #define MAP_ANONYMOUS MAP_ANON #endif -/* Which object file format are we targeting? */ -#if defined(linux_HOST_OS) || defined(solaris2_HOST_OS) \ -|| defined(linux_android_HOST_OS) \ -|| defined(freebsd_HOST_OS) || defined(kfreebsdgnu_HOST_OS) \ -|| defined(dragonfly_HOST_OS) || defined(netbsd_HOST_OS) \ -|| defined(openbsd_HOST_OS) || defined(gnu_HOST_OS) -# define OBJFORMAT_ELF -# include "linker/ElfTypes.h" -#elif defined(mingw32_HOST_OS) -# define OBJFORMAT_PEi386 -# include "linker/PEi386Types.h" -#elif defined(darwin_HOST_OS) || defined(ios_HOST_OS) -# define OBJFORMAT_MACHO -# include "linker/MachOTypes.h" -#else -#error "Unknown OBJECT_FORMAT for HOST_OS" -#endif - /* In order to simplify control flow a bit, some references to mmap-related definitions are blocked off by a C-level if statement rather than a CPP-level #if statement. Since those are dead branches when !RTS_LINKER_USE_MMAP, we ===================================== rts/PrimOps.cmm ===================================== @@ -1827,9 +1827,16 @@ loop: // There are readMVar/takeMVar(s) waiting: wake up the first one tso = StgMVarTSOQueue_tso(q); - StgMVar_head(mvar) = StgMVarTSOQueue_link(q); - if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) { + q = StgMVarTSOQueue_link(q); + StgMVar_head(mvar) = q; + if (q == stg_END_TSO_QUEUE_closure) { StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure; + } else { + if (info == stg_MVAR_CLEAN_info) { + // Resolve #18919. + ccall dirty_MVAR(BaseReg "ptr", mvar "ptr", + StgMVar_value(mvar) "ptr"); + } } ASSERT(StgTSO_block_info(tso) == mvar); @@ -1854,10 +1861,8 @@ loop: // If it was a readMVar, then we can still do work, // so loop back. (XXX: This could take a while) - if (why_blocked == BlockedOnMVarRead) { - q = StgMVarTSOQueue_link(q); + if (why_blocked == BlockedOnMVarRead) goto loop; - } ASSERT(why_blocked == BlockedOnMVar); @@ -1912,9 +1917,16 @@ loop: // There are takeMVar(s) waiting: wake up the first one tso = StgMVarTSOQueue_tso(q); - StgMVar_head(mvar) = StgMVarTSOQueue_link(q); - if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) { + q = StgMVarTSOQueue_link(q); + StgMVar_head(mvar) = q; + if (q == stg_END_TSO_QUEUE_closure) { StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure; + } else { + if (info == stg_MVAR_CLEAN_info) { + // Resolve #18919. + ccall dirty_MVAR(BaseReg "ptr", mvar "ptr", + StgMVar_value(mvar) "ptr"); + } } ASSERT(StgTSO_block_info(tso) == mvar); @@ -1939,10 +1951,8 @@ loop: // If it was a readMVar, then we can still do work, // so loop back. (XXX: This could take a while) - if (why_blocked == BlockedOnMVarRead) { - q = StgMVarTSOQueue_link(q); + if (why_blocked == BlockedOnMVarRead) goto loop; - } ASSERT(why_blocked == BlockedOnMVar); ===================================== rts/Profiling.c ===================================== @@ -54,7 +54,7 @@ FILE *prof_file; // List of all cost centres. Used for reporting. CostCentre *CC_LIST = NULL; // All cost centre stacks temporarily appear here, to be able to make CCS_MAIN a -// parent of all cost centres stacks (done in initProfiling2()). +// parent of all cost centres stacks (done in refreshProfilingCCSs()). static CostCentreStack *CCS_LIST = NULL; #if defined(THREADED_RTS) ===================================== rts/Threads.c ===================================== @@ -803,9 +803,14 @@ loop: // There are takeMVar(s) waiting: wake up the first one tso = q->tso; - mvar->head = q->link; - if (mvar->head == (StgMVarTSOQueue*)&stg_END_TSO_QUEUE_closure) { + mvar->head = q = q->link; + if (q == (StgMVarTSOQueue*)&stg_END_TSO_QUEUE_closure) { mvar->tail = (StgMVarTSOQueue*)&stg_END_TSO_QUEUE_closure; + } else { + if (info == &stg_MVAR_CLEAN_info) { + // Resolve #18919. + dirty_MVAR(&cap->r, (StgClosure*)mvar, mvar->value); + } } ASSERT(tso->block_info.closure == (StgClosure*)mvar); @@ -829,10 +834,8 @@ loop: // If it was a readMVar, then we can still do work, // so loop back. (XXX: This could take a while) - if (why_blocked == BlockedOnMVarRead) { - q = ((StgMVarTSOQueue*)q)->link; + if (why_blocked == BlockedOnMVarRead) goto loop; - } ASSERT(why_blocked == BlockedOnMVar); ===================================== rts/linker/Elf.c ===================================== @@ -15,16 +15,22 @@ #include "RtsUtils.h" #include "RtsSymbolInfo.h" +#include "CheckUnload.h" +#include "LinkerInternals.h" #include "linker/Elf.h" #include "linker/CacheFlush.h" #include "linker/M32Alloc.h" #include "linker/SymbolExtras.h" +#include "ForeignExports.h" +#include "Profiling.h" #include "sm/OSMem.h" #include "GetEnv.h" #include "linker/util.h" #include "linker/elf_util.h" +#include #include +#include #include #if defined(HAVE_SYS_STAT_H) #include @@ -709,7 +715,11 @@ ocGetNames_ELF ( ObjectCode* oc ) * address might be out of range for sections that are mmaped. */ alloc = SECTION_MMAP; - start = mmapForLinker(size, PROT_READ | PROT_WRITE, MAP_ANONYMOUS, -1, 0); + start = mmapAnonForLinker(size); + if (start == NULL) { + barf("failed to mmap memory for bss. " + "errno = %d", errno); + } mapped_start = start; mapped_offset = 0; mapped_size = roundUpToPage(size); @@ -751,9 +761,9 @@ ocGetNames_ELF ( ObjectCode* oc ) unsigned nstubs = numberOfStubsForSection(oc, i); unsigned stub_space = STUB_SIZE * nstubs; - void * mem = mmapForLinker(size+stub_space, PROT_READ | PROT_WRITE, MAP_ANON, -1, 0); + void * mem = mmapAnonForLinker(size+stub_space); - if( mem == MAP_FAILED ) { + if( mem == NULL ) { barf("failed to mmap allocated memory to load section %d. " "errno = %d", i, errno); } @@ -860,11 +870,10 @@ ocGetNames_ELF ( ObjectCode* oc ) } void * common_mem = NULL; if(common_size > 0) { - common_mem = mmapForLinker(common_size, - PROT_READ | PROT_WRITE, - MAP_ANON | MAP_PRIVATE, - -1, 0); - CHECK(common_mem != NULL); + common_mem = mmapAnonForLinker(common_size); + if (common_mem == NULL) { + barf("ocGetNames_ELF: Failed to allocate memory for SHN_COMMONs"); + } } //TODO: we ignore local symbols anyway right? So we can use the @@ -1969,6 +1978,143 @@ int ocRunInit_ELF( ObjectCode *oc ) return 1; } +/* + * Shared object loading + */ + +static int loadNativeObjCb_(struct dl_phdr_info *info, + size_t _size GNUC3_ATTRIBUTE(__unused__), void *data) { + ObjectCode* nc = (ObjectCode*) data; + + // This logic mimicks _dl_addr_inside_object from glibc + // For reference: + // int + // internal_function + // _dl_addr_inside_object (struct link_map *l, const ElfW(Addr) addr) + // { + // int n = l->l_phnum; + // const ElfW(Addr) reladdr = addr - l->l_addr; + // + // while (--n >= 0) + // if (l->l_phdr[n].p_type == PT_LOAD + // && reladdr - l->l_phdr[n].p_vaddr >= 0 + // && reladdr - l->l_phdr[n].p_vaddr < l->l_phdr[n].p_memsz) + // return 1; + // return 0; + // } + + if ((void*) info->dlpi_addr == nc->l_addr) { + int n = info->dlpi_phnum; + while (--n >= 0) { + if (info->dlpi_phdr[n].p_type == PT_LOAD) { + NativeCodeRange* ncr = + stgMallocBytes(sizeof(NativeCodeRange), "loadNativeObjCb_"); + ncr->start = (void*) ((char*) nc->l_addr + info->dlpi_phdr[n].p_vaddr); + ncr->end = (void*) ((char*) ncr->start + info->dlpi_phdr[n].p_memsz); + + ncr->next = nc->nc_ranges; + nc->nc_ranges = ncr; + } + } + } + return 0; +} + +static void copyErrmsg(char** errmsg_dest, char* errmsg) { + if (errmsg == NULL) errmsg = "loadNativeObj_ELF: unknown error"; + *errmsg_dest = stgMallocBytes(strlen(errmsg)+1, "loadNativeObj_ELF"); + strcpy(*errmsg_dest, errmsg); +} + +// need dl_mutex +void freeNativeCode_ELF (ObjectCode *nc) { + dlclose(nc->dlopen_handle); + + NativeCodeRange *ncr = nc->nc_ranges; + while (ncr) { + NativeCodeRange* last_ncr = ncr; + ncr = ncr->next; + stgFree(last_ncr); + } +} + +void * loadNativeObj_ELF (pathchar *path, char **errmsg) +{ + ObjectCode* nc; + void *hdl, *retval; + + IF_DEBUG(linker, debugBelch("loadNativeObj_ELF %" PATH_FMT "\n", path)); + + retval = NULL; + ACQUIRE_LOCK(&dl_mutex); + + /* Loading the same object multiple times will lead to chaos + * as we will have two ObjectCodes but one underlying dlopen + * handle. Fail if this happens. + */ + if (getObjectLoadStatus_(path) != OBJECT_NOT_LOADED) { + copyErrmsg(errmsg, "loadNativeObj_ELF: Already loaded"); + goto dlopen_fail; + } + + nc = mkOc(DYNAMIC_OBJECT, path, NULL, 0, false, NULL, 0); + + foreignExportsLoadingObject(nc); + hdl = dlopen(path, RTLD_NOW|RTLD_LOCAL); + foreignExportsFinishedLoadingObject(); + if (hdl == NULL) { + /* dlopen failed; save the message in errmsg */ + copyErrmsg(errmsg, dlerror()); + goto dlopen_fail; + } + + struct link_map *map; + if (dlinfo(hdl, RTLD_DI_LINKMAP, &map) == -1) { + /* dlinfo failed; save the message in errmsg */ + copyErrmsg(errmsg, dlerror()); + goto dlinfo_fail; + } + + nc->l_addr = (void*) map->l_addr; + nc->dlopen_handle = hdl; + hdl = NULL; // pass handle ownership to nc + + dl_iterate_phdr(loadNativeObjCb_, nc); + if (!nc->nc_ranges) { + copyErrmsg(errmsg, "dl_iterate_phdr failed to find obj"); + goto dl_iterate_phdr_fail; + } + + insertOCSectionIndices(nc); + + nc->next_loaded_object = loaded_objects; + loaded_objects = nc; + + retval = nc->dlopen_handle; + +#if defined(PROFILING) + // collect any new cost centres that were defined in the loaded object. + refreshProfilingCCSs(); +#endif + + goto success; + +dl_iterate_phdr_fail: + // already have dl_mutex + freeNativeCode_ELF(nc); +dlinfo_fail: + if (hdl) dlclose(hdl); +dlopen_fail: +success: + + RELEASE_LOCK(&dl_mutex); + + IF_DEBUG(linker, debugBelch("loadNativeObj_ELF result=%p\n", retval)); + + return retval; +} + + /* * PowerPC & X86_64 ELF specifics */ ===================================== rts/linker/Elf.h ===================================== @@ -14,5 +14,7 @@ int ocGetNames_ELF ( ObjectCode* oc ); int ocResolve_ELF ( ObjectCode* oc ); int ocRunInit_ELF ( ObjectCode* oc ); int ocAllocateExtras_ELF ( ObjectCode *oc ); +void freeNativeCode_ELF ( ObjectCode *nc ); +void *loadNativeObj_ELF ( pathchar *path, char **errmsg ); #include "EndPrivate.h" ===================================== rts/linker/LoadArchive.c ===================================== @@ -489,7 +489,7 @@ static HsInt loadArchive_ (pathchar *path) #if defined(darwin_HOST_OS) || defined(ios_HOST_OS) if (RTS_LINKER_USE_MMAP) - image = mmapForLinker(memberSize, PROT_READ | PROT_WRITE, MAP_ANONYMOUS, -1, 0); + image = mmapAnonForLinker(memberSize); else { /* See loadObj() */ misalignment = machoGetMisalignment(f); @@ -549,7 +549,7 @@ while reading filename from `%" PATH_FMT "'", path); } DEBUG_LOG("Found GNU-variant file index\n"); #if RTS_LINKER_USE_MMAP - gnuFileIndex = mmapForLinker(memberSize + 1, PROT_READ | PROT_WRITE, MAP_ANONYMOUS, -1, 0); + gnuFileIndex = mmapAnonForLinker(memberSize + 1); #else gnuFileIndex = stgMallocBytes(memberSize + 1, "loadArchive(image)"); #endif @@ -613,7 +613,7 @@ fail: stgFree(fileName); if (gnuFileIndex != NULL) { #if RTS_LINKER_USE_MMAP - munmap(gnuFileIndex, gnuFileIndexSize + 1); + munmapForLinker(gnuFileIndex, gnuFileIndexSize + 1, "loadArchive_"); #else stgFree(gnuFileIndex); #endif ===================================== rts/linker/M32Alloc.c ===================================== @@ -24,25 +24,25 @@ Note [Compile Time Trickery] This file implements two versions of each of the `m32_*` functions. At the top of the file there is the real implementation (compiled in when -`RTS_LINKER_USE_MMAP` is true) and a dummy implementation that exists only to +`NEED_M32` is true) and a dummy implementation that exists only to satisfy the compiler and which should never be called. If any of these dummy implementations are called the program will abort. The rationale for this is to allow the calling code to be written without using -the C pre-processor (CPP) `#if` hackery. The value of `RTS_LINKER_USE_MMAP` is -known at compile time, code like: +the C pre-processor (CPP) `#if` hackery. The value of `NEED_M32` is +known at compile time, allowing code like: - if (RTS_LINKER_USE_MMAP) + if (NEED_M32) m32_allocator_init(); -will be compiled to call to `m32_allocator_init` if `RTS_LINKER_USE_MMAP` is -true and will be optimised away to nothing if `RTS_LINKER_USE_MMAP` is false. -However, regardless of the value of `RTS_LINKER_USE_MMAP` the compiler will +will be compiled to call to `m32_allocator_init` if `NEED_M32` is +true and will be optimised away to nothing if `NEED_M32` is false. +However, regardless of the value of `NEED_M32` the compiler will still check the call for syntax and correct function parameter types. */ -#if RTS_LINKER_USE_MMAP == 1 +#if defined(NEED_M32) /* @@ -216,25 +216,6 @@ struct m32_page_t *m32_free_page_pool = NULL; unsigned int m32_free_page_pool_size = 0; // TODO -/** - * Wrapper for `unmap` that handles error cases. - * This is the real implementation. There is another dummy implementation below. - * See the note titled "Compile Time Trickery" at the top of this file. - */ -static void -munmapForLinker (void * addr, size_t size) -{ - IF_DEBUG(linker, - debugBelch("m32_alloc: Unmapping %zu bytes at %p\n", - size, addr)); - - int r = munmap(addr,size); - if (r == -1) { - // Should we abort here? - sysErrorBelch("munmap"); - } -} - /** * Free a page or, if possible, place it in the free page pool. */ @@ -246,7 +227,7 @@ m32_release_page(struct m32_page_t *page) m32_free_page_pool = page; m32_free_page_pool_size ++; } else { - munmapForLinker((void *) page, getPageSize()); + munmapForLinker((void *) page, getPageSize(), "m32_release_page"); } } @@ -263,8 +244,8 @@ m32_alloc_page(void) * pages. */ const size_t pgsz = getPageSize(); - char *chunk = mmapForLinker(pgsz * M32_MAP_PAGES, PROT_READ | PROT_WRITE, MAP_ANONYMOUS, -1, 0); - if (chunk > (char *) 0xffffffff) { + uint8_t *chunk = mmapAnonForLinker(pgsz * M32_MAP_PAGES); + if (chunk > (uint8_t *) 0xffffffff) { barf("m32_alloc_page: failed to get allocation in lower 32-bits"); } @@ -309,7 +290,7 @@ m32_allocator_unmap_list(struct m32_page_t *head) { while (head != NULL) { struct m32_page_t *next = m32_filled_page_get_next(head); - munmapForLinker((void *) head, head->filled_page.size); + munmapForLinker((void *) head, head->filled_page.size, "m32_allocator_unmap_list"); head = next; } } @@ -327,7 +308,7 @@ void m32_allocator_free(m32_allocator *alloc) const size_t pgsz = getPageSize(); for (int i=0; i < M32_MAX_PAGES; i++) { if (alloc->pages[i]) { - munmapForLinker(alloc->pages[i], pgsz); + munmapForLinker(alloc->pages[i], pgsz, "m32_allocator_free"); } } @@ -407,7 +388,14 @@ m32_alloc(struct m32_allocator_t *alloc, size_t size, size_t alignment) if (m32_is_large_object(size,alignment)) { // large object size_t alsize = ROUND_UP(sizeof(struct m32_page_t), alignment); - struct m32_page_t *page = mmapForLinker(alsize+size, PROT_READ | PROT_WRITE, MAP_ANONYMOUS,-1,0); + struct m32_page_t *page = mmapAnonForLinker(alsize+size); + if (page == NULL) { + sysErrorBelch("m32_alloc: Failed to map pages for %zd bytes", size); + return NULL; + } else if (page > (struct m32_page_t *) 0xffffffff) { + debugBelch("m32_alloc: warning: Allocation of %zd bytes resulted in pages above 4GB (%p)", + size, page); + } page->filled_page.size = alsize + size; m32_allocator_push_filled_list(&alloc->unprotected_list, (struct m32_page_t *) page); return (char*) page + alsize; @@ -460,7 +448,7 @@ m32_alloc(struct m32_allocator_t *alloc, size_t size, size_t alignment) return (char*)page + ROUND_UP(sizeof(struct m32_page_t),alignment); } -#elif RTS_LINKER_USE_MMAP == 0 +#else // The following implementations of these functions should never be called. If // they are, there is a bug at the call site. @@ -491,8 +479,4 @@ m32_alloc(m32_allocator *alloc STG_UNUSED, barf("%s: RTS_LINKER_USE_MMAP is %d", __func__, RTS_LINKER_USE_MMAP); } -#else - -#error RTS_LINKER_USE_MMAP should be either `0` or `1`. - #endif ===================================== rts/linker/M32Alloc.h ===================================== @@ -8,19 +8,17 @@ #pragma once -#if RTS_LINKER_USE_MMAP == 1 -#include -#include - -#if defined(HAVE_UNISTD_H) -#include -#endif - +/* + * We use the m32 allocator for symbol extras on Windows and other mmap-using + * platforms. + */ +#if RTS_LINKER_USE_MMAP || defined(mingw32_HOST_OS) +#define NEED_M32 1 #endif #include "BeginPrivate.h" -#if RTS_LINKER_USE_MMAP +#if defined(NEED_M32) #define M32_NO_RETURN /* Nothing */ #else #define M32_NO_RETURN GNUC3_ATTRIBUTE(__noreturn__) ===================================== rts/linker/MachO.c ===================================== @@ -507,11 +507,8 @@ makeGot(ObjectCode * oc) { if(got_slots > 0) { oc->info->got_size = got_slots * sizeof(void*); - oc->info->got_start = mmapForLinker(oc->info->got_size, - PROT_READ | PROT_WRITE, - MAP_ANON | MAP_PRIVATE, - -1, 0); - if( oc->info->got_start == MAP_FAILED ) { + oc->info->got_start = mmapAnonForLinker(oc->info->got_size); + if( oc->info->got_start == NULL ) { barf("MAP_FAILED. errno=%d", errno ); return EXIT_FAILURE; } @@ -528,7 +525,7 @@ makeGot(ObjectCode * oc) { void freeGot(ObjectCode * oc) { - munmap(oc->info->got_start, oc->info->got_size); + munmapForLinker(oc->info->got_start, oc->info->got_size, "freeGot"); oc->info->got_start = NULL; oc->info->got_size = 0; } @@ -1113,7 +1110,7 @@ ocBuildSegments_MachO(ObjectCode *oc) return 1; } - mem = mmapForLinker(size_compound, PROT_READ | PROT_WRITE, MAP_ANON, -1, 0); + mem = mmapAnonForLinker(size_compound); if (NULL == mem) return 0; IF_DEBUG(linker, debugBelch("ocBuildSegments: allocating %d segments\n", n_activeSegments)); ===================================== rts/linker/PEi386.c ===================================== @@ -1788,42 +1788,28 @@ ocGetNames_PEi386 ( ObjectCode* oc ) bool ocAllocateExtras_PEi386 ( ObjectCode* oc ) { - /* If the ObjectCode was unloaded we don't need a trampoline, it's likely - an import library so we're discarding it earlier. */ - if (!oc->info) - return false; + /* If the ObjectCode was unloaded we don't need a trampoline, it's likely + an import library so we're discarding it earlier. */ + if (!oc->info) + return false; - const int mask = default_alignment - 1; - size_t origin = oc->info->trampoline; - oc->symbol_extras - = (SymbolExtra*)((uintptr_t)(oc->info->image + origin + mask) & ~mask); - oc->first_symbol_extra = 0; - COFF_HEADER_INFO *info = oc->info->ch_info; - oc->n_symbol_extras = info->numberOfSymbols; + // These are allocated on-demand from m32 by makeSymbolExtra_PEi386 + oc->first_symbol_extra = 0; + oc->n_symbol_extras = 0; + oc->symbol_extras = NULL; - return true; + return true; } static size_t -makeSymbolExtra_PEi386( ObjectCode* oc, uint64_t index, size_t s, char* symbol ) +makeSymbolExtra_PEi386( ObjectCode* oc, uint64_t index STG_UNUSED, size_t s, char* symbol STG_UNUSED ) { - unsigned int curr_thunk; - SymbolExtra *extra; - curr_thunk = oc->first_symbol_extra + index; - if (index >= oc->n_symbol_extras) { - IF_DEBUG(linker, debugBelch("makeSymbolExtra first:%d, num:%lu, member:%" PATH_FMT ", index:%llu\n", curr_thunk, oc->n_symbol_extras, oc->archiveMemberName, index)); - barf("Can't allocate thunk for `%s' in `%" PATH_FMT "' with member `%" PATH_FMT "'", symbol, oc->fileName, oc->archiveMemberName); - } - - extra = oc->symbol_extras + curr_thunk; + SymbolExtra *extra = m32_alloc(oc->rx_m32, sizeof(SymbolExtra), 8); - if (!extra->addr) - { - // jmp *-14(%rip) - static uint8_t jmp[] = { 0xFF, 0x25, 0xF2, 0xFF, 0xFF, 0xFF }; - extra->addr = (uint64_t)s; - memcpy(extra->jumpIsland, jmp, 6); - } + // jmp *-14(%rip) + static uint8_t jmp[] = { 0xFF, 0x25, 0xF2, 0xFF, 0xFF, 0xFF }; + extra->addr = (uint64_t)s; + memcpy(extra->jumpIsland, jmp, 6); return (size_t)extra->jumpIsland; } ===================================== rts/linker/PEi386Types.h ===================================== @@ -7,10 +7,6 @@ #include #include -/* Some forward declares. */ -struct Section; - - struct SectionFormatInfo { char* name; size_t alignment; ===================================== rts/linker/SymbolExtras.c ===================================== @@ -81,11 +81,11 @@ int ocAllocateExtras(ObjectCode* oc, int count, int first, int bssSize) // symbol_extras is aligned to a page boundary so it can be mprotect'd. bssSize = roundUpToPage(bssSize); size_t allocated_size = n + bssSize + extras_size; - void *new = mmapForLinker(allocated_size, PROT_READ | PROT_WRITE, MAP_ANONYMOUS, -1, 0); + void *new = mmapAnonForLinker(allocated_size); if (new) { memcpy(new, oc->image, oc->fileSize); if (oc->imageMapped) { - munmap(oc->image, n); + munmapForLinker(oc->image, n, "ocAllocateExtras"); } oc->image = new; oc->imageMapped = true; ===================================== rts/linker/elf_got.c ===================================== @@ -48,11 +48,8 @@ makeGot(ObjectCode * oc) { } if(got_slots > 0) { oc->info->got_size = got_slots * sizeof(void *); - void * mem = mmapForLinker(oc->info->got_size, - PROT_READ | PROT_WRITE, - MAP_ANON | MAP_PRIVATE, - -1, 0); - if (mem == MAP_FAILED) { + void * mem = mmapAnonForLinker(oc->info->got_size); + if (mem == NULL) { errorBelch("MAP_FAILED. errno=%d", errno); return EXIT_FAILURE; } @@ -147,7 +144,7 @@ verifyGot(ObjectCode * oc) { void freeGot(ObjectCode * oc) { -// munmap(oc->info->got_start, oc->info->got_size); +// munmapForLinker(oc->info->got_start, oc->info->got_size, "freeGot); oc->info->got_start = 0x0; oc->info->got_size = 0; } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/61c3b2c8586eb299f95ea053fcf08e0548ff2a55...ac2c9225af79962e11cef9a0bf613365acc6da29 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/61c3b2c8586eb299f95ea053fcf08e0548ff2a55...ac2c9225af79962e11cef9a0bf613365acc6da29 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 1 03:02:14 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 30 Nov 2020 22:02:14 -0500 Subject: [Git][ghc/ghc][wip/keepAlive-the-return-of-the-primop] 9 commits: Sized Message-ID: <5fc5b236e0aee_86c111d4a0011298fb@gitlab.mail> Ben Gamari pushed to branch wip/keepAlive-the-return-of-the-primop at Glasgow Haskell Compiler / GHC Commits: 5e5f48e8 by Ben Gamari at 2020-11-30T18:54:39-05:00 Sized - - - - - 5b1d2a82 by Ben Gamari at 2020-11-30T22:00:28-05:00 genprimopcode: Add a second levity-polymorphic tyvar This will be needed shortly. - - - - - 970e078a by GHC GitLab CI at 2020-11-30T22:00:28-05:00 Introduce keepAlive primop - - - - - b4739d60 by Ben Gamari at 2020-11-30T22:00:28-05:00 base: Use keepAlive# in withForeignPtr - - - - - 78ce842a by Ben Gamari at 2020-11-30T22:00:28-05:00 Implement withByteArrayContents in terms of keepAlive# - - - - - f9051eb0 by Ben Gamari at 2020-11-30T22:01:07-05:00 base: Implement GHC.ForeignPtr.Ops in terms of keepAlive# - - - - - d3336c83 by Ben Gamari at 2020-11-30T22:01:08-05:00 base: Use keepAlive# in Foreign.Marshal.Alloc - - - - - a095280e by Ben Gamari at 2020-11-30T22:01:08-05:00 ghc-compact: Use keepAlive# in GHC.Compact.Serialized - - - - - 9e1a58a4 by Ben Gamari at 2020-11-30T22:01:55-05:00 iFix it - - - - - 10 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Data/ByteArray.hs - compiler/GHC/StgToCmm/Prim.hs - libraries/base/Foreign/Marshal/Alloc.hs - libraries/base/GHC/ForeignPtr.hs - libraries/base/GHC/ForeignPtr/Ops.hs - libraries/ghc-compact/GHC/Compact/Serialized.hs - utils/genprimopcode/Main.hs Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -2983,6 +2983,20 @@ primop NumSparks "numSparks#" GenPrimOp has_side_effects = True out_of_line = True + +------------------------------------------------------------------------ +section "Controlling object lifetime" + {Ensuring that objects don't die a premature death.} +------------------------------------------------------------------------ + +-- See Note [keepAlive# magic] in GHC.CoreToStg.Prep. +primop KeepAliveOp "keepAlive#" GenPrimOp + o -> State# RealWorld -> (State# RealWorld -> p) -> p + { TODO. } + with + strictness = { \ _arity -> mkClosedStrictSig [topDmd, topDmd, strictOnceApply1Dmd] topDiv } + + ------------------------------------------------------------------------ section "Tag to enum stuff" {Convert back and forth between values of enumerated types ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -1642,6 +1642,8 @@ app_ok primop_ok fun args -> False -- for the special cases for SeqOp and DataToTagOp | DataToTagOp <- op -> False + | KeepAliveOp <- op + -> False | otherwise -> primop_ok op -- Check the primop itself ===================================== compiler/GHC/CoreToStg/Prep.hs ===================================== @@ -32,7 +32,10 @@ import GHC.Tc.Utils.Env import GHC.Unit import GHC.Builtin.Names +import GHC.Builtin.PrimOps import GHC.Builtin.Types +import GHC.Builtin.Types.Prim ( realWorldStatePrimTy ) +import GHC.Types.Id.Make ( realWorldPrimId, mkPrimOpId ) import GHC.Core.Utils import GHC.Core.Opt.Arity @@ -47,6 +50,7 @@ import GHC.Core.TyCon import GHC.Core.DataCon import GHC.Core.Opt.OccurAnal + import GHC.Data.Maybe import GHC.Data.OrdList import GHC.Data.FastString @@ -63,7 +67,6 @@ import GHC.Types.Var.Set import GHC.Types.Var.Env import GHC.Types.Id import GHC.Types.Id.Info -import GHC.Types.Id.Make ( realWorldPrimId ) import GHC.Types.Basic import GHC.Types.Name ( NamedThing(..), nameSrcSpan, isInternalName ) import GHC.Types.SrcLoc ( SrcSpan(..), realSrcLocSpan, mkRealSrcLoc ) @@ -784,6 +787,38 @@ cpeApp top_env expr -- rather than the far superior "f x y". Test case is par01. = let (terminal, args', depth') = collect_args arg in cpe_app env terminal (args' ++ args) (depth + depth' - 1) + + cpe_app env + (Var f) + args + n + | Just KeepAliveOp <- isPrimOpId_maybe f + , CpeApp (Type arg_rep) + : CpeApp (Type arg_ty) + : CpeApp (Type _result_rep) + : CpeApp (Type result_ty) + : CpeApp arg + : CpeApp s0 + : CpeApp k + : rest <- pprTrace "cpe_app keepAlive#" (ppr args) args + = do { pprTraceM "cpe_app(keepAlive#)" (ppr n) + ; y <- newVar result_ty + ; s2 <- newVar realWorldStatePrimTy + ; -- beta reduce if possible + ; (floats, k') <- case k of + Lam s body -> cpe_app (extendCorePrepEnvExpr env s s0) body rest (n-2) + _ -> cpe_app env k (CpeApp s0 : rest) (n-1) + ; let touchId = mkPrimOpId TouchOp + expr = Case k' y result_ty [(DEFAULT, [], rhs)] + rhs = let scrut = mkApps (Var touchId) [Type arg_rep, Type arg_ty, arg, Var realWorldPrimId] + in Case scrut s2 result_ty [(DEFAULT, [], Var y)] + ; pprTraceM "cpe_app(keepAlive)" (ppr expr) + ; (floats', expr') <- cpeBody env expr + ; return (floats `appendFloats` floats', expr') + } + | Just KeepAliveOp <- isPrimOpId_maybe f + = panic "invalid keepAlive# application" + cpe_app env (Var f) (CpeApp _runtimeRep at Type{} : CpeApp _type at Type{} : CpeApp arg : rest) n | f `hasKey` runRWKey -- N.B. While it may appear that n == 1 in the case of runRW# ===================================== compiler/GHC/Data/ByteArray.hs ===================================== @@ -77,10 +77,15 @@ unsafeMutableByteArrayContents :: MutableByteArray -> Ptr a unsafeMutableByteArrayContents = unsafeByteArrayContents . unsafeCoerce withByteArrayContents :: ByteArray -> (Ptr a -> IO b) -> IO b +#if MIN_VERSION_base(4,15,0) +withByteArrayContents (ByteArray ba) f = + IO $ \s -> keepAlive# ba s (unIO (f (Ptr (byteArrayContents# ba)))) +#else withByteArrayContents (ByteArray ba) f = do r <- f $ Ptr (byteArrayContents# ba) IO $ \s -> case touch# ba s of s' -> (# s', () #) return r +#endif newMutableByteArray :: Int -> IO MutableByteArray newMutableByteArray (I# size) = IO $ \s -> ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -1551,6 +1551,8 @@ emitPrimOp dflags primop = case primop of TraceMarkerOp -> alwaysExternal SetThreadAllocationCounter -> alwaysExternal + KeepAliveOp -> panic "keepAlive# should have been eliminated in CorePrep" + where profile = targetProfile dflags platform = profilePlatform profile ===================================== libraries/base/Foreign/Marshal/Alloc.hs ===================================== @@ -116,19 +116,6 @@ alloca :: forall a b . Storable a => (Ptr a -> IO b) -> IO b alloca = allocaBytesAligned (sizeOf (undefined :: a)) (alignment (undefined :: a)) --- Note [NOINLINE for touch#] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~ --- Both allocaBytes and allocaBytesAligned use the touch#, which is notoriously --- fragile in the presence of simplification (see #14346). In particular, the --- simplifier may drop the continuation containing the touch# if it can prove --- that the action passed to allocaBytes will not return. The hack introduced to --- fix this for 8.2.2 is to mark allocaBytes as NOINLINE, ensuring that the --- simplifier can't see the divergence. --- --- These can be removed once #14375 is fixed, which suggests that we instead do --- away with touch# in favor of a primitive that will capture the scoping left --- implicit in the case of touch#. - -- |@'allocaBytes' n f@ executes the computation @f@, passing as argument -- a pointer to a temporarily allocated block of memory of @n@ bytes. -- The block of memory is sufficiently aligned for any of the basic @@ -143,12 +130,8 @@ allocaBytes (I# size) action = IO $ \ s0 -> case unsafeFreezeByteArray# mbarr# s1 of { (# s2, barr# #) -> let addr = Ptr (byteArrayContents# barr#) in case action addr of { IO action' -> - case action' s2 of { (# s3, r #) -> - case touch# barr# s3 of { s4 -> - (# s4, r #) - }}}}} --- See Note [NOINLINE for touch#] -{-# NOINLINE allocaBytes #-} + keepAlive# barr# s2 action' + }}} allocaBytesAligned :: Int -> Int -> (Ptr a -> IO b) -> IO b allocaBytesAligned (I# size) (I# align) action = IO $ \ s0 -> @@ -156,12 +139,8 @@ allocaBytesAligned (I# size) (I# align) action = IO $ \ s0 -> case unsafeFreezeByteArray# mbarr# s1 of { (# s2, barr# #) -> let addr = Ptr (byteArrayContents# barr#) in case action addr of { IO action' -> - case action' s2 of { (# s3, r #) -> - case touch# barr# s3 of { s4 -> - (# s4, r #) - }}}}} --- See Note [NOINLINE for touch#] -{-# NOINLINE allocaBytesAligned #-} + keepAlive# barr# s2 action' + }}} -- |Resize a memory area that was allocated with 'malloc' or 'mallocBytes' -- to the size needed to store values of type @b at . The returned pointer ===================================== libraries/base/GHC/ForeignPtr.hs ===================================== @@ -526,7 +526,9 @@ withForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b -- or from the object pointed to by the -- 'ForeignPtr', using the operations from the -- 'Storable' class. -withForeignPtr = unsafeWithForeignPtr +withForeignPtr fo@(ForeignPtr _ r) f = IO $ \s -> + case f (unsafeForeignPtrToPtr fo) of + IO action# -> keepAlive# r s action# -- | This is similar to 'withForeignPtr' but comes with an important caveat: -- the user must guarantee that the continuation does not diverge (e.g. loop or ===================================== libraries/base/GHC/ForeignPtr/Ops.hs ===================================== @@ -51,121 +51,114 @@ import GHC.Word import GHC.Int import GHC.Base import GHC.ForeignPtr -import GHC.Ptr - -withFP :: ForeignPtr a - -> (Addr# -> State# RealWorld -> (# State# RealWorld, b #)) - -> IO b -withFP fp f = - withForeignPtr fp (\(Ptr addr) -> IO (f addr)) peekWord8ForeignPtr :: ForeignPtr ty -> Int -> IO Word8 -peekWord8ForeignPtr fp (I# d) = withFP fp $ \addr s0 -> - case readWord8OffAddr# addr d s0 of - (# s1, r #) -> (# s1, W8# r #) +peekWord8ForeignPtr (ForeignPtr addr c) (I# d) = IO $ \s0 -> + case keepAlive# c s0 (readWord8OffAddr# addr d) of + (# s1, r #) -> (# s1, W8# (narrowWord8# r) #) peekWord16ForeignPtr :: ForeignPtr ty -> Int -> IO Word16 -peekWord16ForeignPtr fp (I# d) = withFP fp $ \addr s0 -> - case readWord16OffAddr# addr d s0 of - (# s1, r #) -> (# s1, W16# r #) +peekWord16ForeignPtr (ForeignPtr addr c) (I# d) = IO $ \s0 -> + case keepAlive# c s0 (readWord16OffAddr# addr d) of + (# s1, r #) -> (# s1, W16# (narrowWord16# r) #) peekWord32ForeignPtr :: ForeignPtr ty -> Int -> IO Word32 -peekWord32ForeignPtr fp (I# d) = withFP fp $ \addr s0 -> - case readWord32OffAddr# addr d s0 of - (# s1, r #) -> (# s1, W32# r #) +peekWord32ForeignPtr (ForeignPtr addr c) (I# d) = IO $ \s0 -> + case keepAlive# c s0 (readWord32OffAddr# addr d) of + (# s1, r #) -> (# s1, W32# (narrowWord32# r) #) peekWord64ForeignPtr :: ForeignPtr ty -> Int -> IO Word64 -peekWord64ForeignPtr fp (I# d) = withFP fp $ \addr s0 -> - case readWord64OffAddr# addr d s0 of +peekWord64ForeignPtr (ForeignPtr addr c) (I# d) = IO $ \s0 -> + case keepAlive# c s0 (readWord64OffAddr# addr d) of (# s1, r #) -> (# s1, W64# r #) peekWordForeignPtr :: ForeignPtr ty -> Int -> IO Word -peekWordForeignPtr fp (I# d) = withFP fp $ \addr s0 -> - case readWordOffAddr# addr d s0 of +peekWordForeignPtr (ForeignPtr addr c) (I# d) = IO $ \s0 -> + case keepAlive# c s0 (readWordOffAddr# addr d) of (# s1, r #) -> (# s1, W# r #) peekInt8ForeignPtr :: ForeignPtr ty -> Int -> IO Int8 -peekInt8ForeignPtr fp (I# d) = withFP fp $ \addr s0 -> - case readInt8OffAddr# addr d s0 of - (# s1, r #) -> (# s1, I8# r #) +peekInt8ForeignPtr (ForeignPtr addr c) (I# d) = IO $ \s0 -> + case keepAlive# c s0 (readInt8OffAddr# addr d) of + (# s1, r #) -> (# s1, I8# (narrowInt8# r) #) peekInt16ForeignPtr :: ForeignPtr ty -> Int -> IO Int16 -peekInt16ForeignPtr fp (I# d) = withFP fp $ \addr s0 -> - case readInt16OffAddr# addr d s0 of - (# s1, r #) -> (# s1, I16# r #) +peekInt16ForeignPtr (ForeignPtr addr c) (I# d) = IO $ \s0 -> + case keepAlive# c s0 (readInt16OffAddr# addr d) of + (# s1, r #) -> (# s1, I16# (narrowInt16# r) #) peekInt32ForeignPtr :: ForeignPtr ty -> Int -> IO Int32 -peekInt32ForeignPtr fp (I# d) = withFP fp $ \addr s0 -> - case readInt32OffAddr# addr d s0 of - (# s1, r #) -> (# s1, I32# r #) +peekInt32ForeignPtr (ForeignPtr addr c) (I# d) = IO $ \s0 -> + case keepAlive# c s0 (readInt32OffAddr# addr d) of + (# s1, r #) -> (# s1, I32# (narrowInt32# r) #) peekInt64ForeignPtr :: ForeignPtr ty -> Int -> IO Int64 -peekInt64ForeignPtr fp (I# d) = withFP fp $ \addr s0 -> - case readInt64OffAddr# addr d s0 of +peekInt64ForeignPtr (ForeignPtr addr c) (I# d) = IO $ \s0 -> + case keepAlive# c s0 (readInt64OffAddr# addr d) of (# s1, r #) -> (# s1, I64# r #) peekIntForeignPtr :: ForeignPtr ty -> Int -> IO Int -peekIntForeignPtr fp (I# d) = withFP fp $ \addr s0 -> - case readIntOffAddr# addr d s0 of +peekIntForeignPtr (ForeignPtr addr c) (I# d) = IO $ \s0 -> + case keepAlive# c s0 (readIntOffAddr# addr d) of (# s1, r #) -> (# s1, I# r #) peekCharForeignPtr :: ForeignPtr ty -> Int -> IO Char -peekCharForeignPtr fp (I# d) = withFP fp $ \addr s0 -> - case readCharOffAddr# addr d s0 of +peekCharForeignPtr (ForeignPtr addr c) (I# d) = IO $ \s0 -> + case keepAlive# c s0 (readCharOffAddr# addr d) of (# s1, r #) -> (# s1, C# r #) pokeWord8ForeignPtr :: ForeignPtr ty -> Int -> Word8 -> IO () -pokeWord8ForeignPtr fp (I# d) (W8# n) = withFP fp $ \addr s0 -> - case writeWord8OffAddr# addr d n s0 of +pokeWord8ForeignPtr (ForeignPtr addr c) (I# d) (W8# n) = IO $ \s0 -> + case keepAlive# c s0 (writeWord8OffAddr# addr d (extendWord8# n)) of s1 -> (# s1, () #) pokeWord16ForeignPtr :: ForeignPtr ty -> Int -> Word16 -> IO () -pokeWord16ForeignPtr fp (I# d) (W16# n) = withFP fp $ \addr s0 -> - case writeWord16OffAddr# addr d n s0 of +pokeWord16ForeignPtr (ForeignPtr addr c) (I# d) (W16# n) = IO $ \s0 -> + case keepAlive# c s0 (writeWord16OffAddr# addr d (extendWord16# n)) of s1 -> (# s1, () #) pokeWord32ForeignPtr :: ForeignPtr ty -> Int -> Word32 -> IO () -pokeWord32ForeignPtr fp (I# d) (W32# n) = withFP fp $ \addr s0 -> - case writeWord32OffAddr# addr d n s0 of +pokeWord32ForeignPtr (ForeignPtr addr c) (I# d) (W32# n) = IO $ \s0 -> + case keepAlive# c s0 (writeWord32OffAddr# addr d (extendWord32# n)) of s1 -> (# s1, () #) pokeWord64ForeignPtr :: ForeignPtr ty -> Int -> Word64 -> IO () -pokeWord64ForeignPtr fp (I# d) (W64# n) = withFP fp $ \addr s0 -> - case writeWord64OffAddr# addr d n s0 of +pokeWord64ForeignPtr (ForeignPtr addr c) (I# d) (W64# n) = IO $ \s0 -> + case keepAlive# c s0 (writeWord64OffAddr# addr d n) of s1 -> (# s1, () #) pokeWordForeignPtr :: ForeignPtr ty -> Int -> Word -> IO () -pokeWordForeignPtr fp (I# d) (W# n) = withFP fp $ \addr s0 -> - case writeWord64OffAddr# addr d n s0 of +pokeWordForeignPtr (ForeignPtr addr c) (I# d) (W# n) = IO $ \s0 -> + case keepAlive# c s0 (writeWordOffAddr# addr d n) of s1 -> (# s1, () #) pokeInt8ForeignPtr :: ForeignPtr ty -> Int -> Int8 -> IO () -pokeInt8ForeignPtr fp (I# d) (I8# n) = withFP fp $ \addr s0 -> - case writeInt8OffAddr# addr d n s0 of +pokeInt8ForeignPtr (ForeignPtr addr c) (I# d) (I8# n) = IO $ \s0 -> + case keepAlive# c s0 (writeInt8OffAddr# addr d (extendInt8# n)) of s1 -> (# s1, () #) pokeInt16ForeignPtr :: ForeignPtr ty -> Int -> Int16 -> IO () -pokeInt16ForeignPtr fp (I# d) (I16# n) = withFP fp $ \addr s0 -> - case writeInt16OffAddr# addr d n s0 of +pokeInt16ForeignPtr (ForeignPtr addr c) (I# d) (I16# n) = IO $ \s0 -> + case keepAlive# c s0 (writeInt16OffAddr# addr d (extendInt16# n)) of s1 -> (# s1, () #) pokeInt32ForeignPtr :: ForeignPtr ty -> Int -> Int32 -> IO () -pokeInt32ForeignPtr fp (I# d) (I32# n) = withFP fp $ \addr s0 -> - case writeInt32OffAddr# addr d n s0 of +pokeInt32ForeignPtr (ForeignPtr addr c) (I# d) (I32# n) = IO $ \s0 -> + case keepAlive# c s0 (writeInt32OffAddr# addr d (extendInt32# n)) of s1 -> (# s1, () #) pokeInt64ForeignPtr :: ForeignPtr ty -> Int -> Int64 -> IO () -pokeInt64ForeignPtr fp (I# d) (I64# n) = withFP fp $ \addr s0 -> - case writeInt64OffAddr# addr d n s0 of +pokeInt64ForeignPtr (ForeignPtr addr c) (I# d) (I64# n) = IO $ \s0 -> + case keepAlive# c s0 (writeInt64OffAddr# addr d n) of s1 -> (# s1, () #) pokeIntForeignPtr :: ForeignPtr ty -> Int -> Int -> IO () -pokeIntForeignPtr fp (I# d) (I# n) = withFP fp $ \addr s0 -> - case writeIntOffAddr# addr d n s0 of +pokeIntForeignPtr (ForeignPtr addr c) (I# d) (I# n) = IO $ \s0 -> + case keepAlive# c s0 (writeIntOffAddr# addr d n) of s1 -> (# s1, () #) pokeCharForeignPtr :: ForeignPtr ty -> Int -> Char -> IO () -pokeCharForeignPtr fp (I# d) (C# n) = withFP fp $ \addr s0 -> - case writeCharOffAddr# addr d n s0 of +pokeCharForeignPtr (ForeignPtr addr c) (I# d) (C# n) = IO $ \s0 -> + case keepAlive# c s0 (writeCharOffAddr# addr d n) of s1 -> (# s1, () #) ===================================== libraries/ghc-compact/GHC/Compact/Serialized.hs ===================================== @@ -29,6 +29,7 @@ module GHC.Compact.Serialized( import GHC.Prim import GHC.Types import GHC.Word (Word8) +import GHC.IO (unIO) import GHC.Ptr (Ptr(..), plusPtr) @@ -74,12 +75,6 @@ mkBlockList buffer = compactGetFirstBlock buffer >>= go rest <- go next return $ item : rest --- We MUST mark withSerializedCompact as NOINLINE --- Otherwise the compiler will eliminate the call to touch# --- causing the Compact# to be potentially GCed too eagerly, --- before func had a chance to copy everything into its own --- buffers/sockets/whatever - -- | Serialize the 'Compact', and call the provided function with -- with the 'Compact' serialized representation. It is not safe -- to return the pointer from the action and use it after @@ -89,7 +84,6 @@ mkBlockList buffer = compactGetFirstBlock buffer >>= go -- unsound to use 'unsafeInterleaveIO' to lazily construct -- a lazy bytestring from the 'Ptr'. -- -{-# NOINLINE withSerializedCompact #-} withSerializedCompact :: Compact a -> (SerializedCompact a -> IO c) -> IO c withSerializedCompact (Compact buffer root lock) func = withMVar lock $ \_ -> do @@ -97,9 +91,7 @@ withSerializedCompact (Compact buffer root lock) func = withMVar lock $ \_ -> do (# s', rootAddr #) -> (# s', Ptr rootAddr #) ) blockList <- mkBlockList buffer let serialized = SerializedCompact blockList rootPtr - r <- func serialized - IO (\s -> case touch# buffer s of - s' -> (# s', r #) ) + IO $ \s -> keepAlive# buffer s (unIO $ func serialized) fixupPointers :: Addr# -> Addr# -> State# RealWorld -> (# State# RealWorld, Maybe (Compact a) #) ===================================== utils/genprimopcode/Main.hs ===================================== @@ -503,6 +503,7 @@ gen_latex_doc (Info defaults entries) tvars = tvars_of typ tbinds [] = ". " tbinds ("o":tbs) = "(o::?) " ++ (tbinds tbs) + tbinds ("p":tbs) = "(p::?) " ++ (tbinds tbs) tbinds (tv:tbs) = tv ++ " " ++ (tbinds tbs) tvars_of (TyF t1 t2) = tvars_of t1 `union` tvars_of t2 tvars_of (TyC t1 t2) = tvars_of t1 `union` tvars_of t2 @@ -852,6 +853,7 @@ ppTyVar "b" = "betaTyVar" ppTyVar "c" = "gammaTyVar" ppTyVar "s" = "deltaTyVar" ppTyVar "o" = "runtimeRep1TyVar, openAlphaTyVar" +ppTyVar "p" = "runtimeRep2TyVar, openBetaTyVar" ppTyVar _ = error "Unknown type var" ppType :: Ty -> String @@ -885,6 +887,7 @@ ppType (TyVar "b") = "betaTy" ppType (TyVar "c") = "gammaTy" ppType (TyVar "s") = "deltaTy" ppType (TyVar "o") = "openAlphaTy" +ppType (TyVar "p") = "openBetaTy" ppType (TyApp (TyCon "State#") [x]) = "mkStatePrimTy " ++ ppType x ppType (TyApp (TyCon "MutVar#") [x,y]) = "mkMutVarPrimTy " ++ ppType x View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e88f492b462149616ca4a157f3b871247a575a07...9e1a58a469f3f64a667b3e3aeb8218a26f36077d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e88f492b462149616ca4a157f3b871247a575a07...9e1a58a469f3f64a667b3e3aeb8218a26f36077d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 1 05:38:52 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 01 Dec 2020 00:38:52 -0500 Subject: [Git][ghc/ghc][wip/keepAlive-the-return-of-the-primop] StringBuffer: Use unsafeWithForeignPtr Message-ID: <5fc5d6ec5cb76_86c3fc6aa9884c811388bd@gitlab.mail> Ben Gamari pushed to branch wip/keepAlive-the-return-of-the-primop at Glasgow Haskell Compiler / GHC Commits: e11f088b by Ben Gamari at 2020-12-01T00:38:40-05:00 StringBuffer: Use unsafeWithForeignPtr - - - - - 1 changed file: - compiler/GHC/Data/StringBuffer.hs Changes: ===================================== compiler/GHC/Data/StringBuffer.hs ===================================== @@ -68,6 +68,12 @@ import GHC.IO.Encoding.Failure ( CodingFailureMode(IgnoreCodingFailure) ) import GHC.Exts import Foreign +#if MIN_VERSION_base(4,15,0) +import GHC.ForeignPtr (unsafeWithForeignPtr) +#else +unsafeWithForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b +unsafeWithForeignPtr = withForeignPtr +#endif -- ----------------------------------------------------------------------------- -- The StringBuffer type @@ -107,7 +113,7 @@ hGetStringBuffer fname = do offset_i <- skipBOM h size_i 0 -- offset is 0 initially let size = fromIntegral $ size_i - offset_i buf <- mallocForeignPtrArray (size+3) - withForeignPtr buf $ \ptr -> do + unsafeWithForeignPtr buf $ \ptr -> do r <- if size == 0 then return 0 else hGetBuf h ptr size hClose h if (r /= size) @@ -120,7 +126,7 @@ hGetStringBufferBlock handle wanted offset_i <- hTell handle >>= skipBOM handle size_i let size = min wanted (fromIntegral $ size_i-offset_i) buf <- mallocForeignPtrArray (size+3) - withForeignPtr buf $ \ptr -> + unsafeWithForeignPtr buf $ \ptr -> do r <- if size == 0 then return 0 else hGetBuf handle ptr size if r /= size then ioError (userError $ "short read of file: "++show(r,size,size_i,handle)) @@ -128,7 +134,7 @@ hGetStringBufferBlock handle wanted hPutStringBuffer :: Handle -> StringBuffer -> IO () hPutStringBuffer hdl (StringBuffer buf len cur) - = withForeignPtr (plusForeignPtr buf cur) $ \ptr -> + = unsafeWithForeignPtr (plusForeignPtr buf cur) $ \ptr -> hPutBuf hdl ptr len -- | Skip the byte-order mark if there is one (see #1744 and #6016), @@ -165,9 +171,9 @@ newUTF8StringBuffer buf ptr size = do appendStringBuffers :: StringBuffer -> StringBuffer -> IO StringBuffer appendStringBuffers sb1 sb2 = do newBuf <- mallocForeignPtrArray (size+3) - withForeignPtr newBuf $ \ptr -> - withForeignPtr (buf sb1) $ \sb1Ptr -> - withForeignPtr (buf sb2) $ \sb2Ptr -> + unsafeWithForeignPtr newBuf $ \ptr -> + unsafeWithForeignPtr (buf sb1) $ \sb1Ptr -> + unsafeWithForeignPtr (buf sb2) $ \sb2Ptr -> do copyArray ptr (sb1Ptr `advancePtr` cur sb1) sb1_len copyArray (ptr `advancePtr` sb1_len) (sb2Ptr `advancePtr` cur sb2) sb2_len pokeArray (ptr `advancePtr` size) [0,0,0] @@ -184,7 +190,7 @@ stringToStringBuffer str = unsafePerformIO $ do let size = utf8EncodedLength str buf <- mallocForeignPtrArray (size+3) - withForeignPtr buf $ \ptr -> do + unsafeWithForeignPtr buf $ \ptr -> do utf8EncodeString ptr str pokeArray (ptr `plusPtr` size :: Ptr Word8) [0,0,0] -- sentinels for UTF-8 decoding @@ -203,7 +209,7 @@ nextChar :: StringBuffer -> (Char,StringBuffer) nextChar (StringBuffer buf len (I# cur#)) = -- Getting our fingers dirty a little here, but this is performance-critical inlinePerformIO $ - withForeignPtr buf $ \(Ptr a#) -> + unsafeWithForeignPtr buf $ \(Ptr a#) -> case utf8DecodeCharAddr# (a# `plusAddr#` cur#) 0# of (# c#, nBytes# #) -> let cur' = I# (cur# +# nBytes#) in @@ -220,7 +226,7 @@ prevChar :: StringBuffer -> Char -> Char prevChar (StringBuffer _ _ 0) deflt = deflt prevChar (StringBuffer buf _ cur) _ = inlinePerformIO $ - withForeignPtr buf $ \p -> do + unsafeWithForeignPtr buf $ \p -> do p' <- utf8PrevChar (p `plusPtr` cur) return (fst (utf8DecodeChar p')) @@ -258,7 +264,7 @@ atEnd (StringBuffer _ l c) = l == c atLine :: Int -> StringBuffer -> Maybe StringBuffer atLine line sb@(StringBuffer buf len _) = inlinePerformIO $ - withForeignPtr buf $ \p -> do + unsafeWithForeignPtr buf $ \p -> do p' <- skipToLine line len p if p' == nullPtr then return Nothing @@ -309,14 +315,14 @@ lexemeToFastString :: StringBuffer lexemeToFastString _ 0 = nilFS lexemeToFastString (StringBuffer buf _ cur) len = inlinePerformIO $ - withForeignPtr buf $ \ptr -> + unsafeWithForeignPtr buf $ \ptr -> return $! mkFastStringBytes (ptr `plusPtr` cur) len -- | Return the previous @n@ characters (or fewer if we are less than @n@ -- characters into the buffer. decodePrevNChars :: Int -> StringBuffer -> String decodePrevNChars n (StringBuffer buf _ cur) = - inlinePerformIO $ withForeignPtr buf $ \p0 -> + inlinePerformIO $ unsafeWithForeignPtr buf $ \p0 -> go p0 n "" (p0 `plusPtr` (cur - 1)) where go :: Ptr Word8 -> Int -> String -> Ptr Word8 -> IO String View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e11f088bf1f36cd8889ece8dd59c5d8964b8a2eb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e11f088bf1f36cd8889ece8dd59c5d8964b8a2eb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 1 05:57:10 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 01 Dec 2020 00:57:10 -0500 Subject: [Git][ghc/ghc][wip/backports-9.0] 2 commits: rts: Refactor foreign export tracking Message-ID: <5fc5db3678120_86c15c5d3881139529@gitlab.mail> Ben Gamari pushed to branch wip/backports-9.0 at Glasgow Haskell Compiler / GHC Commits: 43ff60b5 by Ben Gamari at 2020-12-01T00:55:55-05:00 rts: Refactor foreign export tracking This avoids calling `libc` in the initializers which are responsible for registering foreign exports. We believe this should avoid the corruption observed in #18548. See Note [Tracking foreign exports] in rts/ForeignExports.c for an overview of the new scheme. (cherry picked from commit c492134912e5270180881b7345ee86dc32756bdd) - - - - - 85822a88 by Ben Gamari at 2020-12-01T00:57:01-05:00 rts: Refactor unloading of foreign export StablePtrs Previously we would allocate a linked list cell for each foreign export. Now we can avoid this by taking advantage of the fact that they are already broken into groups. (cherry picked from commit 40dc91069d15bfc1d81f1722b39e06cac8fdddd1) - - - - - 10 changed files: - compiler/GHC/HsToCore/Foreign/Decl.hs - includes/Rts.h - + includes/rts/ForeignExports.h - + rts/ForeignExports.c - + rts/ForeignExports.h - rts/Linker.c - rts/LinkerInternals.h - rts/RtsStartup.c - rts/RtsSymbols.c - rts/rts.cabal.in Changes: ===================================== compiler/GHC/HsToCore/Foreign/Decl.hs ===================================== @@ -88,15 +88,16 @@ dsForeigns' :: [LForeignDecl GhcTc] dsForeigns' [] = return (NoStubs, nilOL) dsForeigns' fos = do + mod <- getModule fives <- mapM do_ldecl fos let (hs, cs, idss, bindss) = unzip4 fives fe_ids = concat idss - fe_init_code = map foreignExportInitialiser fe_ids + fe_init_code = foreignExportsInitialiser mod fe_ids -- return (ForeignStubs (vcat hs) - (vcat cs $$ vcat fe_init_code), + (vcat cs $$ fe_init_code), foldr (appOL . toOL) nilOL bindss) where do_ldecl (L loc decl) = putSrcSpanDs loc (do_decl decl) @@ -694,8 +695,8 @@ mkFExportCBits dflags c_nm maybe_target arg_htys res_hty is_IO_res_ty cc ] -foreignExportInitialiser :: Id -> SDoc -foreignExportInitialiser hs_fn = +foreignExportsInitialiser :: Module -> [Id] -> SDoc +foreignExportsInitialiser mod hs_fns = -- Initialise foreign exports by registering a stable pointer from an -- __attribute__((constructor)) function. -- The alternative is to do this from stginit functions generated in @@ -704,14 +705,24 @@ foreignExportInitialiser hs_fn = -- all modules that are imported directly or indirectly are actually used by -- the program. -- (this is bad for big umbrella modules like Graphics.Rendering.OpenGL) + -- + -- See Note [Tracking foreign exports] in rts/ForeignExports.c vcat - [ text "static void stginit_export_" <> ppr hs_fn - <> text "() __attribute__((constructor));" - , text "static void stginit_export_" <> ppr hs_fn <> text "()" - , braces (text "foreignExportStablePtr" - <> parens (text "(StgPtr) &" <> ppr hs_fn <> text "_closure") - <> semi) + [ text "static struct ForeignExportsList" <+> list_symbol <+> equals + <+> braces (text ".exports = " <+> export_list) <> semi + , text "static void " <> ctor_symbol <> text "(void)" + <+> text " __attribute__((constructor));" + , text "static void " <> ctor_symbol <> text "()" + , braces (text "registerForeignExports" <> parens (char '&' <> list_symbol) <> semi) ] + where + mod_str = pprModuleName (moduleName mod) + ctor_symbol = text "stginit_export_" <> mod_str + list_symbol = text "stg_exports_" <> mod_str + export_list = braces $ pprWithCommas closure_ptr hs_fns + + closure_ptr :: Id -> SDoc + closure_ptr fn = text "(StgPtr) &" <> ppr fn <> text "_closure" mkHObj :: Type -> SDoc ===================================== includes/Rts.h ===================================== @@ -213,6 +213,9 @@ void _assertFail(const char *filename, unsigned int linenum) #include "rts/storage/GC.h" #include "rts/NonMoving.h" +/* Foreign exports */ +#include "rts/ForeignExports.h" + /* Other RTS external APIs */ #include "rts/Parallel.h" #include "rts/Signals.h" ===================================== includes/rts/ForeignExports.h ===================================== @@ -0,0 +1,38 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1995-2009 + * + * Interface to the RTS's foreign export tracking code. + * + * Do not #include this file directly: #include "Rts.h" instead. + * + * To understand the structure of the RTS headers, see the wiki: + * https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes + * + * ---------------------------------------------------------------------------*/ + +#pragma once + +struct _ObjectCode; + +/* N.B. See Note [Tracking foreign exports] in + * rts/ForeignExports.c. */ +struct ForeignExportsList { + /* a link field for linking these together into lists. + */ + struct ForeignExportsList *next; + /* the length of ->exports */ + int n_entries; + /* if the RTS linker loaded the module, + * to which ObjectCode these exports belong. */ + struct _ObjectCode *oc; + /* if the RTS linker loaded the module, + * this points to an array of length ->n_entries + * recording the StablePtr for each export. */ + StgStablePtr **stable_ptrs; + /* the exported closures. of length ->exports. */ + StgPtr exports[]; +}; + +void registerForeignExports(struct ForeignExportsList *exports); + ===================================== rts/ForeignExports.c ===================================== @@ -0,0 +1,130 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team 2020 + * + * Management of foreign exports. + * + * ---------------------------------------------------------------------------*/ + +#include "Rts.h" +#include "RtsUtils.h" +#include "ForeignExports.h" + +/* protected by linker_mutex after start-up */ +static struct ForeignExportsList *pending = NULL; +static ObjectCode *loading_obj = NULL; + +/* + * Note [Tracking foreign exports] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * + * Foreign exports are garbage collection roots. That is, things (e.g. CAFs) + * depended upon by a module's `foreign export`s need to be kept alive for as + * long an module is loaded. To ensure this we create a stable pointer to each + * `foreign export`'d closure. This works as follows: + * + * 1. The compiler (namely GHC.HsToCore.Foreign.Decl.foreignExports) + * inserts a C-stub into each module containing a `foreign export`. This + * stub contains two things: + * + * - A `ForeignExportsList` listing all of the exported closures, and + * + * - An initializer which calls `registerForeignExports` with a reference to + * the `ForeignExportsList`. + * + * 2. When the module's object code is loaded, its initializer is called by the + * linker (this might be the system's dynamic linker or GHC's own static + * linker). `registerForeignExports` then places the module's + * `ForeignExportsList` on `pending` list. + * + * 3. When loading has finished (e.g. during RTS initialization or at the end + * of `Linker.c:ocTryLoad`) `processForeignExports` is called. Here we + * traverse the `pending` list and create a `StablePtr` for each export + * therein. + * + * The reason for this two-step process is that we are very restricted in what + * we can do in an initializer function. For instance, we cannot necessarily + * call `malloc` since the `libc`'s own initializer may not have run yet. + * For instance, doing exactly this resulted in #18548. + * + * Another consideration here is that the linker needs to know which + * `StablePtr`s belong to each `ObjectCode` so it can free them when the module is + * unloaded. For this reason, the linker informs us when it is loading an + * object by calling `foreignExportsLoadingObject` and + * `foreignExportsFinishedLoadingObject`. We take note of the `ObjectCode*` we + * are loading in `loading_obj` such that we can associate the `ForeignExportsList` with + * the `ObjectCode` in `processForeignExports`. We then record each of the + * StablePtrs we create in the ->stable_ptrs array of ForeignExportsList so + * they can be enumerated during unloading. + * + */ + +void registerForeignExports(struct ForeignExportsList *exports) +{ + ASSERT(exports->next == NULL); + ASSERT(exports->oc == NULL); + exports->next = pending; + exports->oc = loading_obj; + pending = exports; +} + +/* ----------------------------------------------------------------------------- + Create a StablePtr for a foreign export. This is normally called by + a C function with __attribute__((constructor)), which is generated + by GHC and linked into the module. + + If the object code is being loaded dynamically, then we remember + which StablePtrs were allocated by the constructors and free them + again in unloadObj(). + -------------------------------------------------------------------------- */ + +void foreignExportsLoadingObject(ObjectCode *oc) +{ + ASSERT(loading_obj == NULL); + loading_obj = oc; +} + +void foreignExportsFinishedLoadingObject() +{ + ASSERT(loading_obj != NULL); + loading_obj = NULL; + processForeignExports(); +} + +/* Caller must own linker_mutex so that we can safely modify + * oc->stable_ptrs. */ +void processForeignExports() +{ + while (pending) { + struct ForeignExportsList *cur = pending; + pending = cur->next; + + /* sanity check */ + ASSERT(cur->stable_ptrs == NULL); + + /* N.B. We only need to populate the ->stable_ptrs + * array if the object might later be unloaded. + */ + if (cur->oc != NULL) { + cur->stable_ptrs = + stgMallocBytes(sizeof(StgStablePtr*) * cur->n_entries, + "foreignExportStablePtr"); + + for (int i=0; i < cur->n_entries; i++) { + StgStablePtr *sptr = getStablePtr(cur->exports[i]); + + if (cur->oc != NULL) { + cur->stable_ptrs[i] = sptr; + } + } + cur->next = cur->oc->foreign_exports; + cur->oc->foreign_exports = cur; + } else { + /* can't be unloaded, don't bother populating + * ->stable_ptrs array. */ + for (int i=0; i < cur->n_entries; i++) { + getStablePtr(cur->exports[i]); + } + } + } +} ===================================== rts/ForeignExports.h ===================================== @@ -0,0 +1,21 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team 2020 + * + * Management of foreign exports. + * + * ---------------------------------------------------------------------------*/ + +#pragma once + +#include "Rts.h" +#include "LinkerInternals.h" + +#include "BeginPrivate.h" + +void foreignExportsLoadingObject(ObjectCode *oc); +void foreignExportsFinishedLoadingObject(void); +void processForeignExports(void); + +#include "EndPrivate.h" + ===================================== rts/Linker.c ===================================== @@ -26,6 +26,7 @@ #include "RtsSymbols.h" #include "RtsSymbolInfo.h" #include "Profiling.h" +#include "ForeignExports.h" #include "sm/OSMem.h" #include "linker/M32Alloc.h" #include "linker/CacheFlush.h" @@ -961,37 +962,6 @@ SymbolAddr* lookupSymbol( SymbolName* lbl ) return r; } -/* ----------------------------------------------------------------------------- - Create a StablePtr for a foreign export. This is normally called by - a C function with __attribute__((constructor)), which is generated - by GHC and linked into the module. - - If the object code is being loaded dynamically, then we remember - which StablePtrs were allocated by the constructors and free them - again in unloadObj(). - -------------------------------------------------------------------------- */ - -static ObjectCode *loading_obj = NULL; - -StgStablePtr foreignExportStablePtr (StgPtr p) -{ - ForeignExportStablePtr *fe_sptr; - StgStablePtr *sptr; - - sptr = getStablePtr(p); - - if (loading_obj != NULL) { - fe_sptr = stgMallocBytes(sizeof(ForeignExportStablePtr), - "foreignExportStablePtr"); - fe_sptr->stable_ptr = sptr; - fe_sptr->next = loading_obj->stable_ptrs; - loading_obj->stable_ptrs = fe_sptr; - } - - return sptr; -} - - /* ----------------------------------------------------------------------------- * Debugging aid: look in GHCi's object symbol tables for symbols * within DELTA bytes of the specified address, and show their names. @@ -1205,14 +1175,18 @@ static void freeOcStablePtrs (ObjectCode *oc) { // Release any StablePtrs that were created when this // object module was initialized. - ForeignExportStablePtr *fe_ptr, *next; + struct ForeignExportsList *exports, *next; - for (fe_ptr = oc->stable_ptrs; fe_ptr != NULL; fe_ptr = next) { - next = fe_ptr->next; - freeStablePtr(fe_ptr->stable_ptr); - stgFree(fe_ptr); + for (exports = oc->foreign_exports; exports != NULL; exports = next) { + next = exports->next; + for (int i = 0; i < exports->n_entries; i++) { + freeStablePtr(exports->stable_ptrs[i]); + } + stgFree(exports->stable_ptrs); + exports->stable_ptrs = NULL; + exports->next = NULL; } - oc->stable_ptrs = NULL; + oc->foreign_exports = NULL; } static void @@ -1380,7 +1354,7 @@ mkOc( ObjectType type, pathchar *path, char *image, int imageSize, oc->n_segments = 0; oc->segments = NULL; oc->proddables = NULL; - oc->stable_ptrs = NULL; + oc->foreign_exports = NULL; #if defined(NEED_SYMBOL_EXTRAS) oc->symbol_extras = NULL; #endif @@ -1744,7 +1718,8 @@ int ocTryLoad (ObjectCode* oc) { IF_DEBUG(linker, debugBelch("ocTryLoad: ocRunInit start\n")); - loading_obj = oc; // tells foreignExportStablePtr what to do + // See Note [Tracking foreign exports] in ForeignExports.c + foreignExportsLoadingObject(oc); #if defined(OBJFORMAT_ELF) r = ocRunInit_ELF ( oc ); #elif defined(OBJFORMAT_PEi386) @@ -1754,7 +1729,7 @@ int ocTryLoad (ObjectCode* oc) { #else barf("ocTryLoad: initializers not implemented on this platform"); #endif - loading_obj = NULL; + foreignExportsFinishedLoadingObject(); if (!r) { return r; } ===================================== rts/LinkerInternals.h ===================================== @@ -141,17 +141,6 @@ typedef struct _Segment { int n_sections; } Segment; -/* - * We must keep track of the StablePtrs that are created for foreign - * exports by constructor functions when the module is loaded, so that - * we can free them again when the module is unloaded. If we don't do - * this, then the StablePtr will keep the module alive indefinitely. - */ -typedef struct ForeignExportStablePtr_ { - StgStablePtr stable_ptr; - struct ForeignExportStablePtr_ *next; -} ForeignExportStablePtr; - #if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH) || defined(aarch64_HOST_ARCH) #define NEED_SYMBOL_EXTRAS 1 #endif @@ -280,7 +269,8 @@ typedef struct _ObjectCode { char* bssBegin; char* bssEnd; - ForeignExportStablePtr *stable_ptrs; + /* a list of all ForeignExportsLists owned by this object */ + struct ForeignExportsList *foreign_exports; /* Holds the list of symbols in the .o file which require extra information.*/ ===================================== rts/RtsStartup.c ===================================== @@ -20,6 +20,7 @@ #include "STM.h" /* initSTM */ #include "RtsSignals.h" #include "Weak.h" +#include "ForeignExports.h" /* processForeignExports */ #include "Ticky.h" #include "StgRun.h" #include "Prelude.h" /* fixupRTStoPreludeRefs */ @@ -346,7 +347,13 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config) getStablePtr((StgPtr)processRemoteCompletion_closure); #endif - // Initialize the top-level handler system + /* + * process any foreign exports which were registered while loading the + * image + * */ + processForeignExports(); + + /* initialize the top-level handler system */ initTopHandler(); /* initialise the shared Typeable store */ ===================================== rts/RtsSymbols.c ===================================== @@ -654,7 +654,7 @@ SymI_HasProto(freeFullProgArgv) \ SymI_HasProto(getProcessElapsedTime) \ SymI_HasProto(getStablePtr) \ - SymI_HasProto(foreignExportStablePtr) \ + SymI_HasProto(registerForeignExports) \ SymI_HasProto(hs_init) \ SymI_HasProto(hs_init_with_rtsopts) \ SymI_HasProto(hs_init_ghc) \ ===================================== rts/rts.cabal.in ===================================== @@ -151,6 +151,7 @@ library rts/EventLogWriter.h rts/FileLock.h rts/Flags.h + rts/ForeignExports.h rts/GetTime.h rts/Globals.h rts/Hpc.h @@ -424,6 +425,7 @@ library ClosureFlags.c Disassembler.c FileLock.c + ForeignExports.c Globals.c Hash.c Heap.c View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f72f27a325c16bf2975ee2a8a49c439b46ee8498...85822a8881a7463b479b07d0b4d627a44930f058 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f72f27a325c16bf2975ee2a8a49c439b46ee8498...85822a8881a7463b479b07d0b4d627a44930f058 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 1 06:03:06 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 01 Dec 2020 01:03:06 -0500 Subject: [Git][ghc/ghc][ghc-8.10] Backport: Fix for #18955 to GHC 8.10 #18955 Message-ID: <5fc5dc9ad85a9_86cbee25901141829@gitlab.mail> Ben Gamari pushed to branch ghc-8.10 at Glasgow Haskell Compiler / GHC Commits: 65ed2fdc by Roland Senn at 2020-11-30T14:26:58+01:00 Backport: Fix for #18955 to GHC 8.10 #18955 Since MR !554 (#15454) GHCi automatically enabled the flag `-fobject-code` on any module using the UnboxedTuples or UnboxedSum extensions. MR !1553 (#16876) allowed to inhibit the automatic compiling to object-code of these modules by setting the `fbyte-code` flag. However, it assigned 2 different semantics to this flag and introduced the regression described in issue #18955. This MR fixes this regression by unsetting the internal flag `Opt_ByteCodeIfUnboxed` before it's copied to DynFlags local to the module. In GHC 9.0.1 the issue is solved by introducing a new flag `-f(no-)object-code-if-unboxed`. - - - - - 7 changed files: - compiler/main/DynFlags.hs - compiler/main/GhcMake.hs - ghc/GHCi/UI.hs - + testsuite/tests/ghci/scripts/T18955.hs - + testsuite/tests/ghci/scripts/T18955.script - + testsuite/tests/ghci/scripts/T18955.stdout - testsuite/tests/ghci/scripts/all.T Changes: ===================================== compiler/main/DynFlags.hs ===================================== @@ -658,7 +658,7 @@ data GeneralFlag | Opt_SingleLibFolder | Opt_KeepCAFs | Opt_KeepGoing - | Opt_ByteCode + | Opt_ByteCodeIfUnboxed -- output style opts | Opt_ErrorSpans -- Include full span info in error messages, @@ -3781,10 +3781,10 @@ dynamic_flags_deps = [ , make_ord_flag defFlag "fno-code" (NoArg ((upd $ \d -> d { ghcLink=NoLink }) >> setTarget HscNothing)) - , make_ord_flag defFlag "fbyte-code" - (noArgM $ \dflags -> do - setTarget HscInterpreted - pure $ gopt_set dflags Opt_ByteCode) + , make_ord_flag defFlag "fbyte-code" (NoArg ((upd $ \d -> + -- Enabling Opt_ByteCodeIfUnboxed is a workaround for #18955. + -- See the comments for resetOptByteCodeIfUnboxed for more details. + gopt_set d Opt_ByteCodeIfUnboxed) >> setTarget HscInterpreted)) , make_ord_flag defFlag "fobject-code" $ NoArg $ do dflags <- liftEwM getCmdLineState setTarget $ defaultObjectTarget dflags ===================================== compiler/main/GhcMake.hs ===================================== @@ -2185,7 +2185,7 @@ enableCodeGenForUnboxedTuplesOrSums = where condition ms = unboxed_tuples_or_sums (ms_hspp_opts ms) && - not (gopt Opt_ByteCode (ms_hspp_opts ms)) && + not (gopt Opt_ByteCodeIfUnboxed (ms_hspp_opts ms)) && not (isBootSummary ms) unboxed_tuples_or_sums d = xopt LangExt.UnboxedTuples d || xopt LangExt.UnboxedSums d ===================================== ghc/GHCi/UI.hs ===================================== @@ -1935,6 +1935,7 @@ reloadModuleDefer = wrapDeferTypeErrors . reloadModule -- sessions. doLoadAndCollectInfo :: GhciMonad m => Bool -> LoadHowMuch -> m SuccessFlag doLoadAndCollectInfo retain_context howmuch = do + resetOptByteCodeIfUnboxed -- #18955 doCollectInfo <- isOptionSet CollectInfo doLoad retain_context howmuch >>= \case @@ -1947,6 +1948,25 @@ doLoadAndCollectInfo retain_context howmuch = do return Succeeded flag -> return flag +-- An `OPTIONS_GHC -fbyte-code` pragma at the beginning of a module sets the +-- flag `Opt_ByteCodeIfUnboxed` locally for this module. This stops automatic +-- compilation of this module to object code, if the module uses (or depends +-- on a module using) the UnboxedSums/Tuples extensions. +-- However a GHCi `:set -fbyte-code` command sets the flag Opt_ByteCodeIfUnboxed +-- globally to all modules. This triggered #18955. This function unsets the +-- flag from the global DynFlags before they are copied to the module-specific +-- DynFlags. +-- This is a temporary workaround until GHC 9.0.1, which allows disabling +-- this feature at a finer-grained level by way of the +-- -fno-object-code-if-unboxed flag. See !4531. +resetOptByteCodeIfUnboxed :: GhciMonad m => m () +resetOptByteCodeIfUnboxed = do + dflags <- getDynFlags + when (gopt Opt_ByteCodeIfUnboxed dflags) $ do + _ <- GHC.setProgramDynFlags $ gopt_unset dflags Opt_ByteCodeIfUnboxed + pure () + pure () + doLoad :: GhciMonad m => Bool -> LoadHowMuch -> m SuccessFlag doLoad retain_context howmuch = do -- turn off breakpoints before we load: we can't turn them off later, because ===================================== testsuite/tests/ghci/scripts/T18955.hs ===================================== @@ -0,0 +1,2 @@ +main :: IO () +main = putStrLn "Hello World" ===================================== testsuite/tests/ghci/scripts/T18955.script ===================================== @@ -0,0 +1,3 @@ +:set -v1 +:set -fbyte-code +:l T18955 ===================================== testsuite/tests/ghci/scripts/T18955.stdout ===================================== @@ -0,0 +1,2 @@ +[1 of 1] Compiling Main ( T18955.hs, interpreted ) +Ok, one module loaded. ===================================== testsuite/tests/ghci/scripts/all.T ===================================== @@ -311,3 +311,4 @@ test('T17345', normal, ghci_script, ['T17345.script']) test('T17384', normal, ghci_script, ['T17384.script']) test('T17403', normal, ghci_script, ['T17403.script']) test('T17431', normal, ghci_script, ['T17431.script']) +test('T18955', [extra_hc_opts("-fobject-code")], ghci_script, ['T18955.script']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/65ed2fdca2e0d0e8f3535b31f94dcdc1424e5cf2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/65ed2fdca2e0d0e8f3535b31f94dcdc1424e5cf2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 1 09:32:47 2020 From: gitlab at gitlab.haskell.org (Adam Gundry) Date: Tue, 01 Dec 2020 04:32:47 -0500 Subject: [Git][ghc/ghc][wip/amg/renamer-refactor] Simplify definition of AvailInfo Message-ID: <5fc60dbfc176d_86c879fa9c115862c@gitlab.mail> Adam Gundry pushed to branch wip/amg/renamer-refactor at Glasgow Haskell Compiler / GHC Commits: 655acd4d by Adam Gundry at 2020-12-01T09:30:11+00:00 Simplify definition of AvailInfo This bumps the haddock submodule. - - - - - 13 changed files: - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Rename.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Types/Avail.hs - compiler/GHC/Types/Name/Reader.hs - compiler/GHC/Types/Name/Shape.hs - compiler/GHC/Types/TyThing.hs - testsuite/tests/parser/should_compile/T14189.stderr - utils/haddock Changes: ===================================== compiler/GHC/Builtin/Utils.hs ===================================== @@ -265,7 +265,7 @@ ghcPrimExports :: [IfaceExport] ghcPrimExports = map (avail . idName) ghcPrimIds ++ map (avail . idName . primOpId) allThePrimOps ++ - [ AvailTC n [n] [] + [ availTC n [n] [] | tc <- exposedPrimTyCons, let n = tyConName tc ] ghcPrimDeclDocs :: DeclDocMap ===================================== compiler/GHC/Iface/Load.hs ===================================== @@ -87,7 +87,6 @@ import GHC.Types.TypeEnv import GHC.Types.Unique.FM import GHC.Types.Unique.DSet import GHC.Types.SrcLoc -import GHC.Types.FieldLabel import GHC.Types.TyThing import GHC.Unit.External @@ -1120,16 +1119,16 @@ When printing export lists, we print like this: -} pprExport :: IfaceExport -> SDoc -pprExport (Avail n) = ppr n -pprExport (AvailFL fl) = ppr fl -pprExport (AvailTC _ [] []) = Outputable.empty -pprExport (AvailTC n ns0 fs) - = case ns0 of - (n':ns) | n==n' -> ppr n <> pp_export ns fs - _ -> ppr n <> vbar <> pp_export ns0 fs +pprExport (Avail n) = ppr n +pprExport (AvailTC _ []) = Outputable.empty +pprExport avail@(AvailTC n _) = + ppr n <> mark <> pp_export (availSubordinateChildren avail) where - pp_export [] [] = Outputable.empty - pp_export names fs = braces (hsep (map ppr names ++ map (ppr . flLabel) fs)) + mark | availExportsDecl avail = Outputable.empty + | otherwise = vbar + + pp_export [] = Outputable.empty + pp_export names = braces (hsep (map ppr names)) pprUsage :: Usage -> SDoc pprUsage usage at UsagePackageModule{} ===================================== compiler/GHC/Iface/Make.hs ===================================== @@ -372,15 +372,12 @@ mkIfaceExports exports where sort_subs :: AvailInfo -> AvailInfo sort_subs (Avail n) = Avail n - sort_subs (AvailFL fl) = AvailFL fl - sort_subs (AvailTC n [] fs) = AvailTC n [] (sort_flds fs) - sort_subs (AvailTC n (m:ms) fs) - | n==m = AvailTC n (m:sortBy stableNameCmp ms) (sort_flds fs) - | otherwise = AvailTC n (sortBy stableNameCmp (m:ms)) (sort_flds fs) + sort_subs (AvailTC n []) = AvailTC n [] + sort_subs (AvailTC n (m:ms)) + | ChildName n==m = AvailTC n (m:sortBy stableChildCmp ms) + | otherwise = AvailTC n (sortBy stableChildCmp (m:ms)) -- Maintain the AvailTC Invariant - sort_flds = sortBy (stableNameCmp `on` flSelector) - {- Note [Original module] ~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Iface/Rename.hs ===================================== @@ -242,21 +242,25 @@ rnModule mod = do return (renameHoleModule (unitState dflags) hmap mod) rnAvailInfo :: Rename AvailInfo -rnAvailInfo (Avail n) = Avail <$> rnIfaceGlobal n -rnAvailInfo (AvailFL fl) = AvailFL <$> rnFieldLabel fl -rnAvailInfo (AvailTC n ns fs) = do +rnAvailInfo (Avail c) = Avail <$> rnChild c +rnAvailInfo (AvailTC n ns) = do -- Why don't we rnIfaceGlobal the availName itself? It may not -- actually be exported by the module it putatively is from, in -- which case we won't be able to tell what the name actually -- is. But for the availNames they MUST be exported, so they -- will rename fine. - ns' <- mapM rnIfaceGlobal ns - fs' <- mapM rnFieldLabel fs - case ns' ++ map flSelector fs' of + ns' <- mapM rnChild ns + case ns' of [] -> panic "rnAvailInfoEmpty AvailInfo" - (rep:rest) -> ASSERT2( all ((== nameModule rep) . nameModule) rest, ppr rep $$ hcat (map ppr rest) ) do - n' <- setNameModule (Just (nameModule rep)) n - return (AvailTC n' ns' fs') + (rep:rest) -> ASSERT2( all ((== childModule rep) . childModule) rest, ppr rep $$ hcat (map ppr rest) ) do + n' <- setNameModule (Just (childModule rep)) n + return (AvailTC n' ns') + where + childModule = nameModule . childName + +rnChild :: Rename Child +rnChild (ChildName n) = ChildName <$> rnIfaceGlobal n +rnChild (ChildField fl) = ChildField <$> rnFieldLabel fl rnFieldLabel :: Rename FieldLabel rnFieldLabel (FieldLabel l b sel) = do ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -2279,7 +2279,7 @@ extendPatSynEnv val_decls local_fix_env thing = do { ; let pat_syn_bndrs = concat [ name: map flSelector fields | (name, fields) <- names_with_fls ] ; let avails = map avail (map fst names_with_fls) - ++ map AvailFL (concatMap snd names_with_fls) + ++ map availField (concatMap snd names_with_fls) ; (gbl_env, lcl_env) <- extendGlobalRdrEnvRn avails local_fix_env ; let field_env' = extendNameEnvList (tcg_field_env gbl_env) names_with_fls ===================================== compiler/GHC/Rename/Names.hs ===================================== @@ -762,7 +762,7 @@ getLocalNonValBinders fixity_env ; let fld_env = case unLoc tc_decl of DataDecl { tcdDataDefn = d } -> mk_fld_env d names flds' _ -> [] - ; return (AvailTC main_name names flds', fld_env) } + ; return (availTC main_name names flds', fld_env) } -- Calculate the mapping from constructor names to fields, which @@ -837,7 +837,7 @@ getLocalNonValBinders fixity_env ; let (bndrs, flds) = hsDataFamInstBinders dfid ; sub_names <- mapM newTopSrcBinder bndrs ; flds' <- mapM (newRecordSelector overload_ok sub_names) flds - ; let avail = AvailTC (unLoc main_name) sub_names flds' + ; let avail = availTC (unLoc main_name) sub_names flds' -- main_name is not bound here! fld_env = mk_fld_env (feqn_rhs ti_decl) sub_names flds' ; return (avail, fld_env) } @@ -976,8 +976,8 @@ filterImports iface decl_spec (Just (want_hiding, L l import_items)) -- 'combine' may also be called for pattern synonyms which appear both -- unassociated and associated (#11959) combine :: (Child, AvailInfo, Maybe Name) -> (Child, AvailInfo, Maybe Name) -> (Child, AvailInfo, Maybe Name) - combine (ChildName name1, a1@(AvailTC p1 _ _), mb1) - (ChildName name2, a2@(AvailTC p2 _ _), mb2) + combine (ChildName name1, a1@(AvailTC p1 _), mb1) + (ChildName name2, a2@(AvailTC p2 _), mb2) = ASSERT2( name1 == name2 && isNothing mb1 && isNothing mb2 , ppr name1 <+> ppr name2 <+> ppr mb1 <+> ppr mb2 ) if p1 == name1 then (ChildName name1, a1, Just p2) @@ -1055,11 +1055,8 @@ filterImports iface decl_spec (Just (want_hiding, L l import_items)) Avail {} -- e.g. f(..) -> [DodgyImport $ ieWrappedName tc] - AvailFL {} -- e.g. f(..) - -> [DodgyImport $ ieWrappedName tc] - - AvailTC _ subs fs - | null (drop 1 subs) && null fs -- e.g. T(..) where T is a synonym + AvailTC _ subs + | null (drop 1 subs) -- e.g. T(..) where T is a synonym -> [DodgyImport $ ieWrappedName tc] | not (is_qual decl_spec) -- e.g. import M( T(..) ) @@ -1070,13 +1067,12 @@ filterImports iface decl_spec (Just (want_hiding, L l import_items)) renamed_ie = IEThingAll noExtField (L l (replaceWrappedName tc name)) sub_avails = case avail of - Avail {} -> [] - AvailFL {} -> [] - AvailTC name2 subs fs -> [(renamed_ie, AvailTC name2 (subs \\ [name]) fs)] + Avail {} -> [] + AvailTC name2 subs -> [(renamed_ie, AvailTC name2 (subs \\ [ChildName name]))] case mb_parent of Nothing -> return ([(renamed_ie, avail)], warns) -- non-associated ty/cls - Just parent -> return ((renamed_ie, AvailTC parent [name] []) : sub_avails, warns) + Just parent -> return ((renamed_ie, AvailTC parent [ChildName name]) : sub_avails, warns) -- associated type IEThingAbs _ (L l tc') @@ -1100,19 +1096,9 @@ filterImports iface decl_spec (Just (want_hiding, L l import_items)) (name, avail, mb_parent) <- lookup_name (IEThingAbs noExtField ltc) (ieWrappedName rdr_tc) - let (ns,subflds) = case avail of - AvailTC _ ns' subflds' -> (ns',subflds') - Avail _ -> panic "filterImports" - AvailFL {} -> pprPanic "filterImports" (ppr avail) - -- Look up the children in the sub-names of the parent - let subnames = case ns of -- The tc is first in ns, - [] -> [] -- if it is there at all - -- See the AvailTC Invariant in - -- GHC.Types.Avail - (n1:ns1) | n1 == name -> ns1 - | otherwise -> ns - case lookupChildren (map ChildName subnames ++ map ChildField subflds) rdr_ns of + let subnames = availSubordinateChildren avail + case lookupChildren subnames rdr_ns of Failed rdrs -> failLookupWith (BadImport (IEThingWith xt ltc wc rdrs [])) -- We are trying to import T( a,b,c,d ), and failed @@ -1126,7 +1112,7 @@ filterImports iface decl_spec (Just (want_hiding, L l import_items)) Nothing -> return ([(IEThingWith noExtField (L l name') wc childnames' childflds, - AvailTC name (name:map unLoc childnames) (map unLoc childflds))], + availTC name (name:map unLoc childnames) (map unLoc childflds))], []) where name' = replaceWrappedName rdr_tc name childnames' = map to_ie_post_rn childnames @@ -1135,10 +1121,10 @@ filterImports iface decl_spec (Just (want_hiding, L l import_items)) Just parent -> return ([(IEThingWith noExtField (L l name') wc childnames' childflds, - AvailTC name (map unLoc childnames) (map unLoc childflds)), + availTC name (map unLoc childnames) (map unLoc childflds)), (IEThingWith noExtField (L l name') wc childnames' childflds, - AvailTC parent [name] [])], + availTC parent [name] [])], []) where name' = replaceWrappedName rdr_tc name childnames' = map to_ie_post_rn childnames @@ -1152,7 +1138,7 @@ filterImports iface decl_spec (Just (want_hiding, L l import_items)) = (IEThingAbs noExtField (L l (replaceWrappedName tc n)), trimAvail av n) mkIEThingAbs tc l (n, _, Just parent) = (IEThingAbs noExtField (L l (replaceWrappedName tc n)) - , AvailTC parent [n] []) + , availTC parent [n] []) handle_bad_import m = catchIELookup m $ \err -> case err of BadImport ie | want_hiding -> return ([], [BadImportW ie]) @@ -1635,16 +1621,14 @@ getMinimalImports = fmap combine . mapM mk_minimal -- The main trick here is that if we're importing all the constructors -- we want to say "T(..)", but if we're importing only a subset we want -- to say "T(A,B,C)". So we have to find out what the module exports. - to_ie _ (Avail n) - = [IEVar noExtField (to_ie_post_rn $ noLoc n)] - to_ie _ (AvailFL fl) -- Note [Overloaded field import] - = [IEVar noExtField (to_ie_post_rn $ noLoc (fieldLabelPrintableName fl))] - to_ie _ (AvailTC n [m] []) - | n==m = [IEThingAbs noExtField (to_ie_post_rn $ noLoc n)] - to_ie iface (AvailTC n ns fs) - = case [(xs,gs) | AvailTC x xs gs <- mi_exports iface + to_ie _ (Avail c) -- Note [Overloaded field import] + = [IEVar noExtField (to_ie_post_rn $ noLoc (childPrintableName c))] + to_ie _ avail@(AvailTC n [_]) -- Exporting the main decl and nothing else + | availExportsDecl avail = [IEThingAbs noExtField (to_ie_post_rn $ noLoc n)] + to_ie iface (AvailTC n cs) + = case [xs | avail@(AvailTC x xs) <- mi_exports iface , x == n - , x `elem` xs -- Note [Partial export] + , availExportsDecl avail -- Note [Partial export] ] of [xs] | all_used xs -> [IEThingAll noExtField (to_ie_post_rn $ noLoc n)] | otherwise -> @@ -1660,12 +1644,9 @@ getMinimalImports = fmap combine . mapM mk_minimal (map (to_ie_post_rn . noLoc) (filter (/= n) ns)) (map noLoc fs)] where + (ns, fs) = partitionChildren cs - fld_lbls = map flLabel fs - - all_used (avail_occs, avail_flds) - = all (`elem` ns) avail_occs - && all (`elem` fld_lbls) (map flLabel avail_flds) + all_used avail_cs = all (`elem` cs) avail_cs all_non_overloaded = all (not . flIsOverloaded) @@ -1744,7 +1725,7 @@ Then the minimal import for module B is not import A( C( op ) ) which we would usually generate if C was exported from B. Hence -the (x `elem` xs) test when deciding what to generate. +the availExportsDecl test when deciding what to generate. Note [Overloaded field import] @@ -1799,9 +1780,8 @@ ambiguousImportItemErr rdr avails = hang (text "Ambiguous name" <+> quotes (ppr rdr) <+> text "in import item. It could refer to:") 2 (vcat (map ppr_avail avails)) where - ppr_avail (AvailTC parent _ _) = ppr parent <> parens (ppr rdr) - ppr_avail (Avail name) = ppr name - ppr_avail (AvailFL fl) = ppr fl + ppr_avail (AvailTC parent _) = ppr parent <> parens (ppr rdr) + ppr_avail (Avail name) = ppr name pprImpDeclSpec :: ModIface -> ImpDeclSpec -> SDoc pprImpDeclSpec iface decl_spec = @@ -1844,13 +1824,12 @@ badImportItemErr iface decl_spec ie avails Just con -> badImportItemErrDataCon (availOccName con) iface decl_spec ie Nothing -> badImportItemErrStd iface decl_spec ie where - checkIfDataCon (AvailTC _ ns _) = - case find (\n -> importedFS == nameOccNameFS n) ns of - Just n -> isDataConName n + checkIfDataCon (AvailTC _ ns) = + case find (\n -> importedFS == occNameFS (occName n)) ns of + Just n -> isDataConName (childName n) Nothing -> False checkIfDataCon _ = False - availOccName = nameOccName . availName - nameOccNameFS = occNameFS . nameOccName + availOccName = occName . availChild importedFS = occNameFS . rdrNameOcc $ ieName ie illegalImportItemErr :: SDoc ===================================== compiler/GHC/Tc/Gen/Export.hs ===================================== @@ -246,13 +246,9 @@ exports_from_avail Nothing rdr_env _imports _this_mod -- Even though we don't check whether this is actually a data family -- only data families can locally define subordinate things (`ns` here) -- without locally defining (and instead importing) the parent (`n`) - fix_faminst (AvailTC n ns flds) = - let new_ns = - case ns of - [] -> [n] - (p:_) -> if p == n then ns else n:ns - in AvailTC n new_ns flds - + fix_faminst avail@(AvailTC n ns) + | availExportsDecl avail = avail + | otherwise = AvailTC n (ChildName n:ns) fix_faminst avail = avail @@ -353,7 +349,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod (n, avail, flds) <- lookup_ie_all ie n' let name = unLoc n return (IEThingAll noExtField (replaceLWrappedName n' (unLoc n)) - , AvailTC name (name:avail) flds) + , availTC name (name:avail) flds) lookup_ie ie@(IEThingWith _ l wc sub_rdrs _) @@ -367,7 +363,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod let name = unLoc lname return (IEThingWith noExtField (replaceLWrappedName l name) wc subs (flds ++ (map noLoc all_flds)), - AvailTC name (name : avails ++ all_avail) + availTC name (name : avails ++ all_avail) (map unLoc flds ++ all_flds)) ===================================== compiler/GHC/Types/Avail.hs ===================================== @@ -10,13 +10,18 @@ module GHC.Types.Avail ( Avails, AvailInfo(..), avail, + availField, + availTC, availsToNameSet, availsToNameSetWithSelectors, availsToNameEnv, - availName, availNames, availNonFldNames, + availExportsDecl, + availName, availChild, + availNames, availNonFldNames, availNamesWithSelectors, availFlds, availChildren, + availSubordinateChildren, stableAvailCmp, plusAvail, trimAvail, @@ -26,7 +31,10 @@ module GHC.Types.Avail ( Child(..), childName, - childSrcSpan + childPrintableName, + childSrcSpan, + partitionChildren, + stableChildCmp, ) where import GHC.Prelude @@ -44,8 +52,9 @@ import GHC.Utils.Panic import GHC.Utils.Misc import Data.Data ( Data ) +import Data.Either ( partitionEithers ) import Data.List ( find ) -import Data.Function +import Data.Maybe -- ----------------------------------------------------------------------------- -- The AvailInfo type @@ -53,24 +62,19 @@ import Data.Function -- | Records what things are \"available\", i.e. in scope data AvailInfo - -- | An ordinary identifier in scope - = Avail Name - - -- | A field label in scope, without a parent type (see - -- Note [Representing pattern synonym fields in AvailInfo]). - | AvailFL FieldLabel + -- | An ordinary identifier in scope, or a field label without a parent type + -- (see Note [Representing pattern synonym fields in AvailInfo]). + = Avail Child -- | A type or class in scope -- -- The __AvailTC Invariant__: If the type or class is itself to be in scope, -- it must be /first/ in this list. Thus, typically: -- - -- > AvailTC Eq [Eq, ==, \/=] [] + -- > AvailTC Eq [Eq, ==, \/=] | AvailTC Name -- ^ The name of the type or class - [Name] -- ^ The available pieces of type or class, - -- excluding record fields. - [FieldLabel] -- ^ The record fields of the type + [Child] -- ^ The available pieces of type or class -- (see Note [Representing fields in AvailInfo]). deriving ( Eq -- ^ Used when deciding if the interface has changed @@ -91,11 +95,11 @@ datatype like gives rise to the AvailInfo - AvailTC T [T, MkT] [FieldLabel "foo" False foo] + AvailTC T [T, MkT, FieldLabel "foo" False foo] whereas if -XDuplicateRecordFields is enabled it gives - AvailTC T [T, MkT] [FieldLabel "foo" True $sel:foo:MkT] + AvailTC T [T, MkT, FieldLabel "foo" True $sel:foo:MkT] since the label does not match the selector name. @@ -109,8 +113,8 @@ multiple distinct fields with the same label. For example, gives rise to - AvailTC F [ F, MkFInt, MkFBool ] - [ FieldLabel "foo" True $sel:foo:MkFInt + AvailTC F [ F, MkFInt, MkFBool + , FieldLabel "foo" True $sel:foo:MkFInt , FieldLabel "foo" True $sel:foo:MkFBool ] Moreover, note that the flIsOverloaded flag need not be the same for @@ -119,8 +123,8 @@ the two data instances are defined in different modules, one with `-XDuplicateRecordFields` enabled and one with it disabled. Thus it is possible to have - AvailTC F [ F, MkFInt, MkFBool ] - [ FieldLabel "foo" True $sel:foo:MkFInt + AvailTC F [ F, MkFInt, MkFBool + , FieldLabel "foo" True $sel:foo:MkFInt , FieldLabel "foo" False foo ] If the two data instances are defined in different modules, both @@ -144,39 +148,42 @@ Thus under -XDuplicateRecordFields -XPatternSynoynms, the declaration gives rise to the AvailInfo - Avail MkFoo - AvailFL (FieldLabel "f" True $sel:f:MkFoo) + Avail (ChildName MkFoo) + Avail (ChildField (FieldLabel "f" True $sel:f:MkFoo)) However, if `f` is bundled with a type constructor `T` by using `T(MkFoo,f)` in an export list, then whenever `f` is imported the parent will be `T`, represented as - AvailTC T [T,MkFoo] [FieldLabel "f" True $sel:f:MkFoo] - - -TODO: perhaps we should refactor AvailInfo like this? - - data AvailInfo = AvailChild Child | AvailTC Name [Child] + AvailTC T [ ChildName T + , ChildName MkFoo + , ChildField (FieldLabel "f" True $sel:f:MkFoo) ] -} -- | Compare lexicographically stableAvailCmp :: AvailInfo -> AvailInfo -> Ordering -stableAvailCmp (Avail n1) (Avail n2) = n1 `stableNameCmp` n2 -stableAvailCmp (Avail {}) (AvailFL {}) = LT -stableAvailCmp (Avail {}) (AvailTC {}) = LT -stableAvailCmp (AvailFL {}) (Avail {}) = GT -stableAvailCmp (AvailFL f) (AvailFL g) = flSelector f `stableNameCmp` flSelector g -stableAvailCmp (AvailFL {}) (AvailTC {}) = LT -stableAvailCmp (AvailTC n ns nfs) (AvailTC m ms mfs) = - (n `stableNameCmp` m) `thenCmp` - (cmpList stableNameCmp ns ms) `thenCmp` - (cmpList (stableNameCmp `on` flSelector) nfs mfs) -stableAvailCmp (AvailTC {}) (Avail {}) = GT -stableAvailCmp (AvailTC {}) (AvailFL {}) = GT +stableAvailCmp (Avail c1) (Avail c2) = c1 `stableChildCmp` c2 +stableAvailCmp (Avail {}) (AvailTC {}) = LT +stableAvailCmp (AvailTC n ns) (AvailTC m ms) = (n `stableNameCmp` m) `thenCmp` + (cmpList stableChildCmp ns ms) +stableAvailCmp (AvailTC {}) (Avail {}) = GT + +stableChildCmp :: Child -> Child -> Ordering +stableChildCmp (ChildName n1) (ChildName n2) = n1 `stableNameCmp` n2 +stableChildCmp (ChildName {}) (ChildField {}) = LT +stableChildCmp (ChildField f1) (ChildField f2) = flSelector f1 `stableNameCmp` flSelector f2 +stableChildCmp (ChildField {}) (ChildName {}) = GT avail :: Name -> AvailInfo -avail n = Avail n +avail n = Avail (ChildName n) + +availField :: FieldLabel -> AvailInfo +availField fl = Avail (ChildField fl) + +availTC :: Name -> [Name] -> [FieldLabel] -> AvailInfo +availTC n ns fls = AvailTC n (map ChildName ns ++ map ChildField fls) + -- ----------------------------------------------------------------------------- -- Operations on AvailInfo @@ -194,42 +201,64 @@ availsToNameEnv avails = foldr add emptyNameEnv avails where add avail env = extendNameEnvList env (zip (availNames avail) (repeat avail)) +-- | Does this 'AvailInfo' export the parent decl? This depends on the +-- invariant that the parent is first if it appears at all. +availExportsDecl :: AvailInfo -> Bool +availExportsDecl (AvailTC ty_name names) + | n : _ <- names = ChildName ty_name == n + | otherwise = False +availExportsDecl _ = True + -- | Just the main name made available, i.e. not the available pieces --- of type or class brought into scope by the 'GenAvailInfo' +-- of type or class brought into scope by the 'AvailInfo' availName :: AvailInfo -> Name -availName (Avail n) = n -availName (AvailFL f) = flSelector f -availName (AvailTC n _ _) = n +availName (Avail n) = childName n +availName (AvailTC n _) = n + +availChild :: AvailInfo -> Child +availChild (Avail c) = c +availChild (AvailTC n _) = ChildName n -- | All names made available by the availability information (excluding overloaded selectors) availNames :: AvailInfo -> [Name] -availNames (Avail n) = [n] -availNames (AvailFL f) = [ flSelector f | not (flIsOverloaded f) ] -availNames (AvailTC _ ns fs) = ns ++ [ flSelector f | f <- fs, not (flIsOverloaded f) ] +availNames (Avail c) = childNonOverloadedNames c +availNames (AvailTC _ cs) = concatMap childNonOverloadedNames cs + +childNonOverloadedNames :: Child -> [Name] +childNonOverloadedNames (ChildName n) = [n] +childNonOverloadedNames (ChildField fl) = [ flSelector fl | not (flIsOverloaded fl) ] -- | All names made available by the availability information (including overloaded selectors) availNamesWithSelectors :: AvailInfo -> [Name] -availNamesWithSelectors (Avail n) = [n] -availNamesWithSelectors (AvailFL fl) = [flSelector fl] -availNamesWithSelectors (AvailTC _ ns fs) = ns ++ map flSelector fs +availNamesWithSelectors (Avail c) = [childName c] +availNamesWithSelectors (AvailTC _ cs) = map childName cs -- | Names for non-fields made available by the availability information availNonFldNames :: AvailInfo -> [Name] -availNonFldNames (Avail n) = [n] -availNonFldNames (AvailFL {}) = [] -availNonFldNames (AvailTC _ ns _) = ns +availNonFldNames (Avail (ChildName n)) = [n] +availNonFldNames (Avail (ChildField {})) = [] +availNonFldNames (AvailTC _ ns) = mapMaybe f ns + where + f (ChildName n) = Just n + f (ChildField {}) = Nothing -- | Fields made available by the availability information availFlds :: AvailInfo -> [FieldLabel] -availFlds (Avail {}) = [] -availFlds (AvailFL f) = [f] -availFlds (AvailTC _ _ fs) = fs +availFlds (Avail c) = maybeToList (childFieldLabel c) +availFlds (AvailTC _ cs) = mapMaybe childFieldLabel cs -- | Children made available by the availability information. availChildren :: AvailInfo -> [Child] -availChildren (Avail n) = [ChildName n] -availChildren (AvailFL fl) = [ChildField fl] -availChildren (AvailTC _ ns fs) = map ChildName ns ++ map ChildField fs +availChildren (Avail c) = [c] +availChildren (AvailTC _ cs) = cs + +-- | Children made available by the availability information, other than the +-- main decl itself. +availSubordinateChildren :: AvailInfo -> [Child] +availSubordinateChildren (Avail {}) = [] +availSubordinateChildren avail@(AvailTC _ ns) + | availExportsDecl avail = tail ns + | otherwise = ns -- | Used where we may have an ordinary name or a record field label. @@ -250,10 +279,26 @@ childName :: Child -> Name childName (ChildName name) = name childName (ChildField fl) = flSelector fl +-- | A Name for the child suitable for output to the user. For fields, the +-- OccName will be the field label. See 'fieldLabelPrintableName'. +childPrintableName :: Child -> Name +childPrintableName (ChildName name) = name +childPrintableName (ChildField fl) = fieldLabelPrintableName fl + childSrcSpan :: Child -> SrcSpan childSrcSpan (ChildName name) = nameSrcSpan name childSrcSpan (ChildField fl) = nameSrcSpan (flSelector fl) +childFieldLabel :: Child -> Maybe FieldLabel +childFieldLabel (ChildName {}) = Nothing +childFieldLabel (ChildField fl) = Just fl + +partitionChildren :: [Child] -> ([Name], [FieldLabel]) +partitionChildren = partitionEithers . map to_either + where + to_either (ChildName n) = Left n + to_either (ChildField fl) = Right fl + -- ----------------------------------------------------------------------------- -- Utility @@ -263,31 +308,22 @@ plusAvail a1 a2 | debugIsOn && availName a1 /= availName a2 = pprPanic "GHC.Rename.Env.plusAvail names differ" (hsep [ppr a1,ppr a2]) plusAvail a1@(Avail {}) (Avail {}) = a1 -plusAvail (AvailTC _ [] []) a2@(AvailTC {}) = a2 -plusAvail a1@(AvailTC {}) (AvailTC _ [] []) = a1 -plusAvail (AvailTC n1 (s1:ss1) fs1) (AvailTC n2 (s2:ss2) fs2) - = case (n1==s1, n2==s2) of -- Maintain invariant the parent is first +plusAvail (AvailTC _ []) a2@(AvailTC {}) = a2 +plusAvail a1@(AvailTC {}) (AvailTC _ []) = a1 +plusAvail (AvailTC n1 (s1:ss1)) (AvailTC n2 (s2:ss2)) + = case (ChildName n1==s1, ChildName n2==s2) of -- Maintain invariant the parent is first (True,True) -> AvailTC n1 (s1 : (ss1 `unionLists` ss2)) - (fs1 `unionLists` fs2) (True,False) -> AvailTC n1 (s1 : (ss1 `unionLists` (s2:ss2))) - (fs1 `unionLists` fs2) (False,True) -> AvailTC n1 (s2 : ((s1:ss1) `unionLists` ss2)) - (fs1 `unionLists` fs2) (False,False) -> AvailTC n1 ((s1:ss1) `unionLists` (s2:ss2)) - (fs1 `unionLists` fs2) -plusAvail (AvailTC n1 ss1 fs1) (AvailTC _ [] fs2) - = AvailTC n1 ss1 (fs1 `unionLists` fs2) -plusAvail (AvailTC n1 [] fs1) (AvailTC _ ss2 fs2) - = AvailTC n1 ss2 (fs1 `unionLists` fs2) plusAvail a1 a2 = pprPanic "GHC.Rename.Env.plusAvail" (hsep [ppr a1,ppr a2]) -- | trims an 'AvailInfo' to keep only a single name trimAvail :: AvailInfo -> Name -> AvailInfo -trimAvail (Avail n) _ = Avail n -trimAvail (AvailFL f) _ = AvailFL f -trimAvail (AvailTC n ns fs) m = case find ((== m) . flSelector) fs of - Just x -> AvailTC n [] [x] - Nothing -> ASSERT( m `elem` ns ) AvailTC n [m] [] +trimAvail avail@(Avail {}) _ = avail +trimAvail avail@(AvailTC n ns) m = case find ((== m) . childName) ns of + Just c -> AvailTC n [c] + Nothing -> pprPanic "trimAvail" (hsep [ppr avail, ppr m]) -- | filters 'AvailInfo's by the given predicate filterAvails :: (Name -> Bool) -> [AvailInfo] -> [AvailInfo] @@ -297,14 +333,11 @@ filterAvails keep avails = foldr (filterAvail keep) [] avails filterAvail :: (Name -> Bool) -> AvailInfo -> [AvailInfo] -> [AvailInfo] filterAvail keep ie rest = case ie of - Avail n | keep n -> ie : rest + Avail c | keep (childName c) -> ie : rest | otherwise -> rest - AvailFL fl | keep (flSelector fl) -> ie : rest - | otherwise -> rest - AvailTC tc ns fs -> - let ns' = filter keep ns - fs' = filter (keep . flSelector) fs in - if null ns' && null fs' then rest else AvailTC tc ns' fs' : rest + AvailTC tc cs -> + let cs' = filter (keep . childName) cs + in if null cs' then rest else AvailTC tc cs' : rest -- | Combines 'AvailInfo's from the same family @@ -326,32 +359,37 @@ instance Outputable AvailInfo where pprAvail :: AvailInfo -> SDoc pprAvail (Avail n) = ppr n -pprAvail (AvailFL fl) - = ppr fl -pprAvail (AvailTC n ns fs) - = ppr n <> braces (sep [ fsep (punctuate comma (map ppr ns)) <> semi - , fsep (punctuate comma (map (ppr . flLabel) fs))]) +pprAvail (AvailTC n ns) + = ppr n <> braces (fsep (punctuate comma (map ppr ns))) instance Binary AvailInfo where put_ bh (Avail aa) = do putByte bh 0 put_ bh aa - put_ bh (AvailTC ab ac ad) = do + put_ bh (AvailTC ab ac) = do putByte bh 1 put_ bh ab put_ bh ac - put_ bh ad - put_ bh (AvailFL af) = do - putByte bh 2 - put_ bh af get bh = do h <- getByte bh case h of 0 -> do aa <- get bh return (Avail aa) - 1 -> do ab <- get bh + _ -> do ab <- get bh ac <- get bh - ad <- get bh - return (AvailTC ab ac ad) - _ -> do af <- get bh - return (AvailFL af) + return (AvailTC ab ac) + +instance Binary Child where + put_ bh (ChildName aa) = do + putByte bh 0 + put_ bh aa + put_ bh (ChildField ab) = do + putByte bh 1 + put_ bh ab + get bh = do + h <- getByte bh + case h of + 0 -> do aa <- get bh + return (ChildName aa) + _ -> do ab <- get bh + return (ChildField ab) ===================================== compiler/GHC/Types/Name/Reader.hs ===================================== @@ -659,9 +659,7 @@ gre_name gre = case gre_child gre of -- | A Name for the GRE's child suitable for output to the user. Its OccName -- will be the greOccName. grePrintableName :: GlobalRdrElt -> Name -grePrintableName gre = case gre_child gre of - ChildName name -> name - ChildField fl -> fieldLabelPrintableName fl +grePrintableName = childPrintableName . gre_child -- | The SrcSpan of the name pointed to by the GRE. greDefinitionSrcSpan :: GlobalRdrElt -> SrcSpan @@ -703,15 +701,13 @@ greSrcSpan gre@(GRE { gre_lcl = lcl, gre_imp = iss } ) | otherwise = pprPanic "greSrcSpan" (ppr gre) mkParent :: Name -> AvailInfo -> Parent -mkParent _ (Avail _) = NoParent -mkParent _ (AvailFL _) = NoParent -mkParent n (AvailTC m _ _) | n == m = NoParent - | otherwise = ParentIs m +mkParent _ (Avail _) = NoParent +mkParent n (AvailTC m _) | n == m = NoParent + | otherwise = ParentIs m availParent :: AvailInfo -> Parent -availParent (AvailTC m _ _) = ParentIs m -availParent (Avail {}) = NoParent -availParent (AvailFL {}) = NoParent +availParent (AvailTC m _) = ParentIs m +availParent (Avail {}) = NoParent greParent_maybe :: GlobalRdrElt -> Maybe Name @@ -749,30 +745,25 @@ gresToAvailInfo gres -- need to maintain the invariant that the parent is first. -- -- We also use the invariant that `k` is not already in `ns`. - insertChildIntoChildren :: Name -> [Name] -> Name -> [Name] + insertChildIntoChildren :: Name -> [Child] -> Child -> [Child] insertChildIntoChildren _ [] k = [k] insertChildIntoChildren p (n:ns) k - | p == k = k:n:ns + | ChildName p == k = k:n:ns | otherwise = n:k:ns comb :: GlobalRdrElt -> AvailInfo -> AvailInfo - comb _ (Avail n) = Avail n -- Duplicated name, should not happen - comb _ (AvailFL fl) = AvailFL fl - comb gre (AvailTC m ns fls) - = case (gre_par gre, gre_child gre) of - (NoParent, ChildName me) -> AvailTC m (me:ns) fls -- Not sure this ever happens - (NoParent, ChildField fl) -> AvailTC m ns (fl:fls) - (ParentIs {}, ChildName me) -> AvailTC m (insertChildIntoChildren m ns me) fls - (ParentIs {}, ChildField fl) -> AvailTC m ns (fl:fls) + comb _ (Avail n) = Avail n -- Duplicated name, should not happen + comb gre (AvailTC m ns) + = case gre_par gre of + NoParent -> AvailTC m (gre_child gre:ns) -- Not sure this ever happens + ParentIs {} -> AvailTC m (insertChildIntoChildren m ns (gre_child gre)) availFromGRE :: GlobalRdrElt -> AvailInfo availFromGRE (GRE { gre_child = child, gre_par = parent }) - = case (parent, child) of - (ParentIs p, ChildName me) -> AvailTC p [me] [] - (ParentIs p, ChildField fl) -> AvailTC p [] [fl] - (NoParent, ChildName me) | isTyConName me -> AvailTC me [me] [] - | otherwise -> avail me - (NoParent, ChildField fl) -> AvailFL fl + = case parent of + ParentIs p -> AvailTC p [child] + NoParent | ChildName me <- child, isTyConName me -> AvailTC me [child] + | otherwise -> Avail child emptyGlobalRdrEnv :: GlobalRdrEnv emptyGlobalRdrEnv = emptyOccEnv ===================================== compiler/GHC/Types/Name/Shape.hs ===================================== @@ -183,14 +183,17 @@ substName env n | Just n' <- lookupNameEnv env n = n' -- for type constructors, where it is sufficient to substitute the 'availName' -- to induce a substitution on 'availNames'. substNameAvailInfo :: HscEnv -> ShNameSubst -> AvailInfo -> IO AvailInfo -substNameAvailInfo _ env (Avail n) = return (Avail (substName env n)) -substNameAvailInfo _ env (AvailFL fl) = - return (AvailFL fl { flSelector = substName env (flSelector fl) }) -substNameAvailInfo hsc_env env (AvailTC n ns fs) = +substNameAvailInfo _ env (Avail (ChildName n)) = return (Avail (ChildName (substName env n))) +substNameAvailInfo _ env (Avail (ChildField fl)) = + return (Avail (ChildField fl { flSelector = substName env (flSelector fl) })) +substNameAvailInfo hsc_env env (AvailTC n ns) = let mb_mod = fmap nameModule (lookupNameEnv env n) - in AvailTC (substName env n) - <$> mapM (initIfaceLoad hsc_env . setNameModule mb_mod) ns - <*> mapM (setNameFieldSelector hsc_env mb_mod) fs + in AvailTC (substName env n) <$> mapM (setNameChild hsc_env mb_mod) ns + +setNameChild :: HscEnv -> Maybe Module -> Child -> IO Child +setNameChild hsc_env mb_mod child = case child of + ChildName n -> ChildName <$> initIfaceLoad hsc_env (setNameModule mb_mod n) + ChildField fl -> ChildField <$> setNameFieldSelector hsc_env mb_mod fl -- | Set the 'Module' of a 'FieldSelector' setNameFieldSelector :: HscEnv -> Maybe Module -> FieldLabel -> IO FieldLabel @@ -237,8 +240,8 @@ uAvailInfos flexi as1 as2 = -- pprTrace "uAvailInfos" (ppr as1 $$ ppr as2) $ -- with only name holes from @flexi@ unifiable (all other name holes rigid.) uAvailInfo :: ModuleName -> ShNameSubst -> AvailInfo -> AvailInfo -> Either SDoc ShNameSubst -uAvailInfo flexi subst (Avail n1) (Avail n2) = uName flexi subst n1 n2 -uAvailInfo flexi subst (AvailTC n1 _ _) (AvailTC n2 _ _) = uName flexi subst n1 n2 +uAvailInfo flexi subst (Avail (ChildName n1)) (Avail (ChildName n2)) = uName flexi subst n1 n2 +uAvailInfo flexi subst (AvailTC n1 _) (AvailTC n2 _) = uName flexi subst n1 n2 uAvailInfo _ _ a1 a2 = Left $ text "While merging export lists, could not combine" <+> ppr a1 <+> text "with" <+> ppr a2 <+> parens (text "one is a type, the other is a plain identifier") ===================================== compiler/GHC/Types/TyThing.hs ===================================== @@ -253,11 +253,10 @@ tyThingsTyCoVars tts = tyThingAvailInfo :: TyThing -> [AvailInfo] tyThingAvailInfo (ATyCon t) = case tyConClass_maybe t of - Just c -> [AvailTC n (n : map getName (classMethods c) - ++ map getName (classATs c)) - [] ] + Just c -> [availTC n ((n : map getName (classMethods c) + ++ map getName (classATs c))) [] ] where n = getName c - Nothing -> [AvailTC n (n : map getName dcs) flds] + Nothing -> [availTC n (n : map getName dcs) flds] where n = getName t dcs = tyConDataCons t flds = tyConFieldLabels t ===================================== testsuite/tests/parser/should_compile/T14189.stderr ===================================== @@ -138,12 +138,15 @@ {Name: T14189.f}))])) [(AvailTC {Name: T14189.MyType} - [{Name: T14189.MyType} - ,{Name: T14189.NT}] - [(FieldLabel - {FastString: "f"} - (False) - {Name: T14189.f})])])]) + [(ChildName + {Name: T14189.MyType}) + ,(ChildName + {Name: T14189.NT}) + ,(ChildField + (FieldLabel + {FastString: "f"} + (False) + {Name: T14189.f}))])])]) (Nothing))) ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit ad9cbad7312a64e6757c32bd9488c55ba4f2fec9 +Subproject commit 3d3308a332468f33b5cc32918179bd3f10ee16db View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/655acd4deacffc5432d9b6615ff30cb9c6bc9f33 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/655acd4deacffc5432d9b6615ff30cb9c6bc9f33 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 1 10:56:31 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Tue, 01 Dec 2020 05:56:31 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/sgraf-dmdanal-stuff Message-ID: <5fc6215f9d690_86c3fc6ab83037c116688e@gitlab.mail> Sebastian Graf pushed new branch wip/sgraf-dmdanal-stuff at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/sgraf-dmdanal-stuff You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 1 11:05:30 2020 From: gitlab at gitlab.haskell.org (Andreas Klebinger) Date: Tue, 01 Dec 2020 06:05:30 -0500 Subject: [Git][ghc/ghc][wip/andreask/fix_rts_warnings] Rts/elf-linker: Upcast to 64bit to satisfy format string. Message-ID: <5fc6237a5841_86c13315e801167045@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/fix_rts_warnings at Glasgow Haskell Compiler / GHC Commits: 79285cb6 by Andreas Klebinger at 2020-12-01T12:05:11+01:00 Rts/elf-linker: Upcast to 64bit to satisfy format string. The elf size is 32bit on 32bit builds and 64 otherwise. We just upcast to 64bits before printing now. - - - - - 1 changed file: - rts/linker/Elf.c Changes: ===================================== rts/linker/Elf.c ===================================== @@ -904,8 +904,8 @@ ocGetNames_ELF ( ObjectCode* oc ) ASSERT(common_used <= common_size); IF_DEBUG(linker, - debugBelch("COMMON symbol, size %ld name %s allocated at %p\n", - symbol->elf_sym->st_size, nm, symbol->addr)); + debugBelch("COMMON symbol, size %llu name %s allocated at %p\n", + (long long unsigned int) symbol->elf_sym->st_size, nm, symbol->addr)); /* Pointless to do addProddableBlock() for this area, since the linker should never poke around in it. */ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/79285cb614d656f2fd94e2fe1a0430e6604028bf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/79285cb614d656f2fd94e2fe1a0430e6604028bf You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 1 11:25:29 2020 From: gitlab at gitlab.haskell.org (Andreas Klebinger) Date: Tue, 01 Dec 2020 06:25:29 -0500 Subject: [Git][ghc/ghc][wip/andreask/opt_cmm_sink_sets] Cmm.Sink: Optimize retaining of assignments, live sets. Message-ID: <5fc628295ec66_86c13315e8011708fb@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/opt_cmm_sink_sets at Glasgow Haskell Compiler / GHC Commits: 598bec4c by Andreas Klebinger at 2020-12-01T12:09:08+01:00 Cmm.Sink: Optimize retaining of assignments, live sets. Sinking requires us to track live local regs after each cmm statement. We used to do this via "Set LocalReg". However we can replace this with a solution based on IntSet which is overall more efficient without losing much. The thing we lose is width of the variables, which isn't used by the sinking pass anyway. I also reworked how we keep assignments to regs mentioned in skipped assignments. I put the details into Note [Keeping assignemnts mentioned in skipped RHSs]. The gist of it is instead of keeping track of it via the use count which is a `IntMap Int` we now use the live regs set (IntSet) which is quite a bit faster. I think it also matches the semantics a lot better. The skipped (not discarded) assignment does in fact keep the regs on it's rhs alive so keeping track of this in the live set seems like the clearer solution as well. Improves allocations for T3294 by yet another 1%. - - - - - 5 changed files: - + compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Liveness.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Utils/Outputable.hs - compiler/ghc.cabal.in Changes: ===================================== compiler/GHC/Cmm/LRegSet.hs ===================================== @@ -0,0 +1,49 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module GHC.Cmm.LRegSet ( + LRegSet, + LRegKey, + + emptyLRegSet, + nullLRegSet, + insertLRegSet, + elemLRegSet, + + deleteFromLRegSet, + sizeLRegSet, + + plusLRegSet + ) where + +import GHC.Prelude +import GHC.Types.Unique +import GHC.Cmm.Expr + +import Data.IntSet as IntSet + +-- Compact sets for membership tests of local variables. + +type LRegSet = IntSet.IntSet +type LRegKey = Int + +emptyLRegSet :: LRegSet +emptyLRegSet = IntSet.empty + +nullLRegSet :: LRegSet -> Bool +nullLRegSet = IntSet.null + +insertLRegSet :: LocalReg -> LRegSet -> LRegSet +insertLRegSet l = IntSet.insert (getKey (getUnique l)) + +elemLRegSet :: LocalReg -> LRegSet -> Bool +elemLRegSet l = IntSet.member (getKey (getUnique l)) + +deleteFromLRegSet :: LRegSet -> LocalReg -> LRegSet +deleteFromLRegSet set reg = IntSet.delete (getKey . getUnique $ reg) set + +sizeLRegSet :: IntSet -> Int +sizeLRegSet = IntSet.size + +plusLRegSet :: IntSet -> IntSet -> IntSet +plusLRegSet = IntSet.union ===================================== compiler/GHC/Cmm/Liveness.hs ===================================== @@ -6,9 +6,12 @@ module GHC.Cmm.Liveness ( CmmLocalLive , cmmLocalLiveness + , cmmLocalLivenessL , cmmGlobalLiveness , liveLattice + , liveLatticeL , gen_kill + , gen_killL ) where @@ -22,6 +25,7 @@ import GHC.Cmm.Dataflow.Block import GHC.Cmm.Dataflow.Collections import GHC.Cmm.Dataflow import GHC.Cmm.Dataflow.Label +import GHC.Cmm.LRegSet import GHC.Data.Maybe import GHC.Utils.Outputable @@ -92,3 +96,63 @@ xferLive platform (BlockCC eNode middle xNode) fBase = in mapSingleton (entryLabel eNode) result {-# SPECIALIZE xferLive :: Platform -> TransferFun (CmmLive LocalReg) #-} {-# SPECIALIZE xferLive :: Platform -> TransferFun (CmmLive GlobalReg) #-} + +----------------------------------------------------------------------------- +-- | Specialization that only retains the keys for local variables. +-- +-- Local variablas are mostly glorified Ints, and some parts of the compiler +-- really don't care about anything but the Int part. So we can avoid some +-- overhead by computing a IntSet instead of a Set LocalReg which (unsurprisingly) +-- is quite a bit faster. +----------------------------------------------------------------------------- + +type BlockEntryLivenessL = LabelMap LRegSet + +-- | The dataflow lattice +liveLatticeL :: DataflowLattice LRegSet +liveLatticeL = DataflowLattice emptyLRegSet add + where + add (OldFact old) (NewFact new) = + let !join = plusLRegSet old new + in changedIf (sizeLRegSet join > sizeLRegSet old) join + + +cmmLocalLivenessL :: Platform -> CmmGraph -> BlockEntryLivenessL +cmmLocalLivenessL platform graph = + check $ analyzeCmmBwd liveLatticeL (xferLiveL platform) graph mapEmpty + where + entry = g_entry graph + check facts = + noLiveOnEntryL entry (expectJust "check" $ mapLookup entry facts) facts + +-- | On entry to the procedure, there had better not be any LocalReg's live-in. +noLiveOnEntryL :: BlockId -> LRegSet -> a -> a +noLiveOnEntryL bid in_fact x = + if nullLRegSet in_fact then x + -- TODO: Since LRegSet is a synonym we will just dump the keys as ints, + -- which is not actually that helpful. + else pprPanic "LocalReg's live-in to graph" (ppr bid <+> ppr in_fact) + + + +gen_killL + :: (DefinerOfRegs LocalReg n, UserOfRegs LocalReg n) + => Platform -> n -> LRegSet -> LRegSet +gen_killL platform node set = + let !afterKill = foldRegsDefd platform deleteFromLRegSet set node + in foldRegsUsed platform (flip insertLRegSet) afterKill node +{-# INLINE gen_killL #-} + +xferLiveL + :: ( UserOfRegs LocalReg (CmmNode O O) + , DefinerOfRegs LocalReg (CmmNode O O) + , UserOfRegs LocalReg (CmmNode O C) + , DefinerOfRegs LocalReg (CmmNode O C) + ) + => Platform -> TransferFun LRegSet +xferLiveL platform (BlockCC eNode middle xNode) fBase = + let joined = gen_killL platform xNode $! joinOutFacts liveLatticeL xNode fBase + !result = foldNodesBwdOO (gen_killL platform) middle joined + in mapSingleton (entryLabel eNode) result + + ===================================== compiler/GHC/Cmm/Sink.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE ScopedTypeVariables #-} + module GHC.Cmm.Sink ( cmmSink ) where @@ -9,6 +10,7 @@ import GHC.Prelude import GHC.Cmm import GHC.Cmm.Opt import GHC.Cmm.Liveness +import GHC.Cmm.LRegSet import GHC.Cmm.Utils import GHC.Cmm.Dataflow.Block import GHC.Cmm.Dataflow.Label @@ -17,32 +19,14 @@ import GHC.Cmm.Dataflow.Graph import GHC.Platform.Regs import GHC.Platform -import GHC.Types.Unique import GHC.Types.Unique.FM import qualified Data.IntSet as IntSet import Data.List (partition) -import qualified Data.Set as Set import Data.Maybe import GHC.Exts (inline) --- Compact sets for membership tests of local variables. - -type LRegSet = IntSet.IntSet - -emptyLRegSet :: LRegSet -emptyLRegSet = IntSet.empty - -nullLRegSet :: LRegSet -> Bool -nullLRegSet = IntSet.null - -insertLRegSet :: LocalReg -> LRegSet -> LRegSet -insertLRegSet l = IntSet.insert (getKey (getUnique l)) - -elemLRegSet :: LocalReg -> LRegSet -> Bool -elemLRegSet l = IntSet.member (getKey (getUnique l)) - -- ----------------------------------------------------------------------------- -- Sinking and inlining @@ -170,8 +154,8 @@ type Assignments = [Assignment] cmmSink :: Platform -> CmmGraph -> CmmGraph cmmSink platform graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks where - liveness = cmmLocalLiveness platform graph - getLive l = mapFindWithDefault Set.empty l liveness + liveness = cmmLocalLivenessL platform graph + getLive l = mapFindWithDefault emptyLRegSet l liveness blocks = revPostorder graph @@ -191,8 +175,8 @@ cmmSink platform graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks -- Annotate the middle nodes with the registers live *after* -- the node. This will help us decide whether we can inline -- an assignment in the current node or not. - live = Set.unions (map getLive succs) - live_middle = gen_kill platform last live + live = IntSet.unions (map getLive succs) + live_middle = gen_killL platform last live ann_middles = annotate platform live_middle (blockToList middle) -- Now sink and inline in this block @@ -204,7 +188,7 @@ cmmSink platform graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks -- one predecessor), so identify the join points and the set -- of registers live in them. (joins, nonjoins) = partition (`mapMember` join_pts) succs - live_in_joins = Set.unions (map getLive joins) + live_in_joins = IntSet.unions (map getLive joins) -- We do not want to sink an assignment into multiple branches, -- so identify the set of registers live in multiple successors. @@ -213,26 +197,28 @@ cmmSink platform graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks -- now live in multiple branches. init_live_sets = map getLive nonjoins live_in_multi live_sets r = - case filter (Set.member r) live_sets of + case filter (elemLRegSet r) live_sets of (_one:_two:_) -> True _ -> False -- Now, drop any assignments that we will not sink any further. (dropped_last, assigs'') = dropAssignments platform drop_if init_live_sets assigs' + drop_if :: (LocalReg, CmmExpr, AbsMem) + -> [LRegSet] -> (Bool, [LRegSet]) drop_if a@(r,rhs,_) live_sets = (should_drop, live_sets') where should_drop = conflicts platform a final_last || not (isTrivial platform rhs) && live_in_multi live_sets r - || r `Set.member` live_in_joins + || r `elemLRegSet` live_in_joins live_sets' | should_drop = live_sets | otherwise = map upd live_sets - upd set | r `Set.member` set = set `Set.union` live_rhs + upd set | r `elemLRegSet` set = set `IntSet.union` live_rhs | otherwise = set - live_rhs = foldRegsUsed platform extendRegSet emptyRegSet rhs + live_rhs = foldRegsUsed platform (flip insertLRegSet) emptyLRegSet rhs final_middle = foldl' blockSnoc middle' dropped_last @@ -269,9 +255,9 @@ isTrivial _ _ = False -- -- annotate each node with the set of registers live *after* the node -- -annotate :: Platform -> LocalRegSet -> [CmmNode O O] -> [(LocalRegSet, CmmNode O O)] +annotate :: Platform -> LRegSet -> [CmmNode O O] -> [(LRegSet, CmmNode O O)] annotate platform live nodes = snd $ foldr ann (live,[]) nodes - where ann n (live,nodes) = (gen_kill platform n live, (live,n) : nodes) + where ann n (live,nodes) = (gen_killL platform n live, (live,n) : nodes) -- -- Find the blocks that have multiple successors (join points) @@ -288,13 +274,13 @@ findJoinPoints blocks = mapFilter (>1) succ_counts -- filter the list of assignments to remove any assignments that -- are not live in a continuation. -- -filterAssignments :: Platform -> LocalRegSet -> Assignments -> Assignments +filterAssignments :: Platform -> LRegSet -> Assignments -> Assignments filterAssignments platform live assigs = reverse (go assigs []) where go [] kept = kept go (a@(r,_,_):as) kept | needed = go as (a:kept) | otherwise = go as kept where - needed = r `Set.member` live + needed = r `elemLRegSet` live || any (conflicts platform a) (map toNode kept) -- Note that we must keep assignments that are -- referred to by other assignments we have @@ -315,7 +301,7 @@ filterAssignments platform live assigs = reverse (go assigs []) -- walk :: Platform - -> [(LocalRegSet, CmmNode O O)] -- nodes of the block, annotated with + -> [(LRegSet, CmmNode O O)] -- nodes of the block, annotated with -- the set of registers live *after* -- this node. @@ -369,11 +355,11 @@ shouldSink _ _other = Nothing -- out of inlining, but the inliner will see that r is live -- after the instruction and choose not to inline r in the rhs. -- -shouldDiscard :: CmmNode e x -> LocalRegSet -> Bool +shouldDiscard :: CmmNode e x -> LRegSet -> Bool shouldDiscard node live = case node of CmmAssign r (CmmReg r') | r == r' -> True - CmmAssign (CmmLocal r) _ -> not (r `Set.member` live) + CmmAssign (CmmLocal r) _ -> not (r `elemLRegSet` live) _otherwise -> False @@ -407,7 +393,8 @@ dropAssignments platform should_drop state assigs tryToInline :: forall x. Platform - -> LocalRegSet -- set of registers live after this + -> LRegSet -- set of registers live after this + -- -> LocalRegSet -- set of registers live after this -- node. We cannot inline anything -- that is live after the node, unless -- it is small enough to duplicate. @@ -418,36 +405,42 @@ tryToInline , Assignments -- Remaining assignments ) -tryToInline platform live node assigs = go usages node emptyLRegSet assigs +tryToInline platform liveAfter node assigs = + -- pprTrace "tryToInline assig length:" (ppr $ length assigs) $ + go usages liveAfter node emptyLRegSet assigs where usages :: UniqFM LocalReg Int -- Maps each LocalReg to a count of how often it is used usages = foldLocalRegsUsed platform addUsage emptyUFM node - go _usages node _skipped [] = (node, []) + go :: UniqFM LocalReg Int -> LRegSet -> CmmNode O x -> LRegSet -> Assignments + -> (CmmNode O x, Assignments) + go _usages _live node _skipped [] = (node, []) - go usages node skipped (a@(l,rhs,_) : rest) - | cannot_inline = dont_inline - | occurs_none = discard -- Note [discard during inlining] - | occurs_once = inline_and_discard - | isTrivial platform rhs = inline_and_keep - | otherwise = dont_inline + go usages live node skipped (a@(l,rhs,_) : rest) + | cannot_inline = dont_inline + | occurs_none = discard -- Note [discard during inlining] + | occurs_once = inline_and_discard + | isTrivial platform rhs = inline_and_keep + | otherwise = dont_inline where - inline_and_discard = go usages' inl_node skipped rest + inline_and_discard = go usages' live inl_node skipped rest where usages' = foldLocalRegsUsed platform addUsage usages rhs - discard = go usages node skipped rest + discard = go usages live node skipped rest dont_inline = keep node -- don't inline the assignment, keep it inline_and_keep = keep inl_node -- inline the assignment, keep it keep :: CmmNode O x -> (CmmNode O x, Assignments) keep node' = (final_node, a : rest') - where (final_node, rest') = go usages' node' (insertLRegSet l skipped) rest + where (final_node, rest') = go usages live' node' (insertLRegSet l skipped) rest -- Avoid discarding of assignments to vars on the rhs. -- See Note [Keeping assignemnts mentioned in skipped RHSs] - usages' = foldLocalRegsUsed platform (\m r -> addToUFM m r 2) - usages rhs + -- usages' = foldLocalRegsUsed platform (\m r -> addToUFM m r 2) + -- usages rhs + live' = inline foldLocalRegsUsed platform (\m r -> insertLRegSet r m) + live rhs cannot_inline = skipped `regsUsedIn` rhs -- Note [dependent assignments] || l `elemLRegSet` skipped @@ -455,7 +448,7 @@ tryToInline platform live node assigs = go usages node emptyLRegSet assigs -- How often is l used in the current node. l_usages = lookupUFM usages l - l_live = l `elemRegSet` live + l_live = l `elemLRegSet` live occurs_once = not l_live && l_usages == Just 1 occurs_none = not l_live && l_usages == Nothing @@ -483,9 +476,11 @@ tryToInline platform live node assigs = go usages node emptyLRegSet assigs referencing a variable which hasn't been mentioned after inlining. - We use a hack to do this, which is setting all regs used on the - RHS to two uses. Since we only discard assignments to variables - which are used once or never this prevents discarding of the + We use a hack to do this. + + We pretend the regs from the rhs are live after the current + node. Since we only discard assignments to variables + which are dead after the current block this prevents discarding of the assignment. It still allows inlining should e1 be a trivial rhs however. ===================================== compiler/GHC/Utils/Outputable.hs ===================================== @@ -112,6 +112,7 @@ import Data.Int import qualified Data.IntMap as IM import Data.Set (Set) import qualified Data.Set as Set +import qualified Data.IntSet as IntSet import Data.String import Data.Word import System.IO ( Handle ) @@ -859,6 +860,9 @@ instance (Outputable a) => Outputable (NonEmpty a) where instance (Outputable a) => Outputable (Set a) where ppr s = braces (fsep (punctuate comma (map ppr (Set.toList s)))) +instance Outputable IntSet.IntSet where + ppr s = braces (fsep (punctuate comma (map ppr (IntSet.toList s)))) + instance (Outputable a, Outputable b) => Outputable (a, b) where ppr (x,y) = parens (sep [ppr x <> comma, ppr y]) ===================================== compiler/ghc.cabal.in ===================================== @@ -204,6 +204,7 @@ Library GHC.Cmm.Switch GHC.Cmm.Switch.Implement GHC.CmmToAsm + GHC.Cmm.LRegSet GHC.CmmToAsm.BlockLayout GHC.CmmToAsm.CFG GHC.CmmToAsm.CFG.Dominators View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/598bec4c7f6339a9f3d8f3b616d76cff29422c32 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/598bec4c7f6339a9f3d8f3b616d76cff29422c32 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 1 13:27:17 2020 From: gitlab at gitlab.haskell.org (Andreas Klebinger) Date: Tue, 01 Dec 2020 08:27:17 -0500 Subject: [Git][ghc/ghc][wip/andreask/opt_cmm_sink_sets] GHC.Cmm.Opt: Be stricter in results. Message-ID: <5fc644b538598_86c113040b01175414@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/opt_cmm_sink_sets at Glasgow Haskell Compiler / GHC Commits: 2db81a08 by Andreas Klebinger at 2020-12-01T13:01:00+01:00 GHC.Cmm.Opt: Be stricter in results. Optimization either returns Nothing if nothing is to be done or `Just <cmmExpr>` otherwise. There is no point in being lazy in `cmmExpr`. We usually inspect this element so the thunk gets forced not long after. We might eliminate it as dead code once in a blue moon but that's not a case worth optimizing for. Overall the impact of this is rather low. As Cmm.Opt doesn't allocate much (compared to the rest of GHC) to begin with. - - - - - 1 changed file: - compiler/GHC/Cmm/Opt.hs Changes: ===================================== compiler/GHC/Cmm/Opt.hs ===================================== @@ -58,7 +58,7 @@ cmmMachOpFoldM -> Maybe CmmExpr cmmMachOpFoldM _ op [CmmLit (CmmInt x rep)] - = Just $ case op of + = Just $! case op of MO_S_Neg _ -> CmmLit (CmmInt (-x) rep) MO_Not _ -> CmmLit (CmmInt (complement x) rep) @@ -90,13 +90,13 @@ cmmMachOpFoldM platform conv_outer [CmmMachOp conv_inner [x]] -- but remember to use the signedness from the widening, just in case -- the final conversion is a widen. | rep1 < rep2 && rep2 > rep3 -> - Just $ cmmMachOpFold platform (intconv signed1 rep1 rep3) [x] + Just $! cmmMachOpFold platform (intconv signed1 rep1 rep3) [x] -- Nested widenings: collapse if the signedness is the same | rep1 < rep2 && rep2 < rep3 && signed1 == signed2 -> - Just $ cmmMachOpFold platform (intconv signed1 rep1 rep3) [x] + Just $! cmmMachOpFold platform (intconv signed1 rep1 rep3) [x] -- Nested narrowings: collapse | rep1 > rep2 && rep2 > rep3 -> - Just $ cmmMachOpFold platform (MO_UU_Conv rep1 rep3) [x] + Just $! cmmMachOpFold platform (MO_UU_Conv rep1 rep3) [x] | otherwise -> Nothing where @@ -117,34 +117,34 @@ cmmMachOpFoldM platform mop [CmmLit (CmmInt x xrep), CmmLit (CmmInt y _)] = case mop of -- for comparisons: don't forget to narrow the arguments before -- comparing, since they might be out of range. - MO_Eq _ -> Just $ CmmLit (CmmInt (if x_u == y_u then 1 else 0) (wordWidth platform)) - MO_Ne _ -> Just $ CmmLit (CmmInt (if x_u /= y_u then 1 else 0) (wordWidth platform)) - - MO_U_Gt _ -> Just $ CmmLit (CmmInt (if x_u > y_u then 1 else 0) (wordWidth platform)) - MO_U_Ge _ -> Just $ CmmLit (CmmInt (if x_u >= y_u then 1 else 0) (wordWidth platform)) - MO_U_Lt _ -> Just $ CmmLit (CmmInt (if x_u < y_u then 1 else 0) (wordWidth platform)) - MO_U_Le _ -> Just $ CmmLit (CmmInt (if x_u <= y_u then 1 else 0) (wordWidth platform)) - - MO_S_Gt _ -> Just $ CmmLit (CmmInt (if x_s > y_s then 1 else 0) (wordWidth platform)) - MO_S_Ge _ -> Just $ CmmLit (CmmInt (if x_s >= y_s then 1 else 0) (wordWidth platform)) - MO_S_Lt _ -> Just $ CmmLit (CmmInt (if x_s < y_s then 1 else 0) (wordWidth platform)) - MO_S_Le _ -> Just $ CmmLit (CmmInt (if x_s <= y_s then 1 else 0) (wordWidth platform)) - - MO_Add r -> Just $ CmmLit (CmmInt (x + y) r) - MO_Sub r -> Just $ CmmLit (CmmInt (x - y) r) - MO_Mul r -> Just $ CmmLit (CmmInt (x * y) r) - MO_U_Quot r | y /= 0 -> Just $ CmmLit (CmmInt (x_u `quot` y_u) r) - MO_U_Rem r | y /= 0 -> Just $ CmmLit (CmmInt (x_u `rem` y_u) r) - MO_S_Quot r | y /= 0 -> Just $ CmmLit (CmmInt (x `quot` y) r) - MO_S_Rem r | y /= 0 -> Just $ CmmLit (CmmInt (x `rem` y) r) - - MO_And r -> Just $ CmmLit (CmmInt (x .&. y) r) - MO_Or r -> Just $ CmmLit (CmmInt (x .|. y) r) - MO_Xor r -> Just $ CmmLit (CmmInt (x `xor` y) r) - - MO_Shl r -> Just $ CmmLit (CmmInt (x `shiftL` fromIntegral y) r) - MO_U_Shr r -> Just $ CmmLit (CmmInt (x_u `shiftR` fromIntegral y) r) - MO_S_Shr r -> Just $ CmmLit (CmmInt (x `shiftR` fromIntegral y) r) + MO_Eq _ -> Just $! CmmLit (CmmInt (if x_u == y_u then 1 else 0) (wordWidth platform)) + MO_Ne _ -> Just $! CmmLit (CmmInt (if x_u /= y_u then 1 else 0) (wordWidth platform)) + + MO_U_Gt _ -> Just $! CmmLit (CmmInt (if x_u > y_u then 1 else 0) (wordWidth platform)) + MO_U_Ge _ -> Just $! CmmLit (CmmInt (if x_u >= y_u then 1 else 0) (wordWidth platform)) + MO_U_Lt _ -> Just $! CmmLit (CmmInt (if x_u < y_u then 1 else 0) (wordWidth platform)) + MO_U_Le _ -> Just $! CmmLit (CmmInt (if x_u <= y_u then 1 else 0) (wordWidth platform)) + + MO_S_Gt _ -> Just $! CmmLit (CmmInt (if x_s > y_s then 1 else 0) (wordWidth platform)) + MO_S_Ge _ -> Just $! CmmLit (CmmInt (if x_s >= y_s then 1 else 0) (wordWidth platform)) + MO_S_Lt _ -> Just $! CmmLit (CmmInt (if x_s < y_s then 1 else 0) (wordWidth platform)) + MO_S_Le _ -> Just $! CmmLit (CmmInt (if x_s <= y_s then 1 else 0) (wordWidth platform)) + + MO_Add r -> Just $! CmmLit (CmmInt (x + y) r) + MO_Sub r -> Just $! CmmLit (CmmInt (x - y) r) + MO_Mul r -> Just $! CmmLit (CmmInt (x * y) r) + MO_U_Quot r | y /= 0 -> Just $! CmmLit (CmmInt (x_u `quot` y_u) r) + MO_U_Rem r | y /= 0 -> Just $! CmmLit (CmmInt (x_u `rem` y_u) r) + MO_S_Quot r | y /= 0 -> Just $! CmmLit (CmmInt (x `quot` y) r) + MO_S_Rem r | y /= 0 -> Just $! CmmLit (CmmInt (x `rem` y) r) + + MO_And r -> Just $! CmmLit (CmmInt (x .&. y) r) + MO_Or r -> Just $! CmmLit (CmmInt (x .|. y) r) + MO_Xor r -> Just $! CmmLit (CmmInt (x `xor` y) r) + + MO_Shl r -> Just $! CmmLit (CmmInt (x `shiftL` fromIntegral y) r) + MO_U_Shr r -> Just $! CmmLit (CmmInt (x_u `shiftR` fromIntegral y) r) + MO_S_Shr r -> Just $! CmmLit (CmmInt (x `shiftR` fromIntegral y) r) _ -> Nothing @@ -162,7 +162,7 @@ cmmMachOpFoldM platform mop [CmmLit (CmmInt x xrep), CmmLit (CmmInt y _)] cmmMachOpFoldM platform op [x@(CmmLit _), y] | not (isLit y) && isCommutableMachOp op - = Just (cmmMachOpFold platform op [y, x]) + = Just $! (cmmMachOpFold platform op [y, x]) -- Turn (a+b)+c into a+(b+c) where possible. Because literals are -- moved to the right, it is more likely that we will find @@ -183,7 +183,7 @@ cmmMachOpFoldM platform op [x@(CmmLit _), y] cmmMachOpFoldM platform mop1 [CmmMachOp mop2 [arg1,arg2], arg3] | mop2 `associates_with` mop1 && not (isLit arg1) && not (isPicReg arg1) - = Just (cmmMachOpFold platform mop2 [arg1, cmmMachOpFold platform mop1 [arg2,arg3]]) + = Just $! (cmmMachOpFold platform mop2 [arg1, cmmMachOpFold platform mop1 [arg2,arg3]]) where MO_Add{} `associates_with` MO_Sub{} = True mop1 `associates_with` mop2 = @@ -192,7 +192,7 @@ cmmMachOpFoldM platform mop1 [CmmMachOp mop2 [arg1,arg2], arg3] -- special case: (a - b) + c ==> a + (c - b) cmmMachOpFoldM platform mop1@(MO_Add{}) [CmmMachOp mop2@(MO_Sub{}) [arg1,arg2], arg3] | not (isLit arg1) && not (isPicReg arg1) - = Just (cmmMachOpFold platform mop1 [arg1, cmmMachOpFold platform mop2 [arg3,arg2]]) + = Just $! (cmmMachOpFold platform mop1 [arg1, cmmMachOpFold platform mop2 [arg3,arg2]]) -- special case: (PicBaseReg + lit) + N ==> PicBaseReg + (lit+N) -- @@ -205,27 +205,27 @@ cmmMachOpFoldM platform mop1@(MO_Add{}) [CmmMachOp mop2@(MO_Sub{}) [arg1,arg2], cmmMachOpFoldM _ MO_Add{} [ CmmMachOp op at MO_Add{} [pic, CmmLit lit] , CmmLit (CmmInt n rep) ] | isPicReg pic - = Just $ CmmMachOp op [pic, CmmLit $ cmmOffsetLit lit off ] + = Just $! CmmMachOp op [pic, CmmLit $ cmmOffsetLit lit off ] where off = fromIntegral (narrowS rep n) -- Make a RegOff if we can cmmMachOpFoldM _ (MO_Add _) [CmmReg reg, CmmLit (CmmInt n rep)] - = Just $ cmmRegOff reg (fromIntegral (narrowS rep n)) + = Just $! cmmRegOff reg (fromIntegral (narrowS rep n)) cmmMachOpFoldM _ (MO_Add _) [CmmRegOff reg off, CmmLit (CmmInt n rep)] - = Just $ cmmRegOff reg (off + fromIntegral (narrowS rep n)) + = Just $! cmmRegOff reg (off + fromIntegral (narrowS rep n)) cmmMachOpFoldM _ (MO_Sub _) [CmmReg reg, CmmLit (CmmInt n rep)] - = Just $ cmmRegOff reg (- fromIntegral (narrowS rep n)) + = Just $! cmmRegOff reg (- fromIntegral (narrowS rep n)) cmmMachOpFoldM _ (MO_Sub _) [CmmRegOff reg off, CmmLit (CmmInt n rep)] - = Just $ cmmRegOff reg (off - fromIntegral (narrowS rep n)) + = Just $! cmmRegOff reg (off - fromIntegral (narrowS rep n)) -- Fold label(+/-)offset into a CmmLit where possible cmmMachOpFoldM _ (MO_Add _) [CmmLit lit, CmmLit (CmmInt i rep)] - = Just $ CmmLit (cmmOffsetLit lit (fromIntegral (narrowU rep i))) + = Just $! CmmLit (cmmOffsetLit lit (fromIntegral (narrowU rep i))) cmmMachOpFoldM _ (MO_Add _) [CmmLit (CmmInt i rep), CmmLit lit] - = Just $ CmmLit (cmmOffsetLit lit (fromIntegral (narrowU rep i))) + = Just $! CmmLit (cmmOffsetLit lit (fromIntegral (narrowU rep i))) cmmMachOpFoldM _ (MO_Sub _) [CmmLit lit, CmmLit (CmmInt i rep)] - = Just $ CmmLit (cmmOffsetLit lit (fromIntegral (negate (narrowU rep i)))) + = Just $! CmmLit (cmmOffsetLit lit (fromIntegral (negate (narrowU rep i)))) -- Comparison of literal with widened operand: perform the comparison @@ -245,7 +245,7 @@ cmmMachOpFoldM platform cmp [CmmMachOp conv [x], CmmLit (CmmInt i _)] -- and the literal fits in the smaller size: i == narrow_fn rep i -- then we can do the comparison at the smaller size - = Just (cmmMachOpFold platform narrow_cmp [x, CmmLit (CmmInt i rep)]) + = Just $! (cmmMachOpFold platform narrow_cmp [x, CmmLit (CmmInt i rep)]) where maybe_conversion (MO_UU_Conv from to) | to > from @@ -320,8 +320,8 @@ cmmMachOpFoldM platform mop [x, (CmmLit (CmmInt 1 rep))] MO_Mul _ -> Just x MO_S_Quot _ -> Just x MO_U_Quot _ -> Just x - MO_S_Rem _ -> Just $ CmmLit (CmmInt 0 rep) - MO_U_Rem _ -> Just $ CmmLit (CmmInt 0 rep) + MO_S_Rem _ -> Just $! CmmLit (CmmInt 0 rep) + MO_U_Rem _ -> Just $! CmmLit (CmmInt 0 rep) -- Comparisons; trickier -- See Note [Comparison operators] @@ -346,18 +346,18 @@ cmmMachOpFoldM platform mop [x, (CmmLit (CmmInt n _))] = case mop of MO_Mul rep | Just p <- exactLog2 n -> - Just (cmmMachOpFold platform (MO_Shl rep) [x, CmmLit (CmmInt p rep)]) + Just $! (cmmMachOpFold platform (MO_Shl rep) [x, CmmLit (CmmInt p rep)]) MO_U_Quot rep | Just p <- exactLog2 n -> - Just (cmmMachOpFold platform (MO_U_Shr rep) [x, CmmLit (CmmInt p rep)]) + Just $! (cmmMachOpFold platform (MO_U_Shr rep) [x, CmmLit (CmmInt p rep)]) MO_U_Rem rep | Just _ <- exactLog2 n -> - Just (cmmMachOpFold platform (MO_And rep) [x, CmmLit (CmmInt (n - 1) rep)]) + Just $! (cmmMachOpFold platform (MO_And rep) [x, CmmLit (CmmInt (n - 1) rep)]) MO_S_Quot rep | Just p <- exactLog2 n, CmmReg _ <- x -> -- We duplicate x in signedQuotRemHelper, hence require -- it is a reg. FIXME: remove this restriction. - Just (cmmMachOpFold platform (MO_S_Shr rep) + Just $! (cmmMachOpFold platform (MO_S_Shr rep) [signedQuotRemHelper rep p, CmmLit (CmmInt p rep)]) MO_S_Rem rep | Just p <- exactLog2 n, @@ -366,7 +366,7 @@ cmmMachOpFoldM platform mop [x, (CmmLit (CmmInt n _))] -- We replace (x `rem` 2^p) by (x - (x `quot` 2^p) * 2^p). -- Moreover, we fuse MO_S_Shr (last operation of MO_S_Quot) -- and MO_S_Shl (multiplication by 2^p) into a single MO_And operation. - Just (cmmMachOpFold platform (MO_Sub rep) + Just $! (cmmMachOpFold platform (MO_Sub rep) [x, cmmMachOpFold platform (MO_And rep) [signedQuotRemHelper rep p, CmmLit (CmmInt (- n) rep)]]) _ -> Nothing View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2db81a08a82ffe085c49468e8c078f21f9f21218 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2db81a08a82ffe085c49468e8c078f21f9f21218 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 1 13:34:05 2020 From: gitlab at gitlab.haskell.org (Andreas Klebinger) Date: Tue, 01 Dec 2020 08:34:05 -0500 Subject: [Git][ghc/ghc][wip/andreask/opt_cmm_sink_sets] 2 commits: Cmm.Sink: Optimize retaining of assignments, live sets. Message-ID: <5fc6464d29cdd_86cbee2590117731@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/opt_cmm_sink_sets at Glasgow Haskell Compiler / GHC Commits: 356d7884 by Andreas Klebinger at 2020-12-01T14:33:41+01:00 Cmm.Sink: Optimize retaining of assignments, live sets. Sinking requires us to track live local regs after each cmm statement. We used to do this via "Set LocalReg". However we can replace this with a solution based on IntSet which is overall more efficient without losing much. The thing we lose is width of the variables, which isn't used by the sinking pass anyway. I also reworked how we keep assignments to regs mentioned in skipped assignments. I put the details into Note [Keeping assignemnts mentioned in skipped RHSs]. The gist of it is instead of keeping track of it via the use count which is a `IntMap Int` we now use the live regs set (IntSet) which is quite a bit faster. I think it also matches the semantics a lot better. The skipped (not discarded) assignment does in fact keep the regs on it's rhs alive so keeping track of this in the live set seems like the clearer solution as well. Improves allocations for T3294 by yet another 1%. - - - - - addc2e87 by Andreas Klebinger at 2020-12-01T14:33:48+01:00 GHC.Cmm.Opt: Be stricter in results. Optimization either returns Nothing if nothing is to be done or `Just <cmmExpr>` otherwise. There is no point in being lazy in `cmmExpr`. We usually inspect this element so the thunk gets forced not long after. We might eliminate it as dead code once in a blue moon but that's not a case worth optimizing for. Overall the impact of this is rather low. As Cmm.Opt doesn't allocate much (compared to the rest of GHC) to begin with. - - - - - 6 changed files: - + compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Liveness.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Utils/Outputable.hs - compiler/ghc.cabal.in Changes: ===================================== compiler/GHC/Cmm/LRegSet.hs ===================================== @@ -0,0 +1,49 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module GHC.Cmm.LRegSet ( + LRegSet, + LRegKey, + + emptyLRegSet, + nullLRegSet, + insertLRegSet, + elemLRegSet, + + deleteFromLRegSet, + sizeLRegSet, + + plusLRegSet + ) where + +import GHC.Prelude +import GHC.Types.Unique +import GHC.Cmm.Expr + +import Data.IntSet as IntSet + +-- Compact sets for membership tests of local variables. + +type LRegSet = IntSet.IntSet +type LRegKey = Int + +emptyLRegSet :: LRegSet +emptyLRegSet = IntSet.empty + +nullLRegSet :: LRegSet -> Bool +nullLRegSet = IntSet.null + +insertLRegSet :: LocalReg -> LRegSet -> LRegSet +insertLRegSet l = IntSet.insert (getKey (getUnique l)) + +elemLRegSet :: LocalReg -> LRegSet -> Bool +elemLRegSet l = IntSet.member (getKey (getUnique l)) + +deleteFromLRegSet :: LRegSet -> LocalReg -> LRegSet +deleteFromLRegSet set reg = IntSet.delete (getKey . getUnique $ reg) set + +sizeLRegSet :: IntSet -> Int +sizeLRegSet = IntSet.size + +plusLRegSet :: IntSet -> IntSet -> IntSet +plusLRegSet = IntSet.union ===================================== compiler/GHC/Cmm/Liveness.hs ===================================== @@ -6,9 +6,12 @@ module GHC.Cmm.Liveness ( CmmLocalLive , cmmLocalLiveness + , cmmLocalLivenessL , cmmGlobalLiveness , liveLattice + , liveLatticeL , gen_kill + , gen_killL ) where @@ -22,11 +25,14 @@ import GHC.Cmm.Dataflow.Block import GHC.Cmm.Dataflow.Collections import GHC.Cmm.Dataflow import GHC.Cmm.Dataflow.Label +import GHC.Cmm.LRegSet import GHC.Data.Maybe import GHC.Utils.Outputable import GHC.Utils.Panic +import GHC.Types.Unique + ----------------------------------------------------------------------------- -- Calculating what variables are live on entry to a basic block ----------------------------------------------------------------------------- @@ -92,3 +98,66 @@ xferLive platform (BlockCC eNode middle xNode) fBase = in mapSingleton (entryLabel eNode) result {-# SPECIALIZE xferLive :: Platform -> TransferFun (CmmLive LocalReg) #-} {-# SPECIALIZE xferLive :: Platform -> TransferFun (CmmLive GlobalReg) #-} + +----------------------------------------------------------------------------- +-- | Specialization that only retains the keys for local variables. +-- +-- Local variablas are mostly glorified Ints, and some parts of the compiler +-- really don't care about anything but the Int part. So we can avoid some +-- overhead by computing a IntSet instead of a Set LocalReg which (unsurprisingly) +-- is quite a bit faster. +----------------------------------------------------------------------------- + +type BlockEntryLivenessL = LabelMap LRegSet + +-- | The dataflow lattice +liveLatticeL :: DataflowLattice LRegSet +liveLatticeL = DataflowLattice emptyLRegSet add + where + add (OldFact old) (NewFact new) = + let !join = plusLRegSet old new + in changedIf (sizeLRegSet join > sizeLRegSet old) join + + +cmmLocalLivenessL :: Platform -> CmmGraph -> BlockEntryLivenessL +cmmLocalLivenessL platform graph = + check $ analyzeCmmBwd liveLatticeL (xferLiveL platform) graph mapEmpty + where + entry = g_entry graph + check facts = + noLiveOnEntryL entry (expectJust "check" $ mapLookup entry facts) facts + +-- | On entry to the procedure, there had better not be any LocalReg's live-in. +noLiveOnEntryL :: BlockId -> LRegSet -> a -> a +noLiveOnEntryL bid in_fact x = + if nullLRegSet in_fact then x + else pprPanic "LocalReg's live-in to graph" (ppr bid <+> ppr reg_uniques) + where + -- We convert the int's to uniques so that the printing matches that + -- of registers. + reg_uniques = map mkUniqueGrimily $ elemsLRegSet in_fact + + + + +gen_killL + :: (DefinerOfRegs LocalReg n, UserOfRegs LocalReg n) + => Platform -> n -> LRegSet -> LRegSet +gen_killL platform node set = + let !afterKill = foldRegsDefd platform deleteFromLRegSet set node + in foldRegsUsed platform (flip insertLRegSet) afterKill node +{-# INLINE gen_killL #-} + +xferLiveL + :: ( UserOfRegs LocalReg (CmmNode O O) + , DefinerOfRegs LocalReg (CmmNode O O) + , UserOfRegs LocalReg (CmmNode O C) + , DefinerOfRegs LocalReg (CmmNode O C) + ) + => Platform -> TransferFun LRegSet +xferLiveL platform (BlockCC eNode middle xNode) fBase = + let joined = gen_killL platform xNode $! joinOutFacts liveLatticeL xNode fBase + !result = foldNodesBwdOO (gen_killL platform) middle joined + in mapSingleton (entryLabel eNode) result + + ===================================== compiler/GHC/Cmm/Opt.hs ===================================== @@ -58,7 +58,7 @@ cmmMachOpFoldM -> Maybe CmmExpr cmmMachOpFoldM _ op [CmmLit (CmmInt x rep)] - = Just $ case op of + = Just $! case op of MO_S_Neg _ -> CmmLit (CmmInt (-x) rep) MO_Not _ -> CmmLit (CmmInt (complement x) rep) @@ -90,13 +90,13 @@ cmmMachOpFoldM platform conv_outer [CmmMachOp conv_inner [x]] -- but remember to use the signedness from the widening, just in case -- the final conversion is a widen. | rep1 < rep2 && rep2 > rep3 -> - Just $ cmmMachOpFold platform (intconv signed1 rep1 rep3) [x] + Just $! cmmMachOpFold platform (intconv signed1 rep1 rep3) [x] -- Nested widenings: collapse if the signedness is the same | rep1 < rep2 && rep2 < rep3 && signed1 == signed2 -> - Just $ cmmMachOpFold platform (intconv signed1 rep1 rep3) [x] + Just $! cmmMachOpFold platform (intconv signed1 rep1 rep3) [x] -- Nested narrowings: collapse | rep1 > rep2 && rep2 > rep3 -> - Just $ cmmMachOpFold platform (MO_UU_Conv rep1 rep3) [x] + Just $! cmmMachOpFold platform (MO_UU_Conv rep1 rep3) [x] | otherwise -> Nothing where @@ -117,34 +117,34 @@ cmmMachOpFoldM platform mop [CmmLit (CmmInt x xrep), CmmLit (CmmInt y _)] = case mop of -- for comparisons: don't forget to narrow the arguments before -- comparing, since they might be out of range. - MO_Eq _ -> Just $ CmmLit (CmmInt (if x_u == y_u then 1 else 0) (wordWidth platform)) - MO_Ne _ -> Just $ CmmLit (CmmInt (if x_u /= y_u then 1 else 0) (wordWidth platform)) - - MO_U_Gt _ -> Just $ CmmLit (CmmInt (if x_u > y_u then 1 else 0) (wordWidth platform)) - MO_U_Ge _ -> Just $ CmmLit (CmmInt (if x_u >= y_u then 1 else 0) (wordWidth platform)) - MO_U_Lt _ -> Just $ CmmLit (CmmInt (if x_u < y_u then 1 else 0) (wordWidth platform)) - MO_U_Le _ -> Just $ CmmLit (CmmInt (if x_u <= y_u then 1 else 0) (wordWidth platform)) - - MO_S_Gt _ -> Just $ CmmLit (CmmInt (if x_s > y_s then 1 else 0) (wordWidth platform)) - MO_S_Ge _ -> Just $ CmmLit (CmmInt (if x_s >= y_s then 1 else 0) (wordWidth platform)) - MO_S_Lt _ -> Just $ CmmLit (CmmInt (if x_s < y_s then 1 else 0) (wordWidth platform)) - MO_S_Le _ -> Just $ CmmLit (CmmInt (if x_s <= y_s then 1 else 0) (wordWidth platform)) - - MO_Add r -> Just $ CmmLit (CmmInt (x + y) r) - MO_Sub r -> Just $ CmmLit (CmmInt (x - y) r) - MO_Mul r -> Just $ CmmLit (CmmInt (x * y) r) - MO_U_Quot r | y /= 0 -> Just $ CmmLit (CmmInt (x_u `quot` y_u) r) - MO_U_Rem r | y /= 0 -> Just $ CmmLit (CmmInt (x_u `rem` y_u) r) - MO_S_Quot r | y /= 0 -> Just $ CmmLit (CmmInt (x `quot` y) r) - MO_S_Rem r | y /= 0 -> Just $ CmmLit (CmmInt (x `rem` y) r) - - MO_And r -> Just $ CmmLit (CmmInt (x .&. y) r) - MO_Or r -> Just $ CmmLit (CmmInt (x .|. y) r) - MO_Xor r -> Just $ CmmLit (CmmInt (x `xor` y) r) - - MO_Shl r -> Just $ CmmLit (CmmInt (x `shiftL` fromIntegral y) r) - MO_U_Shr r -> Just $ CmmLit (CmmInt (x_u `shiftR` fromIntegral y) r) - MO_S_Shr r -> Just $ CmmLit (CmmInt (x `shiftR` fromIntegral y) r) + MO_Eq _ -> Just $! CmmLit (CmmInt (if x_u == y_u then 1 else 0) (wordWidth platform)) + MO_Ne _ -> Just $! CmmLit (CmmInt (if x_u /= y_u then 1 else 0) (wordWidth platform)) + + MO_U_Gt _ -> Just $! CmmLit (CmmInt (if x_u > y_u then 1 else 0) (wordWidth platform)) + MO_U_Ge _ -> Just $! CmmLit (CmmInt (if x_u >= y_u then 1 else 0) (wordWidth platform)) + MO_U_Lt _ -> Just $! CmmLit (CmmInt (if x_u < y_u then 1 else 0) (wordWidth platform)) + MO_U_Le _ -> Just $! CmmLit (CmmInt (if x_u <= y_u then 1 else 0) (wordWidth platform)) + + MO_S_Gt _ -> Just $! CmmLit (CmmInt (if x_s > y_s then 1 else 0) (wordWidth platform)) + MO_S_Ge _ -> Just $! CmmLit (CmmInt (if x_s >= y_s then 1 else 0) (wordWidth platform)) + MO_S_Lt _ -> Just $! CmmLit (CmmInt (if x_s < y_s then 1 else 0) (wordWidth platform)) + MO_S_Le _ -> Just $! CmmLit (CmmInt (if x_s <= y_s then 1 else 0) (wordWidth platform)) + + MO_Add r -> Just $! CmmLit (CmmInt (x + y) r) + MO_Sub r -> Just $! CmmLit (CmmInt (x - y) r) + MO_Mul r -> Just $! CmmLit (CmmInt (x * y) r) + MO_U_Quot r | y /= 0 -> Just $! CmmLit (CmmInt (x_u `quot` y_u) r) + MO_U_Rem r | y /= 0 -> Just $! CmmLit (CmmInt (x_u `rem` y_u) r) + MO_S_Quot r | y /= 0 -> Just $! CmmLit (CmmInt (x `quot` y) r) + MO_S_Rem r | y /= 0 -> Just $! CmmLit (CmmInt (x `rem` y) r) + + MO_And r -> Just $! CmmLit (CmmInt (x .&. y) r) + MO_Or r -> Just $! CmmLit (CmmInt (x .|. y) r) + MO_Xor r -> Just $! CmmLit (CmmInt (x `xor` y) r) + + MO_Shl r -> Just $! CmmLit (CmmInt (x `shiftL` fromIntegral y) r) + MO_U_Shr r -> Just $! CmmLit (CmmInt (x_u `shiftR` fromIntegral y) r) + MO_S_Shr r -> Just $! CmmLit (CmmInt (x `shiftR` fromIntegral y) r) _ -> Nothing @@ -162,7 +162,7 @@ cmmMachOpFoldM platform mop [CmmLit (CmmInt x xrep), CmmLit (CmmInt y _)] cmmMachOpFoldM platform op [x@(CmmLit _), y] | not (isLit y) && isCommutableMachOp op - = Just (cmmMachOpFold platform op [y, x]) + = Just $! (cmmMachOpFold platform op [y, x]) -- Turn (a+b)+c into a+(b+c) where possible. Because literals are -- moved to the right, it is more likely that we will find @@ -183,7 +183,7 @@ cmmMachOpFoldM platform op [x@(CmmLit _), y] cmmMachOpFoldM platform mop1 [CmmMachOp mop2 [arg1,arg2], arg3] | mop2 `associates_with` mop1 && not (isLit arg1) && not (isPicReg arg1) - = Just (cmmMachOpFold platform mop2 [arg1, cmmMachOpFold platform mop1 [arg2,arg3]]) + = Just $! (cmmMachOpFold platform mop2 [arg1, cmmMachOpFold platform mop1 [arg2,arg3]]) where MO_Add{} `associates_with` MO_Sub{} = True mop1 `associates_with` mop2 = @@ -192,7 +192,7 @@ cmmMachOpFoldM platform mop1 [CmmMachOp mop2 [arg1,arg2], arg3] -- special case: (a - b) + c ==> a + (c - b) cmmMachOpFoldM platform mop1@(MO_Add{}) [CmmMachOp mop2@(MO_Sub{}) [arg1,arg2], arg3] | not (isLit arg1) && not (isPicReg arg1) - = Just (cmmMachOpFold platform mop1 [arg1, cmmMachOpFold platform mop2 [arg3,arg2]]) + = Just $! (cmmMachOpFold platform mop1 [arg1, cmmMachOpFold platform mop2 [arg3,arg2]]) -- special case: (PicBaseReg + lit) + N ==> PicBaseReg + (lit+N) -- @@ -205,27 +205,27 @@ cmmMachOpFoldM platform mop1@(MO_Add{}) [CmmMachOp mop2@(MO_Sub{}) [arg1,arg2], cmmMachOpFoldM _ MO_Add{} [ CmmMachOp op at MO_Add{} [pic, CmmLit lit] , CmmLit (CmmInt n rep) ] | isPicReg pic - = Just $ CmmMachOp op [pic, CmmLit $ cmmOffsetLit lit off ] + = Just $! CmmMachOp op [pic, CmmLit $ cmmOffsetLit lit off ] where off = fromIntegral (narrowS rep n) -- Make a RegOff if we can cmmMachOpFoldM _ (MO_Add _) [CmmReg reg, CmmLit (CmmInt n rep)] - = Just $ cmmRegOff reg (fromIntegral (narrowS rep n)) + = Just $! cmmRegOff reg (fromIntegral (narrowS rep n)) cmmMachOpFoldM _ (MO_Add _) [CmmRegOff reg off, CmmLit (CmmInt n rep)] - = Just $ cmmRegOff reg (off + fromIntegral (narrowS rep n)) + = Just $! cmmRegOff reg (off + fromIntegral (narrowS rep n)) cmmMachOpFoldM _ (MO_Sub _) [CmmReg reg, CmmLit (CmmInt n rep)] - = Just $ cmmRegOff reg (- fromIntegral (narrowS rep n)) + = Just $! cmmRegOff reg (- fromIntegral (narrowS rep n)) cmmMachOpFoldM _ (MO_Sub _) [CmmRegOff reg off, CmmLit (CmmInt n rep)] - = Just $ cmmRegOff reg (off - fromIntegral (narrowS rep n)) + = Just $! cmmRegOff reg (off - fromIntegral (narrowS rep n)) -- Fold label(+/-)offset into a CmmLit where possible cmmMachOpFoldM _ (MO_Add _) [CmmLit lit, CmmLit (CmmInt i rep)] - = Just $ CmmLit (cmmOffsetLit lit (fromIntegral (narrowU rep i))) + = Just $! CmmLit (cmmOffsetLit lit (fromIntegral (narrowU rep i))) cmmMachOpFoldM _ (MO_Add _) [CmmLit (CmmInt i rep), CmmLit lit] - = Just $ CmmLit (cmmOffsetLit lit (fromIntegral (narrowU rep i))) + = Just $! CmmLit (cmmOffsetLit lit (fromIntegral (narrowU rep i))) cmmMachOpFoldM _ (MO_Sub _) [CmmLit lit, CmmLit (CmmInt i rep)] - = Just $ CmmLit (cmmOffsetLit lit (fromIntegral (negate (narrowU rep i)))) + = Just $! CmmLit (cmmOffsetLit lit (fromIntegral (negate (narrowU rep i)))) -- Comparison of literal with widened operand: perform the comparison @@ -245,7 +245,7 @@ cmmMachOpFoldM platform cmp [CmmMachOp conv [x], CmmLit (CmmInt i _)] -- and the literal fits in the smaller size: i == narrow_fn rep i -- then we can do the comparison at the smaller size - = Just (cmmMachOpFold platform narrow_cmp [x, CmmLit (CmmInt i rep)]) + = Just $! (cmmMachOpFold platform narrow_cmp [x, CmmLit (CmmInt i rep)]) where maybe_conversion (MO_UU_Conv from to) | to > from @@ -320,8 +320,8 @@ cmmMachOpFoldM platform mop [x, (CmmLit (CmmInt 1 rep))] MO_Mul _ -> Just x MO_S_Quot _ -> Just x MO_U_Quot _ -> Just x - MO_S_Rem _ -> Just $ CmmLit (CmmInt 0 rep) - MO_U_Rem _ -> Just $ CmmLit (CmmInt 0 rep) + MO_S_Rem _ -> Just $! CmmLit (CmmInt 0 rep) + MO_U_Rem _ -> Just $! CmmLit (CmmInt 0 rep) -- Comparisons; trickier -- See Note [Comparison operators] @@ -346,18 +346,18 @@ cmmMachOpFoldM platform mop [x, (CmmLit (CmmInt n _))] = case mop of MO_Mul rep | Just p <- exactLog2 n -> - Just (cmmMachOpFold platform (MO_Shl rep) [x, CmmLit (CmmInt p rep)]) + Just $! (cmmMachOpFold platform (MO_Shl rep) [x, CmmLit (CmmInt p rep)]) MO_U_Quot rep | Just p <- exactLog2 n -> - Just (cmmMachOpFold platform (MO_U_Shr rep) [x, CmmLit (CmmInt p rep)]) + Just $! (cmmMachOpFold platform (MO_U_Shr rep) [x, CmmLit (CmmInt p rep)]) MO_U_Rem rep | Just _ <- exactLog2 n -> - Just (cmmMachOpFold platform (MO_And rep) [x, CmmLit (CmmInt (n - 1) rep)]) + Just $! (cmmMachOpFold platform (MO_And rep) [x, CmmLit (CmmInt (n - 1) rep)]) MO_S_Quot rep | Just p <- exactLog2 n, CmmReg _ <- x -> -- We duplicate x in signedQuotRemHelper, hence require -- it is a reg. FIXME: remove this restriction. - Just (cmmMachOpFold platform (MO_S_Shr rep) + Just $! (cmmMachOpFold platform (MO_S_Shr rep) [signedQuotRemHelper rep p, CmmLit (CmmInt p rep)]) MO_S_Rem rep | Just p <- exactLog2 n, @@ -366,7 +366,7 @@ cmmMachOpFoldM platform mop [x, (CmmLit (CmmInt n _))] -- We replace (x `rem` 2^p) by (x - (x `quot` 2^p) * 2^p). -- Moreover, we fuse MO_S_Shr (last operation of MO_S_Quot) -- and MO_S_Shl (multiplication by 2^p) into a single MO_And operation. - Just (cmmMachOpFold platform (MO_Sub rep) + Just $! (cmmMachOpFold platform (MO_Sub rep) [x, cmmMachOpFold platform (MO_And rep) [signedQuotRemHelper rep p, CmmLit (CmmInt (- n) rep)]]) _ -> Nothing ===================================== compiler/GHC/Cmm/Sink.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE ScopedTypeVariables #-} + module GHC.Cmm.Sink ( cmmSink ) where @@ -9,6 +10,7 @@ import GHC.Prelude import GHC.Cmm import GHC.Cmm.Opt import GHC.Cmm.Liveness +import GHC.Cmm.LRegSet import GHC.Cmm.Utils import GHC.Cmm.Dataflow.Block import GHC.Cmm.Dataflow.Label @@ -17,32 +19,14 @@ import GHC.Cmm.Dataflow.Graph import GHC.Platform.Regs import GHC.Platform -import GHC.Types.Unique import GHC.Types.Unique.FM import qualified Data.IntSet as IntSet import Data.List (partition) -import qualified Data.Set as Set import Data.Maybe import GHC.Exts (inline) --- Compact sets for membership tests of local variables. - -type LRegSet = IntSet.IntSet - -emptyLRegSet :: LRegSet -emptyLRegSet = IntSet.empty - -nullLRegSet :: LRegSet -> Bool -nullLRegSet = IntSet.null - -insertLRegSet :: LocalReg -> LRegSet -> LRegSet -insertLRegSet l = IntSet.insert (getKey (getUnique l)) - -elemLRegSet :: LocalReg -> LRegSet -> Bool -elemLRegSet l = IntSet.member (getKey (getUnique l)) - -- ----------------------------------------------------------------------------- -- Sinking and inlining @@ -170,8 +154,8 @@ type Assignments = [Assignment] cmmSink :: Platform -> CmmGraph -> CmmGraph cmmSink platform graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks where - liveness = cmmLocalLiveness platform graph - getLive l = mapFindWithDefault Set.empty l liveness + liveness = cmmLocalLivenessL platform graph + getLive l = mapFindWithDefault emptyLRegSet l liveness blocks = revPostorder graph @@ -191,8 +175,8 @@ cmmSink platform graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks -- Annotate the middle nodes with the registers live *after* -- the node. This will help us decide whether we can inline -- an assignment in the current node or not. - live = Set.unions (map getLive succs) - live_middle = gen_kill platform last live + live = IntSet.unions (map getLive succs) + live_middle = gen_killL platform last live ann_middles = annotate platform live_middle (blockToList middle) -- Now sink and inline in this block @@ -204,7 +188,7 @@ cmmSink platform graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks -- one predecessor), so identify the join points and the set -- of registers live in them. (joins, nonjoins) = partition (`mapMember` join_pts) succs - live_in_joins = Set.unions (map getLive joins) + live_in_joins = IntSet.unions (map getLive joins) -- We do not want to sink an assignment into multiple branches, -- so identify the set of registers live in multiple successors. @@ -213,26 +197,28 @@ cmmSink platform graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks -- now live in multiple branches. init_live_sets = map getLive nonjoins live_in_multi live_sets r = - case filter (Set.member r) live_sets of + case filter (elemLRegSet r) live_sets of (_one:_two:_) -> True _ -> False -- Now, drop any assignments that we will not sink any further. (dropped_last, assigs'') = dropAssignments platform drop_if init_live_sets assigs' + drop_if :: (LocalReg, CmmExpr, AbsMem) + -> [LRegSet] -> (Bool, [LRegSet]) drop_if a@(r,rhs,_) live_sets = (should_drop, live_sets') where should_drop = conflicts platform a final_last || not (isTrivial platform rhs) && live_in_multi live_sets r - || r `Set.member` live_in_joins + || r `elemLRegSet` live_in_joins live_sets' | should_drop = live_sets | otherwise = map upd live_sets - upd set | r `Set.member` set = set `Set.union` live_rhs + upd set | r `elemLRegSet` set = set `IntSet.union` live_rhs | otherwise = set - live_rhs = foldRegsUsed platform extendRegSet emptyRegSet rhs + live_rhs = foldRegsUsed platform (flip insertLRegSet) emptyLRegSet rhs final_middle = foldl' blockSnoc middle' dropped_last @@ -269,9 +255,9 @@ isTrivial _ _ = False -- -- annotate each node with the set of registers live *after* the node -- -annotate :: Platform -> LocalRegSet -> [CmmNode O O] -> [(LocalRegSet, CmmNode O O)] +annotate :: Platform -> LRegSet -> [CmmNode O O] -> [(LRegSet, CmmNode O O)] annotate platform live nodes = snd $ foldr ann (live,[]) nodes - where ann n (live,nodes) = (gen_kill platform n live, (live,n) : nodes) + where ann n (live,nodes) = (gen_killL platform n live, (live,n) : nodes) -- -- Find the blocks that have multiple successors (join points) @@ -288,13 +274,13 @@ findJoinPoints blocks = mapFilter (>1) succ_counts -- filter the list of assignments to remove any assignments that -- are not live in a continuation. -- -filterAssignments :: Platform -> LocalRegSet -> Assignments -> Assignments +filterAssignments :: Platform -> LRegSet -> Assignments -> Assignments filterAssignments platform live assigs = reverse (go assigs []) where go [] kept = kept go (a@(r,_,_):as) kept | needed = go as (a:kept) | otherwise = go as kept where - needed = r `Set.member` live + needed = r `elemLRegSet` live || any (conflicts platform a) (map toNode kept) -- Note that we must keep assignments that are -- referred to by other assignments we have @@ -315,7 +301,7 @@ filterAssignments platform live assigs = reverse (go assigs []) -- walk :: Platform - -> [(LocalRegSet, CmmNode O O)] -- nodes of the block, annotated with + -> [(LRegSet, CmmNode O O)] -- nodes of the block, annotated with -- the set of registers live *after* -- this node. @@ -369,11 +355,11 @@ shouldSink _ _other = Nothing -- out of inlining, but the inliner will see that r is live -- after the instruction and choose not to inline r in the rhs. -- -shouldDiscard :: CmmNode e x -> LocalRegSet -> Bool +shouldDiscard :: CmmNode e x -> LRegSet -> Bool shouldDiscard node live = case node of CmmAssign r (CmmReg r') | r == r' -> True - CmmAssign (CmmLocal r) _ -> not (r `Set.member` live) + CmmAssign (CmmLocal r) _ -> not (r `elemLRegSet` live) _otherwise -> False @@ -407,7 +393,8 @@ dropAssignments platform should_drop state assigs tryToInline :: forall x. Platform - -> LocalRegSet -- set of registers live after this + -> LRegSet -- set of registers live after this + -- -> LocalRegSet -- set of registers live after this -- node. We cannot inline anything -- that is live after the node, unless -- it is small enough to duplicate. @@ -418,36 +405,42 @@ tryToInline , Assignments -- Remaining assignments ) -tryToInline platform live node assigs = go usages node emptyLRegSet assigs +tryToInline platform liveAfter node assigs = + -- pprTrace "tryToInline assig length:" (ppr $ length assigs) $ + go usages liveAfter node emptyLRegSet assigs where usages :: UniqFM LocalReg Int -- Maps each LocalReg to a count of how often it is used usages = foldLocalRegsUsed platform addUsage emptyUFM node - go _usages node _skipped [] = (node, []) + go :: UniqFM LocalReg Int -> LRegSet -> CmmNode O x -> LRegSet -> Assignments + -> (CmmNode O x, Assignments) + go _usages _live node _skipped [] = (node, []) - go usages node skipped (a@(l,rhs,_) : rest) - | cannot_inline = dont_inline - | occurs_none = discard -- Note [discard during inlining] - | occurs_once = inline_and_discard - | isTrivial platform rhs = inline_and_keep - | otherwise = dont_inline + go usages live node skipped (a@(l,rhs,_) : rest) + | cannot_inline = dont_inline + | occurs_none = discard -- Note [discard during inlining] + | occurs_once = inline_and_discard + | isTrivial platform rhs = inline_and_keep + | otherwise = dont_inline where - inline_and_discard = go usages' inl_node skipped rest + inline_and_discard = go usages' live inl_node skipped rest where usages' = foldLocalRegsUsed platform addUsage usages rhs - discard = go usages node skipped rest + discard = go usages live node skipped rest dont_inline = keep node -- don't inline the assignment, keep it inline_and_keep = keep inl_node -- inline the assignment, keep it keep :: CmmNode O x -> (CmmNode O x, Assignments) keep node' = (final_node, a : rest') - where (final_node, rest') = go usages' node' (insertLRegSet l skipped) rest + where (final_node, rest') = go usages live' node' (insertLRegSet l skipped) rest -- Avoid discarding of assignments to vars on the rhs. -- See Note [Keeping assignemnts mentioned in skipped RHSs] - usages' = foldLocalRegsUsed platform (\m r -> addToUFM m r 2) - usages rhs + -- usages' = foldLocalRegsUsed platform (\m r -> addToUFM m r 2) + -- usages rhs + live' = inline foldLocalRegsUsed platform (\m r -> insertLRegSet r m) + live rhs cannot_inline = skipped `regsUsedIn` rhs -- Note [dependent assignments] || l `elemLRegSet` skipped @@ -455,7 +448,7 @@ tryToInline platform live node assigs = go usages node emptyLRegSet assigs -- How often is l used in the current node. l_usages = lookupUFM usages l - l_live = l `elemRegSet` live + l_live = l `elemLRegSet` live occurs_once = not l_live && l_usages == Just 1 occurs_none = not l_live && l_usages == Nothing @@ -483,9 +476,11 @@ tryToInline platform live node assigs = go usages node emptyLRegSet assigs referencing a variable which hasn't been mentioned after inlining. - We use a hack to do this, which is setting all regs used on the - RHS to two uses. Since we only discard assignments to variables - which are used once or never this prevents discarding of the + We use a hack to do this. + + We pretend the regs from the rhs are live after the current + node. Since we only discard assignments to variables + which are dead after the current block this prevents discarding of the assignment. It still allows inlining should e1 be a trivial rhs however. ===================================== compiler/GHC/Utils/Outputable.hs ===================================== @@ -112,6 +112,7 @@ import Data.Int import qualified Data.IntMap as IM import Data.Set (Set) import qualified Data.Set as Set +import qualified Data.IntSet as IntSet import Data.String import Data.Word import System.IO ( Handle ) @@ -859,6 +860,9 @@ instance (Outputable a) => Outputable (NonEmpty a) where instance (Outputable a) => Outputable (Set a) where ppr s = braces (fsep (punctuate comma (map ppr (Set.toList s)))) +instance Outputable IntSet.IntSet where + ppr s = braces (fsep (punctuate comma (map ppr (IntSet.toList s)))) + instance (Outputable a, Outputable b) => Outputable (a, b) where ppr (x,y) = parens (sep [ppr x <> comma, ppr y]) ===================================== compiler/ghc.cabal.in ===================================== @@ -204,6 +204,7 @@ Library GHC.Cmm.Switch GHC.Cmm.Switch.Implement GHC.CmmToAsm + GHC.Cmm.LRegSet GHC.CmmToAsm.BlockLayout GHC.CmmToAsm.CFG GHC.CmmToAsm.CFG.Dominators View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2db81a08a82ffe085c49468e8c078f21f9f21218...addc2e87fa68f6cc69b7b3f59e3d00e0a9edac1a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2db81a08a82ffe085c49468e8c078f21f9f21218...addc2e87fa68f6cc69b7b3f59e3d00e0a9edac1a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 1 13:35:10 2020 From: gitlab at gitlab.haskell.org (Andreas Klebinger) Date: Tue, 01 Dec 2020 08:35:10 -0500 Subject: [Git][ghc/ghc][wip/andreask/opt_cmm_sink_sets] 77 commits: Add Addr# atomic primops (#17751) Message-ID: <5fc6468e400f6_86c111d4a0011778c6@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/opt_cmm_sink_sets at Glasgow Haskell Compiler / GHC Commits: 52114fa0 by Sylvain Henry at 2020-11-16T11:48:47+01:00 Add Addr# atomic primops (#17751) This reuses the codegen used for ByteArray#'s atomic primops. - - - - - 8150f654 by Sebastian Graf at 2020-11-18T23:38:40-05:00 PmCheck: Print types of uncovered patterns (#18932) In order to avoid confusion as in #18932, we display the type of the match variables in the non-exhaustiveness warning, e.g. ``` T18932.hs:14:1: warning: [-Wincomplete-patterns] Pattern match(es) are non-exhaustive In an equation for ‘g’: Patterns of type ‘T a’, ‘T a’, ‘T a’ not matched: (MkT2 _) (MkT1 _) (MkT1 _) (MkT2 _) (MkT1 _) (MkT2 _) (MkT2 _) (MkT2 _) (MkT1 _) (MkT2 _) (MkT2 _) (MkT2 _) ... | 14 | g (MkT1 x) (MkT1 _) (MkT1 _) = x | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ``` It also allows us to omit the type signature on wildcard matches which we previously showed in only some situations, particularly `-XEmptyCase`. Fixes #18932. - - - - - 165352a2 by Krzysztof Gogolewski at 2020-11-20T02:08:36-05:00 Export indexError from GHC.Ix (#18579) - - - - - b57845c3 by Kamil Dworakowski at 2020-11-20T02:09:16-05:00 Clarify interruptible FFI wrt masking state - - - - - 321d1bd8 by Sebastian Graf at 2020-11-20T02:09:51-05:00 Fix strictness signatures of `prefetchValue*#` primops Their strictness signatures said the primops are strict in their first argument, which is wrong: Handing it a thunk will prefetch the pointer to the thunk, but not evaluate it. Hence not strict. The regression test `T8256` actually tests for laziness in the first argument, so GHC apparently never exploited the strictness signature. See also https://gitlab.haskell.org/ghc/ghc/-/issues/8256#note_310867, where this came up. - - - - - 0aec78b6 by Sebastian Graf at 2020-11-20T02:09:51-05:00 Demand: Interleave usage and strictness demands (#18903) As outlined in #18903, interleaving usage and strictness demands not only means a more compact demand representation, but also allows us to express demands that we weren't easily able to express before. Call demands are *relative* in the sense that a call demand `Cn(cd)` on `g` says "`g` is called `n` times. *Whenever `g` is called*, the result is used according to `cd`". Example from #18903: ```hs h :: Int -> Int h m = let g :: Int -> (Int,Int) g 1 = (m, 0) g n = (2 * n, 2 `div` n) {-# NOINLINE g #-} in case m of 1 -> 0 2 -> snd (g m) _ -> uncurry (+) (g m) ``` Without the interleaved representation, we would just get `L` for the strictness demand on `g`. Now we are able to express that whenever `g` is called, its second component is used strictly in denoting `g` by `1C1(P(1P(U),SP(U)))`. This would allow Nested CPR to unbox the division, for example. Fixes #18903. While fixing regressions, I also discovered and fixed #18957. Metric Decrease: T13253-spj - - - - - 3a55b3a2 by Sebastian Graf at 2020-11-20T02:09:51-05:00 Update user's guide entry on demand analysis and worker/wrapper The demand signature notation has been undocumented for a long time. The only source to understand it, apart from reading the `Outputable` instance, has been an outdated wiki page. Since the previous commits have reworked the demand lattice, I took it as an opportunity to also write some documentation about notation. - - - - - fc963932 by Greg Steuck at 2020-11-20T02:10:31-05:00 Find hadrian location more reliably in cabal-install output Fix #18944 - - - - - 9f40cf6c by Ben Gamari at 2020-11-20T02:11:07-05:00 rts/linker: Align bssSize to page size when mapping symbol extras We place symbol_extras right after bss. We also need to ensure that symbol_extras can be mprotect'd independently from the rest of the image. To ensure this we round up the size of bss to a page boundary, thus ensuring that symbol_extras is also page-aligned. - - - - - b739c319 by Ben Gamari at 2020-11-20T02:11:43-05:00 gitlab-ci: Add usage message to ci.sh - - - - - 802e9180 by Ben Gamari at 2020-11-20T02:11:43-05:00 gitlab-ci: Add VERBOSE environment variable And change the make build system's default behavior to V=0, greatly reducing build log sizes. - - - - - 2a8a979c by Ben Gamari at 2020-11-21T01:13:26-05:00 users-guide: A bit of clean-up in profiling flag documentation - - - - - 56804e33 by Ben Gamari at 2020-11-21T01:13:26-05:00 testsuite: Refactor CountParserDeps - - - - - 53ad67ea by Ben Gamari at 2020-11-21T01:13:26-05:00 Introduce -fprof-callers flag This introducing a new compiler flag to provide a convenient way to introduce profiler cost-centers on all occurrences of the named identifier. Closes #18566. - - - - - ecfd0278 by Sylvain Henry at 2020-11-21T01:14:09-05:00 Move Plugins into HscEnv (#17957) Loaded plugins have nothing to do in DynFlags so this patch moves them into HscEnv (session state). "DynFlags plugins" become "Driver plugins" to still be able to register static plugins. Bump haddock submodule - - - - - 72f2257c by Sylvain Henry at 2020-11-21T01:14:09-05:00 Don't initialize plugins in the Core2Core pipeline Some plugins can be added via TH (cf addCorePlugin). Initialize them in the driver instead of in the Core2Core pipeline. - - - - - ddbeeb3c by Ryan Scott at 2020-11-21T01:14:44-05:00 Add regression test for #10504 This issue was fixed at some point between GHC 8.0 and 8.2. Let's add a regression test to ensure that it stays fixed. Fixes #10504. - - - - - a4a6dc2a by Ben Gamari at 2020-11-21T01:15:21-05:00 dwarf: Apply info table offset consistently Previously we failed to apply the info table offset to the aranges and DIEs, meaning that we often failed to unwind in gdb. For some reason this only seemed to manifest in the RTS's Cmm closures. Nevertheless, now we can unwind completely up to `main` - - - - - 69bfbc21 by Ben Gamari at 2020-11-21T01:15:56-05:00 hadrian: Disable stripping when debug information is enabled - - - - - 7e93ae8b by Ben Gamari at 2020-11-21T13:13:29-05:00 rts: Post ticky entry counts to the eventlog We currently only post the entry counters, not the other global counters as in my experience the former are more useful. We use the heap profiler's census period to decide when to dump. Also spruces up the documentation surrounding ticky-ticky a bit. - - - - - bc9c3916 by Ben Gamari at 2020-11-22T06:28:10-05:00 Implement -ddump-c-backend argument To dump output of the C backend. - - - - - 901bc220 by Ben Gamari at 2020-11-22T12:39:02-05:00 Bump time submodule to 1.11.1 Also bumps directory, Cabal, hpc, time, and unix submodules. Closes #18847. - - - - - 92c0afbf by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Dump STG when ticky is enabled This changes the "ticky" modifier to enable dumping of final STG as this is generally needed to make sense of the ticky profiles. - - - - - d23fef68 by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Introduce notion of flavour transformers This extends Hadrian's notion of "flavour", as described in #18942. - - - - - 179d0bec by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Add a viaLlvmBackend modifier Note that this also slightly changes the semantics of these flavours as we only use LLVM for >= stage1 builds. - - - - - d4d95e51 by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Add profiled_ghc and no_dynamic_ghc modifiers - - - - - 6815603f by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Drop redundant flavour definitions Drop the profiled, LLVM, and ThreadSanitizer flavour definitions as these can now be realized with flavour transformers. - - - - - f88f4339 by Ben Gamari at 2020-11-24T02:43:20-05:00 rts: Flush eventlog buffers from flushEventLog As noted in #18043, flushTrace failed flush anything beyond the writer. This means that a significant amount of data sitting in capability-local event buffers may never get flushed, despite the users' pleads for us to flush. Fix this by making flushEventLog flush all of the event buffers before flushing the writer. Fixes #18043. - - - - - 7c03cc50 by Ben Gamari at 2020-11-24T02:43:55-05:00 gitlab-ci: Run LLVM job on appropriately-labelled MRs Namely, those marked with the ~"LLVM backend" label - - - - - 9b95d815 by Ben Gamari at 2020-11-24T02:43:55-05:00 gitlab-ci: Run LLVM builds on Debian 10 The current Debian 9 image doesn't provide LLVM 7. - - - - - 2ed3e6c0 by Ben Gamari at 2020-11-24T02:43:55-05:00 CmmToLlvm: Declare signature for memcmp Otherwise `opt` fails with: error: use of undefined value '@memcmp$def' - - - - - be5d74ca by Moritz Angermann at 2020-11-26T16:00:32-05:00 [Sized Cmm] properly retain sizes. This replaces all Word<N> = W<N># Word# and Int<N> = I<N># Int# with Word<N> = W<N># Word<N># and Int<N> = I<N># Int<N>#, thus providing us with properly sized primitives in the codegenerator instead of pretending they are all full machine words. This came up when implementing darwinpcs for arm64. The darwinpcs reqires us to pack function argugments in excess of registers on the stack. While most procedure call standards (pcs) assume arguments are just passed in 8 byte slots; and thus the caller does not know the exact signature to make the call, darwinpcs requires us to adhere to the prototype, and thus have the correct sizes. If we specify CInt in the FFI call, it should correspond to the C int, and not just be Word sized, when it's only half the size. This does change the expected output of T16402 but the new result is no less correct as it eliminates the narrowing (instead of the `and` as was previously done). Bumps the array, bytestring, text, and binary submodules. Co-Authored-By: Ben Gamari <ben at well-typed.com> Metric Increase: T13701 T14697 - - - - - a84e53f9 by Andreas Klebinger at 2020-11-26T16:00:32-05:00 RTS: Fix failed inlining of copy_tag. On windows using gcc-10 gcc failed to inline copy_tag into evacuate. To fix this we now set the always_inline attribute for the various copy* functions in Evac.c. The main motivation here is not the overhead of the function call, but rather that this allows the code to "specialize" for the size of the closure we copy which is often known at compile time. An earlier commit also tried to avoid evacuate_large inlining. But didn't quite succeed. So I also marked evacuate_large as noinline. Fixes #12416 - - - - - cdbd16f5 by Sylvain Henry at 2020-11-26T16:00:33-05:00 Fix toArgRep to support 64-bit reps on all systems [This is @Ericson2314 writing a commit message for @hsyl20's patch.] (Progress towards #11953, #17377, #17375) `Int64Rep` and `Word64Rep` are currently broken on 64-bit systems. This is because they should use "native arg rep" but instead use "large arg rep" as they do on 32-bit systems, which is either a non-concept or a 128-bit rep depending on one's vantage point. Now, these reps currently aren't used during 64-bit compilation, so the brokenness isn't observed, but I don't think that constitutes reasons not to fix it. Firstly, the linked issues there is a clearly expressed desire to use explicit-bitwidth constructs in more places. Secondly, per [1], there are other bugs that *do* manifest from not threading explicit-bitwidth information all the way through the compilation pipeline. One can therefore view this as one piece of the larger effort to do that, improve ergnomics, and squash remaining bugs. Also, this is needed for !3658. I could just merge this as part of that, but I'm keen on merging fixes "as they are ready" so the fixes that aren't ready are isolated and easier to debug. [1]: https://mail.haskell.org/pipermail/ghc-devs/2020-October/019332.html - - - - - a9378e69 by Tim Barnes at 2020-11-26T16:00:34-05:00 Set dynamic users-guide TOC spacing (fixes #18554) - - - - - 86a59d93 by Ben Gamari at 2020-11-26T16:00:34-05:00 rts: Use RTS_LIKELY in CHECK Most compilers probably already infer that `barf` diverges but it nevertheless doesn't hurt to be explicit. - - - - - 5757e82b by Matthew Pickering at 2020-11-26T16:00:35-05:00 Remove special case for GHC.ByteCode.Instr This was added in https://github.com/nomeata/ghc-heap-view/commit/34935206e51b9c86902481d84d2f368a6fd93423 GHC.ByteCode.Instr.BreakInfo no longer exists so the special case is dead code. Any check like this can be easily dealt with in client code. - - - - - d9c8b5b4 by Matthew Pickering at 2020-11-26T16:00:35-05:00 Split Up getClosureDataFromHeapRep Motivation 1. Don't enforce the repeated decoding of an info table, when the client can cache it (ghc-debug) 2. Allow the constructor information decoding to be overridden, this casues segfaults in ghc-debug - - - - - 3e3555cc by Andreas Klebinger at 2020-11-26T16:00:35-05:00 RegAlloc: Add missing raPlatformfield to RegAllocStatsSpill Fixes #18994 Co-Author: Benjamin Maurer <maurer.benjamin at gmail.com> - - - - - a1a75aa9 by Ben Gamari at 2020-11-27T06:20:41-05:00 rts: Allocate MBlocks with MAP_TOP_DOWN on Windows As noted in #18991, we would previously allocate heap in low memory. Due to this the linker, which typically *needs* low memory, would end up competing with the heap. In longer builds we end up running out of low memory entirely, leading to linking failures. - - - - - 75fc1ed5 by Sylvain Henry at 2020-11-28T15:40:23-05:00 Hadrian: fix detection of ghc-pkg for cross-compilers - - - - - 7cb5df96 by Sylvain Henry at 2020-11-28T15:40:23-05:00 hadrian: fix ghc-pkg uses (#17601) Make sure ghc-pkg doesn't read the compiler "settings" file by passing --no-user-package-db. - - - - - e3fd4226 by Ben Gamari at 2020-11-28T15:40:23-05:00 gitlab-ci: Introduce a nightly cross-compilation job This adds a job to test cross-compilation from x86-64 to AArch64 with Hadrian. Fixes #18234 - - - - - 698d3d96 by Ben Gamari at 2020-11-28T15:41:00-05:00 gitlab-ci: Only deploy GitLab Pages in ghc/ghc> The deployments are quite large and yet are currently only served for the ghc/ghc> project. - - - - - 625726f9 by David Eichmann at 2020-11-28T15:41:37-05:00 ghc-heap: partial TSO/STACK decoding Co-authored-by: Sven Tennie <sven.tennie at gmail.com> Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> Co-authored-by: Ben Gamari <bgamari.foss at gmail.com> - - - - - 22ea9c29 by Andreas Klebinger at 2020-11-28T15:42:13-05:00 Small optimization to CmmSink. Inside `regsUsedIn` we can avoid some thunks by specializing the recursion. In particular we avoid the thunk for `(f e z)` in the MachOp/Load branches, where we know this will evaluate to z. Reduces allocations for T3294 by ~1%. - - - - - bba42c62 by John Ericson at 2020-11-28T15:42:49-05:00 Make primop handler indentation more consistent - - - - - c82bc8e9 by John Ericson at 2020-11-28T15:42:49-05:00 Cleanup some primop constructor names Harmonize the internal (big sum type) names of the native vs fixed-sized number primops a bit. (Mainly by renaming the former.) No user-facing names are changed. - - - - - ae14f160 by Ben Gamari at 2020-11-28T15:43:25-05:00 testsuite: Mark T14702 as fragile on Windows Due to #18953. - - - - - 1bc104b0 by Ben Gamari at 2020-11-29T15:33:18-05:00 withTimings: Emit allocations counter This will allow us to back out the allocations per compiler pass from the eventlog. Note that we dump the allocation counter rather than the difference since this will allow us to determine how much work is done *between* `withTiming` blocks. - - - - - e992ea84 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 ThreadPaused: Don't zero slop until free vars are pushed When threadPaused blackholes a thunk it calls `OVERWRITING_CLOSURE` to zero the slop for the benefit of the sanity checker. Previously this was done *before* pushing the thunk's free variables to the update remembered set. Consequently we would pull zero'd pointers to the update remembered set. - - - - - e82cd140 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Fix regression from TSAN work The TSAN rework (specifically aad1f803) introduced a subtle regression in GC.c, swapping `g0` in place of `gen`. Whoops! Fixes #18997. - - - - - 35a5207e by GHC GitLab CI at 2020-11-29T15:33:54-05:00 rts/Messages: Add missing write barrier in THROWTO message update After a THROWTO message has been handle the message closure is overwritten by a NULL message. We must ensure that the original closure's pointers continue to be visible to the nonmoving GC. - - - - - 0120829f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Add missing write barrier in shrinkSmallByteArray - - - - - 8a4d8fb6 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 Updates: Don't zero slop until closure has been pushed Ensure that the the free variables have been pushed to the update remembered set before we zero the slop. - - - - - 2793cfdc by GHC GitLab CI at 2020-11-29T15:33:54-05:00 OSThreads: Fix error code checking pthread_join returns its error code and apparently doesn't set errno. - - - - - e391a16f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Don't join to mark_thread on shutdown The mark thread is not joinable as we detach from it on creation. - - - - - 60d088ab by Ben Gamari at 2020-11-29T15:33:54-05:00 nonmoving: Add reference to Ueno 2016 - - - - - 3aa60362 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Ensure that evacuated large objects are marked See Note [Non-moving GC: Marking evacuated objects]. - - - - - 8d304a99 by Ben Gamari at 2020-11-30T10:15:22-05:00 rts/m32: Refactor handling of allocator seeding Previously, in an attempt to reduce fragmentation, each new allocator would map a region of M32_MAX_PAGES fresh pages to seed itself. However, this ends up being extremely wasteful since it turns out that we often use fewer than this. Consequently, these pages end up getting freed which, ends up fragmenting our address space more than than we would have if we had naively allocated pages on-demand. Here we refactor m32 to avoid this waste while achieving the fragmentation mitigation previously desired. In particular, we move all page allocation into the global m32_alloc_page, which will pull a page from the free page pool. If the free page pool is empty we then refill it by allocating a region of M32_MAP_PAGES and adding them to the pool. Furthermore, we do away with the initial seeding entirely. That is, the allocator starts with no active pages: pages are rather allocated on an as-needed basis. On the whole this ends up being a pleasingly simple change, simultaneously making m32 more efficient, more robust, and simpler. Fixes #18980. - - - - - b6629289 by Ben Gamari at 2020-11-30T10:15:58-05:00 rts: Use CHECK instead of assert Use the GHC wrappers instead of <assert.h>. - - - - - 9f4efa6a by Ben Gamari at 2020-11-30T10:15:58-05:00 rts/linker: Replace some ASSERTs with CHECK In the past some people have confused ASSERT, which is for checking internal invariants, which CHECK, which should be used when checking things that might fail due to bad input (and therefore should be enabled even in the release compiler). Change some of these cases in the linker to use CHECK. - - - - - 0f8a4655 by Ryan Scott at 2020-11-30T10:16:34-05:00 Allow deploy:pages job to fail See #18973. - - - - - 49ebe369 by chessai at 2020-11-30T19:47:40-05:00 Optimisations in Data.Foldable (T17867) This PR concerns the following functions from `Data.Foldable`: * minimum * maximum * sum * product * minimumBy * maximumBy - Default implementations of these functions now use `foldl'` or `foldMap'`. - All have been marked with INLINEABLE to make room for further optimisations. - - - - - 4d79ef65 by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - 6af074ce by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - ab334262 by Viktor Dukhovni at 2020-11-30T19:48:17-05:00 dirty MVAR after mutating TSO queue head While the original head and tail of the TSO queue may be in the same generation as the MVAR, interior elements of the queue could be younger after a GC run and may then be exposed by putMVar operation that updates the queue head. Resolves #18919 - - - - - 5eb163f3 by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Don't allow shared libraries to be loaded multiple times - - - - - 490aa14d by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Initialise CCSs from native shared objects - - - - - 6ac3db5f by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Move shared library loading logic into Elf.c - - - - - b6698d73 by GHC GitLab CI at 2020-11-30T19:48:53-05:00 rts/linker: Don't declare dynamic objects with image_mapped This previously resulted in warnings due to spurious unmap failures. - - - - - b94a65af by jneira at 2020-11-30T19:49:31-05:00 Include tried paths in findToolDir error - - - - - ecc9f3dc by Andreas Klebinger at 2020-12-01T14:34:55+01:00 CodeGen: Make folds User/DefinerOfRegs INLINEABLE. Reduces allocation for the test case I was looking at by about 1.2%. Mostly from avoiding allocation of some folding functions which turn into let-no-escape bindings which just reuse their environment instead. We also force inlining in a few key places in CmmSink which helps a bit more. - - - - - bf4b3330 by Andreas Klebinger at 2020-12-01T14:34:55+01:00 CmmSink: Force inlining of foldRegsDefd Helps avoid allocating the folding function. Improves perf for T3294 by about 1%. - - - - - 8378f35e by Andreas Klebinger at 2020-12-01T14:34:55+01:00 Cmm: Make a few types and utility function slightly stricter. About 0.6% reduction in allocations for the code I was looking at. Not a huge difference but no need to throw away performance. - - - - - db03e2b7 by Andreas Klebinger at 2020-12-01T14:34:56+01:00 Cmm.Sink: Optimize retaining of assignments, live sets. Sinking requires us to track live local regs after each cmm statement. We used to do this via "Set LocalReg". However we can replace this with a solution based on IntSet which is overall more efficient without losing much. The thing we lose is width of the variables, which isn't used by the sinking pass anyway. I also reworked how we keep assignments to regs mentioned in skipped assignments. I put the details into Note [Keeping assignemnts mentioned in skipped RHSs]. The gist of it is instead of keeping track of it via the use count which is a `IntMap Int` we now use the live regs set (IntSet) which is quite a bit faster. I think it also matches the semantics a lot better. The skipped (not discarded) assignment does in fact keep the regs on it's rhs alive so keeping track of this in the live set seems like the clearer solution as well. Improves allocations for T3294 by yet another 1%. - - - - - 43ae672c by Andreas Klebinger at 2020-12-01T14:34:56+01:00 GHC.Cmm.Opt: Be stricter in results. Optimization either returns Nothing if nothing is to be done or `Just <cmmExpr>` otherwise. There is no point in being lazy in `cmmExpr`. We usually inspect this element so the thunk gets forced not long after. We might eliminate it as dead code once in a blue moon but that's not a case worth optimizing for. Overall the impact of this is rather low. As Cmm.Opt doesn't allocate much (compared to the rest of GHC) to begin with. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/Expr.hs - + compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Liveness.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/Reg/Graph.hs - compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Lint.hs - + compiler/GHC/Core/Opt/CallerCC.hs - + compiler/GHC/Core/Opt/CallerCC.hs-boot - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/CprAnal.hs - compiler/GHC/Core/Opt/DmdAnal.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/addc2e87fa68f6cc69b7b3f59e3d00e0a9edac1a...43ae672ca01105a5c0e56b2f775e77e1182e2e65 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/addc2e87fa68f6cc69b7b3f59e3d00e0a9edac1a...43ae672ca01105a5c0e56b2f775e77e1182e2e65 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 1 14:26:14 2020 From: gitlab at gitlab.haskell.org (Andreas Klebinger) Date: Tue, 01 Dec 2020 09:26:14 -0500 Subject: [Git][ghc/ghc][wip/andreask/opt_cmm_sink_sets] 2 commits: Cmm.Sink: Optimize retaining of assignments, live sets. Message-ID: <5fc65286bb7eb_86cbee259011987fd@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/opt_cmm_sink_sets at Glasgow Haskell Compiler / GHC Commits: 5b931ed4 by Andreas Klebinger at 2020-12-01T15:10:08+01:00 Cmm.Sink: Optimize retaining of assignments, live sets. Sinking requires us to track live local regs after each cmm statement. We used to do this via "Set LocalReg". However we can replace this with a solution based on IntSet which is overall more efficient without losing much. The thing we lose is width of the variables, which isn't used by the sinking pass anyway. I also reworked how we keep assignments to regs mentioned in skipped assignments. I put the details into Note [Keeping assignemnts mentioned in skipped RHSs]. The gist of it is instead of keeping track of it via the use count which is a `IntMap Int` we now use the live regs set (IntSet) which is quite a bit faster. I think it also matches the semantics a lot better. The skipped (not discarded) assignment does in fact keep the regs on it's rhs alive so keeping track of this in the live set seems like the clearer solution as well. Improves allocations for T3294 by yet another 1%. - - - - - 84f789ee by Andreas Klebinger at 2020-12-01T15:25:57+01:00 GHC.Cmm.Opt: Be stricter in results. Optimization either returns Nothing if nothing is to be done or `Just <cmmExpr>` otherwise. There is no point in being lazy in `cmmExpr`. We usually inspect this element so the thunk gets forced not long after. We might eliminate it as dead code once in a blue moon but that's not a case worth optimizing for. Overall the impact of this is rather low. As Cmm.Opt doesn't allocate much (compared to the rest of GHC) to begin with. - - - - - 6 changed files: - + compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Liveness.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Utils/Outputable.hs - compiler/ghc.cabal.in Changes: ===================================== compiler/GHC/Cmm/LRegSet.hs ===================================== @@ -0,0 +1,53 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module GHC.Cmm.LRegSet ( + LRegSet, + LRegKey, + + emptyLRegSet, + nullLRegSet, + insertLRegSet, + elemLRegSet, + + deleteFromLRegSet, + sizeLRegSet, + + plusLRegSet, + elemsLRegSet + ) where + +import GHC.Prelude +import GHC.Types.Unique +import GHC.Cmm.Expr + +import Data.IntSet as IntSet + +-- Compact sets for membership tests of local variables. + +type LRegSet = IntSet.IntSet +type LRegKey = Int + +emptyLRegSet :: LRegSet +emptyLRegSet = IntSet.empty + +nullLRegSet :: LRegSet -> Bool +nullLRegSet = IntSet.null + +insertLRegSet :: LocalReg -> LRegSet -> LRegSet +insertLRegSet l = IntSet.insert (getKey (getUnique l)) + +elemLRegSet :: LocalReg -> LRegSet -> Bool +elemLRegSet l = IntSet.member (getKey (getUnique l)) + +deleteFromLRegSet :: LRegSet -> LocalReg -> LRegSet +deleteFromLRegSet set reg = IntSet.delete (getKey . getUnique $ reg) set + +sizeLRegSet :: IntSet -> Int +sizeLRegSet = IntSet.size + +plusLRegSet :: IntSet -> IntSet -> IntSet +plusLRegSet = IntSet.union + +elemsLRegSet :: IntSet -> [Int] +elemsLRegSet = IntSet.toList \ No newline at end of file ===================================== compiler/GHC/Cmm/Liveness.hs ===================================== @@ -6,9 +6,12 @@ module GHC.Cmm.Liveness ( CmmLocalLive , cmmLocalLiveness + , cmmLocalLivenessL , cmmGlobalLiveness , liveLattice + , liveLatticeL , gen_kill + , gen_killL ) where @@ -22,11 +25,14 @@ import GHC.Cmm.Dataflow.Block import GHC.Cmm.Dataflow.Collections import GHC.Cmm.Dataflow import GHC.Cmm.Dataflow.Label +import GHC.Cmm.LRegSet import GHC.Data.Maybe import GHC.Utils.Outputable import GHC.Utils.Panic +import GHC.Types.Unique + ----------------------------------------------------------------------------- -- Calculating what variables are live on entry to a basic block ----------------------------------------------------------------------------- @@ -92,3 +98,66 @@ xferLive platform (BlockCC eNode middle xNode) fBase = in mapSingleton (entryLabel eNode) result {-# SPECIALIZE xferLive :: Platform -> TransferFun (CmmLive LocalReg) #-} {-# SPECIALIZE xferLive :: Platform -> TransferFun (CmmLive GlobalReg) #-} + +----------------------------------------------------------------------------- +-- | Specialization that only retains the keys for local variables. +-- +-- Local variablas are mostly glorified Ints, and some parts of the compiler +-- really don't care about anything but the Int part. So we can avoid some +-- overhead by computing a IntSet instead of a Set LocalReg which (unsurprisingly) +-- is quite a bit faster. +----------------------------------------------------------------------------- + +type BlockEntryLivenessL = LabelMap LRegSet + +-- | The dataflow lattice +liveLatticeL :: DataflowLattice LRegSet +liveLatticeL = DataflowLattice emptyLRegSet add + where + add (OldFact old) (NewFact new) = + let !join = plusLRegSet old new + in changedIf (sizeLRegSet join > sizeLRegSet old) join + + +cmmLocalLivenessL :: Platform -> CmmGraph -> BlockEntryLivenessL +cmmLocalLivenessL platform graph = + check $ analyzeCmmBwd liveLatticeL (xferLiveL platform) graph mapEmpty + where + entry = g_entry graph + check facts = + noLiveOnEntryL entry (expectJust "check" $ mapLookup entry facts) facts + +-- | On entry to the procedure, there had better not be any LocalReg's live-in. +noLiveOnEntryL :: BlockId -> LRegSet -> a -> a +noLiveOnEntryL bid in_fact x = + if nullLRegSet in_fact then x + else pprPanic "LocalReg's live-in to graph" (ppr bid <+> ppr reg_uniques) + where + -- We convert the int's to uniques so that the printing matches that + -- of registers. + reg_uniques = map mkUniqueGrimily $ elemsLRegSet in_fact + + + + +gen_killL + :: (DefinerOfRegs LocalReg n, UserOfRegs LocalReg n) + => Platform -> n -> LRegSet -> LRegSet +gen_killL platform node set = + let !afterKill = foldRegsDefd platform deleteFromLRegSet set node + in foldRegsUsed platform (flip insertLRegSet) afterKill node +{-# INLINE gen_killL #-} + +xferLiveL + :: ( UserOfRegs LocalReg (CmmNode O O) + , DefinerOfRegs LocalReg (CmmNode O O) + , UserOfRegs LocalReg (CmmNode O C) + , DefinerOfRegs LocalReg (CmmNode O C) + ) + => Platform -> TransferFun LRegSet +xferLiveL platform (BlockCC eNode middle xNode) fBase = + let joined = gen_killL platform xNode $! joinOutFacts liveLatticeL xNode fBase + !result = foldNodesBwdOO (gen_killL platform) middle joined + in mapSingleton (entryLabel eNode) result + + ===================================== compiler/GHC/Cmm/Opt.hs ===================================== @@ -58,7 +58,7 @@ cmmMachOpFoldM -> Maybe CmmExpr cmmMachOpFoldM _ op [CmmLit (CmmInt x rep)] - = Just $ case op of + = Just $! case op of MO_S_Neg _ -> CmmLit (CmmInt (-x) rep) MO_Not _ -> CmmLit (CmmInt (complement x) rep) @@ -90,13 +90,13 @@ cmmMachOpFoldM platform conv_outer [CmmMachOp conv_inner [x]] -- but remember to use the signedness from the widening, just in case -- the final conversion is a widen. | rep1 < rep2 && rep2 > rep3 -> - Just $ cmmMachOpFold platform (intconv signed1 rep1 rep3) [x] + Just $! cmmMachOpFold platform (intconv signed1 rep1 rep3) [x] -- Nested widenings: collapse if the signedness is the same | rep1 < rep2 && rep2 < rep3 && signed1 == signed2 -> - Just $ cmmMachOpFold platform (intconv signed1 rep1 rep3) [x] + Just $! cmmMachOpFold platform (intconv signed1 rep1 rep3) [x] -- Nested narrowings: collapse | rep1 > rep2 && rep2 > rep3 -> - Just $ cmmMachOpFold platform (MO_UU_Conv rep1 rep3) [x] + Just $! cmmMachOpFold platform (MO_UU_Conv rep1 rep3) [x] | otherwise -> Nothing where @@ -117,34 +117,34 @@ cmmMachOpFoldM platform mop [CmmLit (CmmInt x xrep), CmmLit (CmmInt y _)] = case mop of -- for comparisons: don't forget to narrow the arguments before -- comparing, since they might be out of range. - MO_Eq _ -> Just $ CmmLit (CmmInt (if x_u == y_u then 1 else 0) (wordWidth platform)) - MO_Ne _ -> Just $ CmmLit (CmmInt (if x_u /= y_u then 1 else 0) (wordWidth platform)) - - MO_U_Gt _ -> Just $ CmmLit (CmmInt (if x_u > y_u then 1 else 0) (wordWidth platform)) - MO_U_Ge _ -> Just $ CmmLit (CmmInt (if x_u >= y_u then 1 else 0) (wordWidth platform)) - MO_U_Lt _ -> Just $ CmmLit (CmmInt (if x_u < y_u then 1 else 0) (wordWidth platform)) - MO_U_Le _ -> Just $ CmmLit (CmmInt (if x_u <= y_u then 1 else 0) (wordWidth platform)) - - MO_S_Gt _ -> Just $ CmmLit (CmmInt (if x_s > y_s then 1 else 0) (wordWidth platform)) - MO_S_Ge _ -> Just $ CmmLit (CmmInt (if x_s >= y_s then 1 else 0) (wordWidth platform)) - MO_S_Lt _ -> Just $ CmmLit (CmmInt (if x_s < y_s then 1 else 0) (wordWidth platform)) - MO_S_Le _ -> Just $ CmmLit (CmmInt (if x_s <= y_s then 1 else 0) (wordWidth platform)) - - MO_Add r -> Just $ CmmLit (CmmInt (x + y) r) - MO_Sub r -> Just $ CmmLit (CmmInt (x - y) r) - MO_Mul r -> Just $ CmmLit (CmmInt (x * y) r) - MO_U_Quot r | y /= 0 -> Just $ CmmLit (CmmInt (x_u `quot` y_u) r) - MO_U_Rem r | y /= 0 -> Just $ CmmLit (CmmInt (x_u `rem` y_u) r) - MO_S_Quot r | y /= 0 -> Just $ CmmLit (CmmInt (x `quot` y) r) - MO_S_Rem r | y /= 0 -> Just $ CmmLit (CmmInt (x `rem` y) r) - - MO_And r -> Just $ CmmLit (CmmInt (x .&. y) r) - MO_Or r -> Just $ CmmLit (CmmInt (x .|. y) r) - MO_Xor r -> Just $ CmmLit (CmmInt (x `xor` y) r) - - MO_Shl r -> Just $ CmmLit (CmmInt (x `shiftL` fromIntegral y) r) - MO_U_Shr r -> Just $ CmmLit (CmmInt (x_u `shiftR` fromIntegral y) r) - MO_S_Shr r -> Just $ CmmLit (CmmInt (x `shiftR` fromIntegral y) r) + MO_Eq _ -> Just $! CmmLit (CmmInt (if x_u == y_u then 1 else 0) (wordWidth platform)) + MO_Ne _ -> Just $! CmmLit (CmmInt (if x_u /= y_u then 1 else 0) (wordWidth platform)) + + MO_U_Gt _ -> Just $! CmmLit (CmmInt (if x_u > y_u then 1 else 0) (wordWidth platform)) + MO_U_Ge _ -> Just $! CmmLit (CmmInt (if x_u >= y_u then 1 else 0) (wordWidth platform)) + MO_U_Lt _ -> Just $! CmmLit (CmmInt (if x_u < y_u then 1 else 0) (wordWidth platform)) + MO_U_Le _ -> Just $! CmmLit (CmmInt (if x_u <= y_u then 1 else 0) (wordWidth platform)) + + MO_S_Gt _ -> Just $! CmmLit (CmmInt (if x_s > y_s then 1 else 0) (wordWidth platform)) + MO_S_Ge _ -> Just $! CmmLit (CmmInt (if x_s >= y_s then 1 else 0) (wordWidth platform)) + MO_S_Lt _ -> Just $! CmmLit (CmmInt (if x_s < y_s then 1 else 0) (wordWidth platform)) + MO_S_Le _ -> Just $! CmmLit (CmmInt (if x_s <= y_s then 1 else 0) (wordWidth platform)) + + MO_Add r -> Just $! CmmLit (CmmInt (x + y) r) + MO_Sub r -> Just $! CmmLit (CmmInt (x - y) r) + MO_Mul r -> Just $! CmmLit (CmmInt (x * y) r) + MO_U_Quot r | y /= 0 -> Just $! CmmLit (CmmInt (x_u `quot` y_u) r) + MO_U_Rem r | y /= 0 -> Just $! CmmLit (CmmInt (x_u `rem` y_u) r) + MO_S_Quot r | y /= 0 -> Just $! CmmLit (CmmInt (x `quot` y) r) + MO_S_Rem r | y /= 0 -> Just $! CmmLit (CmmInt (x `rem` y) r) + + MO_And r -> Just $! CmmLit (CmmInt (x .&. y) r) + MO_Or r -> Just $! CmmLit (CmmInt (x .|. y) r) + MO_Xor r -> Just $! CmmLit (CmmInt (x `xor` y) r) + + MO_Shl r -> Just $! CmmLit (CmmInt (x `shiftL` fromIntegral y) r) + MO_U_Shr r -> Just $! CmmLit (CmmInt (x_u `shiftR` fromIntegral y) r) + MO_S_Shr r -> Just $! CmmLit (CmmInt (x `shiftR` fromIntegral y) r) _ -> Nothing @@ -162,7 +162,7 @@ cmmMachOpFoldM platform mop [CmmLit (CmmInt x xrep), CmmLit (CmmInt y _)] cmmMachOpFoldM platform op [x@(CmmLit _), y] | not (isLit y) && isCommutableMachOp op - = Just (cmmMachOpFold platform op [y, x]) + = Just $! (cmmMachOpFold platform op [y, x]) -- Turn (a+b)+c into a+(b+c) where possible. Because literals are -- moved to the right, it is more likely that we will find @@ -183,7 +183,7 @@ cmmMachOpFoldM platform op [x@(CmmLit _), y] cmmMachOpFoldM platform mop1 [CmmMachOp mop2 [arg1,arg2], arg3] | mop2 `associates_with` mop1 && not (isLit arg1) && not (isPicReg arg1) - = Just (cmmMachOpFold platform mop2 [arg1, cmmMachOpFold platform mop1 [arg2,arg3]]) + = Just $! (cmmMachOpFold platform mop2 [arg1, cmmMachOpFold platform mop1 [arg2,arg3]]) where MO_Add{} `associates_with` MO_Sub{} = True mop1 `associates_with` mop2 = @@ -192,7 +192,7 @@ cmmMachOpFoldM platform mop1 [CmmMachOp mop2 [arg1,arg2], arg3] -- special case: (a - b) + c ==> a + (c - b) cmmMachOpFoldM platform mop1@(MO_Add{}) [CmmMachOp mop2@(MO_Sub{}) [arg1,arg2], arg3] | not (isLit arg1) && not (isPicReg arg1) - = Just (cmmMachOpFold platform mop1 [arg1, cmmMachOpFold platform mop2 [arg3,arg2]]) + = Just $! (cmmMachOpFold platform mop1 [arg1, cmmMachOpFold platform mop2 [arg3,arg2]]) -- special case: (PicBaseReg + lit) + N ==> PicBaseReg + (lit+N) -- @@ -205,27 +205,27 @@ cmmMachOpFoldM platform mop1@(MO_Add{}) [CmmMachOp mop2@(MO_Sub{}) [arg1,arg2], cmmMachOpFoldM _ MO_Add{} [ CmmMachOp op at MO_Add{} [pic, CmmLit lit] , CmmLit (CmmInt n rep) ] | isPicReg pic - = Just $ CmmMachOp op [pic, CmmLit $ cmmOffsetLit lit off ] + = Just $! CmmMachOp op [pic, CmmLit $ cmmOffsetLit lit off ] where off = fromIntegral (narrowS rep n) -- Make a RegOff if we can cmmMachOpFoldM _ (MO_Add _) [CmmReg reg, CmmLit (CmmInt n rep)] - = Just $ cmmRegOff reg (fromIntegral (narrowS rep n)) + = Just $! cmmRegOff reg (fromIntegral (narrowS rep n)) cmmMachOpFoldM _ (MO_Add _) [CmmRegOff reg off, CmmLit (CmmInt n rep)] - = Just $ cmmRegOff reg (off + fromIntegral (narrowS rep n)) + = Just $! cmmRegOff reg (off + fromIntegral (narrowS rep n)) cmmMachOpFoldM _ (MO_Sub _) [CmmReg reg, CmmLit (CmmInt n rep)] - = Just $ cmmRegOff reg (- fromIntegral (narrowS rep n)) + = Just $! cmmRegOff reg (- fromIntegral (narrowS rep n)) cmmMachOpFoldM _ (MO_Sub _) [CmmRegOff reg off, CmmLit (CmmInt n rep)] - = Just $ cmmRegOff reg (off - fromIntegral (narrowS rep n)) + = Just $! cmmRegOff reg (off - fromIntegral (narrowS rep n)) -- Fold label(+/-)offset into a CmmLit where possible cmmMachOpFoldM _ (MO_Add _) [CmmLit lit, CmmLit (CmmInt i rep)] - = Just $ CmmLit (cmmOffsetLit lit (fromIntegral (narrowU rep i))) + = Just $! CmmLit (cmmOffsetLit lit (fromIntegral (narrowU rep i))) cmmMachOpFoldM _ (MO_Add _) [CmmLit (CmmInt i rep), CmmLit lit] - = Just $ CmmLit (cmmOffsetLit lit (fromIntegral (narrowU rep i))) + = Just $! CmmLit (cmmOffsetLit lit (fromIntegral (narrowU rep i))) cmmMachOpFoldM _ (MO_Sub _) [CmmLit lit, CmmLit (CmmInt i rep)] - = Just $ CmmLit (cmmOffsetLit lit (fromIntegral (negate (narrowU rep i)))) + = Just $! CmmLit (cmmOffsetLit lit (fromIntegral (negate (narrowU rep i)))) -- Comparison of literal with widened operand: perform the comparison @@ -245,7 +245,7 @@ cmmMachOpFoldM platform cmp [CmmMachOp conv [x], CmmLit (CmmInt i _)] -- and the literal fits in the smaller size: i == narrow_fn rep i -- then we can do the comparison at the smaller size - = Just (cmmMachOpFold platform narrow_cmp [x, CmmLit (CmmInt i rep)]) + = Just $! (cmmMachOpFold platform narrow_cmp [x, CmmLit (CmmInt i rep)]) where maybe_conversion (MO_UU_Conv from to) | to > from @@ -320,8 +320,8 @@ cmmMachOpFoldM platform mop [x, (CmmLit (CmmInt 1 rep))] MO_Mul _ -> Just x MO_S_Quot _ -> Just x MO_U_Quot _ -> Just x - MO_S_Rem _ -> Just $ CmmLit (CmmInt 0 rep) - MO_U_Rem _ -> Just $ CmmLit (CmmInt 0 rep) + MO_S_Rem _ -> Just $! CmmLit (CmmInt 0 rep) + MO_U_Rem _ -> Just $! CmmLit (CmmInt 0 rep) -- Comparisons; trickier -- See Note [Comparison operators] @@ -346,18 +346,18 @@ cmmMachOpFoldM platform mop [x, (CmmLit (CmmInt n _))] = case mop of MO_Mul rep | Just p <- exactLog2 n -> - Just (cmmMachOpFold platform (MO_Shl rep) [x, CmmLit (CmmInt p rep)]) + Just $! (cmmMachOpFold platform (MO_Shl rep) [x, CmmLit (CmmInt p rep)]) MO_U_Quot rep | Just p <- exactLog2 n -> - Just (cmmMachOpFold platform (MO_U_Shr rep) [x, CmmLit (CmmInt p rep)]) + Just $! (cmmMachOpFold platform (MO_U_Shr rep) [x, CmmLit (CmmInt p rep)]) MO_U_Rem rep | Just _ <- exactLog2 n -> - Just (cmmMachOpFold platform (MO_And rep) [x, CmmLit (CmmInt (n - 1) rep)]) + Just $! (cmmMachOpFold platform (MO_And rep) [x, CmmLit (CmmInt (n - 1) rep)]) MO_S_Quot rep | Just p <- exactLog2 n, CmmReg _ <- x -> -- We duplicate x in signedQuotRemHelper, hence require -- it is a reg. FIXME: remove this restriction. - Just (cmmMachOpFold platform (MO_S_Shr rep) + Just $! (cmmMachOpFold platform (MO_S_Shr rep) [signedQuotRemHelper rep p, CmmLit (CmmInt p rep)]) MO_S_Rem rep | Just p <- exactLog2 n, @@ -366,7 +366,7 @@ cmmMachOpFoldM platform mop [x, (CmmLit (CmmInt n _))] -- We replace (x `rem` 2^p) by (x - (x `quot` 2^p) * 2^p). -- Moreover, we fuse MO_S_Shr (last operation of MO_S_Quot) -- and MO_S_Shl (multiplication by 2^p) into a single MO_And operation. - Just (cmmMachOpFold platform (MO_Sub rep) + Just $! (cmmMachOpFold platform (MO_Sub rep) [x, cmmMachOpFold platform (MO_And rep) [signedQuotRemHelper rep p, CmmLit (CmmInt (- n) rep)]]) _ -> Nothing ===================================== compiler/GHC/Cmm/Sink.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE ScopedTypeVariables #-} + module GHC.Cmm.Sink ( cmmSink ) where @@ -9,6 +10,7 @@ import GHC.Prelude import GHC.Cmm import GHC.Cmm.Opt import GHC.Cmm.Liveness +import GHC.Cmm.LRegSet import GHC.Cmm.Utils import GHC.Cmm.Dataflow.Block import GHC.Cmm.Dataflow.Label @@ -17,32 +19,14 @@ import GHC.Cmm.Dataflow.Graph import GHC.Platform.Regs import GHC.Platform -import GHC.Types.Unique import GHC.Types.Unique.FM import qualified Data.IntSet as IntSet import Data.List (partition) -import qualified Data.Set as Set import Data.Maybe import GHC.Exts (inline) --- Compact sets for membership tests of local variables. - -type LRegSet = IntSet.IntSet - -emptyLRegSet :: LRegSet -emptyLRegSet = IntSet.empty - -nullLRegSet :: LRegSet -> Bool -nullLRegSet = IntSet.null - -insertLRegSet :: LocalReg -> LRegSet -> LRegSet -insertLRegSet l = IntSet.insert (getKey (getUnique l)) - -elemLRegSet :: LocalReg -> LRegSet -> Bool -elemLRegSet l = IntSet.member (getKey (getUnique l)) - -- ----------------------------------------------------------------------------- -- Sinking and inlining @@ -170,8 +154,8 @@ type Assignments = [Assignment] cmmSink :: Platform -> CmmGraph -> CmmGraph cmmSink platform graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks where - liveness = cmmLocalLiveness platform graph - getLive l = mapFindWithDefault Set.empty l liveness + liveness = cmmLocalLivenessL platform graph + getLive l = mapFindWithDefault emptyLRegSet l liveness blocks = revPostorder graph @@ -191,8 +175,8 @@ cmmSink platform graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks -- Annotate the middle nodes with the registers live *after* -- the node. This will help us decide whether we can inline -- an assignment in the current node or not. - live = Set.unions (map getLive succs) - live_middle = gen_kill platform last live + live = IntSet.unions (map getLive succs) + live_middle = gen_killL platform last live ann_middles = annotate platform live_middle (blockToList middle) -- Now sink and inline in this block @@ -204,7 +188,7 @@ cmmSink platform graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks -- one predecessor), so identify the join points and the set -- of registers live in them. (joins, nonjoins) = partition (`mapMember` join_pts) succs - live_in_joins = Set.unions (map getLive joins) + live_in_joins = IntSet.unions (map getLive joins) -- We do not want to sink an assignment into multiple branches, -- so identify the set of registers live in multiple successors. @@ -213,26 +197,28 @@ cmmSink platform graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks -- now live in multiple branches. init_live_sets = map getLive nonjoins live_in_multi live_sets r = - case filter (Set.member r) live_sets of + case filter (elemLRegSet r) live_sets of (_one:_two:_) -> True _ -> False -- Now, drop any assignments that we will not sink any further. (dropped_last, assigs'') = dropAssignments platform drop_if init_live_sets assigs' + drop_if :: (LocalReg, CmmExpr, AbsMem) + -> [LRegSet] -> (Bool, [LRegSet]) drop_if a@(r,rhs,_) live_sets = (should_drop, live_sets') where should_drop = conflicts platform a final_last || not (isTrivial platform rhs) && live_in_multi live_sets r - || r `Set.member` live_in_joins + || r `elemLRegSet` live_in_joins live_sets' | should_drop = live_sets | otherwise = map upd live_sets - upd set | r `Set.member` set = set `Set.union` live_rhs + upd set | r `elemLRegSet` set = set `IntSet.union` live_rhs | otherwise = set - live_rhs = foldRegsUsed platform extendRegSet emptyRegSet rhs + live_rhs = foldRegsUsed platform (flip insertLRegSet) emptyLRegSet rhs final_middle = foldl' blockSnoc middle' dropped_last @@ -269,9 +255,9 @@ isTrivial _ _ = False -- -- annotate each node with the set of registers live *after* the node -- -annotate :: Platform -> LocalRegSet -> [CmmNode O O] -> [(LocalRegSet, CmmNode O O)] +annotate :: Platform -> LRegSet -> [CmmNode O O] -> [(LRegSet, CmmNode O O)] annotate platform live nodes = snd $ foldr ann (live,[]) nodes - where ann n (live,nodes) = (gen_kill platform n live, (live,n) : nodes) + where ann n (live,nodes) = (gen_killL platform n live, (live,n) : nodes) -- -- Find the blocks that have multiple successors (join points) @@ -288,13 +274,13 @@ findJoinPoints blocks = mapFilter (>1) succ_counts -- filter the list of assignments to remove any assignments that -- are not live in a continuation. -- -filterAssignments :: Platform -> LocalRegSet -> Assignments -> Assignments +filterAssignments :: Platform -> LRegSet -> Assignments -> Assignments filterAssignments platform live assigs = reverse (go assigs []) where go [] kept = kept go (a@(r,_,_):as) kept | needed = go as (a:kept) | otherwise = go as kept where - needed = r `Set.member` live + needed = r `elemLRegSet` live || any (conflicts platform a) (map toNode kept) -- Note that we must keep assignments that are -- referred to by other assignments we have @@ -315,7 +301,7 @@ filterAssignments platform live assigs = reverse (go assigs []) -- walk :: Platform - -> [(LocalRegSet, CmmNode O O)] -- nodes of the block, annotated with + -> [(LRegSet, CmmNode O O)] -- nodes of the block, annotated with -- the set of registers live *after* -- this node. @@ -369,11 +355,11 @@ shouldSink _ _other = Nothing -- out of inlining, but the inliner will see that r is live -- after the instruction and choose not to inline r in the rhs. -- -shouldDiscard :: CmmNode e x -> LocalRegSet -> Bool +shouldDiscard :: CmmNode e x -> LRegSet -> Bool shouldDiscard node live = case node of CmmAssign r (CmmReg r') | r == r' -> True - CmmAssign (CmmLocal r) _ -> not (r `Set.member` live) + CmmAssign (CmmLocal r) _ -> not (r `elemLRegSet` live) _otherwise -> False @@ -407,7 +393,8 @@ dropAssignments platform should_drop state assigs tryToInline :: forall x. Platform - -> LocalRegSet -- set of registers live after this + -> LRegSet -- set of registers live after this + -- -> LocalRegSet -- set of registers live after this -- node. We cannot inline anything -- that is live after the node, unless -- it is small enough to duplicate. @@ -418,36 +405,42 @@ tryToInline , Assignments -- Remaining assignments ) -tryToInline platform live node assigs = go usages node emptyLRegSet assigs +tryToInline platform liveAfter node assigs = + -- pprTrace "tryToInline assig length:" (ppr $ length assigs) $ + go usages liveAfter node emptyLRegSet assigs where usages :: UniqFM LocalReg Int -- Maps each LocalReg to a count of how often it is used usages = foldLocalRegsUsed platform addUsage emptyUFM node - go _usages node _skipped [] = (node, []) + go :: UniqFM LocalReg Int -> LRegSet -> CmmNode O x -> LRegSet -> Assignments + -> (CmmNode O x, Assignments) + go _usages _live node _skipped [] = (node, []) - go usages node skipped (a@(l,rhs,_) : rest) - | cannot_inline = dont_inline - | occurs_none = discard -- Note [discard during inlining] - | occurs_once = inline_and_discard - | isTrivial platform rhs = inline_and_keep - | otherwise = dont_inline + go usages live node skipped (a@(l,rhs,_) : rest) + | cannot_inline = dont_inline + | occurs_none = discard -- Note [discard during inlining] + | occurs_once = inline_and_discard + | isTrivial platform rhs = inline_and_keep + | otherwise = dont_inline where - inline_and_discard = go usages' inl_node skipped rest + inline_and_discard = go usages' live inl_node skipped rest where usages' = foldLocalRegsUsed platform addUsage usages rhs - discard = go usages node skipped rest + discard = go usages live node skipped rest dont_inline = keep node -- don't inline the assignment, keep it inline_and_keep = keep inl_node -- inline the assignment, keep it keep :: CmmNode O x -> (CmmNode O x, Assignments) keep node' = (final_node, a : rest') - where (final_node, rest') = go usages' node' (insertLRegSet l skipped) rest + where (final_node, rest') = go usages live' node' (insertLRegSet l skipped) rest -- Avoid discarding of assignments to vars on the rhs. -- See Note [Keeping assignemnts mentioned in skipped RHSs] - usages' = foldLocalRegsUsed platform (\m r -> addToUFM m r 2) - usages rhs + -- usages' = foldLocalRegsUsed platform (\m r -> addToUFM m r 2) + -- usages rhs + live' = inline foldLocalRegsUsed platform (\m r -> insertLRegSet r m) + live rhs cannot_inline = skipped `regsUsedIn` rhs -- Note [dependent assignments] || l `elemLRegSet` skipped @@ -455,7 +448,7 @@ tryToInline platform live node assigs = go usages node emptyLRegSet assigs -- How often is l used in the current node. l_usages = lookupUFM usages l - l_live = l `elemRegSet` live + l_live = l `elemLRegSet` live occurs_once = not l_live && l_usages == Just 1 occurs_none = not l_live && l_usages == Nothing @@ -483,9 +476,11 @@ tryToInline platform live node assigs = go usages node emptyLRegSet assigs referencing a variable which hasn't been mentioned after inlining. - We use a hack to do this, which is setting all regs used on the - RHS to two uses. Since we only discard assignments to variables - which are used once or never this prevents discarding of the + We use a hack to do this. + + We pretend the regs from the rhs are live after the current + node. Since we only discard assignments to variables + which are dead after the current block this prevents discarding of the assignment. It still allows inlining should e1 be a trivial rhs however. ===================================== compiler/GHC/Utils/Outputable.hs ===================================== @@ -115,6 +115,7 @@ import Data.Int import qualified Data.IntMap as IM import Data.Set (Set) import qualified Data.Set as Set +import qualified Data.IntSet as IntSet import Data.String import Data.Word import System.IO ( Handle ) @@ -863,6 +864,9 @@ instance (Outputable a) => Outputable (NonEmpty a) where instance (Outputable a) => Outputable (Set a) where ppr s = braces (fsep (punctuate comma (map ppr (Set.toList s)))) +instance Outputable IntSet.IntSet where + ppr s = braces (fsep (punctuate comma (map ppr (IntSet.toList s)))) + instance (Outputable a, Outputable b) => Outputable (a, b) where ppr (x,y) = parens (sep [ppr x <> comma, ppr y]) ===================================== compiler/ghc.cabal.in ===================================== @@ -205,6 +205,7 @@ Library GHC.Cmm.Switch GHC.Cmm.Switch.Implement GHC.CmmToAsm + GHC.Cmm.LRegSet GHC.CmmToAsm.BlockLayout GHC.CmmToAsm.CFG GHC.CmmToAsm.CFG.Dominators View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/43ae672ca01105a5c0e56b2f775e77e1182e2e65...84f789ee8f45e6a3936d0c1343c442140035f286 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/43ae672ca01105a5c0e56b2f775e77e1182e2e65...84f789ee8f45e6a3936d0c1343c442140035f286 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 1 14:57:38 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 01 Dec 2020 09:57:38 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 18 commits: Optimisations in Data.Foldable (T17867) Message-ID: <5fc659e2d6670_86c3fc6aa9884c812097be@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 49ebe369 by chessai at 2020-11-30T19:47:40-05:00 Optimisations in Data.Foldable (T17867) This PR concerns the following functions from `Data.Foldable`: * minimum * maximum * sum * product * minimumBy * maximumBy - Default implementations of these functions now use `foldl'` or `foldMap'`. - All have been marked with INLINEABLE to make room for further optimisations. - - - - - 4d79ef65 by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - 6af074ce by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - ab334262 by Viktor Dukhovni at 2020-11-30T19:48:17-05:00 dirty MVAR after mutating TSO queue head While the original head and tail of the TSO queue may be in the same generation as the MVAR, interior elements of the queue could be younger after a GC run and may then be exposed by putMVar operation that updates the queue head. Resolves #18919 - - - - - 5eb163f3 by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Don't allow shared libraries to be loaded multiple times - - - - - 490aa14d by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Initialise CCSs from native shared objects - - - - - 6ac3db5f by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Move shared library loading logic into Elf.c - - - - - b6698d73 by GHC GitLab CI at 2020-11-30T19:48:53-05:00 rts/linker: Don't declare dynamic objects with image_mapped This previously resulted in warnings due to spurious unmap failures. - - - - - b94a65af by jneira at 2020-11-30T19:49:31-05:00 Include tried paths in findToolDir error - - - - - a0297104 by Richard Eisenberg at 2020-12-01T09:57:29-05:00 Move core flattening algorithm to Core.Unify This sets the stage for a later change, where this algorithm will be needed from GHC.Core.InstEnv. This commit also splits GHC.Core.Map into GHC.Core.Map.Type and GHC.Core.Map.Expr, in order to avoid module import cycles with GHC.Core. - - - - - 6e7569b9 by Richard Eisenberg at 2020-12-01T09:57:29-05:00 Bump the # of commits searched for perf baseline The previous value of 75 meant that a feature branch with more than 75 commits would get spurious CI passes. This affects #18692, but does not fix that ticket, because if a baseline cannot be found, we should fail, not succeed. - - - - - eae1e45c by Richard Eisenberg at 2020-12-01T09:57:29-05:00 Remove flattening variables This patch redesigns the flattener to simplify type family applications directly instead of using flattening meta-variables and skolems. The key new innovation is the CanEqLHS type and the new CEqCan constraint (Ct). A CanEqLHS is either a type variable or exactly-saturated type family application; either can now be rewritten using a CEqCan constraint in the inert set. Because the flattener no longer reduces all type family applications to variables, there was some performance degradation if a lengthy type family application is now flattened over and over (not making progress). To compensate, this patch contains some extra optimizations in the flattener, leading to a number of performance improvements. Close #18875. Close #18910. There are many extra parts of the compiler that had to be affected in writing this patch: * The family-application cache (formerly the flat-cache) sometimes stores coercions built from Given inerts. When these inerts get kicked out, we must kick out from the cache as well. (This was, I believe, true previously, but somehow never caused trouble.) Kicking out from the cache requires adding a filterTM function to TrieMap. * This patch obviates the need to distinguish "blocking" coercion holes from non-blocking ones (which, previously, arose from CFunEqCans). There is thus some simplification around coercion holes. * Extra commentary throughout parts of the code I read through, to preserve the knowledge I gained while working. * A change in the pure unifier around unifying skolems with other types. Unifying a skolem now leads to SurelyApart, not MaybeApart, as documented in Note [Binding when looking up instances] in GHC.Core.InstEnv. * Some more use of MCoercion where appropriate. * Previously, class-instance lookup automatically noticed that e.g. C Int was a "unifier" to a target [W] C (F Bool), because the F Bool was flattened to a variable. Now, a little more care must be taken around checking for unifying instances. * Previously, tcSplitTyConApp_maybe would split (Eq a => a). This is silly, because (=>) is not a tycon in Haskell. Fixed now, but there are some knock-on changes in e.g. TrieMap code and in the canonicaliser. * New function anyFreeVarsOf{Type,Co} to check whether a free variable satisfies a certain predicate. * Type synonyms now remember whether or not they are "forgetful"; a forgetful synonym drops at least one argument. This is useful when flattening; see flattenView. * The pattern-match completeness checker invokes the solver. This invocation might need to look through newtypes when checking representational equality. Thus, the desugarer needs to keep track of the in-scope variables to know what newtype constructors are in scope. I bet this bug was around before but never noticed. * Extra-constraints wildcards are no longer simplified before printing. See Note [Do not simplify ConstraintHoles] in GHC.Tc.Solver. * Whether or not there are Given equalities has become slightly subtler. See the new HasGivenEqs datatype. * Note [Type variable cycles in Givens] in GHC.Tc.Solver.Canonical explains a significant new wrinkle in the new approach. * See Note [What might match later?] in GHC.Tc.Solver.Interact, which explains the fix to #18910. * The inert_count field of InertCans wasn't actually used, so I removed it. Though I (Richard) did the implementation, Simon PJ was very involved in design and review. This updates the Haddock submodule to avoid #18932 by adding a type signature. ------------------------- Metric Decrease: T12227 T5030 T9872a T9872b T9872c Metric Increase: T9872d ------------------------- - - - - - 3396e770 by Richard Eisenberg at 2020-12-01T09:57:29-05:00 Rename the flattener to become the rewriter. Now that flattening doesn't produce flattening variables, it's not really flattening anything: it's rewriting. This change also means that the rewriter can no longer be confused the core flattener (in GHC.Core.Unify), which is sometimes used during type-checking. - - - - - 818d0d23 by Ben Gamari at 2020-12-01T09:57:29-05:00 rts: Introduce mmapAnonForLinker Previously most of the uses of mmapForLinker were mapping anonymous memory, resulting in a great deal of unnecessary repetition. Factor this out into a new helper. Also fixes a few places where error checking was missing or suboptimal. - - - - - 9c928d97 by Ben Gamari at 2020-12-01T09:57:29-05:00 rts/linker: Introduce munmapForLinker Consolidates munmap calls to ensure consistent error handling. - - - - - 85c7582a by Ben Gamari at 2020-12-01T09:57:29-05:00 rts/Linker: Introduce Windows implementations for mmapForLinker, et al. - - - - - b23c84a5 by Ben Gamari at 2020-12-01T09:57:29-05:00 rts/m32: Introduce NEEDS_M32 macro Instead of relying on RTS_LINKER_USE_MMAP - - - - - aa1f4b6c by Ben Gamari at 2020-12-01T09:57:29-05:00 rts/linker: Use m32 to allocate symbol extras in PEi386 - - - - - 30 changed files: - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Axiom.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FamInstEnv.hs - compiler/GHC/Core/InstEnv.hs - + compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Map.hs → compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/Opt/CSE.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/TyCon/Env.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/Maybe.hs - compiler/GHC/Data/TrieMap.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - compiler/GHC/HsToCore/Types.hs - compiler/GHC/Iface/Ext/Utils.hs - compiler/GHC/Stg/CSE.hs - compiler/GHC/SysTools/BaseDir.hs - compiler/GHC/Tc/Errors.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0b4d31339aff7f0a60fbf409a2637de8809a6572...aa1f4b6c450635e8a10ade33e019d60391ebec51 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0b4d31339aff7f0a60fbf409a2637de8809a6572...aa1f4b6c450635e8a10ade33e019d60391ebec51 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 1 15:33:13 2020 From: gitlab at gitlab.haskell.org (Andreas Klebinger) Date: Tue, 01 Dec 2020 10:33:13 -0500 Subject: [Git][ghc/ghc][wip/andreask/opt_cmm_sink_sets] 2 commits: Cmm.Sink: Optimize retaining of assignments, live sets. Message-ID: <5fc662393f8b2_86c3fc677e4686c12130c8@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/opt_cmm_sink_sets at Glasgow Haskell Compiler / GHC Commits: 5eb6496b by Andreas Klebinger at 2020-12-01T16:30:03+01:00 Cmm.Sink: Optimize retaining of assignments, live sets. Sinking requires us to track live local regs after each cmm statement. We used to do this via "Set LocalReg". However we can replace this with a solution based on IntSet which is overall more efficient without losing much. The thing we lose is width of the variables, which isn't used by the sinking pass anyway. I also reworked how we keep assignments to regs mentioned in skipped assignments. I put the details into Note [Keeping assignemnts mentioned in skipped RHSs]. The gist of it is instead of keeping track of it via the use count which is a `IntMap Int` we now use the live regs set (IntSet) which is quite a bit faster. I think it also matches the semantics a lot better. The skipped (not discarded) assignment does in fact keep the regs on it's rhs alive so keeping track of this in the live set seems like the clearer solution as well. Improves allocations for T3294 by yet another 1%. - - - - - 23e1050e by Andreas Klebinger at 2020-12-01T16:30:13+01:00 GHC.Cmm.Opt: Be stricter in results. Optimization either returns Nothing if nothing is to be done or `Just <cmmExpr>` otherwise. There is no point in being lazy in `cmmExpr`. We usually inspect this element so the thunk gets forced not long after. We might eliminate it as dead code once in a blue moon but that's not a case worth optimizing for. Overall the impact of this is rather low. As Cmm.Opt doesn't allocate much (compared to the rest of GHC) to begin with. - - - - - 6 changed files: - + compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Liveness.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Utils/Outputable.hs - compiler/ghc.cabal.in Changes: ===================================== compiler/GHC/Cmm/LRegSet.hs ===================================== @@ -0,0 +1,53 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module GHC.Cmm.LRegSet ( + LRegSet, + LRegKey, + + emptyLRegSet, + nullLRegSet, + insertLRegSet, + elemLRegSet, + + deleteFromLRegSet, + sizeLRegSet, + + plusLRegSet, + elemsLRegSet + ) where + +import GHC.Prelude +import GHC.Types.Unique +import GHC.Cmm.Expr + +import Data.IntSet as IntSet + +-- Compact sets for membership tests of local variables. + +type LRegSet = IntSet.IntSet +type LRegKey = Int + +emptyLRegSet :: LRegSet +emptyLRegSet = IntSet.empty + +nullLRegSet :: LRegSet -> Bool +nullLRegSet = IntSet.null + +insertLRegSet :: LocalReg -> LRegSet -> LRegSet +insertLRegSet l = IntSet.insert (getKey (getUnique l)) + +elemLRegSet :: LocalReg -> LRegSet -> Bool +elemLRegSet l = IntSet.member (getKey (getUnique l)) + +deleteFromLRegSet :: LRegSet -> LocalReg -> LRegSet +deleteFromLRegSet set reg = IntSet.delete (getKey . getUnique $ reg) set + +sizeLRegSet :: IntSet -> Int +sizeLRegSet = IntSet.size + +plusLRegSet :: IntSet -> IntSet -> IntSet +plusLRegSet = IntSet.union + +elemsLRegSet :: IntSet -> [Int] +elemsLRegSet = IntSet.toList ===================================== compiler/GHC/Cmm/Liveness.hs ===================================== @@ -6,9 +6,12 @@ module GHC.Cmm.Liveness ( CmmLocalLive , cmmLocalLiveness + , cmmLocalLivenessL , cmmGlobalLiveness , liveLattice + , liveLatticeL , gen_kill + , gen_killL ) where @@ -22,11 +25,14 @@ import GHC.Cmm.Dataflow.Block import GHC.Cmm.Dataflow.Collections import GHC.Cmm.Dataflow import GHC.Cmm.Dataflow.Label +import GHC.Cmm.LRegSet import GHC.Data.Maybe import GHC.Utils.Outputable import GHC.Utils.Panic +import GHC.Types.Unique + ----------------------------------------------------------------------------- -- Calculating what variables are live on entry to a basic block ----------------------------------------------------------------------------- @@ -92,3 +98,66 @@ xferLive platform (BlockCC eNode middle xNode) fBase = in mapSingleton (entryLabel eNode) result {-# SPECIALIZE xferLive :: Platform -> TransferFun (CmmLive LocalReg) #-} {-# SPECIALIZE xferLive :: Platform -> TransferFun (CmmLive GlobalReg) #-} + +----------------------------------------------------------------------------- +-- | Specialization that only retains the keys for local variables. +-- +-- Local variablas are mostly glorified Ints, and some parts of the compiler +-- really don't care about anything but the Int part. So we can avoid some +-- overhead by computing a IntSet instead of a Set LocalReg which (unsurprisingly) +-- is quite a bit faster. +----------------------------------------------------------------------------- + +type BlockEntryLivenessL = LabelMap LRegSet + +-- | The dataflow lattice +liveLatticeL :: DataflowLattice LRegSet +liveLatticeL = DataflowLattice emptyLRegSet add + where + add (OldFact old) (NewFact new) = + let !join = plusLRegSet old new + in changedIf (sizeLRegSet join > sizeLRegSet old) join + + +cmmLocalLivenessL :: Platform -> CmmGraph -> BlockEntryLivenessL +cmmLocalLivenessL platform graph = + check $ analyzeCmmBwd liveLatticeL (xferLiveL platform) graph mapEmpty + where + entry = g_entry graph + check facts = + noLiveOnEntryL entry (expectJust "check" $ mapLookup entry facts) facts + +-- | On entry to the procedure, there had better not be any LocalReg's live-in. +noLiveOnEntryL :: BlockId -> LRegSet -> a -> a +noLiveOnEntryL bid in_fact x = + if nullLRegSet in_fact then x + else pprPanic "LocalReg's live-in to graph" (ppr bid <+> ppr reg_uniques) + where + -- We convert the int's to uniques so that the printing matches that + -- of registers. + reg_uniques = map mkUniqueGrimily $ elemsLRegSet in_fact + + + + +gen_killL + :: (DefinerOfRegs LocalReg n, UserOfRegs LocalReg n) + => Platform -> n -> LRegSet -> LRegSet +gen_killL platform node set = + let !afterKill = foldRegsDefd platform deleteFromLRegSet set node + in foldRegsUsed platform (flip insertLRegSet) afterKill node +{-# INLINE gen_killL #-} + +xferLiveL + :: ( UserOfRegs LocalReg (CmmNode O O) + , DefinerOfRegs LocalReg (CmmNode O O) + , UserOfRegs LocalReg (CmmNode O C) + , DefinerOfRegs LocalReg (CmmNode O C) + ) + => Platform -> TransferFun LRegSet +xferLiveL platform (BlockCC eNode middle xNode) fBase = + let joined = gen_killL platform xNode $! joinOutFacts liveLatticeL xNode fBase + !result = foldNodesBwdOO (gen_killL platform) middle joined + in mapSingleton (entryLabel eNode) result + + ===================================== compiler/GHC/Cmm/Opt.hs ===================================== @@ -58,7 +58,7 @@ cmmMachOpFoldM -> Maybe CmmExpr cmmMachOpFoldM _ op [CmmLit (CmmInt x rep)] - = Just $ case op of + = Just $! case op of MO_S_Neg _ -> CmmLit (CmmInt (-x) rep) MO_Not _ -> CmmLit (CmmInt (complement x) rep) @@ -90,13 +90,13 @@ cmmMachOpFoldM platform conv_outer [CmmMachOp conv_inner [x]] -- but remember to use the signedness from the widening, just in case -- the final conversion is a widen. | rep1 < rep2 && rep2 > rep3 -> - Just $ cmmMachOpFold platform (intconv signed1 rep1 rep3) [x] + Just $! cmmMachOpFold platform (intconv signed1 rep1 rep3) [x] -- Nested widenings: collapse if the signedness is the same | rep1 < rep2 && rep2 < rep3 && signed1 == signed2 -> - Just $ cmmMachOpFold platform (intconv signed1 rep1 rep3) [x] + Just $! cmmMachOpFold platform (intconv signed1 rep1 rep3) [x] -- Nested narrowings: collapse | rep1 > rep2 && rep2 > rep3 -> - Just $ cmmMachOpFold platform (MO_UU_Conv rep1 rep3) [x] + Just $! cmmMachOpFold platform (MO_UU_Conv rep1 rep3) [x] | otherwise -> Nothing where @@ -117,34 +117,34 @@ cmmMachOpFoldM platform mop [CmmLit (CmmInt x xrep), CmmLit (CmmInt y _)] = case mop of -- for comparisons: don't forget to narrow the arguments before -- comparing, since they might be out of range. - MO_Eq _ -> Just $ CmmLit (CmmInt (if x_u == y_u then 1 else 0) (wordWidth platform)) - MO_Ne _ -> Just $ CmmLit (CmmInt (if x_u /= y_u then 1 else 0) (wordWidth platform)) - - MO_U_Gt _ -> Just $ CmmLit (CmmInt (if x_u > y_u then 1 else 0) (wordWidth platform)) - MO_U_Ge _ -> Just $ CmmLit (CmmInt (if x_u >= y_u then 1 else 0) (wordWidth platform)) - MO_U_Lt _ -> Just $ CmmLit (CmmInt (if x_u < y_u then 1 else 0) (wordWidth platform)) - MO_U_Le _ -> Just $ CmmLit (CmmInt (if x_u <= y_u then 1 else 0) (wordWidth platform)) - - MO_S_Gt _ -> Just $ CmmLit (CmmInt (if x_s > y_s then 1 else 0) (wordWidth platform)) - MO_S_Ge _ -> Just $ CmmLit (CmmInt (if x_s >= y_s then 1 else 0) (wordWidth platform)) - MO_S_Lt _ -> Just $ CmmLit (CmmInt (if x_s < y_s then 1 else 0) (wordWidth platform)) - MO_S_Le _ -> Just $ CmmLit (CmmInt (if x_s <= y_s then 1 else 0) (wordWidth platform)) - - MO_Add r -> Just $ CmmLit (CmmInt (x + y) r) - MO_Sub r -> Just $ CmmLit (CmmInt (x - y) r) - MO_Mul r -> Just $ CmmLit (CmmInt (x * y) r) - MO_U_Quot r | y /= 0 -> Just $ CmmLit (CmmInt (x_u `quot` y_u) r) - MO_U_Rem r | y /= 0 -> Just $ CmmLit (CmmInt (x_u `rem` y_u) r) - MO_S_Quot r | y /= 0 -> Just $ CmmLit (CmmInt (x `quot` y) r) - MO_S_Rem r | y /= 0 -> Just $ CmmLit (CmmInt (x `rem` y) r) - - MO_And r -> Just $ CmmLit (CmmInt (x .&. y) r) - MO_Or r -> Just $ CmmLit (CmmInt (x .|. y) r) - MO_Xor r -> Just $ CmmLit (CmmInt (x `xor` y) r) - - MO_Shl r -> Just $ CmmLit (CmmInt (x `shiftL` fromIntegral y) r) - MO_U_Shr r -> Just $ CmmLit (CmmInt (x_u `shiftR` fromIntegral y) r) - MO_S_Shr r -> Just $ CmmLit (CmmInt (x `shiftR` fromIntegral y) r) + MO_Eq _ -> Just $! CmmLit (CmmInt (if x_u == y_u then 1 else 0) (wordWidth platform)) + MO_Ne _ -> Just $! CmmLit (CmmInt (if x_u /= y_u then 1 else 0) (wordWidth platform)) + + MO_U_Gt _ -> Just $! CmmLit (CmmInt (if x_u > y_u then 1 else 0) (wordWidth platform)) + MO_U_Ge _ -> Just $! CmmLit (CmmInt (if x_u >= y_u then 1 else 0) (wordWidth platform)) + MO_U_Lt _ -> Just $! CmmLit (CmmInt (if x_u < y_u then 1 else 0) (wordWidth platform)) + MO_U_Le _ -> Just $! CmmLit (CmmInt (if x_u <= y_u then 1 else 0) (wordWidth platform)) + + MO_S_Gt _ -> Just $! CmmLit (CmmInt (if x_s > y_s then 1 else 0) (wordWidth platform)) + MO_S_Ge _ -> Just $! CmmLit (CmmInt (if x_s >= y_s then 1 else 0) (wordWidth platform)) + MO_S_Lt _ -> Just $! CmmLit (CmmInt (if x_s < y_s then 1 else 0) (wordWidth platform)) + MO_S_Le _ -> Just $! CmmLit (CmmInt (if x_s <= y_s then 1 else 0) (wordWidth platform)) + + MO_Add r -> Just $! CmmLit (CmmInt (x + y) r) + MO_Sub r -> Just $! CmmLit (CmmInt (x - y) r) + MO_Mul r -> Just $! CmmLit (CmmInt (x * y) r) + MO_U_Quot r | y /= 0 -> Just $! CmmLit (CmmInt (x_u `quot` y_u) r) + MO_U_Rem r | y /= 0 -> Just $! CmmLit (CmmInt (x_u `rem` y_u) r) + MO_S_Quot r | y /= 0 -> Just $! CmmLit (CmmInt (x `quot` y) r) + MO_S_Rem r | y /= 0 -> Just $! CmmLit (CmmInt (x `rem` y) r) + + MO_And r -> Just $! CmmLit (CmmInt (x .&. y) r) + MO_Or r -> Just $! CmmLit (CmmInt (x .|. y) r) + MO_Xor r -> Just $! CmmLit (CmmInt (x `xor` y) r) + + MO_Shl r -> Just $! CmmLit (CmmInt (x `shiftL` fromIntegral y) r) + MO_U_Shr r -> Just $! CmmLit (CmmInt (x_u `shiftR` fromIntegral y) r) + MO_S_Shr r -> Just $! CmmLit (CmmInt (x `shiftR` fromIntegral y) r) _ -> Nothing @@ -162,7 +162,7 @@ cmmMachOpFoldM platform mop [CmmLit (CmmInt x xrep), CmmLit (CmmInt y _)] cmmMachOpFoldM platform op [x@(CmmLit _), y] | not (isLit y) && isCommutableMachOp op - = Just (cmmMachOpFold platform op [y, x]) + = Just $! (cmmMachOpFold platform op [y, x]) -- Turn (a+b)+c into a+(b+c) where possible. Because literals are -- moved to the right, it is more likely that we will find @@ -183,7 +183,7 @@ cmmMachOpFoldM platform op [x@(CmmLit _), y] cmmMachOpFoldM platform mop1 [CmmMachOp mop2 [arg1,arg2], arg3] | mop2 `associates_with` mop1 && not (isLit arg1) && not (isPicReg arg1) - = Just (cmmMachOpFold platform mop2 [arg1, cmmMachOpFold platform mop1 [arg2,arg3]]) + = Just $! (cmmMachOpFold platform mop2 [arg1, cmmMachOpFold platform mop1 [arg2,arg3]]) where MO_Add{} `associates_with` MO_Sub{} = True mop1 `associates_with` mop2 = @@ -192,7 +192,7 @@ cmmMachOpFoldM platform mop1 [CmmMachOp mop2 [arg1,arg2], arg3] -- special case: (a - b) + c ==> a + (c - b) cmmMachOpFoldM platform mop1@(MO_Add{}) [CmmMachOp mop2@(MO_Sub{}) [arg1,arg2], arg3] | not (isLit arg1) && not (isPicReg arg1) - = Just (cmmMachOpFold platform mop1 [arg1, cmmMachOpFold platform mop2 [arg3,arg2]]) + = Just $! (cmmMachOpFold platform mop1 [arg1, cmmMachOpFold platform mop2 [arg3,arg2]]) -- special case: (PicBaseReg + lit) + N ==> PicBaseReg + (lit+N) -- @@ -205,27 +205,27 @@ cmmMachOpFoldM platform mop1@(MO_Add{}) [CmmMachOp mop2@(MO_Sub{}) [arg1,arg2], cmmMachOpFoldM _ MO_Add{} [ CmmMachOp op at MO_Add{} [pic, CmmLit lit] , CmmLit (CmmInt n rep) ] | isPicReg pic - = Just $ CmmMachOp op [pic, CmmLit $ cmmOffsetLit lit off ] + = Just $! CmmMachOp op [pic, CmmLit $ cmmOffsetLit lit off ] where off = fromIntegral (narrowS rep n) -- Make a RegOff if we can cmmMachOpFoldM _ (MO_Add _) [CmmReg reg, CmmLit (CmmInt n rep)] - = Just $ cmmRegOff reg (fromIntegral (narrowS rep n)) + = Just $! cmmRegOff reg (fromIntegral (narrowS rep n)) cmmMachOpFoldM _ (MO_Add _) [CmmRegOff reg off, CmmLit (CmmInt n rep)] - = Just $ cmmRegOff reg (off + fromIntegral (narrowS rep n)) + = Just $! cmmRegOff reg (off + fromIntegral (narrowS rep n)) cmmMachOpFoldM _ (MO_Sub _) [CmmReg reg, CmmLit (CmmInt n rep)] - = Just $ cmmRegOff reg (- fromIntegral (narrowS rep n)) + = Just $! cmmRegOff reg (- fromIntegral (narrowS rep n)) cmmMachOpFoldM _ (MO_Sub _) [CmmRegOff reg off, CmmLit (CmmInt n rep)] - = Just $ cmmRegOff reg (off - fromIntegral (narrowS rep n)) + = Just $! cmmRegOff reg (off - fromIntegral (narrowS rep n)) -- Fold label(+/-)offset into a CmmLit where possible cmmMachOpFoldM _ (MO_Add _) [CmmLit lit, CmmLit (CmmInt i rep)] - = Just $ CmmLit (cmmOffsetLit lit (fromIntegral (narrowU rep i))) + = Just $! CmmLit (cmmOffsetLit lit (fromIntegral (narrowU rep i))) cmmMachOpFoldM _ (MO_Add _) [CmmLit (CmmInt i rep), CmmLit lit] - = Just $ CmmLit (cmmOffsetLit lit (fromIntegral (narrowU rep i))) + = Just $! CmmLit (cmmOffsetLit lit (fromIntegral (narrowU rep i))) cmmMachOpFoldM _ (MO_Sub _) [CmmLit lit, CmmLit (CmmInt i rep)] - = Just $ CmmLit (cmmOffsetLit lit (fromIntegral (negate (narrowU rep i)))) + = Just $! CmmLit (cmmOffsetLit lit (fromIntegral (negate (narrowU rep i)))) -- Comparison of literal with widened operand: perform the comparison @@ -245,7 +245,7 @@ cmmMachOpFoldM platform cmp [CmmMachOp conv [x], CmmLit (CmmInt i _)] -- and the literal fits in the smaller size: i == narrow_fn rep i -- then we can do the comparison at the smaller size - = Just (cmmMachOpFold platform narrow_cmp [x, CmmLit (CmmInt i rep)]) + = Just $! (cmmMachOpFold platform narrow_cmp [x, CmmLit (CmmInt i rep)]) where maybe_conversion (MO_UU_Conv from to) | to > from @@ -320,8 +320,8 @@ cmmMachOpFoldM platform mop [x, (CmmLit (CmmInt 1 rep))] MO_Mul _ -> Just x MO_S_Quot _ -> Just x MO_U_Quot _ -> Just x - MO_S_Rem _ -> Just $ CmmLit (CmmInt 0 rep) - MO_U_Rem _ -> Just $ CmmLit (CmmInt 0 rep) + MO_S_Rem _ -> Just $! CmmLit (CmmInt 0 rep) + MO_U_Rem _ -> Just $! CmmLit (CmmInt 0 rep) -- Comparisons; trickier -- See Note [Comparison operators] @@ -346,18 +346,18 @@ cmmMachOpFoldM platform mop [x, (CmmLit (CmmInt n _))] = case mop of MO_Mul rep | Just p <- exactLog2 n -> - Just (cmmMachOpFold platform (MO_Shl rep) [x, CmmLit (CmmInt p rep)]) + Just $! (cmmMachOpFold platform (MO_Shl rep) [x, CmmLit (CmmInt p rep)]) MO_U_Quot rep | Just p <- exactLog2 n -> - Just (cmmMachOpFold platform (MO_U_Shr rep) [x, CmmLit (CmmInt p rep)]) + Just $! (cmmMachOpFold platform (MO_U_Shr rep) [x, CmmLit (CmmInt p rep)]) MO_U_Rem rep | Just _ <- exactLog2 n -> - Just (cmmMachOpFold platform (MO_And rep) [x, CmmLit (CmmInt (n - 1) rep)]) + Just $! (cmmMachOpFold platform (MO_And rep) [x, CmmLit (CmmInt (n - 1) rep)]) MO_S_Quot rep | Just p <- exactLog2 n, CmmReg _ <- x -> -- We duplicate x in signedQuotRemHelper, hence require -- it is a reg. FIXME: remove this restriction. - Just (cmmMachOpFold platform (MO_S_Shr rep) + Just $! (cmmMachOpFold platform (MO_S_Shr rep) [signedQuotRemHelper rep p, CmmLit (CmmInt p rep)]) MO_S_Rem rep | Just p <- exactLog2 n, @@ -366,7 +366,7 @@ cmmMachOpFoldM platform mop [x, (CmmLit (CmmInt n _))] -- We replace (x `rem` 2^p) by (x - (x `quot` 2^p) * 2^p). -- Moreover, we fuse MO_S_Shr (last operation of MO_S_Quot) -- and MO_S_Shl (multiplication by 2^p) into a single MO_And operation. - Just (cmmMachOpFold platform (MO_Sub rep) + Just $! (cmmMachOpFold platform (MO_Sub rep) [x, cmmMachOpFold platform (MO_And rep) [signedQuotRemHelper rep p, CmmLit (CmmInt (- n) rep)]]) _ -> Nothing ===================================== compiler/GHC/Cmm/Sink.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE ScopedTypeVariables #-} + module GHC.Cmm.Sink ( cmmSink ) where @@ -9,6 +10,7 @@ import GHC.Prelude import GHC.Cmm import GHC.Cmm.Opt import GHC.Cmm.Liveness +import GHC.Cmm.LRegSet import GHC.Cmm.Utils import GHC.Cmm.Dataflow.Block import GHC.Cmm.Dataflow.Label @@ -17,32 +19,14 @@ import GHC.Cmm.Dataflow.Graph import GHC.Platform.Regs import GHC.Platform -import GHC.Types.Unique import GHC.Types.Unique.FM import qualified Data.IntSet as IntSet import Data.List (partition) -import qualified Data.Set as Set import Data.Maybe import GHC.Exts (inline) --- Compact sets for membership tests of local variables. - -type LRegSet = IntSet.IntSet - -emptyLRegSet :: LRegSet -emptyLRegSet = IntSet.empty - -nullLRegSet :: LRegSet -> Bool -nullLRegSet = IntSet.null - -insertLRegSet :: LocalReg -> LRegSet -> LRegSet -insertLRegSet l = IntSet.insert (getKey (getUnique l)) - -elemLRegSet :: LocalReg -> LRegSet -> Bool -elemLRegSet l = IntSet.member (getKey (getUnique l)) - -- ----------------------------------------------------------------------------- -- Sinking and inlining @@ -170,8 +154,8 @@ type Assignments = [Assignment] cmmSink :: Platform -> CmmGraph -> CmmGraph cmmSink platform graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks where - liveness = cmmLocalLiveness platform graph - getLive l = mapFindWithDefault Set.empty l liveness + liveness = cmmLocalLivenessL platform graph + getLive l = mapFindWithDefault emptyLRegSet l liveness blocks = revPostorder graph @@ -191,8 +175,8 @@ cmmSink platform graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks -- Annotate the middle nodes with the registers live *after* -- the node. This will help us decide whether we can inline -- an assignment in the current node or not. - live = Set.unions (map getLive succs) - live_middle = gen_kill platform last live + live = IntSet.unions (map getLive succs) + live_middle = gen_killL platform last live ann_middles = annotate platform live_middle (blockToList middle) -- Now sink and inline in this block @@ -204,7 +188,7 @@ cmmSink platform graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks -- one predecessor), so identify the join points and the set -- of registers live in them. (joins, nonjoins) = partition (`mapMember` join_pts) succs - live_in_joins = Set.unions (map getLive joins) + live_in_joins = IntSet.unions (map getLive joins) -- We do not want to sink an assignment into multiple branches, -- so identify the set of registers live in multiple successors. @@ -213,26 +197,28 @@ cmmSink platform graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks -- now live in multiple branches. init_live_sets = map getLive nonjoins live_in_multi live_sets r = - case filter (Set.member r) live_sets of + case filter (elemLRegSet r) live_sets of (_one:_two:_) -> True _ -> False -- Now, drop any assignments that we will not sink any further. (dropped_last, assigs'') = dropAssignments platform drop_if init_live_sets assigs' + drop_if :: (LocalReg, CmmExpr, AbsMem) + -> [LRegSet] -> (Bool, [LRegSet]) drop_if a@(r,rhs,_) live_sets = (should_drop, live_sets') where should_drop = conflicts platform a final_last || not (isTrivial platform rhs) && live_in_multi live_sets r - || r `Set.member` live_in_joins + || r `elemLRegSet` live_in_joins live_sets' | should_drop = live_sets | otherwise = map upd live_sets - upd set | r `Set.member` set = set `Set.union` live_rhs + upd set | r `elemLRegSet` set = set `IntSet.union` live_rhs | otherwise = set - live_rhs = foldRegsUsed platform extendRegSet emptyRegSet rhs + live_rhs = foldRegsUsed platform (flip insertLRegSet) emptyLRegSet rhs final_middle = foldl' blockSnoc middle' dropped_last @@ -269,9 +255,9 @@ isTrivial _ _ = False -- -- annotate each node with the set of registers live *after* the node -- -annotate :: Platform -> LocalRegSet -> [CmmNode O O] -> [(LocalRegSet, CmmNode O O)] +annotate :: Platform -> LRegSet -> [CmmNode O O] -> [(LRegSet, CmmNode O O)] annotate platform live nodes = snd $ foldr ann (live,[]) nodes - where ann n (live,nodes) = (gen_kill platform n live, (live,n) : nodes) + where ann n (live,nodes) = (gen_killL platform n live, (live,n) : nodes) -- -- Find the blocks that have multiple successors (join points) @@ -288,13 +274,13 @@ findJoinPoints blocks = mapFilter (>1) succ_counts -- filter the list of assignments to remove any assignments that -- are not live in a continuation. -- -filterAssignments :: Platform -> LocalRegSet -> Assignments -> Assignments +filterAssignments :: Platform -> LRegSet -> Assignments -> Assignments filterAssignments platform live assigs = reverse (go assigs []) where go [] kept = kept go (a@(r,_,_):as) kept | needed = go as (a:kept) | otherwise = go as kept where - needed = r `Set.member` live + needed = r `elemLRegSet` live || any (conflicts platform a) (map toNode kept) -- Note that we must keep assignments that are -- referred to by other assignments we have @@ -315,7 +301,7 @@ filterAssignments platform live assigs = reverse (go assigs []) -- walk :: Platform - -> [(LocalRegSet, CmmNode O O)] -- nodes of the block, annotated with + -> [(LRegSet, CmmNode O O)] -- nodes of the block, annotated with -- the set of registers live *after* -- this node. @@ -369,11 +355,11 @@ shouldSink _ _other = Nothing -- out of inlining, but the inliner will see that r is live -- after the instruction and choose not to inline r in the rhs. -- -shouldDiscard :: CmmNode e x -> LocalRegSet -> Bool +shouldDiscard :: CmmNode e x -> LRegSet -> Bool shouldDiscard node live = case node of CmmAssign r (CmmReg r') | r == r' -> True - CmmAssign (CmmLocal r) _ -> not (r `Set.member` live) + CmmAssign (CmmLocal r) _ -> not (r `elemLRegSet` live) _otherwise -> False @@ -407,7 +393,8 @@ dropAssignments platform should_drop state assigs tryToInline :: forall x. Platform - -> LocalRegSet -- set of registers live after this + -> LRegSet -- set of registers live after this + -- -> LocalRegSet -- set of registers live after this -- node. We cannot inline anything -- that is live after the node, unless -- it is small enough to duplicate. @@ -418,36 +405,42 @@ tryToInline , Assignments -- Remaining assignments ) -tryToInline platform live node assigs = go usages node emptyLRegSet assigs +tryToInline platform liveAfter node assigs = + -- pprTrace "tryToInline assig length:" (ppr $ length assigs) $ + go usages liveAfter node emptyLRegSet assigs where usages :: UniqFM LocalReg Int -- Maps each LocalReg to a count of how often it is used usages = foldLocalRegsUsed platform addUsage emptyUFM node - go _usages node _skipped [] = (node, []) + go :: UniqFM LocalReg Int -> LRegSet -> CmmNode O x -> LRegSet -> Assignments + -> (CmmNode O x, Assignments) + go _usages _live node _skipped [] = (node, []) - go usages node skipped (a@(l,rhs,_) : rest) - | cannot_inline = dont_inline - | occurs_none = discard -- Note [discard during inlining] - | occurs_once = inline_and_discard - | isTrivial platform rhs = inline_and_keep - | otherwise = dont_inline + go usages live node skipped (a@(l,rhs,_) : rest) + | cannot_inline = dont_inline + | occurs_none = discard -- Note [discard during inlining] + | occurs_once = inline_and_discard + | isTrivial platform rhs = inline_and_keep + | otherwise = dont_inline where - inline_and_discard = go usages' inl_node skipped rest + inline_and_discard = go usages' live inl_node skipped rest where usages' = foldLocalRegsUsed platform addUsage usages rhs - discard = go usages node skipped rest + discard = go usages live node skipped rest dont_inline = keep node -- don't inline the assignment, keep it inline_and_keep = keep inl_node -- inline the assignment, keep it keep :: CmmNode O x -> (CmmNode O x, Assignments) keep node' = (final_node, a : rest') - where (final_node, rest') = go usages' node' (insertLRegSet l skipped) rest + where (final_node, rest') = go usages live' node' (insertLRegSet l skipped) rest -- Avoid discarding of assignments to vars on the rhs. -- See Note [Keeping assignemnts mentioned in skipped RHSs] - usages' = foldLocalRegsUsed platform (\m r -> addToUFM m r 2) - usages rhs + -- usages' = foldLocalRegsUsed platform (\m r -> addToUFM m r 2) + -- usages rhs + live' = inline foldLocalRegsUsed platform (\m r -> insertLRegSet r m) + live rhs cannot_inline = skipped `regsUsedIn` rhs -- Note [dependent assignments] || l `elemLRegSet` skipped @@ -455,7 +448,7 @@ tryToInline platform live node assigs = go usages node emptyLRegSet assigs -- How often is l used in the current node. l_usages = lookupUFM usages l - l_live = l `elemRegSet` live + l_live = l `elemLRegSet` live occurs_once = not l_live && l_usages == Just 1 occurs_none = not l_live && l_usages == Nothing @@ -483,9 +476,11 @@ tryToInline platform live node assigs = go usages node emptyLRegSet assigs referencing a variable which hasn't been mentioned after inlining. - We use a hack to do this, which is setting all regs used on the - RHS to two uses. Since we only discard assignments to variables - which are used once or never this prevents discarding of the + We use a hack to do this. + + We pretend the regs from the rhs are live after the current + node. Since we only discard assignments to variables + which are dead after the current block this prevents discarding of the assignment. It still allows inlining should e1 be a trivial rhs however. ===================================== compiler/GHC/Utils/Outputable.hs ===================================== @@ -115,6 +115,7 @@ import Data.Int import qualified Data.IntMap as IM import Data.Set (Set) import qualified Data.Set as Set +import qualified Data.IntSet as IntSet import Data.String import Data.Word import System.IO ( Handle ) @@ -863,6 +864,9 @@ instance (Outputable a) => Outputable (NonEmpty a) where instance (Outputable a) => Outputable (Set a) where ppr s = braces (fsep (punctuate comma (map ppr (Set.toList s)))) +instance Outputable IntSet.IntSet where + ppr s = braces (fsep (punctuate comma (map ppr (IntSet.toList s)))) + instance (Outputable a, Outputable b) => Outputable (a, b) where ppr (x,y) = parens (sep [ppr x <> comma, ppr y]) ===================================== compiler/ghc.cabal.in ===================================== @@ -205,6 +205,7 @@ Library GHC.Cmm.Switch GHC.Cmm.Switch.Implement GHC.CmmToAsm + GHC.Cmm.LRegSet GHC.CmmToAsm.BlockLayout GHC.CmmToAsm.CFG GHC.CmmToAsm.CFG.Dominators View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/84f789ee8f45e6a3936d0c1343c442140035f286...23e1050e1a9abaa58e2216143c5165efec9ff31c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/84f789ee8f45e6a3936d0c1343c442140035f286...23e1050e1a9abaa58e2216143c5165efec9ff31c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 1 17:30:54 2020 From: gitlab at gitlab.haskell.org (Shayne Fletcher) Date: Tue, 01 Dec 2020 12:30:54 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/19014 Message-ID: <5fc67dce5ada2_86cbee259012308f0@gitlab.mail> Shayne Fletcher pushed new branch wip/19014 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/19014 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 1 17:49:00 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 01 Dec 2020 12:49:00 -0500 Subject: [Git][ghc/ghc][wip/tsan-ghc-8.10] 79 commits: Backport: Fix for #18955 to GHC 8.10 #18955 Message-ID: <5fc6820c42042_86c3fc6ab857f4412396d5@gitlab.mail> Ben Gamari pushed to branch wip/tsan-ghc-8.10 at Glasgow Haskell Compiler / GHC Commits: 65ed2fdc by Roland Senn at 2020-11-30T14:26:58+01:00 Backport: Fix for #18955 to GHC 8.10 #18955 Since MR !554 (#15454) GHCi automatically enabled the flag `-fobject-code` on any module using the UnboxedTuples or UnboxedSum extensions. MR !1553 (#16876) allowed to inhibit the automatic compiling to object-code of these modules by setting the `fbyte-code` flag. However, it assigned 2 different semantics to this flag and introduced the regression described in issue #18955. This MR fixes this regression by unsetting the internal flag `Opt_ByteCodeIfUnboxed` before it's copied to DynFlags local to the module. In GHC 9.0.1 the issue is solved by introducing a new flag `-f(no-)object-code-if-unboxed`. - - - - - 3e418e85 by Ben Gamari at 2020-12-01T12:48:52-05:00 SMP.h: Add C11-style atomic operations - - - - - e11cdee8 by Ben Gamari at 2020-12-01T12:48:53-05:00 rts: Infrastructure for testing with ThreadSanitizer - - - - - 0420a914 by Ben Gamari at 2020-12-01T12:48:53-05:00 rts/CNF: Initialize all bdescrs in group It seems wise and cheap to ensure that the whole bdescr of all blocks of a compact group is valid, even if most cases only look at the flags field. - - - - - 3fc4f18c by Ben Gamari at 2020-12-01T12:48:53-05:00 rts/Capability: Intialize interrupt field Previously this was left uninitialized. Also clarify some comments. - - - - - 0db05bae by Ben Gamari at 2020-12-01T12:48:53-05:00 rts/Task: Make comments proper Notes - - - - - 92beeb48 by Ben Gamari at 2020-12-01T12:48:53-05:00 rts/SpinLock: Move to proper atomics This is fairly straightforward; we just needed to use relaxed operations for the PROF_SPIN counters and a release store instead of a write barrier. - - - - - ca5adbeb by Ben Gamari at 2020-12-01T12:48:53-05:00 rts/OSThreads: Fix data race Previously we would race on the cached processor count. Avoiding this is straightforward; just use relaxed operations. - - - - - b76a4cb3 by Ben Gamari at 2020-12-01T12:48:53-05:00 rts/ClosureMaros: Use relaxed atomics - - - - - 42603f7b by Ben Gamari at 2020-12-01T12:48:53-05:00 testsuite: Fix thread leak in hs_try_putmvar00[13] - - - - - 31cc96ac by Ben Gamari at 2020-12-01T12:48:53-05:00 rts: Introduce SET_HDR_RELEASE Also ensure that we also store the info table pointer last to ensure that the synchronization covers all stores. - - - - - f5474698 by Ben Gamari at 2020-12-01T12:48:53-05:00 rts: Factor out logic to identify a good capability for running a task Not only does this make the control flow a bit clearer but it also allows us to add a TSAN suppression on this logic, which requires (harmless) data races. - - - - - e56161d7 by Ben Gamari at 2020-12-01T12:48:53-05:00 rts: Annotate benign race in waitForCapability - - - - - 67a18092 by Ben Gamari at 2020-12-01T12:48:53-05:00 rts: Clarify locking behavior of releaseCapability_ - - - - - eed7218e by Ben Gamari at 2020-12-01T12:48:53-05:00 rts: Add assertions for task ownership of capabilities - - - - - b4ea5341 by Ben Gamari at 2020-12-01T12:48:53-05:00 rts: Use relaxed atomics on n_returning_tasks This mitigates the warning of a benign race on n_returning_tasks in shouldYieldCapability. See #17261. - - - - - 2220752f by Ben Gamari at 2020-12-01T12:48:53-05:00 rts: Mitigate races in capability interruption logic - - - - - 444e6476 by Ben Gamari at 2020-12-01T12:48:53-05:00 rts/Capability: Use relaxed operations for last_free_capability - - - - - 3c626d75 by Ben Gamari at 2020-12-01T12:48:53-05:00 rts: Use relaxed operations for cap->running_task (TODO) This shouldn't be necessary since only the owning thread of the capability should be touching this. - - - - - efa866e6 by Ben Gamari at 2020-12-01T12:48:53-05:00 rts/Schedule: Use relaxed operations for sched_state - - - - - a12ce9ad by Ben Gamari at 2020-12-01T12:48:53-05:00 rts: Accept data race in work-stealing implementation This race is okay since the task is owned by the capability pushing it. By Note [Ownership of Task] this means that the capability is free to write to `task->cap` without taking `task->lock`. Fixes #17276. - - - - - eaf108c8 by Ben Gamari at 2020-12-01T12:48:53-05:00 rts: Eliminate data races on pending_sync - - - - - 2398fea7 by Ben Gamari at 2020-12-01T12:48:53-05:00 rts/Schedule: Eliminate data races on recent_activity We cannot safely use relaxed atomics here. - - - - - 7f2bacf5 by Ben Gamari at 2020-12-01T12:48:53-05:00 rts: Avoid data races in message handling - - - - - cd94f7bf by Ben Gamari at 2020-12-01T12:48:53-05:00 rts/Messages: Drop incredibly fishy write barrier executeMessage previously had a write barrier at the beginning of its loop apparently in an attempt to synchronize with another thread's writes to the Message. I would guess that the author had intended to use a load barrier here given that there are no globally-visible writes done in executeMessage. I've removed the redundant barrier since the necessary load barrier is now provided by the ACQUIRE_LOAD. - - - - - 2f5e1853 by Ben Gamari at 2020-12-01T12:48:53-05:00 rts/ThreadPaused: Avoid data races - - - - - 9600e424 by Ben Gamari at 2020-12-01T12:48:53-05:00 rts/Schedule: Eliminate data races in run queue management - - - - - 7e84329b by Ben Gamari at 2020-12-01T12:48:53-05:00 rts: Eliminate shutdown data race on task counters - - - - - 061611c9 by Ben Gamari at 2020-12-01T12:48:53-05:00 rts/Threads: Avoid data races (TODO) Replace barriers with appropriate ordering. Drop redundant barrier in tryWakeupThread (the RELEASE barrier will be provided by sendMessage's mutex release). We use relaxed operations on why_blocked and the stack although it's not clear to me why this is necessary. - - - - - 99c5e53a by Ben Gamari at 2020-12-01T12:48:53-05:00 rts/Messages: Annotate benign race - - - - - 88644055 by Ben Gamari at 2020-12-01T12:48:53-05:00 rts/RaiseAsync: Synchronize what_next read - - - - - 20a89e98 by Ben Gamari at 2020-12-01T12:48:53-05:00 rts/Task: Move debugTrace to avoid data race Specifically, we need to hold all_tasks_mutex to read taskCount. - - - - - aebe5c4d by Ben Gamari at 2020-12-01T12:48:53-05:00 Disable flawed assertion - - - - - 914196db by Ben Gamari at 2020-12-01T12:48:53-05:00 Document schedulePushWork race - - - - - 68e93f4d by Ben Gamari at 2020-12-01T12:48:53-05:00 Capabiliity: Properly fix data race on n_returning_tasks There is a real data race but can be made safe by using proper atomic (but relaxed) accesses. - - - - - 0ad7e4fe by Ben Gamari at 2020-12-01T12:48:53-05:00 rts: Make write of to_cap->inbox atomic This is necessary since emptyInbox may read from to_cap->inbox without taking cap->lock. - - - - - f4fa413d by Ben Gamari at 2020-12-01T12:48:53-05:00 gitlab-ci: Add nightly-x86_64-linux-deb9-tsan job - - - - - aa2dc3a6 by GHC GitLab CI at 2020-12-01T12:48:53-05:00 testsuite: Mark setnumcapabilities001 as broken with TSAN Due to #18808. - - - - - d29d1d59 by GHC GitLab CI at 2020-12-01T12:48:53-05:00 testsuite: Skip divbyzero and derefnull under TSAN ThreadSanitizer changes the output of these tests. - - - - - db69bfe9 by Ben Gamari at 2020-12-01T12:48:54-05:00 testsuite: Skip high memory usage tests with TSAN ThreadSanitizer significantly increases the memory footprint of tests, so much so that it can send machines into OOM. - - - - - 7dbf4140 by Ben Gamari at 2020-12-01T12:48:54-05:00 testsuite: Mark hie002 as high_memory_usage This test has a peak residency of 1GByte; this is large enough to classify as "high" in my book. - - - - - 80019b4d by Ben Gamari at 2020-12-01T12:48:54-05:00 testsuite: Mark T9872[abc] as high_memory_usage These all have a maximum residency of over 2 GB. - - - - - cbc7e06d by Ben Gamari at 2020-12-01T12:48:54-05:00 gitlab-ci: Disable documentation in TSAN build Haddock chews through enough memory to cause the CI builders to OOM and there's frankly no reason to build documentation in this job anyways. - - - - - fcd68815 by Ben Gamari at 2020-12-01T12:48:54-05:00 TSANUtils: Ensure that C11 atomics are supported - - - - - f966c105 by Ben Gamari at 2020-12-01T12:48:54-05:00 testsuite: Mark T3807 as broken with TSAN Due to #18883. - - - - - 38a0ede0 by Ben Gamari at 2020-12-01T12:48:54-05:00 testsuite: Mark T13702 as broken with TSAN due to #18884 - - - - - 571a13e8 by Ben Gamari at 2020-12-01T12:48:54-05:00 rts/BlockAlloc: Use relaxed operations - - - - - 2ecc5693 by Ben Gamari at 2020-12-01T12:48:54-05:00 rts: Rework handling of mutlist scavenging statistics - - - - - 78a5bdff by Ben Gamari at 2020-12-01T12:48:54-05:00 rts: Avoid data races in StablePtr implementation This fixes two potentially problematic data races in the StablePtr implementation: * We would fail to RELEASE the stable pointer table when enlarging it, causing other cores to potentially see uninitialized memory. * We would fail to ACQUIRE when dereferencing a stable pointer. - - - - - a191f6d5 by Ben Gamari at 2020-12-01T12:48:54-05:00 rts/Storage: Use atomics - - - - - 7d4d0751 by Ben Gamari at 2020-12-01T12:48:54-05:00 rts/Updates: Use proper atomic operations - - - - - afdc79e8 by Ben Gamari at 2020-12-01T12:48:54-05:00 rts/Weak: Eliminate data races By taking all_tasks_mutex in stat_exit. Also better-document the fact that the task statistics are protected by all_tasks_mutex. - - - - - 2e3a9399 by Ben Gamari at 2020-12-01T12:48:54-05:00 rts/GC: Use atomics - - - - - c6855d59 by Ben Gamari at 2020-12-01T12:48:54-05:00 rts: Use RELEASE ordering in unlockClosure - - - - - 84cf7ed6 by Ben Gamari at 2020-12-01T12:48:54-05:00 rts/Storage: Accept races on heap size counters - - - - - f9480f50 by Ben Gamari at 2020-12-01T12:48:54-05:00 rts: Join to concurrent mark thread during shutdown Previously we would take all capabilities but fail to join on the thread itself, potentially resulting in a leaked thread. - - - - - 0ea9a980 by GHC GitLab CI at 2020-12-01T12:48:54-05:00 rts: Fix race in GC CPU time accounting Ensure that the GC leader synchronizes with workers before calling stat_endGC. - - - - - e97ed920 by Ben Gamari at 2020-12-01T12:48:54-05:00 rts/SpinLock: Separate out slow path Not only is this in general a good idea, but it turns out that GCC unrolls the retry loop, resulting is massive code bloat in critical parts of the RTS (e.g. `evacuate`). - - - - - e0bf6738 by Ben Gamari at 2020-12-01T12:48:54-05:00 rts: Use relaxed ordering on spinlock counters - - - - - 48054cf2 by Ben Gamari at 2020-12-01T12:48:54-05:00 rts: Annotate hopefully "benign" races in freeGroup - - - - - dddd97ec by Ben Gamari at 2020-12-01T12:48:54-05:00 Strengthen ordering in releaseGCThreads - - - - - bfe39b7f by Ben Gamari at 2020-12-01T12:48:54-05:00 rts/WSDeque: Rewrite with proper atomics After a few attempts at shoring up the previous implementation, I ended up turning to the literature and now use the proven implementation, > N.M. Lê, A. Pop, A.Cohen, and F.Z. Nardelli. "Correct and Efficient > Work-Stealing for Weak Memory Models". PPoPP'13, February 2013, > ACM 978-1-4503-1922/13/02. Note only is this approach formally proven correct under C11 semantics but it is also proved to be a bit faster in practice. - - - - - f9ed0fd2 by Ben Gamari at 2020-12-01T12:48:54-05:00 rts: Use relaxed atomics for whitehole spin stats - - - - - 211af4a1 by Ben Gamari at 2020-12-01T12:48:54-05:00 rts: Avoid lock order inversion during fork Fixes #17275. - - - - - 7131d341 by GHC GitLab CI at 2020-12-01T12:48:54-05:00 rts: Use proper relaxe operations in getCurrentThreadCPUTime Here we are doing lazy initialization; it's okay if we do the check more than once, hence relaxed operation is fine. - - - - - 20178cde by Ben Gamari at 2020-12-01T12:48:54-05:00 rts/STM: Use atomics This fixes a potentially harmful race where we failed to synchronize before looking at a TVar's current_value. Also did a bit of refactoring to avoid abstract over management of max_commits. - - - - - 8894b402 by Ben Gamari at 2020-12-01T12:48:54-05:00 rts/stm: Strengthen orderings to SEQ_CST instead of volatile Previously the `current_value`, `first_watch_queue_entry`, and `num_updates` fields of `StgTVar` were marked as `volatile` in an attempt to provide strong ordering. Of course, this isn't sufficient. We now use proper atomic operations. In most of these cases I strengthen the ordering all the way to SEQ_CST although it's possible that some could be weakened with some thought. - - - - - 81a9029b by Ben Gamari at 2020-12-01T12:48:54-05:00 Mitigate data races in event manager startup/shutdown - - - - - 9801d049 by Ben Gamari at 2020-12-01T12:48:54-05:00 Suppress data race due to close This suppresses the other side of a race during shutdown. - - - - - 9b5bd302 by Ben Gamari at 2020-12-01T12:48:54-05:00 rts: Accept benign races in Proftimer - - - - - 25b9c7f9 by Ben Gamari at 2020-12-01T12:48:54-05:00 rts: Pause timer while changing capability count This avoids #17289. - - - - - a433c908 by Ben Gamari at 2020-12-01T12:48:54-05:00 Fix #17289 - - - - - 2161aed8 by Ben Gamari at 2020-12-01T12:48:54-05:00 suppress #17289 (ticker) race - - - - - c93f11fe by Ben Gamari at 2020-12-01T12:48:54-05:00 rts: Fix timer initialization Previously `initScheduler` would attempt to pause the ticker and in so doing acquire the ticker mutex. However, initTicker, which is responsible for initializing said mutex, hadn't been called yet. - - - - - 1ada18d2 by Ben Gamari at 2020-12-01T12:48:54-05:00 rts: Fix races in Pthread timer backend shudown We can generally be pretty relaxed in the barriers here since the timer thread is a loop. - - - - - d315985a by Ben Gamari at 2020-12-01T12:48:54-05:00 rts/Stats: Hide a few unused unnecessarily global functions - - - - - 953de20f by Ben Gamari at 2020-12-01T12:48:55-05:00 rts/Stats: Protect with mutex While on face value this seems a bit heavy, I think it's far better than enforcing ordering on every access. - - - - - 9ad6e1f1 by Ben Gamari at 2020-12-01T12:48:55-05:00 rts: Tear down stats_mutex after exitHeapProfiling Since the latter wants to call getRTSStats. - - - - - 0f28389c by Ben Gamari at 2020-12-01T12:48:55-05:00 rts/Stats: Reintroduce mut_user_time Fix the previous backport; this function was dead code in master but is still needed due to ProfHeap.c in ghc-8.10. - - - - - 30 changed files: - .gitlab-ci.yml - compiler/main/DynFlags.hs - compiler/main/GhcMake.hs - ghc/GHCi/UI.hs - hadrian/hadrian.cabal - hadrian/src/Flavour.hs - hadrian/src/Settings.hs - + hadrian/src/Settings/Flavours/ThreadSanitizer.hs - includes/Rts.h - includes/rts/OSThreads.h - includes/rts/SpinLock.h - includes/rts/StablePtr.h - + includes/rts/TSANUtils.h - includes/rts/storage/ClosureMacros.h - includes/rts/storage/Closures.h - includes/rts/storage/GC.h - includes/stg/SMP.h - libraries/base/GHC/Event/Control.hs - + rts/.tsan-suppressions - rts/Capability.c - rts/Capability.h - rts/Messages.c - rts/Proftimer.c - rts/RaiseAsync.c - rts/RtsStartup.c - rts/SMPClosureOps.h - rts/STM.c - rts/Schedule.c - rts/Schedule.h - rts/Sparks.c The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/383bb46f9de2e5943ac7d5bc5722af9d36ede017...0f28389c783a54a74c472f176c250ddf7a9c4bf4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/383bb46f9de2e5943ac7d5bc5722af9d36ede017...0f28389c783a54a74c472f176c250ddf7a9c4bf4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 1 18:02:41 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Tue, 01 Dec 2020 13:02:41 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/T18962 Message-ID: <5fc6854125355_86c113040b0124128@gitlab.mail> Sebastian Graf pushed new branch wip/T18962 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T18962 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 1 18:08:32 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Tue, 01 Dec 2020 13:08:32 -0500 Subject: [Git][ghc/ghc][wip/T18962] Activate SAT with -O1 Message-ID: <5fc686a0cc740_86c111d4a00124142c@gitlab.mail> Sebastian Graf pushed to branch wip/T18962 at Glasgow Haskell Compiler / GHC Commits: 1d7586ab by Sebastian Graf at 2020-12-01T19:08:25+01:00 Activate SAT with -O1 - - - - - 1 changed file: - compiler/GHC/Driver/Session.hs Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -4015,7 +4015,7 @@ optLevelFlags -- see Note [Documenting optimisation flags] , ([2], Opt_SpecConstr) -- , ([2], Opt_RegsGraph) -- RegsGraph suffers performance regression. See #7679 --- , ([2], Opt_StaticArgumentTransformation) + , ([1,2], Opt_StaticArgumentTransformation) -- Static Argument Transformation needs investigation. See #9374 ] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1d7586abde66c5bfb5b993d1f3f8a94224c11d99 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1d7586abde66c5bfb5b993d1f3f8a94224c11d99 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 1 18:08:52 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Tue, 01 Dec 2020 13:08:52 -0500 Subject: [Git][ghc/ghc][wip/T18962] Activate SAT with -O1 Message-ID: <5fc686b4c7762_86c13315e80124163d@gitlab.mail> Sebastian Graf pushed to branch wip/T18962 at Glasgow Haskell Compiler / GHC Commits: 2ba459d4 by Sebastian Graf at 2020-12-01T19:08:34+01:00 Activate SAT with -O1 To see whether it breaks in CI and so on - - - - - 1 changed file: - compiler/GHC/Driver/Session.hs Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -4015,7 +4015,7 @@ optLevelFlags -- see Note [Documenting optimisation flags] , ([2], Opt_SpecConstr) -- , ([2], Opt_RegsGraph) -- RegsGraph suffers performance regression. See #7679 --- , ([2], Opt_StaticArgumentTransformation) + , ([1,2], Opt_StaticArgumentTransformation) -- Static Argument Transformation needs investigation. See #9374 ] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2ba459d44695bb6767c31ceed986ac405477fe77 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2ba459d44695bb6767c31ceed986ac405477fe77 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 1 20:45:58 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 01 Dec 2020 15:45:58 -0500 Subject: [Git][ghc/ghc][wip/tyconapp-opts] 87 commits: nativeGen: Make makeImportsDoc take an NCGConfig rather than DynFlags Message-ID: <5fc6ab86c2d59_86c3fc6ab857f4412563b2@gitlab.mail> Ben Gamari pushed to branch wip/tyconapp-opts at Glasgow Haskell Compiler / GHC Commits: fcfda909 by Ben Gamari at 2020-11-11T03:19:59-05:00 nativeGen: Make makeImportsDoc take an NCGConfig rather than DynFlags It appears this was an oversight as there is no reason the full DynFlags is necessary. - - - - - 6e23695e by Ben Gamari at 2020-11-11T03:19:59-05:00 Move this_module into NCGConfig In various places in the NCG we need the Module currently being compiled. Let's move this into the environment instead of chewing threw another register. - - - - - c6264a2d by Ben Gamari at 2020-11-11T03:20:00-05:00 codeGen: Produce local symbols for module-internal functions It turns out that some important native debugging/profiling tools (e.g. perf) rely only on symbol tables for function name resolution (as opposed to using DWARF DIEs). However, previously GHC would emit temporary symbols (e.g. `.La42b`) to identify module-internal entities. Such symbols are dropped during linking and therefore not visible to runtime tools (in addition to having rather un-helpful unique names). For instance, `perf report` would often end up attributing all cost to the libc `frame_dummy` symbol since Haskell code was no covered by any proper symbol (see #17605). We now rather follow the model of C compilers and emit descriptively-named local symbols for module internal things. Since this will increase object file size this behavior can be disabled with the `-fno-expose-internal-symbols` flag. With this `perf record` can finally be used against Haskell executables. Even more, with `-g3` `perf annotate` provides inline source code. - - - - - 584058dd by Ben Gamari at 2020-11-11T03:20:00-05:00 Enable -fexpose-internal-symbols when debug level >=2 This seems like a reasonable default as the object file size increases by around 5%. - - - - - c34a4b98 by Ömer Sinan Ağacan at 2020-11-11T03:20:35-05:00 Fix and enable object unloading in GHCi Fixes #16525 by tracking dependencies between object file symbols and marking symbol liveness during garbage collection See Note [Object unloading] in CheckUnload.c for details. - - - - - 2782487f by Ray Shih at 2020-11-11T03:20:35-05:00 Add loadNativeObj and unloadNativeObj (This change is originally written by niteria) This adds two functions: * `loadNativeObj` * `unloadNativeObj` and implements them for Linux. They are useful if you want to load a shared object with Haskell code using the system linker and have GHC call dlclose() after the code is no longer referenced from the heap. Using the system linker allows you to load the shared object above outside the low-mem region. It also loads the DWARF sections in a way that `perf` understands. `dl_iterate_phdr` is what makes this implementation Linux specific. - - - - - 7a65f9e1 by GHC GitLab CI at 2020-11-11T03:20:35-05:00 rts: Introduce highMemDynamic - - - - - e9e1b2e7 by GHC GitLab CI at 2020-11-11T03:20:35-05:00 Introduce test for dynamic library unloading This uses the highMemDynamic flag introduced earlier to verify that dynamic objects are properly unloaded. - - - - - 5506f134 by Krzysztof Gogolewski at 2020-11-11T03:21:14-05:00 Force argument in setIdMult (#18925) - - - - - 787e93ae by Ben Gamari at 2020-11-11T23:14:11-05:00 testsuite: Add testcase for #18733 - - - - - 5353fd50 by Ben Gamari at 2020-11-12T10:05:30-05:00 compiler: Fix recompilation checking In ticket #18733 we noticed a rather serious deficiency in the current fingerprinting logic for recursive groups. I have described the old fingerprinting story and its problems in Note [Fingerprinting recursive groups] and have reworked the story accordingly to avoid these issues. Fixes #18733. - - - - - 63fa3997 by Sebastian Graf at 2020-11-13T14:29:39-05:00 Arity: Rework `ArityType` to fix monotonicity (#18870) As we found out in #18870, `andArityType` is not monotone, with potentially severe consequences for termination of fixed-point iteration. That showed in an abundance of "Exciting arity" DEBUG messages that are emitted whenever we do more than one step in fixed-point iteration. The solution necessitates also recording `OneShotInfo` info for `ABot` arity type. Thus we get the following definition for `ArityType`: ``` data ArityType = AT [OneShotInfo] Divergence ``` The majority of changes in this patch are the result of refactoring use sites of `ArityType` to match the new definition. The regression test `T18870` asserts that we indeed don't emit any DEBUG output anymore for a function where we previously would have. Similarly, there's a regression test `T18937` for #18937, which we expect to be broken for now. Fixes #18870. - - - - - 197d59fa by Sebastian Graf at 2020-11-13T14:29:39-05:00 Arity: Emit "Exciting arity" warning only after second iteration (#18937) See Note [Exciting arity] why we emit the warning at all and why we only do after the second iteration now. Fixes #18937. - - - - - de7ec9dd by David Eichmann at 2020-11-13T14:30:16-05:00 Add rts_listThreads and rts_listMiscRoots to RtsAPI.h These are used to find the current roots of the garbage collector. Co-authored-by: Sven Tennie's avatarSven Tennie <sven.tennie at gmail.com> Co-authored-by: Matthew Pickering's avatarMatthew Pickering <matthewtpickering at gmail.com> Co-authored-by: default avatarBen Gamari <bgamari.foss at gmail.com> - - - - - 24a86f09 by Ben Gamari at 2020-11-13T14:30:51-05:00 gitlab-ci: Cache cabal store in linting job - - - - - 0a7e592c by Ben Gamari at 2020-11-15T03:35:45-05:00 nativeGen/dwarf: Fix procedure end addresses Previously the `.debug_aranges` and `.debug_info` (DIE) DWARF information would claim that procedures (represented with a `DW_TAG_subprogram` DIE) would only span the range covered by their entry block. This omitted all of the continuation blocks (represented by `DW_TAG_lexical_block` DIEs), confusing `perf`. Fix this by introducing a end-of-procedure label and using this as the `DW_AT_high_pc` of procedure `DW_TAG_subprogram` DIEs Fixes #17605. - - - - - 1e19183d by Ben Gamari at 2020-11-15T03:35:45-05:00 nativeGen/dwarf: Only produce DW_AT_source_note DIEs in -g3 Standard debugging tools don't know how to understand these so let's not produce them unless asked. - - - - - ad73370f by Ben Gamari at 2020-11-15T03:35:45-05:00 nativeGen/dwarf: Use DW_AT_linkage instead of DW_AT_MIPS_linkage - - - - - a2539650 by Ben Gamari at 2020-11-15T03:35:45-05:00 gitlab-ci: Add DWARF release jobs for Debian 10, Fedora27 - - - - - d61adb3d by Ryan Scott at 2020-11-15T03:36:21-05:00 Name (tc)SplitForAll- functions more consistently There is a zoo of `splitForAll-` functions in `GHC.Core.Type` (as well as `tcSplitForAll-` functions in `GHC.Tc.Utils.TcType`) that all do very similar things, but vary in the particular form of type variable that they return. To make things worse, the names of these functions are often quite misleading. Some particularly egregious examples: * `splitForAllTys` returns `TyCoVar`s, but `splitSomeForAllTys` returns `VarBndr`s. * `splitSomeForAllTys` returns `VarBndr`s, but `tcSplitSomeForAllTys` returns `TyVar`s. * `splitForAllTys` returns `TyCoVar`s, but `splitForAllTysInvis` returns `InvisTVBinder`s. (This in particular arose in the context of #18939, and this finally motivated me to bite the bullet and improve the status quo vis-à-vis how we name these functions.) In an attempt to bring some sanity to how these functions are named, I have opted to rename most of these functions en masse to use consistent suffixes that describe the particular form of type variable that each function returns. In concrete terms, this amounts to: * Functions that return a `TyVar` now use the suffix `-TyVar`. This caused the following functions to be renamed: * `splitTyVarForAllTys` -> `splitForAllTyVars` * `splitForAllTy_ty_maybe` -> `splitForAllTyVar_maybe` * `tcSplitForAllTys` -> `tcSplitForAllTyVars` * `tcSplitSomeForAllTys` -> `tcSplitSomeForAllTyVars` * Functions that return a `CoVar` now use the suffix `-CoVar`. This caused the following functions to be renamed: * `splitForAllTy_co_maybe` -> `splitForAllCoVar_maybe` * Functions that return a `TyCoVar` now use the suffix `-TyCoVar`. This caused the following functions to be renamed: * `splitForAllTy` -> `splitForAllTyCoVar` * `splitForAllTys` -> `splitForAllTyCoVars` * `splitForAllTys'` -> `splitForAllTyCoVars'` * `splitForAllTy_maybe` -> `splitForAllTyCoVar_maybe` * Functions that return a `VarBndr` now use the suffix corresponding to the most relevant type synonym. This caused the following functions to be renamed: * `splitForAllVarBndrs` -> `splitForAllTyCoVarBinders` * `splitForAllTysInvis` -> `splitForAllInvisTVBinders` * `splitForAllTysReq` -> `splitForAllReqTVBinders` * `splitSomeForAllTys` -> `splitSomeForAllTyCoVarBndrs` * `tcSplitForAllVarBndrs` -> `tcSplitForAllTyVarBinders` * `tcSplitForAllTysInvis` -> `tcSplitForAllInvisTVBinders` * `tcSplitForAllTysReq` -> `tcSplitForAllReqTVBinders` * `tcSplitForAllTy_maybe` -> `tcSplitForAllTyVarBinder_maybe` Note that I left the following functions alone: * Functions that split apart things besides `ForAllTy`s, such as `splitFunTys` or `splitPiTys`. Thankfully, there are far fewer of these functions than there are functions that split apart `ForAllTy`s, so there isn't much of a pressing need to apply the new naming convention elsewhere. * Functions that split apart `ForAllCo`s in `Coercion`s, such as `GHC.Core.Coercion.splitForAllCo_maybe`. We could theoretically apply the new naming convention here, but then we'd have to figure out how to disambiguate `Type`-splitting functions from `Coercion`-splitting functions. Ultimately, the `Coercion`-splitting functions aren't used nearly as much as the `Type`-splitting functions, so I decided to leave the former alone. This is purely refactoring and should cause no change in behavior. - - - - - 645444af by Ryan Scott at 2020-11-15T03:36:21-05:00 Use tcSplitForAllInvisTyVars (not tcSplitForAllTyVars) in more places The use of `tcSplitForAllTyVars` in `tcDataFamInstHeader` was the immediate cause of #18939, and replacing it with a new `tcSplitForAllInvisTyVars` function (which behaves like `tcSplitForAllTyVars` but only splits invisible type variables) fixes the issue. However, this led me to realize that _most_ uses of `tcSplitForAllTyVars` in GHC really ought to be `tcSplitForAllInvisTyVars` instead. While I was in town, I opted to replace most uses of `tcSplitForAllTys` with `tcSplitForAllTysInvis` to reduce the likelihood of such bugs in the future. I say "most uses" above since there is one notable place where we _do_ want to use `tcSplitForAllTyVars`: in `GHC.Tc.Validity.forAllTyErr`, which produces the "`Illegal polymorphic type`" error message if you try to use a higher-rank `forall` without having `RankNTypes` enabled. Here, we really do want to split all `forall`s, not just invisible ones, or we run the risk of giving an inaccurate error message in the newly added `T18939_Fail` test case. I debated at some length whether I wanted to name the new function `tcSplitForAllInvisTyVars` or `tcSplitForAllTyVarsInvisible`, but in the end, I decided that I liked the former better. For consistency's sake, I opted to rename the existing `splitPiTysInvisible` and `splitPiTysInvisibleN` functions to `splitInvisPiTys` and `splitPiTysInvisN`, respectively, so that they use the same naming convention. As a consequence, this ended up requiring a `haddock` submodule bump. Fixes #18939. - - - - - 8887102f by Moritz Angermann at 2020-11-15T03:36:56-05:00 AArch64/arm64 adjustments This addes the necessary logic to support aarch64 on elf, as well as aarch64 on mach-o, which Apple calls arm64. We change architecture name to AArch64, which is the official arm naming scheme. - - - - - fc644b1a by Ben Gamari at 2020-11-15T03:37:31-05:00 ghc-bin: Build with eventlogging by default We now have all sorts of great facilities using the eventlog which were previously unavailable without building a custom GHC. Fix this by linking with `-eventlog` by default. - - - - - 52114fa0 by Sylvain Henry at 2020-11-16T11:48:47+01:00 Add Addr# atomic primops (#17751) This reuses the codegen used for ByteArray#'s atomic primops. - - - - - 8150f654 by Sebastian Graf at 2020-11-18T23:38:40-05:00 PmCheck: Print types of uncovered patterns (#18932) In order to avoid confusion as in #18932, we display the type of the match variables in the non-exhaustiveness warning, e.g. ``` T18932.hs:14:1: warning: [-Wincomplete-patterns] Pattern match(es) are non-exhaustive In an equation for ‘g’: Patterns of type ‘T a’, ‘T a’, ‘T a’ not matched: (MkT2 _) (MkT1 _) (MkT1 _) (MkT2 _) (MkT1 _) (MkT2 _) (MkT2 _) (MkT2 _) (MkT1 _) (MkT2 _) (MkT2 _) (MkT2 _) ... | 14 | g (MkT1 x) (MkT1 _) (MkT1 _) = x | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ``` It also allows us to omit the type signature on wildcard matches which we previously showed in only some situations, particularly `-XEmptyCase`. Fixes #18932. - - - - - 165352a2 by Krzysztof Gogolewski at 2020-11-20T02:08:36-05:00 Export indexError from GHC.Ix (#18579) - - - - - b57845c3 by Kamil Dworakowski at 2020-11-20T02:09:16-05:00 Clarify interruptible FFI wrt masking state - - - - - 321d1bd8 by Sebastian Graf at 2020-11-20T02:09:51-05:00 Fix strictness signatures of `prefetchValue*#` primops Their strictness signatures said the primops are strict in their first argument, which is wrong: Handing it a thunk will prefetch the pointer to the thunk, but not evaluate it. Hence not strict. The regression test `T8256` actually tests for laziness in the first argument, so GHC apparently never exploited the strictness signature. See also https://gitlab.haskell.org/ghc/ghc/-/issues/8256#note_310867, where this came up. - - - - - 0aec78b6 by Sebastian Graf at 2020-11-20T02:09:51-05:00 Demand: Interleave usage and strictness demands (#18903) As outlined in #18903, interleaving usage and strictness demands not only means a more compact demand representation, but also allows us to express demands that we weren't easily able to express before. Call demands are *relative* in the sense that a call demand `Cn(cd)` on `g` says "`g` is called `n` times. *Whenever `g` is called*, the result is used according to `cd`". Example from #18903: ```hs h :: Int -> Int h m = let g :: Int -> (Int,Int) g 1 = (m, 0) g n = (2 * n, 2 `div` n) {-# NOINLINE g #-} in case m of 1 -> 0 2 -> snd (g m) _ -> uncurry (+) (g m) ``` Without the interleaved representation, we would just get `L` for the strictness demand on `g`. Now we are able to express that whenever `g` is called, its second component is used strictly in denoting `g` by `1C1(P(1P(U),SP(U)))`. This would allow Nested CPR to unbox the division, for example. Fixes #18903. While fixing regressions, I also discovered and fixed #18957. Metric Decrease: T13253-spj - - - - - 3a55b3a2 by Sebastian Graf at 2020-11-20T02:09:51-05:00 Update user's guide entry on demand analysis and worker/wrapper The demand signature notation has been undocumented for a long time. The only source to understand it, apart from reading the `Outputable` instance, has been an outdated wiki page. Since the previous commits have reworked the demand lattice, I took it as an opportunity to also write some documentation about notation. - - - - - fc963932 by Greg Steuck at 2020-11-20T02:10:31-05:00 Find hadrian location more reliably in cabal-install output Fix #18944 - - - - - 9f40cf6c by Ben Gamari at 2020-11-20T02:11:07-05:00 rts/linker: Align bssSize to page size when mapping symbol extras We place symbol_extras right after bss. We also need to ensure that symbol_extras can be mprotect'd independently from the rest of the image. To ensure this we round up the size of bss to a page boundary, thus ensuring that symbol_extras is also page-aligned. - - - - - b739c319 by Ben Gamari at 2020-11-20T02:11:43-05:00 gitlab-ci: Add usage message to ci.sh - - - - - 802e9180 by Ben Gamari at 2020-11-20T02:11:43-05:00 gitlab-ci: Add VERBOSE environment variable And change the make build system's default behavior to V=0, greatly reducing build log sizes. - - - - - 2a8a979c by Ben Gamari at 2020-11-21T01:13:26-05:00 users-guide: A bit of clean-up in profiling flag documentation - - - - - 56804e33 by Ben Gamari at 2020-11-21T01:13:26-05:00 testsuite: Refactor CountParserDeps - - - - - 53ad67ea by Ben Gamari at 2020-11-21T01:13:26-05:00 Introduce -fprof-callers flag This introducing a new compiler flag to provide a convenient way to introduce profiler cost-centers on all occurrences of the named identifier. Closes #18566. - - - - - ecfd0278 by Sylvain Henry at 2020-11-21T01:14:09-05:00 Move Plugins into HscEnv (#17957) Loaded plugins have nothing to do in DynFlags so this patch moves them into HscEnv (session state). "DynFlags plugins" become "Driver plugins" to still be able to register static plugins. Bump haddock submodule - - - - - 72f2257c by Sylvain Henry at 2020-11-21T01:14:09-05:00 Don't initialize plugins in the Core2Core pipeline Some plugins can be added via TH (cf addCorePlugin). Initialize them in the driver instead of in the Core2Core pipeline. - - - - - ddbeeb3c by Ryan Scott at 2020-11-21T01:14:44-05:00 Add regression test for #10504 This issue was fixed at some point between GHC 8.0 and 8.2. Let's add a regression test to ensure that it stays fixed. Fixes #10504. - - - - - a4a6dc2a by Ben Gamari at 2020-11-21T01:15:21-05:00 dwarf: Apply info table offset consistently Previously we failed to apply the info table offset to the aranges and DIEs, meaning that we often failed to unwind in gdb. For some reason this only seemed to manifest in the RTS's Cmm closures. Nevertheless, now we can unwind completely up to `main` - - - - - 69bfbc21 by Ben Gamari at 2020-11-21T01:15:56-05:00 hadrian: Disable stripping when debug information is enabled - - - - - 7e93ae8b by Ben Gamari at 2020-11-21T13:13:29-05:00 rts: Post ticky entry counts to the eventlog We currently only post the entry counters, not the other global counters as in my experience the former are more useful. We use the heap profiler's census period to decide when to dump. Also spruces up the documentation surrounding ticky-ticky a bit. - - - - - bc9c3916 by Ben Gamari at 2020-11-22T06:28:10-05:00 Implement -ddump-c-backend argument To dump output of the C backend. - - - - - 901bc220 by Ben Gamari at 2020-11-22T12:39:02-05:00 Bump time submodule to 1.11.1 Also bumps directory, Cabal, hpc, time, and unix submodules. Closes #18847. - - - - - 92c0afbf by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Dump STG when ticky is enabled This changes the "ticky" modifier to enable dumping of final STG as this is generally needed to make sense of the ticky profiles. - - - - - d23fef68 by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Introduce notion of flavour transformers This extends Hadrian's notion of "flavour", as described in #18942. - - - - - 179d0bec by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Add a viaLlvmBackend modifier Note that this also slightly changes the semantics of these flavours as we only use LLVM for >= stage1 builds. - - - - - d4d95e51 by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Add profiled_ghc and no_dynamic_ghc modifiers - - - - - 6815603f by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Drop redundant flavour definitions Drop the profiled, LLVM, and ThreadSanitizer flavour definitions as these can now be realized with flavour transformers. - - - - - f88f4339 by Ben Gamari at 2020-11-24T02:43:20-05:00 rts: Flush eventlog buffers from flushEventLog As noted in #18043, flushTrace failed flush anything beyond the writer. This means that a significant amount of data sitting in capability-local event buffers may never get flushed, despite the users' pleads for us to flush. Fix this by making flushEventLog flush all of the event buffers before flushing the writer. Fixes #18043. - - - - - 7c03cc50 by Ben Gamari at 2020-11-24T02:43:55-05:00 gitlab-ci: Run LLVM job on appropriately-labelled MRs Namely, those marked with the ~"LLVM backend" label - - - - - 9b95d815 by Ben Gamari at 2020-11-24T02:43:55-05:00 gitlab-ci: Run LLVM builds on Debian 10 The current Debian 9 image doesn't provide LLVM 7. - - - - - 2ed3e6c0 by Ben Gamari at 2020-11-24T02:43:55-05:00 CmmToLlvm: Declare signature for memcmp Otherwise `opt` fails with: error: use of undefined value '@memcmp$def' - - - - - be5d74ca by Moritz Angermann at 2020-11-26T16:00:32-05:00 [Sized Cmm] properly retain sizes. This replaces all Word<N> = W<N># Word# and Int<N> = I<N># Int# with Word<N> = W<N># Word<N># and Int<N> = I<N># Int<N>#, thus providing us with properly sized primitives in the codegenerator instead of pretending they are all full machine words. This came up when implementing darwinpcs for arm64. The darwinpcs reqires us to pack function argugments in excess of registers on the stack. While most procedure call standards (pcs) assume arguments are just passed in 8 byte slots; and thus the caller does not know the exact signature to make the call, darwinpcs requires us to adhere to the prototype, and thus have the correct sizes. If we specify CInt in the FFI call, it should correspond to the C int, and not just be Word sized, when it's only half the size. This does change the expected output of T16402 but the new result is no less correct as it eliminates the narrowing (instead of the `and` as was previously done). Bumps the array, bytestring, text, and binary submodules. Co-Authored-By: Ben Gamari <ben at well-typed.com> Metric Increase: T13701 T14697 - - - - - a84e53f9 by Andreas Klebinger at 2020-11-26T16:00:32-05:00 RTS: Fix failed inlining of copy_tag. On windows using gcc-10 gcc failed to inline copy_tag into evacuate. To fix this we now set the always_inline attribute for the various copy* functions in Evac.c. The main motivation here is not the overhead of the function call, but rather that this allows the code to "specialize" for the size of the closure we copy which is often known at compile time. An earlier commit also tried to avoid evacuate_large inlining. But didn't quite succeed. So I also marked evacuate_large as noinline. Fixes #12416 - - - - - cdbd16f5 by Sylvain Henry at 2020-11-26T16:00:33-05:00 Fix toArgRep to support 64-bit reps on all systems [This is @Ericson2314 writing a commit message for @hsyl20's patch.] (Progress towards #11953, #17377, #17375) `Int64Rep` and `Word64Rep` are currently broken on 64-bit systems. This is because they should use "native arg rep" but instead use "large arg rep" as they do on 32-bit systems, which is either a non-concept or a 128-bit rep depending on one's vantage point. Now, these reps currently aren't used during 64-bit compilation, so the brokenness isn't observed, but I don't think that constitutes reasons not to fix it. Firstly, the linked issues there is a clearly expressed desire to use explicit-bitwidth constructs in more places. Secondly, per [1], there are other bugs that *do* manifest from not threading explicit-bitwidth information all the way through the compilation pipeline. One can therefore view this as one piece of the larger effort to do that, improve ergnomics, and squash remaining bugs. Also, this is needed for !3658. I could just merge this as part of that, but I'm keen on merging fixes "as they are ready" so the fixes that aren't ready are isolated and easier to debug. [1]: https://mail.haskell.org/pipermail/ghc-devs/2020-October/019332.html - - - - - a9378e69 by Tim Barnes at 2020-11-26T16:00:34-05:00 Set dynamic users-guide TOC spacing (fixes #18554) - - - - - 86a59d93 by Ben Gamari at 2020-11-26T16:00:34-05:00 rts: Use RTS_LIKELY in CHECK Most compilers probably already infer that `barf` diverges but it nevertheless doesn't hurt to be explicit. - - - - - 5757e82b by Matthew Pickering at 2020-11-26T16:00:35-05:00 Remove special case for GHC.ByteCode.Instr This was added in https://github.com/nomeata/ghc-heap-view/commit/34935206e51b9c86902481d84d2f368a6fd93423 GHC.ByteCode.Instr.BreakInfo no longer exists so the special case is dead code. Any check like this can be easily dealt with in client code. - - - - - d9c8b5b4 by Matthew Pickering at 2020-11-26T16:00:35-05:00 Split Up getClosureDataFromHeapRep Motivation 1. Don't enforce the repeated decoding of an info table, when the client can cache it (ghc-debug) 2. Allow the constructor information decoding to be overridden, this casues segfaults in ghc-debug - - - - - 3e3555cc by Andreas Klebinger at 2020-11-26T16:00:35-05:00 RegAlloc: Add missing raPlatformfield to RegAllocStatsSpill Fixes #18994 Co-Author: Benjamin Maurer <maurer.benjamin at gmail.com> - - - - - a1a75aa9 by Ben Gamari at 2020-11-27T06:20:41-05:00 rts: Allocate MBlocks with MAP_TOP_DOWN on Windows As noted in #18991, we would previously allocate heap in low memory. Due to this the linker, which typically *needs* low memory, would end up competing with the heap. In longer builds we end up running out of low memory entirely, leading to linking failures. - - - - - 75fc1ed5 by Sylvain Henry at 2020-11-28T15:40:23-05:00 Hadrian: fix detection of ghc-pkg for cross-compilers - - - - - 7cb5df96 by Sylvain Henry at 2020-11-28T15:40:23-05:00 hadrian: fix ghc-pkg uses (#17601) Make sure ghc-pkg doesn't read the compiler "settings" file by passing --no-user-package-db. - - - - - e3fd4226 by Ben Gamari at 2020-11-28T15:40:23-05:00 gitlab-ci: Introduce a nightly cross-compilation job This adds a job to test cross-compilation from x86-64 to AArch64 with Hadrian. Fixes #18234 - - - - - 698d3d96 by Ben Gamari at 2020-11-28T15:41:00-05:00 gitlab-ci: Only deploy GitLab Pages in ghc/ghc> The deployments are quite large and yet are currently only served for the ghc/ghc> project. - - - - - 625726f9 by David Eichmann at 2020-11-28T15:41:37-05:00 ghc-heap: partial TSO/STACK decoding Co-authored-by: Sven Tennie <sven.tennie at gmail.com> Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> Co-authored-by: Ben Gamari <bgamari.foss at gmail.com> - - - - - 22ea9c29 by Andreas Klebinger at 2020-11-28T15:42:13-05:00 Small optimization to CmmSink. Inside `regsUsedIn` we can avoid some thunks by specializing the recursion. In particular we avoid the thunk for `(f e z)` in the MachOp/Load branches, where we know this will evaluate to z. Reduces allocations for T3294 by ~1%. - - - - - bba42c62 by John Ericson at 2020-11-28T15:42:49-05:00 Make primop handler indentation more consistent - - - - - c82bc8e9 by John Ericson at 2020-11-28T15:42:49-05:00 Cleanup some primop constructor names Harmonize the internal (big sum type) names of the native vs fixed-sized number primops a bit. (Mainly by renaming the former.) No user-facing names are changed. - - - - - ae14f160 by Ben Gamari at 2020-11-28T15:43:25-05:00 testsuite: Mark T14702 as fragile on Windows Due to #18953. - - - - - 1bc104b0 by Ben Gamari at 2020-11-29T15:33:18-05:00 withTimings: Emit allocations counter This will allow us to back out the allocations per compiler pass from the eventlog. Note that we dump the allocation counter rather than the difference since this will allow us to determine how much work is done *between* `withTiming` blocks. - - - - - e992ea84 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 ThreadPaused: Don't zero slop until free vars are pushed When threadPaused blackholes a thunk it calls `OVERWRITING_CLOSURE` to zero the slop for the benefit of the sanity checker. Previously this was done *before* pushing the thunk's free variables to the update remembered set. Consequently we would pull zero'd pointers to the update remembered set. - - - - - e82cd140 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Fix regression from TSAN work The TSAN rework (specifically aad1f803) introduced a subtle regression in GC.c, swapping `g0` in place of `gen`. Whoops! Fixes #18997. - - - - - 35a5207e by GHC GitLab CI at 2020-11-29T15:33:54-05:00 rts/Messages: Add missing write barrier in THROWTO message update After a THROWTO message has been handle the message closure is overwritten by a NULL message. We must ensure that the original closure's pointers continue to be visible to the nonmoving GC. - - - - - 0120829f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Add missing write barrier in shrinkSmallByteArray - - - - - 8a4d8fb6 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 Updates: Don't zero slop until closure has been pushed Ensure that the the free variables have been pushed to the update remembered set before we zero the slop. - - - - - 2793cfdc by GHC GitLab CI at 2020-11-29T15:33:54-05:00 OSThreads: Fix error code checking pthread_join returns its error code and apparently doesn't set errno. - - - - - e391a16f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Don't join to mark_thread on shutdown The mark thread is not joinable as we detach from it on creation. - - - - - 60d088ab by Ben Gamari at 2020-11-29T15:33:54-05:00 nonmoving: Add reference to Ueno 2016 - - - - - 3aa60362 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Ensure that evacuated large objects are marked See Note [Non-moving GC: Marking evacuated objects]. - - - - - 8d304a99 by Ben Gamari at 2020-11-30T10:15:22-05:00 rts/m32: Refactor handling of allocator seeding Previously, in an attempt to reduce fragmentation, each new allocator would map a region of M32_MAX_PAGES fresh pages to seed itself. However, this ends up being extremely wasteful since it turns out that we often use fewer than this. Consequently, these pages end up getting freed which, ends up fragmenting our address space more than than we would have if we had naively allocated pages on-demand. Here we refactor m32 to avoid this waste while achieving the fragmentation mitigation previously desired. In particular, we move all page allocation into the global m32_alloc_page, which will pull a page from the free page pool. If the free page pool is empty we then refill it by allocating a region of M32_MAP_PAGES and adding them to the pool. Furthermore, we do away with the initial seeding entirely. That is, the allocator starts with no active pages: pages are rather allocated on an as-needed basis. On the whole this ends up being a pleasingly simple change, simultaneously making m32 more efficient, more robust, and simpler. Fixes #18980. - - - - - b6629289 by Ben Gamari at 2020-11-30T10:15:58-05:00 rts: Use CHECK instead of assert Use the GHC wrappers instead of <assert.h>. - - - - - 9f4efa6a by Ben Gamari at 2020-11-30T10:15:58-05:00 rts/linker: Replace some ASSERTs with CHECK In the past some people have confused ASSERT, which is for checking internal invariants, which CHECK, which should be used when checking things that might fail due to bad input (and therefore should be enabled even in the release compiler). Change some of these cases in the linker to use CHECK. - - - - - 0f8a4655 by Ryan Scott at 2020-11-30T10:16:34-05:00 Allow deploy:pages job to fail See #18973. - - - - - cca6623b by Ben Gamari at 2020-12-01T20:44:57+00:00 Optimise nullary type constructor usage During the compilation of programs GHC very frequently deals with the `Type` type, which is a synonym of `TYPE 'LiftedRep`. This patch teaches GHC to avoid expanding the `Type` synonym (and other nullary type synonyms) during type comparisons, saving a good amount of work. This optimisation is described in `Note [Comparing nullary type synonyms]`. To maximize the impact of this optimisation, we introduce a few special-cases to reduce `TYPE 'LiftedRep` to `Type`. See `Note [Prefer Type over TYPE 'LiftedPtrRep]`. Closes #17958. Bumps haddock submodule Metric Decrease: T18698b T1969 T12227 T12545 T12707 T14683 T3064 T5631 T5642 T9020 T9872a T13035 haddock.Cabal haddock.base - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - aclocal.m4 - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - + compiler/GHC/Builtin/Types/Prim.hs-boot - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/Config.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/Dwarf/Constants.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/Monad.hs - compiler/GHC/CmmToAsm/PIC.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/Reg/Graph.hs - compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs - compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs - compiler/GHC/CmmToAsm/Reg/Linear.hs - compiler/GHC/CmmToAsm/Reg/Linear/FreeRegs.hs - compiler/GHC/CmmToAsm/Reg/Target.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/334ca3f8d40048fb067d79413bf664475a1de457...cca6623b6c7ca657df55f2709de8c4cb10198d69 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/334ca3f8d40048fb067d79413bf664475a1de457...cca6623b6c7ca657df55f2709de8c4cb10198d69 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 1 21:15:58 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Tue, 01 Dec 2020 16:15:58 -0500 Subject: [Git][ghc/ghc][wip/T18962] 2 commits: SAT: Attach SAT'd definition as INLINABLE unfolding Message-ID: <5fc6b28e1e4b8_86c111d4a001257447@gitlab.mail> Sebastian Graf pushed to branch wip/T18962 at Glasgow Haskell Compiler / GHC Commits: a3f6ee2a by Sebastian Graf at 2020-12-01T22:15:48+01:00 SAT: Attach SAT'd definition as INLINABLE unfolding SAT is most beneficial if we can specialise a recursive function for the static arguments at a call site by inlining it. >From the standpoint of generated code, the SAT'd definition is very often inferior and will be inverted by our selective lambda lifting pass, which runs late in the STG pipeline. So we don't even want to execute the SAT'd code, just inline it if we can! So we just attach an INLINABLE unfolding to a SAT'able function with the non-recursive SAT'd RHS. - - - - - 380b0b25 by Sebastian Graf at 2020-12-01T22:15:48+01:00 Activate SAT with -O1 To see whether it breaks in CI and so on - - - - - 3 changed files: - compiler/GHC/Core/Opt/StaticArgs.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Driver/Session.hs Changes: ===================================== compiler/GHC/Core/Opt/StaticArgs.hs ===================================== @@ -31,6 +31,12 @@ map = /\ ab -> \f -> \xs -> let map' ys = case ys of Notice that for a compiler that uses lambda lifting this is useless as map' will be transformed back to what map was. +SG: We do selective lambda lifting, but only for code generation, as +an alternative to closure conversion. And when lambda lifting fires, it +makes sure it reduces allocation. The benefit of SAT is from being able +to specialise for static args and the resulting simplifications! If the +static arg is left unexploited, we actually end up with worse code. + We could possibly do the same for big lambdas, but we don't as they will eventually be removed in later stages of the compiler, therefore there is no penalty in keeping them. @@ -59,6 +65,8 @@ import GHC.Core import GHC.Core.Utils import GHC.Core.Type import GHC.Core.Coercion +import GHC.Core.SimpleOpt (defaultSimpleOpts) +import GHC.Core.Unfold.Make (mkInlinableUnfolding) import GHC.Types.Id import GHC.Types.Name import GHC.Types.Var.Env @@ -95,16 +103,23 @@ satBind (Rec [(binder, rhs)]) interesting_ids = do let interesting_ids' = interesting_ids `addOneToUniqSet` binder (rhs_binders, rhs_body) = collectBinders rhs (rhs_body', sat_info_rhs_body) <- satTopLevelExpr rhs_body interesting_ids' + -- The following two lines intersect the SATInfo from call sites with + -- the order of parameters from the *definition* (sat_info_rhs_from_args) + -- Ex: If we have the only call site @f a v@, but the defn of @f@ is + -- @f a b = ...@, then @a@ is a static arg, but @v@ is not. + -- TODO: better names!! let sat_info_rhs_from_args = unitVarEnv binder (bindersToSATInfo rhs_binders) sat_info_rhs' = mergeIdSATInfo sat_info_rhs_from_args sat_info_rhs_body + -- I don't think the following lines are effective at guarding against + -- shadowing: shadowing = binder `elementOfUniqSet` interesting_ids sat_info_rhs'' = if shadowing then sat_info_rhs' `delFromUFM` binder -- For safety else sat_info_rhs' - bind' <- saTransformMaybe binder (lookupUFM sat_info_rhs' binder) - rhs_binders rhs_body' + bind' <- saTransformUnfolding binder (lookupUFM sat_info_rhs' binder) + rhs_binders rhs_body' return (bind', sat_info_rhs'') satBind (Rec pairs) interesting_ids = do let (binders, rhss) = unzip pairs @@ -163,7 +178,7 @@ mergeIdSATInfo = plusUFM_C mergeSATInfo mergeIdSATInfos :: [IdSATInfo] -> IdSATInfo mergeIdSATInfos = foldl' mergeIdSATInfo emptyIdSATInfo -bindersToSATInfo :: [Id] -> SATInfo +bindersToSATInfo :: [Var] -> SATInfo bindersToSATInfo vs = map (Static . binderToApp) vs where binderToApp v | isId v = VarApp v | isTyVar v = TypeApp $ mkTyVarTy v @@ -271,6 +286,7 @@ newUnique = getUniqueM ************************************************************************ +SG: This is incomprehensible without giving the map example first. To do the transformation, the game plan is to: 1. Create a small nonrecursive RHS that takes the @@ -367,8 +383,8 @@ type argument. This is bad because it means the application sat_worker_s1aU x_a6 is not well typed. -} -saTransformMaybe :: Id -> Maybe SATInfo -> [Id] -> CoreExpr -> SatM CoreBind -saTransformMaybe binder maybe_arg_staticness rhs_binders rhs_body +_saTransformMaybe :: Id -> Maybe SATInfo -> [Id] -> CoreExpr -> SatM CoreBind +_saTransformMaybe binder maybe_arg_staticness rhs_binders rhs_body | Just arg_staticness <- maybe_arg_staticness , should_transform arg_staticness = saTransform binder arg_staticness rhs_binders rhs_body @@ -379,6 +395,17 @@ saTransformMaybe binder maybe_arg_staticness rhs_binders rhs_body where n_static_args = count isStaticValue staticness +saTransformUnfolding :: Id -> Maybe SATInfo -> [Id] -> CoreExpr -> SatM CoreBind +saTransformUnfolding binder maybe_arg_staticness rhs_binders rhs_body + | Just arg_staticness <- maybe_arg_staticness + , any (not . isStatic) arg_staticness + , not (isStableUnfolding (idUnfolding binder)) + = do { NonRec _binder' rhs' <- saTransform binder arg_staticness rhs_binders rhs_body + ; let binder' = binder `setIdUnfolding` mkInlinableUnfolding defaultSimpleOpts rhs' + ; return (Rec [(binder', mkLams rhs_binders rhs_body)]) } + | otherwise + = return (Rec [(binder, mkLams rhs_binders rhs_body)]) + saTransform :: Id -> SATInfo -> [Id] -> CoreExpr -> SatM CoreBind saTransform binder arg_staticness rhs_binders rhs_body = do { shadow_lam_bndrs <- mapM clone binders_w_staticness @@ -434,3 +461,7 @@ saTransform binder arg_staticness rhs_binders rhs_body isStaticValue :: Staticness App -> Bool isStaticValue (Static (VarApp _)) = True isStaticValue _ = False + +isStatic :: Staticness a -> Bool +isStatic (Static _) = True +isStatic _ = True ===================================== compiler/GHC/Core/SimpleOpt.hs ===================================== @@ -93,6 +93,11 @@ data SimpleOpts = SimpleOpts { so_uf_opts :: !UnfoldingOpts -- ^ Unfolding options , so_co_opts :: !OptCoercionOpts -- ^ Coercion optimiser options } +-- SG: I find the name "SimpleOpts" terrible. It's misleading in multiple ways: +-- You'd read it and mistake it for *Simpl*Opts, options for the Simplifier. +-- And you might mistake it for Simple*Opts*, simple options for ... what? +-- And then SimpleOptOpts would be less missleading, but ugly because OptOpts. +-- So why not SimpleOptConfig? -- | Default options for the Simple optimiser. defaultSimpleOpts :: SimpleOpts ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -4015,7 +4015,7 @@ optLevelFlags -- see Note [Documenting optimisation flags] , ([2], Opt_SpecConstr) -- , ([2], Opt_RegsGraph) -- RegsGraph suffers performance regression. See #7679 --- , ([2], Opt_StaticArgumentTransformation) + , ([1,2], Opt_StaticArgumentTransformation) -- Static Argument Transformation needs investigation. See #9374 ] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2ba459d44695bb6767c31ceed986ac405477fe77...380b0b257adda4c0a6f3c86ff57d9f5efb8497d2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2ba459d44695bb6767c31ceed986ac405477fe77...380b0b257adda4c0a6f3c86ff57d9f5efb8497d2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 1 22:19:54 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 01 Dec 2020 17:19:54 -0500 Subject: [Git][ghc/ghc][wip/backports-9.0] 3 commits: hadrian: Pass input file to makeindex Message-ID: <5fc6c18a60e68_86c3fc677e4686c126388e@gitlab.mail> Ben Gamari pushed to branch wip/backports-9.0 at Glasgow Haskell Compiler / GHC Commits: 2a622d0f by Ben Gamari at 2020-12-01T21:39:09+00:00 hadrian: Pass input file to makeindex Strangely I find that on Alpine (and apparently only on Alpine) the latex makeindex command expects to be given a filename, lest it reads from stdin. (cherry picked from commit 389a668343c0d4f5fa095112ff98d0da6998e99d) - - - - - 553ec815 by GHC GitLab CI at 2020-12-01T22:19:04+00:00 Fix various documentation issues - - - - - 007055cc by GHC GitLab CI at 2020-12-01T22:19:12+00:00 Fix cas_int - - - - - 5 changed files: - docs/users_guide/9.0.1-notes.rst - docs/users_guide/ghci.rst - docs/users_guide/runtime_control.rst - hadrian/src/Builder.hs - testsuite/tests/codeGen/should_run/cas_int.hs Changes: ===================================== docs/users_guide/9.0.1-notes.rst ===================================== @@ -56,7 +56,9 @@ Highlights - GHC now relies on a new ``ghc-bignum`` package to provide Integer/Natural implementations. This package supports the following backends: + - gmp: adapted from integer-gmp package that was used before + - native: new Haskell implementation, faster than ``integer-simple`` which is not used anymore ===================================== docs/users_guide/ghci.rst ===================================== @@ -2549,6 +2549,7 @@ commonly used commands. be used. .. code-block:: none + ghci>:set -XDataKinds -XUndecidableInstances ghci>import GHC.TypeLits ghci>class A a ===================================== docs/users_guide/runtime_control.rst ===================================== @@ -183,6 +183,10 @@ Event log output Furthermore GHC lets you specify the way event log data (see :rts-flag:`-l ⟨flags⟩`) is written through a custom :c:type:`EventLogWriter`: +.. c:type:: size_t + + :hidden: + .. c:type:: EventLogWriter A sink of event-log data. ===================================== hadrian/src/Builder.hs ===================================== @@ -282,7 +282,7 @@ instance H.Builder Builder where cmd' echo [path] "--no-split" [ "-o", output] [input] Xelatex -> unit $ cmd' [Cwd output] [path] buildArgs - Makeindex -> unit $ cmd' [Cwd output] [path] buildArgs + Makeindex -> unit $ cmd' [Cwd output] [path] (buildArgs ++ [input]) Tar _ -> cmd' buildOptions echo [path] buildArgs _ -> cmd' echo [path] buildArgs ===================================== testsuite/tests/codeGen/should_run/cas_int.hs ===================================== @@ -26,16 +26,16 @@ import GHC.Ptr #include "MachDeps.h" main = do - alloca $ \(ptr_p :: Ptr (Ptr Int)) -> do - alloca $ \(ptr_i :: Ptr Int) -> do - alloca $ \(ptr_j :: Ptr Int) -> do - poke ptr_i (1 :: Int) - poke ptr_j (2 :: Int) + alloca $ \(ptr_p :: Ptr (Ptr Word)) -> do + alloca $ \(ptr_i :: Ptr Word) -> do + alloca $ \(ptr_j :: Ptr Word) -> do + poke ptr_i (1 :: Word) + poke ptr_j (2 :: Word) --expected to swap - res_i <- cas ptr_i 1 3 :: IO Int + res_i <- cas ptr_i 1 3 :: IO Word -- expected to fail - res_j <- cas ptr_j 1 4 :: IO Int + res_j <- cas ptr_j 1 4 :: IO Word putStrLn "Returned results:" --(1,2) @@ -48,7 +48,7 @@ main = do --(3,2) print (i,j) -cas :: Ptr Int -> Int -> Int -> IO Int -cas (Ptr ptr) (I# expected) (I# desired)= do - IO $ \s -> case (atomicCasInt# ptr expected desired s) of - (# s2, old_val #) -> (# s2, I# old_val #) +cas :: Ptr Word -> Word -> Word -> IO Word +cas (Ptr ptr) (W# expected) (W# desired)= do + IO $ \s -> case (atomicCasWordAddr# ptr expected desired s) of + (# s2, old_val #) -> (# s2, W# old_val #) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/85822a8881a7463b479b07d0b4d627a44930f058...007055cc5856caeac957489bd4ce061cf4b43459 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/85822a8881a7463b479b07d0b4d627a44930f058...007055cc5856caeac957489bd4ce061cf4b43459 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 1 22:38:48 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 01 Dec 2020 17:38:48 -0500 Subject: [Git][ghc/ghc][wip/tyconapp-opts] Optimise nullary type constructor usage Message-ID: <5fc6c5f873c7d_86c3fc6ab83037c126462e@gitlab.mail> Ben Gamari pushed to branch wip/tyconapp-opts at Glasgow Haskell Compiler / GHC Commits: c61782a7 by Ben Gamari at 2020-12-01T22:38:09+00:00 Optimise nullary type constructor usage During the compilation of programs GHC very frequently deals with the `Type` type, which is a synonym of `TYPE 'LiftedRep`. This patch teaches GHC to avoid expanding the `Type` synonym (and other nullary type synonyms) during type comparisons, saving a good amount of work. This optimisation is described in `Note [Comparing nullary type synonyms]`. To maximize the impact of this optimisation, we introduce a few special-cases to reduce `TYPE 'LiftedRep` to `Type`. See `Note [Prefer Type over TYPE 'LiftedPtrRep]`. Closes #17958. Bumps haddock submodule Metric Decrease: T18698b T1969 T12227 T12545 T12707 T14683 T3064 T5631 T5642 T9020 T9630 T9872a T13035 haddock.Cabal haddock.base - - - - - 23 changed files: - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - + compiler/GHC/Builtin/Types/Prim.hs-boot - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/TcType.hs - testsuite/tests/deSugar/should_compile/T2431.stderr - testsuite/tests/deriving/should_compile/T14578.stderr - testsuite/tests/plugins/plugins09.stdout - testsuite/tests/plugins/plugins10.stdout - testsuite/tests/plugins/plugins11.stdout - testsuite/tests/plugins/static-plugins.stdout - testsuite/tests/printer/T18052a.stderr - testsuite/tests/simplCore/should_compile/T13143.stderr - testsuite/tests/simplCore/should_compile/T18013.stderr - testsuite/tests/simplCore/should_compile/T7360.stderr - testsuite/tests/typecheck/should_compile/T13032.stderr - utils/haddock Changes: ===================================== compiler/GHC/Builtin/Types.hs ===================================== @@ -170,6 +170,7 @@ import GHC.Types.Var (VarBndr (Bndr)) import GHC.Settings.Constants ( mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE, mAX_SUM_SIZE ) import GHC.Unit.Module ( Module ) import GHC.Core.Type +import qualified GHC.Core.TyCo.Rep as TyCoRep (Type(TyConApp)) import GHC.Types.RepType import GHC.Core.DataCon import GHC.Core.ConLike @@ -689,7 +690,7 @@ constraintKindTyCon :: TyCon constraintKindTyCon = pcTyCon constraintKindTyConName Nothing [] [] liftedTypeKind, typeToTypeKind, constraintKind :: Kind -liftedTypeKind = tYPE liftedRepTy +liftedTypeKind = TyCoRep.TyConApp liftedTypeKindTyCon [] typeToTypeKind = liftedTypeKind `mkVisFunTyMany` liftedTypeKind constraintKind = mkTyConApp constraintKindTyCon [] @@ -1413,8 +1414,8 @@ runtimeRepTy = mkTyConTy runtimeRepTyCon -- type Type = tYPE 'LiftedRep liftedTypeKindTyCon :: TyCon liftedTypeKindTyCon = buildSynTyCon liftedTypeKindTyConName - [] liftedTypeKind [] - (tYPE liftedRepTy) + [] liftedTypeKind [] rhs + where rhs = TyCoRep.TyConApp tYPETyCon [liftedRepTy] runtimeRepTyCon :: TyCon runtimeRepTyCon = pcTyCon runtimeRepTyConName Nothing [] ===================================== compiler/GHC/Builtin/Types/Prim.hs ===================================== @@ -551,10 +551,6 @@ mkPrimTcName built_in_syntax occ key tycon = mkWiredInName gHC_PRIM (mkTcOccFS occ) key (mkATyCon tycon) built_in_syntax ----------------------------- --- | Given a RuntimeRep, applies TYPE to it. --- see Note [TYPE and RuntimeRep] -tYPE :: Type -> Type -tYPE rr = TyConApp tYPETyCon [rr] -- Given a Multiplicity, applies FUN to it. functionWithMultiplicity :: Type -> Type ===================================== compiler/GHC/Builtin/Types/Prim.hs-boot ===================================== @@ -0,0 +1,5 @@ +module GHC.Builtin.Types.Prim where + +import GHC.Core.TyCon + +tYPETyCon :: TyCon ===================================== compiler/GHC/Core/TyCo/Rep.hs ===================================== @@ -52,6 +52,7 @@ module GHC.Core.TyCo.Rep ( mkVisFunTyMany, mkVisFunTysMany, mkInvisFunTyMany, mkInvisFunTysMany, mkTyConApp, + tYPE, -- * Functions over binders TyCoBinder(..), TyCoVarBinder, TyBinder, @@ -90,8 +91,9 @@ import GHC.Core.TyCon import GHC.Core.Coercion.Axiom -- others -import GHC.Builtin.Names ( liftedTypeKindTyConKey, manyDataConKey ) -import {-# SOURCE #-} GHC.Builtin.Types ( liftedTypeKindTyCon, manyDataConTy ) +import GHC.Builtin.Names ( liftedTypeKindTyConKey, liftedRepDataConKey, manyDataConKey, tYPETyConKey ) +import {-# SOURCE #-} GHC.Builtin.Types ( liftedTypeKindTyCon, liftedTypeKind, manyDataConTy ) +import {-# SOURCE #-} GHC.Builtin.Types.Prim ( tYPETyCon ) import GHC.Types.Basic ( LeftOrRight(..), pickLR ) import GHC.Types.Unique ( hasKey ) import GHC.Utils.Outputable @@ -1018,12 +1020,64 @@ mkTyConApp tycon tys -- avoid reboxing every time `mkTyConApp` is called. = ASSERT2( null tys, ppr tycon $$ ppr tys ) manyDataConTy + -- See Note [Prefer Type over TYPE 'LiftedRep]. + | tycon `hasKey` tYPETyConKey + , [rep] <- tys + = tYPE rep + -- The catch-all case | otherwise = TyConApp tycon tys +{- +Note [Prefer Type over TYPE 'LiftedRep] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The Core of nearly any program will have numerous occurrences of + at TYPE 'LiftedRep@ floating about. Consequently, we try hard to ensure +that operations on such types are efficient. Specifically, we strive to + + a. Avoid heap allocation of such types + b. Use a small (shallow in the tree-depth sense) representation + for such types + +Goal (b) is particularly useful as it makes traversals (e.g. free variable +traversal, substitution, and comparison) more efficient. +Comparison in particular takes special advantage of nullary type synonym +applications, Note [Comparing nullary type synonyms] in "GHC.Core.Type". + +To accomplish these we use a number of tricks: + + * Instead of representing the lifted kind as + @TyConApp tYPETyCon [liftedRepDataCon]@ we rather prefer to + use the 'GHC.Types.Type' type synonym. This serves goal (b) + since there are no applied type arguments to traverse, e.g., during + comparison. + + * We have a top-level binding to represent `TyConApp GHC.Types.Type []` + (namely 'GHC.Builtin.Types.Prim.liftedTypeKind'), ensuring that we + don't need to allocate such types (goal (a)). + + * To avoid allocating 'TyConApp' constructors + 'GHC.Builtin.Types.Prim.tYPE' catches the lifted case and returns + `liftedTypeKind` instead of building an application (goal (a)). + + * Similarly, 'Type.mkTyConApp' catches applications of `TYPE` and + handles them using 'GHC.Builtin.Types.Prim.tYPE', ensuring + that it benefits from the optimisation described above (goal (a)). + +See #17958. +-} + +-- | Given a RuntimeRep, applies TYPE to it. +-- See Note [TYPE and RuntimeRep] in GHC.Builtin.Types.Prim. +tYPE :: Type -> Type +tYPE (TyConApp tc []) + -- See Note [Prefer Type of TYPE 'LiftedRep] + | tc `hasKey` liftedRepDataConKey = liftedTypeKind -- TYPE 'LiftedRep +tYPE rr = TyConApp tYPETyCon [rr] + -- This is a single, global definition of the type `Type` -- Defined here so it is only allocated once. --- See Note [mkTyConApp and Type] +-- See Note [mkTyConApp and Type] in this module. liftedTypeKindTyConApp :: Type liftedTypeKindTyConApp = TyConApp liftedTypeKindTyCon [] ===================================== compiler/GHC/Core/TyCo/Subst.hs ===================================== @@ -424,6 +424,7 @@ zipTCvSubst tcvs tys -- | Generates the in-scope set for the 'TCvSubst' from the types in the -- incoming environment. No CoVars, please! mkTvSubstPrs :: [(TyVar, Type)] -> TCvSubst +mkTvSubstPrs [] = emptyTCvSubst mkTvSubstPrs prs = ASSERT2( onlyTyVarsAndNoCoercionTy, text "prs" <+> ppr prs ) mkTvSubst in_scope tenv ===================================== compiler/GHC/Core/TyCon.hs ===================================== @@ -2310,12 +2310,14 @@ expandSynTyCon_maybe -- ^ Expand a type synonym application, if any expandSynTyCon_maybe tc tys | SynonymTyCon { tyConTyVars = tvs, synTcRhs = rhs, tyConArity = arity } <- tc - = case tys `listLengthCmp` arity of - GT -> Just (tvs `zip` tys, rhs, drop arity tys) - EQ -> Just (tvs `zip` tys, rhs, []) - LT -> Nothing - | otherwise - = Nothing + = case tys of + [] -> Just ([], rhs, []) -- Avoid a bit of work in the case of nullary synonyms + _ -> case tys `listLengthCmp` arity of + GT -> Just (tvs `zip` tys, rhs, drop arity tys) + EQ -> Just (tvs `zip` tys, rhs, []) + LT -> Nothing + | otherwise + = Nothing ---------------- ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -382,15 +382,16 @@ how roles in kinds might work out. -} -- | Gives the typechecker view of a type. This unwraps synonyms but --- leaves 'Constraint' alone. c.f. coreView, which turns Constraint into --- TYPE LiftedRep. Returns Nothing if no unwrapping happens. +-- leaves 'Constraint' alone. c.f. 'coreView', which turns 'Constraint' into +-- @TYPE LiftedRep at . Returns 'Nothing' if no unwrapping happens. -- See also Note [coreView vs tcView] {-# INLINE tcView #-} tcView :: Type -> Maybe Type -tcView (TyConApp tc tys) | Just (tenv, rhs, tys') <- expandSynTyCon_maybe tc tys - = Just (mkAppTys (substTy (mkTvSubstPrs tenv) rhs) tys') +tcView (TyConApp tc tys) + | res@(Just _) <- expandSynTyConApp_maybe tc tys + = res -- The free vars of 'rhs' should all be bound by 'tenv', so it's - -- ok to use 'substTy' here. + -- ok to use 'substTy' here (which is what expandSynTyConApp_maybe does). -- See also Note [The substitution invariant] in GHC.Core.TyCo.Subst. -- Its important to use mkAppTys, rather than (foldl AppTy), -- because the function part might well return a @@ -399,17 +400,16 @@ tcView _ = Nothing {-# INLINE coreView #-} coreView :: Type -> Maybe Type --- ^ This function Strips off the /top layer only/ of a type synonym +-- ^ This function strips off the /top layer only/ of a type synonym -- application (if any) its underlying representation type. --- Returns Nothing if there is nothing to look through. +-- Returns 'Nothing' if there is nothing to look through. -- This function considers 'Constraint' to be a synonym of @TYPE LiftedRep at . -- -- By being non-recursive and inlined, this case analysis gets efficiently -- joined onto the case analysis that the caller is already doing coreView ty@(TyConApp tc tys) - | Just (tenv, rhs, tys') <- expandSynTyCon_maybe tc tys - = Just (mkAppTys (substTy (mkTvSubstPrs tenv) rhs) tys') - -- This equation is exactly like tcView + | res@(Just _) <- expandSynTyConApp_maybe tc tys + = res -- At the Core level, Constraint = Type -- See Note [coreView vs tcView] @@ -419,6 +419,30 @@ coreView ty@(TyConApp tc tys) coreView _ = Nothing +----------------------------------------------- +expandSynTyConApp_maybe :: TyCon -> [Type] -> Maybe Type +expandSynTyConApp_maybe tc tys + | Just (tvs, rhs) <- synTyConDefn_maybe tc + , n_tys >= arity + = Just (expand_syn arity tvs rhs n_tys tys) + | otherwise + = Nothing + where + n_tys = length tys + arity = tyConArity tc +-- Without this INLINE the call to expandSynTyConApp_maybe in coreView +-- will result in an avoidable allocation. +{-# INLINE expandSynTyConApp_maybe #-} + +-- | A helper for 'expandSynTyConApp_maybe' to avoid inlining this cold path +-- into call-sites. +expand_syn :: Int -> [TyVar] -> Type -> Int -> [Type] -> Type +expand_syn arity tvs rhs n_tys tys + | n_tys > arity = mkAppTys rhs' (drop arity tys) + | otherwise = rhs' + where + rhs' = substTy (mkTvSubstPrs (tvs `zip` tys)) rhs + {-# INLINE coreFullView #-} coreFullView :: Type -> Type -- ^ Iterates 'coreView' until there is no more to synonym to expand. @@ -2194,6 +2218,36 @@ But the left is an AppTy while the right is a TyConApp. The solution is to use repSplitAppTy_maybe to break up the TyConApp into its pieces and then continue. Easy to do, but also easy to forget to do. + +Note [Comparing nullary type synonyms] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider the task of testing equality between two 'Type's of the form + + TyConApp tc [] + +where @tc@ is a type synonym. A naive way to perform this comparison these +would first expand the synonym and then compare the resulting expansions. + +However, this is obviously wasteful and the RHS of @tc@ may be large; it is +much better to rather compare the TyCons directly. Consequently, before +expanding type synonyms in type comparisons we first look for a nullary +TyConApp and simply compare the TyCons if we find one. Of course, if we find +that the TyCons are *not* equal then we still need to perform the expansion as +their RHSs may still be equal. + +We perform this optimisation in a number of places: + + * GHC.Core.Types.eqType + * GHC.Core.Types.nonDetCmpType + * GHC.Core.Unify.unify_ty + * TcCanonical.can_eq_nc' + * TcUnify.uType + +This optimisation is especially helpful for the ubiquitous GHC.Types.Type, +since GHC prefers to use the type synonym over @TYPE 'LiftedRep@ applications +whenever possible. See [Prefer Type over TYPE 'LiftedRep] in +GHC.Core.TyCo.Rep for details. + -} eqType :: Type -> Type -> Bool @@ -2305,6 +2359,10 @@ nonDetCmpTypeX env orig_t1 orig_t2 = -- Returns both the resulting ordering relation between the two types -- and whether either contains a cast. go :: RnEnv2 -> Type -> Type -> TypeOrdering + -- See Note [Comparing nullary type synonyms]. + go _ (TyConApp tc1 []) (TyConApp tc2 []) + | tc1 == tc2 + = TEQ go env t1 t2 | Just t1' <- coreView t1 = go env t1' t2 | Just t2' <- coreView t2 = go env t1 t2' ===================================== compiler/GHC/Core/Unify.hs ===================================== @@ -957,7 +957,12 @@ unify_ty :: UMEnv -- Respects newtypes, PredTypes unify_ty env ty1 ty2 kco - -- Use tcView, not coreView. See Note [coreView vs tcView] in GHC.Core.Type. + -- See Note [Comparing nullary type synonyms] in GHC.Core.Type. + | TyConApp tc1 [] <- ty1 + , TyConApp tc2 [] <- ty2 + , tc1 == tc2 = return () + + -- TODO: More commentary needed here | Just ty1' <- tcView ty1 = unify_ty env ty1' ty2 kco | Just ty2' <- tcView ty2 = unify_ty env ty1 ty2' kco | CastTy ty1' co <- ty1 = if um_unif env ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -961,6 +961,11 @@ can_eq_nc' -> Type -> Type -- RHS, after and before type-synonym expansion, resp -> TcS (StopOrContinue Ct) +-- See Note [Comparing nullary type synonyms] in GHC.Core.Type. +can_eq_nc' _flat _rdr_env _envs ev eq_rel ty1@(TyConApp tc1 []) _ps_ty1 (TyConApp tc2 []) _ps_ty2 + | tc1 == tc2 + = canEqReflexive ev eq_rel ty1 + -- Expand synonyms first; see Note [Type synonyms and canonicalization] can_eq_nc' flat rdr_env envs ev eq_rel ty1 ps_ty1 ty2 ps_ty2 | Just ty1' <- tcView ty1 = can_eq_nc' flat rdr_env envs ev eq_rel ty1' ps_ty1 ty2 ps_ty2 ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -120,7 +120,6 @@ import GHC.Types.Id as Id import GHC.Types.Name import GHC.Types.Var.Set import GHC.Builtin.Types -import GHC.Builtin.Types.Prim import GHC.Types.Var.Env import GHC.Types.Name.Env import GHC.Utils.Misc ===================================== compiler/GHC/Tc/Utils/TcType.hs ===================================== @@ -1552,6 +1552,11 @@ tc_eq_type keep_syns vis_only orig_ty1 orig_ty2 = go orig_env orig_ty1 orig_ty2 where go :: RnEnv2 -> Type -> Type -> Bool + -- See Note [Comparing nullary type synonyms] in GHC.Core.Type. + go _ (TyConApp tc1 []) (TyConApp tc2 []) + | tc1 == tc2 + = True + go env t1 t2 | not keep_syns, Just t1' <- tcView t1 = go env t1' t2 go env t1 t2 | not keep_syns, Just t2' <- tcView t2 = go env t1 t2' ===================================== testsuite/tests/deSugar/should_compile/T2431.stderr ===================================== @@ -1,9 +1,9 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 63, types: 43, coercions: 1, joins: 0/0} + = {terms: 63, types: 39, coercions: 1, joins: 0/0} --- RHS size: {terms: 2, types: 4, coercions: 1, joins: 0/0} +-- RHS size: {terms: 2, types: 3, coercions: 1, joins: 0/0} T2431.$WRefl [InlPrag=INLINE[final] CONLIKE] :: forall a. a :~: a [GblId[DataConWrapper], Caf=NoCafRefs, @@ -15,7 +15,7 @@ T2431.$WRefl [InlPrag=INLINE[final] CONLIKE] :: forall a. a :~: a T2431.$WRefl = \ (@a) -> T2431.Refl @a @a @~(_N :: a GHC.Prim.~# a) --- RHS size: {terms: 4, types: 8, coercions: 0, joins: 0/0} +-- RHS size: {terms: 4, types: 7, coercions: 0, joins: 0/0} absurd :: forall a. (Int :~: Bool) -> a [GblId, Arity=1, Str=b, Cpr=b, Unf=OtherCon []] absurd = \ (@a) (x :: Int :~: Bool) -> case x of { } ===================================== testsuite/tests/deriving/should_compile/T14578.stderr ===================================== @@ -16,13 +16,12 @@ Derived class instances: = GHC.Prim.coerce @(T14578.App (Data.Functor.Compose.Compose f g) a -> T14578.App (Data.Functor.Compose.Compose f g) a - -> T14578.App (Data.Functor.Compose.Compose f g) a) + -> T14578.App (Data.Functor.Compose.Compose f g) a) @(T14578.Wat f g a -> T14578.Wat f g a -> T14578.Wat f g a) ((GHC.Base.<>) @(T14578.App (Data.Functor.Compose.Compose f g) a)) GHC.Base.sconcat = GHC.Prim.coerce - @(GHC.Base.NonEmpty - (T14578.App (Data.Functor.Compose.Compose f g) a) + @(GHC.Base.NonEmpty (T14578.App (Data.Functor.Compose.Compose f g) a) -> T14578.App (Data.Functor.Compose.Compose f g) a) @(GHC.Base.NonEmpty (T14578.Wat f g a) -> T14578.Wat f g a) (GHC.Base.sconcat @@ -31,7 +30,7 @@ Derived class instances: = GHC.Prim.coerce @(b -> T14578.App (Data.Functor.Compose.Compose f g) a - -> T14578.App (Data.Functor.Compose.Compose f g) a) + -> T14578.App (Data.Functor.Compose.Compose f g) a) @(b -> T14578.Wat f g a -> T14578.Wat f g a) (GHC.Base.stimes @(T14578.App (Data.Functor.Compose.Compose f g) a)) ===================================== testsuite/tests/plugins/plugins09.stdout ===================================== @@ -3,6 +3,5 @@ interfacePlugin: Prelude interfacePlugin: GHC.Float interfacePlugin: GHC.Base typeCheckPlugin (rn) -interfacePlugin: GHC.Types typeCheckPlugin (tc) interfacePlugin: GHC.Num.BigNat ===================================== testsuite/tests/plugins/plugins10.stdout ===================================== @@ -6,7 +6,6 @@ interfacePlugin: GHC.Float interfacePlugin: GHC.Base interfacePlugin: Language.Haskell.TH.Syntax typeCheckPlugin (rn) -interfacePlugin: GHC.Types typeCheckPlugin (tc) interfacePlugin: GHC.Num.BigNat parsePlugin(a) ===================================== testsuite/tests/plugins/plugins11.stdout ===================================== @@ -3,6 +3,5 @@ interfacePlugin: Prelude interfacePlugin: GHC.Float interfacePlugin: GHC.Base typeCheckPlugin (rn) -interfacePlugin: GHC.Types typeCheckPlugin (tc) interfacePlugin: GHC.Num.BigNat ===================================== testsuite/tests/plugins/static-plugins.stdout ===================================== @@ -5,11 +5,11 @@ interfacePlugin: GHC.Float interfacePlugin: GHC.Base interfacePlugin: System.IO typeCheckPlugin (rn) -interfacePlugin: GHC.Prim -interfacePlugin: GHC.Show interfacePlugin: GHC.Types +interfacePlugin: GHC.Show interfacePlugin: GHC.TopHandler typeCheckPlugin (tc) +interfacePlugin: GHC.Prim interfacePlugin: GHC.CString interfacePlugin: GHC.Num.BigNat ==pure.1 ===================================== testsuite/tests/printer/T18052a.stderr ===================================== @@ -10,9 +10,9 @@ Dependent packages: [base-4.16.0.0, ghc-bignum-1.0, ghc-prim-0.8.0] ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 24, types: 61, coercions: 0, joins: 0/0} + = {terms: 24, types: 52, coercions: 0, joins: 0/0} --- RHS size: {terms: 7, types: 8, coercions: 0, joins: 0/0} +-- RHS size: {terms: 7, types: 6, coercions: 0, joins: 0/0} T18052a.$b:||: :: forall {a} {b}. a -> b -> (a, b) [GblId, Arity=2, Unf=OtherCon []] T18052a.$b:||: = \ (@a) (@b) (x :: a) (y :: b) -> (x, y) @@ -22,7 +22,7 @@ T18052a.$b:||: = \ (@a) (@b) (x :: a) (y :: b) -> (x, y) [GblId] (+++) = ++ --- RHS size: {terms: 13, types: 20, coercions: 0, joins: 0/0} +-- RHS size: {terms: 13, types: 18, coercions: 0, joins: 0/0} T18052a.$m:||: :: forall {rep :: GHC.Types.RuntimeRep} {r :: TYPE rep} {a} {b}. (a, b) -> (a -> b -> r) -> ((# #) -> r) -> r ===================================== testsuite/tests/simplCore/should_compile/T13143.stderr ===================================== @@ -1,17 +1,17 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 71, types: 44, coercions: 0, joins: 0/0} + = {terms: 71, types: 40, coercions: 0, joins: 0/0} Rec { --- RHS size: {terms: 4, types: 4, coercions: 0, joins: 0/0} +-- RHS size: {terms: 4, types: 3, coercions: 0, joins: 0/0} T13143.$wf [InlPrag=NOINLINE, Occ=LoopBreaker] :: forall {a}. (# #) -> a [GblId, Arity=1, Str=b, Cpr=b, Unf=OtherCon []] T13143.$wf = \ (@a) _ [Occ=Dead] -> T13143.$wf @a GHC.Prim.(##) end Rec } --- RHS size: {terms: 4, types: 4, coercions: 0, joins: 0/0} +-- RHS size: {terms: 4, types: 3, coercions: 0, joins: 0/0} f [InlPrag=[final]] :: forall a. Int -> a [GblId, Arity=1, ===================================== testsuite/tests/simplCore/should_compile/T18013.stderr ===================================== @@ -129,9 +129,9 @@ Rule fired: Class op fmap (BUILTIN) ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 52, types: 106, coercions: 17, joins: 0/1} + = {terms: 52, types: 101, coercions: 17, joins: 0/1} --- RHS size: {terms: 37, types: 87, coercions: 17, joins: 0/1} +-- RHS size: {terms: 37, types: 84, coercions: 17, joins: 0/1} mapMaybeRule :: forall a b. Rule IO a b -> Rule IO (Maybe a) (Maybe b) [GblId, ===================================== testsuite/tests/simplCore/should_compile/T7360.stderr ===================================== @@ -1,7 +1,7 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 106, types: 47, coercions: 0, joins: 0/0} + = {terms: 106, types: 45, coercions: 0, joins: 0/0} -- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} T7360.$WFoo3 [InlPrag=INLINE[final] CONLIKE] :: Int %1 -> Foo @@ -31,7 +31,7 @@ T7360.fun4 :: () WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 20 0}] T7360.fun4 = fun1 T7360.Foo1 --- RHS size: {terms: 11, types: 8, coercions: 0, joins: 0/0} +-- RHS size: {terms: 11, types: 7, coercions: 0, joins: 0/0} fun2 :: forall {a}. [a] -> ((), Int) [GblId, Arity=1, ===================================== testsuite/tests/typecheck/should_compile/T13032.stderr ===================================== @@ -1,9 +1,9 @@ ==================== Desugar (after optimization) ==================== Result size of Desugar (after optimization) - = {terms: 13, types: 24, coercions: 0, joins: 0/0} + = {terms: 13, types: 18, coercions: 0, joins: 0/0} --- RHS size: {terms: 6, types: 11, coercions: 0, joins: 0/0} +-- RHS size: {terms: 6, types: 8, coercions: 0, joins: 0/0} f :: forall a b. (a ~ b) => a -> b -> Bool [LclIdX, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 2d06af2fc535dacc4bac45d45e8eb95a7620caac +Subproject commit 5726d91cfe8ad40d3f32b1ee6957c1f42a1c4a01 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c61782a7a1001fba689fb60877ab1b218079b1a7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c61782a7a1001fba689fb60877ab1b218079b1a7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 1 23:31:42 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Tue, 01 Dec 2020 18:31:42 -0500 Subject: [Git][ghc/ghc][wip/T18962] 2 commits: SAT: Attach SAT'd definition as INLINABLE unfolding Message-ID: <5fc6d25e7cab9_86cbee2590126775b@gitlab.mail> Sebastian Graf pushed to branch wip/T18962 at Glasgow Haskell Compiler / GHC Commits: e4dc48a5 by Sebastian Graf at 2020-12-02T00:31:35+01:00 SAT: Attach SAT'd definition as INLINABLE unfolding SAT is most beneficial if we can specialise a recursive function for the static arguments at a call site by inlining it. >From the standpoint of generated code, the SAT'd definition is very often inferior and will be inverted by our selective lambda lifting pass, which runs late in the STG pipeline. So we don't even want to execute the SAT'd code, just inline it if we can! So we just attach an INLINABLE unfolding to a SAT'able function with the non-recursive SAT'd RHS. - - - - - 7e1fd0f7 by Sebastian Graf at 2020-12-02T00:31:35+01:00 Activate SAT with -O1 To see whether it breaks in CI and so on - - - - - 3 changed files: - compiler/GHC/Core/Opt/StaticArgs.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Driver/Session.hs Changes: ===================================== compiler/GHC/Core/Opt/StaticArgs.hs ===================================== @@ -31,6 +31,12 @@ map = /\ ab -> \f -> \xs -> let map' ys = case ys of Notice that for a compiler that uses lambda lifting this is useless as map' will be transformed back to what map was. +SG: We do selective lambda lifting, but only for code generation, as +an alternative to closure conversion. And when lambda lifting fires, it +makes sure it reduces allocation. The benefit of SAT is from being able +to specialise for static args and the resulting simplifications! If the +static arg is left unexploited, we actually end up with worse code. + We could possibly do the same for big lambdas, but we don't as they will eventually be removed in later stages of the compiler, therefore there is no penalty in keeping them. @@ -59,6 +65,8 @@ import GHC.Core import GHC.Core.Utils import GHC.Core.Type import GHC.Core.Coercion +import GHC.Core.SimpleOpt (defaultSimpleOpts) +import GHC.Core.Unfold.Make (mkInlinableUnfolding) import GHC.Types.Id import GHC.Types.Name import GHC.Types.Var.Env @@ -95,16 +103,23 @@ satBind (Rec [(binder, rhs)]) interesting_ids = do let interesting_ids' = interesting_ids `addOneToUniqSet` binder (rhs_binders, rhs_body) = collectBinders rhs (rhs_body', sat_info_rhs_body) <- satTopLevelExpr rhs_body interesting_ids' + -- The following two lines intersect the SATInfo from call sites with + -- the order of parameters from the *definition* (sat_info_rhs_from_args) + -- Ex: If we have the only call site @f a v@, but the defn of @f@ is + -- @f a b = ...@, then @a@ is a static arg, but @v@ is not. + -- TODO: better names!! let sat_info_rhs_from_args = unitVarEnv binder (bindersToSATInfo rhs_binders) sat_info_rhs' = mergeIdSATInfo sat_info_rhs_from_args sat_info_rhs_body + -- I don't think the following lines are effective at guarding against + -- shadowing: shadowing = binder `elementOfUniqSet` interesting_ids sat_info_rhs'' = if shadowing then sat_info_rhs' `delFromUFM` binder -- For safety else sat_info_rhs' - bind' <- saTransformMaybe binder (lookupUFM sat_info_rhs' binder) - rhs_binders rhs_body' + bind' <- saTransformUnfolding binder (lookupUFM sat_info_rhs' binder) + rhs_binders rhs_body' return (bind', sat_info_rhs'') satBind (Rec pairs) interesting_ids = do let (binders, rhss) = unzip pairs @@ -163,7 +178,7 @@ mergeIdSATInfo = plusUFM_C mergeSATInfo mergeIdSATInfos :: [IdSATInfo] -> IdSATInfo mergeIdSATInfos = foldl' mergeIdSATInfo emptyIdSATInfo -bindersToSATInfo :: [Id] -> SATInfo +bindersToSATInfo :: [Var] -> SATInfo bindersToSATInfo vs = map (Static . binderToApp) vs where binderToApp v | isId v = VarApp v | isTyVar v = TypeApp $ mkTyVarTy v @@ -271,6 +286,7 @@ newUnique = getUniqueM ************************************************************************ +SG: This is incomprehensible without giving the map example first. To do the transformation, the game plan is to: 1. Create a small nonrecursive RHS that takes the @@ -367,8 +383,8 @@ type argument. This is bad because it means the application sat_worker_s1aU x_a6 is not well typed. -} -saTransformMaybe :: Id -> Maybe SATInfo -> [Id] -> CoreExpr -> SatM CoreBind -saTransformMaybe binder maybe_arg_staticness rhs_binders rhs_body +_saTransformMaybe :: Id -> Maybe SATInfo -> [Id] -> CoreExpr -> SatM CoreBind +_saTransformMaybe binder maybe_arg_staticness rhs_binders rhs_body | Just arg_staticness <- maybe_arg_staticness , should_transform arg_staticness = saTransform binder arg_staticness rhs_binders rhs_body @@ -379,6 +395,17 @@ saTransformMaybe binder maybe_arg_staticness rhs_binders rhs_body where n_static_args = count isStaticValue staticness +saTransformUnfolding :: Id -> Maybe SATInfo -> [Id] -> CoreExpr -> SatM CoreBind +saTransformUnfolding binder maybe_arg_staticness rhs_binders rhs_body + | Just arg_staticness <- maybe_arg_staticness + , any isStatic arg_staticness + , not (isStableUnfolding (idUnfolding binder)) + = do { NonRec _binder' rhs' <- saTransform binder arg_staticness rhs_binders rhs_body + ; let binder' = binder `setIdUnfolding` mkInlinableUnfolding defaultSimpleOpts rhs' + ; return (Rec [(binder', mkLams rhs_binders rhs_body)]) } + | otherwise + = return (Rec [(binder, mkLams rhs_binders rhs_body)]) + saTransform :: Id -> SATInfo -> [Id] -> CoreExpr -> SatM CoreBind saTransform binder arg_staticness rhs_binders rhs_body = do { shadow_lam_bndrs <- mapM clone binders_w_staticness @@ -434,3 +461,7 @@ saTransform binder arg_staticness rhs_binders rhs_body isStaticValue :: Staticness App -> Bool isStaticValue (Static (VarApp _)) = True isStaticValue _ = False + +isStatic :: Staticness a -> Bool +isStatic (Static _) = True +isStatic _ = True ===================================== compiler/GHC/Core/SimpleOpt.hs ===================================== @@ -93,6 +93,11 @@ data SimpleOpts = SimpleOpts { so_uf_opts :: !UnfoldingOpts -- ^ Unfolding options , so_co_opts :: !OptCoercionOpts -- ^ Coercion optimiser options } +-- SG: I find the name "SimpleOpts" terrible. It's misleading in multiple ways: +-- You'd read it and mistake it for *Simpl*Opts, options for the Simplifier. +-- And you might mistake it for Simple*Opts*, simple options for ... what? +-- And then SimpleOptOpts would be less missleading, but ugly because OptOpts. +-- So why not SimpleOptConfig? -- | Default options for the Simple optimiser. defaultSimpleOpts :: SimpleOpts ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -4015,7 +4015,7 @@ optLevelFlags -- see Note [Documenting optimisation flags] , ([2], Opt_SpecConstr) -- , ([2], Opt_RegsGraph) -- RegsGraph suffers performance regression. See #7679 --- , ([2], Opt_StaticArgumentTransformation) + , ([1,2], Opt_StaticArgumentTransformation) -- Static Argument Transformation needs investigation. See #9374 ] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/380b0b257adda4c0a6f3c86ff57d9f5efb8497d2...7e1fd0f7ff638d5acc13bb84a11819c7fc4745b3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/380b0b257adda4c0a6f3c86ff57d9f5efb8497d2...7e1fd0f7ff638d5acc13bb84a11819c7fc4745b3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 2 00:57:50 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 01 Dec 2020 19:57:50 -0500 Subject: [Git][ghc/ghc][master] 4 commits: Move core flattening algorithm to Core.Unify Message-ID: <5fc6e68e72d59_86c3fc6ab83037c12740f8@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 72a87fbc by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Move core flattening algorithm to Core.Unify This sets the stage for a later change, where this algorithm will be needed from GHC.Core.InstEnv. This commit also splits GHC.Core.Map into GHC.Core.Map.Type and GHC.Core.Map.Expr, in order to avoid module import cycles with GHC.Core. - - - - - 0dd45d0a by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Bump the # of commits searched for perf baseline The previous value of 75 meant that a feature branch with more than 75 commits would get spurious CI passes. This affects #18692, but does not fix that ticket, because if a baseline cannot be found, we should fail, not succeed. - - - - - 8bb52d91 by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Remove flattening variables This patch redesigns the flattener to simplify type family applications directly instead of using flattening meta-variables and skolems. The key new innovation is the CanEqLHS type and the new CEqCan constraint (Ct). A CanEqLHS is either a type variable or exactly-saturated type family application; either can now be rewritten using a CEqCan constraint in the inert set. Because the flattener no longer reduces all type family applications to variables, there was some performance degradation if a lengthy type family application is now flattened over and over (not making progress). To compensate, this patch contains some extra optimizations in the flattener, leading to a number of performance improvements. Close #18875. Close #18910. There are many extra parts of the compiler that had to be affected in writing this patch: * The family-application cache (formerly the flat-cache) sometimes stores coercions built from Given inerts. When these inerts get kicked out, we must kick out from the cache as well. (This was, I believe, true previously, but somehow never caused trouble.) Kicking out from the cache requires adding a filterTM function to TrieMap. * This patch obviates the need to distinguish "blocking" coercion holes from non-blocking ones (which, previously, arose from CFunEqCans). There is thus some simplification around coercion holes. * Extra commentary throughout parts of the code I read through, to preserve the knowledge I gained while working. * A change in the pure unifier around unifying skolems with other types. Unifying a skolem now leads to SurelyApart, not MaybeApart, as documented in Note [Binding when looking up instances] in GHC.Core.InstEnv. * Some more use of MCoercion where appropriate. * Previously, class-instance lookup automatically noticed that e.g. C Int was a "unifier" to a target [W] C (F Bool), because the F Bool was flattened to a variable. Now, a little more care must be taken around checking for unifying instances. * Previously, tcSplitTyConApp_maybe would split (Eq a => a). This is silly, because (=>) is not a tycon in Haskell. Fixed now, but there are some knock-on changes in e.g. TrieMap code and in the canonicaliser. * New function anyFreeVarsOf{Type,Co} to check whether a free variable satisfies a certain predicate. * Type synonyms now remember whether or not they are "forgetful"; a forgetful synonym drops at least one argument. This is useful when flattening; see flattenView. * The pattern-match completeness checker invokes the solver. This invocation might need to look through newtypes when checking representational equality. Thus, the desugarer needs to keep track of the in-scope variables to know what newtype constructors are in scope. I bet this bug was around before but never noticed. * Extra-constraints wildcards are no longer simplified before printing. See Note [Do not simplify ConstraintHoles] in GHC.Tc.Solver. * Whether or not there are Given equalities has become slightly subtler. See the new HasGivenEqs datatype. * Note [Type variable cycles in Givens] in GHC.Tc.Solver.Canonical explains a significant new wrinkle in the new approach. * See Note [What might match later?] in GHC.Tc.Solver.Interact, which explains the fix to #18910. * The inert_count field of InertCans wasn't actually used, so I removed it. Though I (Richard) did the implementation, Simon PJ was very involved in design and review. This updates the Haddock submodule to avoid #18932 by adding a type signature. ------------------------- Metric Decrease: T12227 T5030 T9872a T9872b T9872c Metric Increase: T9872d ------------------------- - - - - - d66660ba by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Rename the flattener to become the rewriter. Now that flattening doesn't produce flattening variables, it's not really flattening anything: it's rewriting. This change also means that the rewriter can no longer be confused the core flattener (in GHC.Core.Unify), which is sometimes used during type-checking. - - - - - 30 changed files: - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Axiom.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FamInstEnv.hs - compiler/GHC/Core/InstEnv.hs - + compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Map.hs → compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/Opt/CSE.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/TyCon/Env.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/Maybe.hs - compiler/GHC/Data/TrieMap.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - compiler/GHC/HsToCore/Types.hs - compiler/GHC/Iface/Ext/Utils.hs - compiler/GHC/Stg/CSE.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Gen/Bind.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b94a65afe1e270245cd5b9fe03d59b726dfba8c4...d66660ba4c491f9937a1a959b009d90f08a4fbee -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b94a65afe1e270245cd5b9fe03d59b726dfba8c4...d66660ba4c491f9937a1a959b009d90f08a4fbee You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 2 00:58:26 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 01 Dec 2020 19:58:26 -0500 Subject: [Git][ghc/ghc][master] 5 commits: rts: Introduce mmapAnonForLinker Message-ID: <5fc6e6b2e0bdb_86c111d4a0012779ba@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: add0aeae by Ben Gamari at 2020-12-01T19:58:17-05:00 rts: Introduce mmapAnonForLinker Previously most of the uses of mmapForLinker were mapping anonymous memory, resulting in a great deal of unnecessary repetition. Factor this out into a new helper. Also fixes a few places where error checking was missing or suboptimal. - - - - - 97d71646 by Ben Gamari at 2020-12-01T19:58:17-05:00 rts/linker: Introduce munmapForLinker Consolidates munmap calls to ensure consistent error handling. - - - - - d8872af0 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/Linker: Introduce Windows implementations for mmapForLinker, et al. - - - - - c35d0e03 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/m32: Introduce NEEDS_M32 macro Instead of relying on RTS_LINKER_USE_MMAP - - - - - 41c64eb5 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/linker: Use m32 to allocate symbol extras in PEi386 - - - - - 10 changed files: - rts/Linker.c - rts/LinkerInternals.h - rts/linker/Elf.c - rts/linker/LoadArchive.c - rts/linker/M32Alloc.c - rts/linker/M32Alloc.h - rts/linker/MachO.c - rts/linker/PEi386.c - rts/linker/SymbolExtras.c - rts/linker/elf_got.c Changes: ===================================== rts/Linker.c ===================================== @@ -45,6 +45,8 @@ #include #endif +#include +#include #include #include #include @@ -1021,7 +1023,38 @@ resolveSymbolAddr (pathchar* buffer, int size, #endif /* OBJFORMAT_PEi386 */ } -#if RTS_LINKER_USE_MMAP +#if defined(mingw32_HOST_OS) + +// +// Returns NULL on failure. +// +void * +mmapAnonForLinker (size_t bytes) +{ + return VirtualAlloc(NULL, bytes, MEM_COMMIT | MEM_RESERVE, PAGE_READWRITE); +} + +void +munmapForLinker (void *addr, size_t bytes, const char *caller) +{ + if (VirtualFree(addr, 0, MEM_RELEASE) == 0) { + sysErrorBelch("munmapForLinker: %s: Failed to unmap %zd bytes at %p", + caller, bytes, addr); + } +} + +void +mmapForLinkerMarkExecutable(void *start, size_t len) +{ + DWORD old; + if (VirtualProtect(start, len, PAGE_EXECUTE_READ, &old) == 0) { + sysErrorBelch("mmapForLinkerMarkExecutable: failed to protect %zd bytes at %p", + len, start); + ASSERT(false); + } +} + +#elif RTS_LINKER_USE_MMAP // // Returns NULL on failure. // @@ -1080,7 +1113,7 @@ mmap_again: fixed = MAP_FIXED; goto mmap_again; #else - errorBelch("loadObj: failed to mmap() memory below 2Gb; " + errorBelch("mmapForLinker: failed to mmap() memory below 2Gb; " "asked for %lu bytes at %p. " "Try specifying an address with +RTS -xm -RTS", size, map_addr); @@ -1140,6 +1173,24 @@ mmap_again: return result; } +/* + * Map read/write pages in low memory. Returns NULL on failure. + */ +void * +mmapAnonForLinker (size_t bytes) +{ + return mmapForLinker (bytes, PROT_READ|PROT_WRITE, MAP_ANONYMOUS, -1, 0); +} + +void munmapForLinker (void *addr, size_t bytes, const char *caller) +{ + int r = munmap(addr, bytes); + if (r == -1) { + // Should we abort here? + sysErrorBelch("munmap: %s", caller); + } +} + /* Note [Memory protection in the linker] * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ * For many years the linker would simply map all of its memory @@ -1155,8 +1206,9 @@ mmap_again: * Note that the m32 allocator handles protection of its allocations. For this * reason the caller to m32_alloc() must tell the allocator whether the * allocation needs to be executable. The caller must then ensure that they - * call m32_flush() after they are finished filling the region, which will - * cause the allocator to change the protection bits to PROT_READ|PROT_EXEC. + * call m32_allocator_flush() after they are finished filling the region, which + * will cause the allocator to change the protection bits to + * PROT_READ|PROT_EXEC. * */ @@ -1225,7 +1277,7 @@ freePreloadObjectFile (ObjectCode *oc) #else if (RTS_LINKER_USE_MMAP && oc->imageMapped) { - munmap(oc->image, oc->fileSize); + munmapForLinker(oc->image, oc->fileSize, "freePreloadObjectFile"); } else { stgFree(oc->image); @@ -1273,13 +1325,15 @@ void freeObjectCode (ObjectCode *oc) switch(oc->sections[i].alloc){ #if RTS_LINKER_USE_MMAP case SECTION_MMAP: - munmap(oc->sections[i].mapped_start, - oc->sections[i].mapped_size); + munmapForLinker( + oc->sections[i].mapped_start, + oc->sections[i].mapped_size, + "freeObjectCode"); break; +#endif case SECTION_M32: // Freed by m32_allocator_free break; -#endif case SECTION_MALLOC: IF_DEBUG(zero_on_gc, memset(oc->sections[i].start, @@ -1322,7 +1376,7 @@ void freeObjectCode (ObjectCode *oc) ocDeinit_ELF(oc); #endif -#if RTS_LINKER_USE_MMAP == 1 +#if defined(NEED_M32) m32_allocator_free(oc->rx_m32); m32_allocator_free(oc->rw_m32); #endif @@ -1400,7 +1454,7 @@ mkOc( ObjectType type, pathchar *path, char *image, int imageSize, oc->mark = object_code_mark_bit; oc->dependencies = allocHashSet(); -#if RTS_LINKER_USE_MMAP +#if defined(NEED_M32) oc->rw_m32 = m32_allocator_new(false); oc->rx_m32 = m32_allocator_new(true); #endif @@ -1737,7 +1791,7 @@ int ocTryLoad (ObjectCode* oc) { // We have finished loading and relocating; flush the m32 allocators to // setup page protections. -#if RTS_LINKER_USE_MMAP +#if defined(NEED_M32) m32_allocator_flush(oc->rx_m32); m32_allocator_flush(oc->rw_m32); #endif @@ -2043,7 +2097,7 @@ void freeSegments (ObjectCode *oc) continue; } else { #if RTS_LINKER_USE_MMAP - CHECKM(0 == munmap(s->start, s->size), "freeSegments: failed to unmap memory"); + munmapForLinker(s->start, s->size, "freeSegments"); #else stgFree(s->start); #endif ===================================== rts/LinkerInternals.h ===================================== @@ -169,6 +169,14 @@ typedef struct _Segment { #define NEED_SYMBOL_EXTRAS 1 #endif +/* + * We use the m32 allocator for symbol extras on Windows and other mmap-using + * platforms. + */ +#if RTS_LINKER_USE_MMAP || defined(mingw32_HOST_ARCH) +#define NEED_M32 1 +#endif + /* Jump Islands are sniplets of machine code required for relative * address relocations on the PowerPC, x86_64 and ARM. */ @@ -300,7 +308,7 @@ struct _ObjectCode { require extra information.*/ StrHashTable *extraInfos; -#if RTS_LINKER_USE_MMAP == 1 +#if defined(NEED_M32) /* The m32 allocators used for allocating small sections and symbol extras * during loading. We have two: one for (writeable) data and one for * (read-only/executable) code. */ @@ -362,8 +370,10 @@ void exitLinker( void ); void freeObjectCode (ObjectCode *oc); SymbolAddr* loadSymbol(SymbolName *lbl, RtsSymbolInfo *pinfo); +void *mmapAnonForLinker (size_t bytes); void *mmapForLinker (size_t bytes, uint32_t prot, uint32_t flags, int fd, int offset); void mmapForLinkerMarkExecutable (void *start, size_t len); +void munmapForLinker (void *addr, size_t bytes, const char *caller); void addProddableBlock ( ObjectCode* oc, void* start, int size ); void checkProddableBlock (ObjectCode *oc, void *addr, size_t size ); ===================================== rts/linker/Elf.c ===================================== @@ -30,6 +30,7 @@ #include #include +#include #include #if defined(HAVE_SYS_STAT_H) #include @@ -714,7 +715,11 @@ ocGetNames_ELF ( ObjectCode* oc ) * address might be out of range for sections that are mmaped. */ alloc = SECTION_MMAP; - start = mmapForLinker(size, PROT_READ | PROT_WRITE, MAP_ANONYMOUS, -1, 0); + start = mmapAnonForLinker(size); + if (start == NULL) { + barf("failed to mmap memory for bss. " + "errno = %d", errno); + } mapped_start = start; mapped_offset = 0; mapped_size = roundUpToPage(size); @@ -756,9 +761,9 @@ ocGetNames_ELF ( ObjectCode* oc ) unsigned nstubs = numberOfStubsForSection(oc, i); unsigned stub_space = STUB_SIZE * nstubs; - void * mem = mmapForLinker(size+stub_space, PROT_READ | PROT_WRITE, MAP_ANON, -1, 0); + void * mem = mmapAnonForLinker(size+stub_space); - if( mem == MAP_FAILED ) { + if( mem == NULL ) { barf("failed to mmap allocated memory to load section %d. " "errno = %d", i, errno); } @@ -865,11 +870,10 @@ ocGetNames_ELF ( ObjectCode* oc ) } void * common_mem = NULL; if(common_size > 0) { - common_mem = mmapForLinker(common_size, - PROT_READ | PROT_WRITE, - MAP_ANON | MAP_PRIVATE, - -1, 0); - CHECK(common_mem != NULL); + common_mem = mmapAnonForLinker(common_size); + if (common_mem == NULL) { + barf("ocGetNames_ELF: Failed to allocate memory for SHN_COMMONs"); + } } //TODO: we ignore local symbols anyway right? So we can use the ===================================== rts/linker/LoadArchive.c ===================================== @@ -489,7 +489,7 @@ static HsInt loadArchive_ (pathchar *path) #if defined(darwin_HOST_OS) || defined(ios_HOST_OS) if (RTS_LINKER_USE_MMAP) - image = mmapForLinker(memberSize, PROT_READ | PROT_WRITE, MAP_ANONYMOUS, -1, 0); + image = mmapAnonForLinker(memberSize); else { /* See loadObj() */ misalignment = machoGetMisalignment(f); @@ -549,7 +549,7 @@ while reading filename from `%" PATH_FMT "'", path); } DEBUG_LOG("Found GNU-variant file index\n"); #if RTS_LINKER_USE_MMAP - gnuFileIndex = mmapForLinker(memberSize + 1, PROT_READ | PROT_WRITE, MAP_ANONYMOUS, -1, 0); + gnuFileIndex = mmapAnonForLinker(memberSize + 1); #else gnuFileIndex = stgMallocBytes(memberSize + 1, "loadArchive(image)"); #endif @@ -613,7 +613,7 @@ fail: stgFree(fileName); if (gnuFileIndex != NULL) { #if RTS_LINKER_USE_MMAP - munmap(gnuFileIndex, gnuFileIndexSize + 1); + munmapForLinker(gnuFileIndex, gnuFileIndexSize + 1, "loadArchive_"); #else stgFree(gnuFileIndex); #endif ===================================== rts/linker/M32Alloc.c ===================================== @@ -24,25 +24,25 @@ Note [Compile Time Trickery] This file implements two versions of each of the `m32_*` functions. At the top of the file there is the real implementation (compiled in when -`RTS_LINKER_USE_MMAP` is true) and a dummy implementation that exists only to +`NEED_M32` is true) and a dummy implementation that exists only to satisfy the compiler and which should never be called. If any of these dummy implementations are called the program will abort. The rationale for this is to allow the calling code to be written without using -the C pre-processor (CPP) `#if` hackery. The value of `RTS_LINKER_USE_MMAP` is -known at compile time, code like: +the C pre-processor (CPP) `#if` hackery. The value of `NEED_M32` is +known at compile time, allowing code like: - if (RTS_LINKER_USE_MMAP) + if (NEED_M32) m32_allocator_init(); -will be compiled to call to `m32_allocator_init` if `RTS_LINKER_USE_MMAP` is -true and will be optimised away to nothing if `RTS_LINKER_USE_MMAP` is false. -However, regardless of the value of `RTS_LINKER_USE_MMAP` the compiler will +will be compiled to call to `m32_allocator_init` if `NEED_M32` is +true and will be optimised away to nothing if `NEED_M32` is false. +However, regardless of the value of `NEED_M32` the compiler will still check the call for syntax and correct function parameter types. */ -#if RTS_LINKER_USE_MMAP == 1 +#if defined(NEED_M32) /* @@ -216,25 +216,6 @@ struct m32_page_t *m32_free_page_pool = NULL; unsigned int m32_free_page_pool_size = 0; // TODO -/** - * Wrapper for `unmap` that handles error cases. - * This is the real implementation. There is another dummy implementation below. - * See the note titled "Compile Time Trickery" at the top of this file. - */ -static void -munmapForLinker (void * addr, size_t size) -{ - IF_DEBUG(linker, - debugBelch("m32_alloc: Unmapping %zu bytes at %p\n", - size, addr)); - - int r = munmap(addr,size); - if (r == -1) { - // Should we abort here? - sysErrorBelch("munmap"); - } -} - /** * Free a page or, if possible, place it in the free page pool. */ @@ -246,7 +227,7 @@ m32_release_page(struct m32_page_t *page) m32_free_page_pool = page; m32_free_page_pool_size ++; } else { - munmapForLinker((void *) page, getPageSize()); + munmapForLinker((void *) page, getPageSize(), "m32_release_page"); } } @@ -263,8 +244,8 @@ m32_alloc_page(void) * pages. */ const size_t pgsz = getPageSize(); - char *chunk = mmapForLinker(pgsz * M32_MAP_PAGES, PROT_READ | PROT_WRITE, MAP_ANONYMOUS, -1, 0); - if (chunk > (char *) 0xffffffff) { + uint8_t *chunk = mmapAnonForLinker(pgsz * M32_MAP_PAGES); + if (chunk > (uint8_t *) 0xffffffff) { barf("m32_alloc_page: failed to get allocation in lower 32-bits"); } @@ -309,7 +290,7 @@ m32_allocator_unmap_list(struct m32_page_t *head) { while (head != NULL) { struct m32_page_t *next = m32_filled_page_get_next(head); - munmapForLinker((void *) head, head->filled_page.size); + munmapForLinker((void *) head, head->filled_page.size, "m32_allocator_unmap_list"); head = next; } } @@ -327,7 +308,7 @@ void m32_allocator_free(m32_allocator *alloc) const size_t pgsz = getPageSize(); for (int i=0; i < M32_MAX_PAGES; i++) { if (alloc->pages[i]) { - munmapForLinker(alloc->pages[i], pgsz); + munmapForLinker(alloc->pages[i], pgsz, "m32_allocator_free"); } } @@ -407,7 +388,14 @@ m32_alloc(struct m32_allocator_t *alloc, size_t size, size_t alignment) if (m32_is_large_object(size,alignment)) { // large object size_t alsize = ROUND_UP(sizeof(struct m32_page_t), alignment); - struct m32_page_t *page = mmapForLinker(alsize+size, PROT_READ | PROT_WRITE, MAP_ANONYMOUS,-1,0); + struct m32_page_t *page = mmapAnonForLinker(alsize+size); + if (page == NULL) { + sysErrorBelch("m32_alloc: Failed to map pages for %zd bytes", size); + return NULL; + } else if (page > (struct m32_page_t *) 0xffffffff) { + debugBelch("m32_alloc: warning: Allocation of %zd bytes resulted in pages above 4GB (%p)", + size, page); + } page->filled_page.size = alsize + size; m32_allocator_push_filled_list(&alloc->unprotected_list, (struct m32_page_t *) page); return (char*) page + alsize; @@ -460,7 +448,7 @@ m32_alloc(struct m32_allocator_t *alloc, size_t size, size_t alignment) return (char*)page + ROUND_UP(sizeof(struct m32_page_t),alignment); } -#elif RTS_LINKER_USE_MMAP == 0 +#else // The following implementations of these functions should never be called. If // they are, there is a bug at the call site. @@ -491,8 +479,4 @@ m32_alloc(m32_allocator *alloc STG_UNUSED, barf("%s: RTS_LINKER_USE_MMAP is %d", __func__, RTS_LINKER_USE_MMAP); } -#else - -#error RTS_LINKER_USE_MMAP should be either `0` or `1`. - #endif ===================================== rts/linker/M32Alloc.h ===================================== @@ -8,19 +8,17 @@ #pragma once -#if RTS_LINKER_USE_MMAP == 1 -#include -#include - -#if defined(HAVE_UNISTD_H) -#include -#endif - +/* + * We use the m32 allocator for symbol extras on Windows and other mmap-using + * platforms. + */ +#if RTS_LINKER_USE_MMAP || defined(mingw32_HOST_OS) +#define NEED_M32 1 #endif #include "BeginPrivate.h" -#if RTS_LINKER_USE_MMAP +#if defined(NEED_M32) #define M32_NO_RETURN /* Nothing */ #else #define M32_NO_RETURN GNUC3_ATTRIBUTE(__noreturn__) ===================================== rts/linker/MachO.c ===================================== @@ -507,11 +507,8 @@ makeGot(ObjectCode * oc) { if(got_slots > 0) { oc->info->got_size = got_slots * sizeof(void*); - oc->info->got_start = mmapForLinker(oc->info->got_size, - PROT_READ | PROT_WRITE, - MAP_ANON | MAP_PRIVATE, - -1, 0); - if( oc->info->got_start == MAP_FAILED ) { + oc->info->got_start = mmapAnonForLinker(oc->info->got_size); + if( oc->info->got_start == NULL ) { barf("MAP_FAILED. errno=%d", errno ); return EXIT_FAILURE; } @@ -528,7 +525,7 @@ makeGot(ObjectCode * oc) { void freeGot(ObjectCode * oc) { - munmap(oc->info->got_start, oc->info->got_size); + munmapForLinker(oc->info->got_start, oc->info->got_size, "freeGot"); oc->info->got_start = NULL; oc->info->got_size = 0; } @@ -1113,7 +1110,7 @@ ocBuildSegments_MachO(ObjectCode *oc) return 1; } - mem = mmapForLinker(size_compound, PROT_READ | PROT_WRITE, MAP_ANON, -1, 0); + mem = mmapAnonForLinker(size_compound); if (NULL == mem) return 0; IF_DEBUG(linker, debugBelch("ocBuildSegments: allocating %d segments\n", n_activeSegments)); ===================================== rts/linker/PEi386.c ===================================== @@ -1788,42 +1788,28 @@ ocGetNames_PEi386 ( ObjectCode* oc ) bool ocAllocateExtras_PEi386 ( ObjectCode* oc ) { - /* If the ObjectCode was unloaded we don't need a trampoline, it's likely - an import library so we're discarding it earlier. */ - if (!oc->info) - return false; + /* If the ObjectCode was unloaded we don't need a trampoline, it's likely + an import library so we're discarding it earlier. */ + if (!oc->info) + return false; - const int mask = default_alignment - 1; - size_t origin = oc->info->trampoline; - oc->symbol_extras - = (SymbolExtra*)((uintptr_t)(oc->info->image + origin + mask) & ~mask); - oc->first_symbol_extra = 0; - COFF_HEADER_INFO *info = oc->info->ch_info; - oc->n_symbol_extras = info->numberOfSymbols; + // These are allocated on-demand from m32 by makeSymbolExtra_PEi386 + oc->first_symbol_extra = 0; + oc->n_symbol_extras = 0; + oc->symbol_extras = NULL; - return true; + return true; } static size_t -makeSymbolExtra_PEi386( ObjectCode* oc, uint64_t index, size_t s, char* symbol ) +makeSymbolExtra_PEi386( ObjectCode* oc, uint64_t index STG_UNUSED, size_t s, char* symbol STG_UNUSED ) { - unsigned int curr_thunk; - SymbolExtra *extra; - curr_thunk = oc->first_symbol_extra + index; - if (index >= oc->n_symbol_extras) { - IF_DEBUG(linker, debugBelch("makeSymbolExtra first:%d, num:%lu, member:%" PATH_FMT ", index:%llu\n", curr_thunk, oc->n_symbol_extras, oc->archiveMemberName, index)); - barf("Can't allocate thunk for `%s' in `%" PATH_FMT "' with member `%" PATH_FMT "'", symbol, oc->fileName, oc->archiveMemberName); - } - - extra = oc->symbol_extras + curr_thunk; + SymbolExtra *extra = m32_alloc(oc->rx_m32, sizeof(SymbolExtra), 8); - if (!extra->addr) - { - // jmp *-14(%rip) - static uint8_t jmp[] = { 0xFF, 0x25, 0xF2, 0xFF, 0xFF, 0xFF }; - extra->addr = (uint64_t)s; - memcpy(extra->jumpIsland, jmp, 6); - } + // jmp *-14(%rip) + static uint8_t jmp[] = { 0xFF, 0x25, 0xF2, 0xFF, 0xFF, 0xFF }; + extra->addr = (uint64_t)s; + memcpy(extra->jumpIsland, jmp, 6); return (size_t)extra->jumpIsland; } ===================================== rts/linker/SymbolExtras.c ===================================== @@ -81,11 +81,11 @@ int ocAllocateExtras(ObjectCode* oc, int count, int first, int bssSize) // symbol_extras is aligned to a page boundary so it can be mprotect'd. bssSize = roundUpToPage(bssSize); size_t allocated_size = n + bssSize + extras_size; - void *new = mmapForLinker(allocated_size, PROT_READ | PROT_WRITE, MAP_ANONYMOUS, -1, 0); + void *new = mmapAnonForLinker(allocated_size); if (new) { memcpy(new, oc->image, oc->fileSize); if (oc->imageMapped) { - munmap(oc->image, n); + munmapForLinker(oc->image, n, "ocAllocateExtras"); } oc->image = new; oc->imageMapped = true; ===================================== rts/linker/elf_got.c ===================================== @@ -48,11 +48,8 @@ makeGot(ObjectCode * oc) { } if(got_slots > 0) { oc->info->got_size = got_slots * sizeof(void *); - void * mem = mmapForLinker(oc->info->got_size, - PROT_READ | PROT_WRITE, - MAP_ANON | MAP_PRIVATE, - -1, 0); - if (mem == MAP_FAILED) { + void * mem = mmapAnonForLinker(oc->info->got_size); + if (mem == NULL) { errorBelch("MAP_FAILED. errno=%d", errno); return EXIT_FAILURE; } @@ -147,7 +144,7 @@ verifyGot(ObjectCode * oc) { void freeGot(ObjectCode * oc) { -// munmap(oc->info->got_start, oc->info->got_size); +// munmapForLinker(oc->info->got_start, oc->info->got_size, "freeGot); oc->info->got_start = 0x0; oc->info->got_size = 0; } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d66660ba4c491f9937a1a959b009d90f08a4fbee...41c64eb5db50c80e110e47b7ab1c1ee18dada46b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d66660ba4c491f9937a1a959b009d90f08a4fbee...41c64eb5db50c80e110e47b7ab1c1ee18dada46b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 2 01:16:53 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Tue, 01 Dec 2020 20:16:53 -0500 Subject: [Git][ghc/ghc][wip/T18962] 2 commits: SAT: Attach SAT'd definition as INLINABLE unfolding Message-ID: <5fc6eb051efd6_86c879fa9c1278969@gitlab.mail> Sebastian Graf pushed to branch wip/T18962 at Glasgow Haskell Compiler / GHC Commits: db633a78 by Sebastian Graf at 2020-12-02T02:16:45+01:00 SAT: Attach SAT'd definition as INLINABLE unfolding SAT is most beneficial if we can specialise a recursive function for the static arguments at a call site by inlining it. >From the standpoint of generated code, the SAT'd definition is very often inferior and will be inverted by our selective lambda lifting pass, which runs late in the STG pipeline. So we don't even want to execute the SAT'd code, just inline it if we can! So we just attach an INLINABLE unfolding to a SAT'able function with the non-recursive SAT'd RHS. - - - - - 1822f12a by Sebastian Graf at 2020-12-02T02:16:45+01:00 Activate SAT with -O1 To see whether it breaks in CI and so on - - - - - 3 changed files: - compiler/GHC/Core/Opt/StaticArgs.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Driver/Session.hs Changes: ===================================== compiler/GHC/Core/Opt/StaticArgs.hs ===================================== @@ -31,6 +31,12 @@ map = /\ ab -> \f -> \xs -> let map' ys = case ys of Notice that for a compiler that uses lambda lifting this is useless as map' will be transformed back to what map was. +SG: We do selective lambda lifting, but only for code generation, as +an alternative to closure conversion. And when lambda lifting fires, it +makes sure it reduces allocation. The benefit of SAT is from being able +to specialise for static args and the resulting simplifications! If the +static arg is left unexploited, we actually end up with worse code. + We could possibly do the same for big lambdas, but we don't as they will eventually be removed in later stages of the compiler, therefore there is no penalty in keeping them. @@ -59,6 +65,8 @@ import GHC.Core import GHC.Core.Utils import GHC.Core.Type import GHC.Core.Coercion +import GHC.Core.SimpleOpt (defaultSimpleOpts) +import GHC.Core.Unfold.Make (mkInlinableUnfolding) import GHC.Types.Id import GHC.Types.Name import GHC.Types.Var.Env @@ -95,16 +103,23 @@ satBind (Rec [(binder, rhs)]) interesting_ids = do let interesting_ids' = interesting_ids `addOneToUniqSet` binder (rhs_binders, rhs_body) = collectBinders rhs (rhs_body', sat_info_rhs_body) <- satTopLevelExpr rhs_body interesting_ids' + -- The following two lines intersect the SATInfo from call sites with + -- the order of parameters from the *definition* (sat_info_rhs_from_args) + -- Ex: If we have the only call site @f a v@, but the defn of @f@ is + -- @f a b = ...@, then @a@ is a static arg, but @v@ is not. + -- TODO: better names!! let sat_info_rhs_from_args = unitVarEnv binder (bindersToSATInfo rhs_binders) sat_info_rhs' = mergeIdSATInfo sat_info_rhs_from_args sat_info_rhs_body + -- I don't think the following lines are effective at guarding against + -- shadowing: shadowing = binder `elementOfUniqSet` interesting_ids sat_info_rhs'' = if shadowing then sat_info_rhs' `delFromUFM` binder -- For safety else sat_info_rhs' - bind' <- saTransformMaybe binder (lookupUFM sat_info_rhs' binder) - rhs_binders rhs_body' + bind' <- saTransformUnfolding binder (lookupUFM sat_info_rhs' binder) + rhs_binders rhs_body' return (bind', sat_info_rhs'') satBind (Rec pairs) interesting_ids = do let (binders, rhss) = unzip pairs @@ -163,7 +178,7 @@ mergeIdSATInfo = plusUFM_C mergeSATInfo mergeIdSATInfos :: [IdSATInfo] -> IdSATInfo mergeIdSATInfos = foldl' mergeIdSATInfo emptyIdSATInfo -bindersToSATInfo :: [Id] -> SATInfo +bindersToSATInfo :: [Var] -> SATInfo bindersToSATInfo vs = map (Static . binderToApp) vs where binderToApp v | isId v = VarApp v | isTyVar v = TypeApp $ mkTyVarTy v @@ -271,6 +286,7 @@ newUnique = getUniqueM ************************************************************************ +SG: This is incomprehensible without giving the map example first. To do the transformation, the game plan is to: 1. Create a small nonrecursive RHS that takes the @@ -367,8 +383,8 @@ type argument. This is bad because it means the application sat_worker_s1aU x_a6 is not well typed. -} -saTransformMaybe :: Id -> Maybe SATInfo -> [Id] -> CoreExpr -> SatM CoreBind -saTransformMaybe binder maybe_arg_staticness rhs_binders rhs_body +_saTransformMaybe :: Id -> Maybe SATInfo -> [Id] -> CoreExpr -> SatM CoreBind +_saTransformMaybe binder maybe_arg_staticness rhs_binders rhs_body | Just arg_staticness <- maybe_arg_staticness , should_transform arg_staticness = saTransform binder arg_staticness rhs_binders rhs_body @@ -379,6 +395,17 @@ saTransformMaybe binder maybe_arg_staticness rhs_binders rhs_body where n_static_args = count isStaticValue staticness +saTransformUnfolding :: Id -> Maybe SATInfo -> [Id] -> CoreExpr -> SatM CoreBind +saTransformUnfolding binder maybe_arg_staticness rhs_binders rhs_body + | Just arg_staticness <- maybe_arg_staticness + , any isStaticValue arg_staticness + , not (isStableUnfolding (idUnfolding binder)) + = do { NonRec _binder' rhs' <- saTransform binder arg_staticness rhs_binders rhs_body + ; let binder' = binder `setIdUnfolding` mkInlinableUnfolding defaultSimpleOpts rhs' + ; return (Rec [(binder', mkLams rhs_binders rhs_body)]) } + | otherwise + = return (Rec [(binder, mkLams rhs_binders rhs_body)]) + saTransform :: Id -> SATInfo -> [Id] -> CoreExpr -> SatM CoreBind saTransform binder arg_staticness rhs_binders rhs_body = do { shadow_lam_bndrs <- mapM clone binders_w_staticness ===================================== compiler/GHC/Core/SimpleOpt.hs ===================================== @@ -93,6 +93,11 @@ data SimpleOpts = SimpleOpts { so_uf_opts :: !UnfoldingOpts -- ^ Unfolding options , so_co_opts :: !OptCoercionOpts -- ^ Coercion optimiser options } +-- SG: I find the name "SimpleOpts" terrible. It's misleading in multiple ways: +-- You'd read it and mistake it for *Simpl*Opts, options for the Simplifier. +-- And you might mistake it for Simple*Opts*, simple options for ... what? +-- And then SimpleOptOpts would be less missleading, but ugly because OptOpts. +-- So why not SimpleOptConfig? -- | Default options for the Simple optimiser. defaultSimpleOpts :: SimpleOpts ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -4015,7 +4015,7 @@ optLevelFlags -- see Note [Documenting optimisation flags] , ([2], Opt_SpecConstr) -- , ([2], Opt_RegsGraph) -- RegsGraph suffers performance regression. See #7679 --- , ([2], Opt_StaticArgumentTransformation) + , ([1,2], Opt_StaticArgumentTransformation) -- Static Argument Transformation needs investigation. See #9374 ] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7e1fd0f7ff638d5acc13bb84a11819c7fc4745b3...1822f12a313da30fed1cca513a7c26c8620aaeb5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7e1fd0f7ff638d5acc13bb84a11819c7fc4745b3...1822f12a313da30fed1cca513a7c26c8620aaeb5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 2 05:04:47 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 02 Dec 2020 00:04:47 -0500 Subject: [Git][ghc/ghc] Deleted branch wip/tsan-ghc-8.10 Message-ID: <5fc7206fe66f4_86c3fc6ab857f4412871c0@gitlab.mail> Ben Gamari deleted branch wip/tsan-ghc-8.10 at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 2 05:04:49 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 02 Dec 2020 00:04:49 -0500 Subject: [Git][ghc/ghc][ghc-8.10] 78 commits: SMP.h: Add C11-style atomic operations Message-ID: <5fc7207176c01_86cf57456812873a@gitlab.mail> Ben Gamari pushed to branch ghc-8.10 at Glasgow Haskell Compiler / GHC Commits: 3e418e85 by Ben Gamari at 2020-12-01T12:48:52-05:00 SMP.h: Add C11-style atomic operations - - - - - e11cdee8 by Ben Gamari at 2020-12-01T12:48:53-05:00 rts: Infrastructure for testing with ThreadSanitizer - - - - - 0420a914 by Ben Gamari at 2020-12-01T12:48:53-05:00 rts/CNF: Initialize all bdescrs in group It seems wise and cheap to ensure that the whole bdescr of all blocks of a compact group is valid, even if most cases only look at the flags field. - - - - - 3fc4f18c by Ben Gamari at 2020-12-01T12:48:53-05:00 rts/Capability: Intialize interrupt field Previously this was left uninitialized. Also clarify some comments. - - - - - 0db05bae by Ben Gamari at 2020-12-01T12:48:53-05:00 rts/Task: Make comments proper Notes - - - - - 92beeb48 by Ben Gamari at 2020-12-01T12:48:53-05:00 rts/SpinLock: Move to proper atomics This is fairly straightforward; we just needed to use relaxed operations for the PROF_SPIN counters and a release store instead of a write barrier. - - - - - ca5adbeb by Ben Gamari at 2020-12-01T12:48:53-05:00 rts/OSThreads: Fix data race Previously we would race on the cached processor count. Avoiding this is straightforward; just use relaxed operations. - - - - - b76a4cb3 by Ben Gamari at 2020-12-01T12:48:53-05:00 rts/ClosureMaros: Use relaxed atomics - - - - - 42603f7b by Ben Gamari at 2020-12-01T12:48:53-05:00 testsuite: Fix thread leak in hs_try_putmvar00[13] - - - - - 31cc96ac by Ben Gamari at 2020-12-01T12:48:53-05:00 rts: Introduce SET_HDR_RELEASE Also ensure that we also store the info table pointer last to ensure that the synchronization covers all stores. - - - - - f5474698 by Ben Gamari at 2020-12-01T12:48:53-05:00 rts: Factor out logic to identify a good capability for running a task Not only does this make the control flow a bit clearer but it also allows us to add a TSAN suppression on this logic, which requires (harmless) data races. - - - - - e56161d7 by Ben Gamari at 2020-12-01T12:48:53-05:00 rts: Annotate benign race in waitForCapability - - - - - 67a18092 by Ben Gamari at 2020-12-01T12:48:53-05:00 rts: Clarify locking behavior of releaseCapability_ - - - - - eed7218e by Ben Gamari at 2020-12-01T12:48:53-05:00 rts: Add assertions for task ownership of capabilities - - - - - b4ea5341 by Ben Gamari at 2020-12-01T12:48:53-05:00 rts: Use relaxed atomics on n_returning_tasks This mitigates the warning of a benign race on n_returning_tasks in shouldYieldCapability. See #17261. - - - - - 2220752f by Ben Gamari at 2020-12-01T12:48:53-05:00 rts: Mitigate races in capability interruption logic - - - - - 444e6476 by Ben Gamari at 2020-12-01T12:48:53-05:00 rts/Capability: Use relaxed operations for last_free_capability - - - - - 3c626d75 by Ben Gamari at 2020-12-01T12:48:53-05:00 rts: Use relaxed operations for cap->running_task (TODO) This shouldn't be necessary since only the owning thread of the capability should be touching this. - - - - - efa866e6 by Ben Gamari at 2020-12-01T12:48:53-05:00 rts/Schedule: Use relaxed operations for sched_state - - - - - a12ce9ad by Ben Gamari at 2020-12-01T12:48:53-05:00 rts: Accept data race in work-stealing implementation This race is okay since the task is owned by the capability pushing it. By Note [Ownership of Task] this means that the capability is free to write to `task->cap` without taking `task->lock`. Fixes #17276. - - - - - eaf108c8 by Ben Gamari at 2020-12-01T12:48:53-05:00 rts: Eliminate data races on pending_sync - - - - - 2398fea7 by Ben Gamari at 2020-12-01T12:48:53-05:00 rts/Schedule: Eliminate data races on recent_activity We cannot safely use relaxed atomics here. - - - - - 7f2bacf5 by Ben Gamari at 2020-12-01T12:48:53-05:00 rts: Avoid data races in message handling - - - - - cd94f7bf by Ben Gamari at 2020-12-01T12:48:53-05:00 rts/Messages: Drop incredibly fishy write barrier executeMessage previously had a write barrier at the beginning of its loop apparently in an attempt to synchronize with another thread's writes to the Message. I would guess that the author had intended to use a load barrier here given that there are no globally-visible writes done in executeMessage. I've removed the redundant barrier since the necessary load barrier is now provided by the ACQUIRE_LOAD. - - - - - 2f5e1853 by Ben Gamari at 2020-12-01T12:48:53-05:00 rts/ThreadPaused: Avoid data races - - - - - 9600e424 by Ben Gamari at 2020-12-01T12:48:53-05:00 rts/Schedule: Eliminate data races in run queue management - - - - - 7e84329b by Ben Gamari at 2020-12-01T12:48:53-05:00 rts: Eliminate shutdown data race on task counters - - - - - 061611c9 by Ben Gamari at 2020-12-01T12:48:53-05:00 rts/Threads: Avoid data races (TODO) Replace barriers with appropriate ordering. Drop redundant barrier in tryWakeupThread (the RELEASE barrier will be provided by sendMessage's mutex release). We use relaxed operations on why_blocked and the stack although it's not clear to me why this is necessary. - - - - - 99c5e53a by Ben Gamari at 2020-12-01T12:48:53-05:00 rts/Messages: Annotate benign race - - - - - 88644055 by Ben Gamari at 2020-12-01T12:48:53-05:00 rts/RaiseAsync: Synchronize what_next read - - - - - 20a89e98 by Ben Gamari at 2020-12-01T12:48:53-05:00 rts/Task: Move debugTrace to avoid data race Specifically, we need to hold all_tasks_mutex to read taskCount. - - - - - aebe5c4d by Ben Gamari at 2020-12-01T12:48:53-05:00 Disable flawed assertion - - - - - 914196db by Ben Gamari at 2020-12-01T12:48:53-05:00 Document schedulePushWork race - - - - - 68e93f4d by Ben Gamari at 2020-12-01T12:48:53-05:00 Capabiliity: Properly fix data race on n_returning_tasks There is a real data race but can be made safe by using proper atomic (but relaxed) accesses. - - - - - 0ad7e4fe by Ben Gamari at 2020-12-01T12:48:53-05:00 rts: Make write of to_cap->inbox atomic This is necessary since emptyInbox may read from to_cap->inbox without taking cap->lock. - - - - - f4fa413d by Ben Gamari at 2020-12-01T12:48:53-05:00 gitlab-ci: Add nightly-x86_64-linux-deb9-tsan job - - - - - aa2dc3a6 by GHC GitLab CI at 2020-12-01T12:48:53-05:00 testsuite: Mark setnumcapabilities001 as broken with TSAN Due to #18808. - - - - - d29d1d59 by GHC GitLab CI at 2020-12-01T12:48:53-05:00 testsuite: Skip divbyzero and derefnull under TSAN ThreadSanitizer changes the output of these tests. - - - - - db69bfe9 by Ben Gamari at 2020-12-01T12:48:54-05:00 testsuite: Skip high memory usage tests with TSAN ThreadSanitizer significantly increases the memory footprint of tests, so much so that it can send machines into OOM. - - - - - 7dbf4140 by Ben Gamari at 2020-12-01T12:48:54-05:00 testsuite: Mark hie002 as high_memory_usage This test has a peak residency of 1GByte; this is large enough to classify as "high" in my book. - - - - - 80019b4d by Ben Gamari at 2020-12-01T12:48:54-05:00 testsuite: Mark T9872[abc] as high_memory_usage These all have a maximum residency of over 2 GB. - - - - - cbc7e06d by Ben Gamari at 2020-12-01T12:48:54-05:00 gitlab-ci: Disable documentation in TSAN build Haddock chews through enough memory to cause the CI builders to OOM and there's frankly no reason to build documentation in this job anyways. - - - - - fcd68815 by Ben Gamari at 2020-12-01T12:48:54-05:00 TSANUtils: Ensure that C11 atomics are supported - - - - - f966c105 by Ben Gamari at 2020-12-01T12:48:54-05:00 testsuite: Mark T3807 as broken with TSAN Due to #18883. - - - - - 38a0ede0 by Ben Gamari at 2020-12-01T12:48:54-05:00 testsuite: Mark T13702 as broken with TSAN due to #18884 - - - - - 571a13e8 by Ben Gamari at 2020-12-01T12:48:54-05:00 rts/BlockAlloc: Use relaxed operations - - - - - 2ecc5693 by Ben Gamari at 2020-12-01T12:48:54-05:00 rts: Rework handling of mutlist scavenging statistics - - - - - 78a5bdff by Ben Gamari at 2020-12-01T12:48:54-05:00 rts: Avoid data races in StablePtr implementation This fixes two potentially problematic data races in the StablePtr implementation: * We would fail to RELEASE the stable pointer table when enlarging it, causing other cores to potentially see uninitialized memory. * We would fail to ACQUIRE when dereferencing a stable pointer. - - - - - a191f6d5 by Ben Gamari at 2020-12-01T12:48:54-05:00 rts/Storage: Use atomics - - - - - 7d4d0751 by Ben Gamari at 2020-12-01T12:48:54-05:00 rts/Updates: Use proper atomic operations - - - - - afdc79e8 by Ben Gamari at 2020-12-01T12:48:54-05:00 rts/Weak: Eliminate data races By taking all_tasks_mutex in stat_exit. Also better-document the fact that the task statistics are protected by all_tasks_mutex. - - - - - 2e3a9399 by Ben Gamari at 2020-12-01T12:48:54-05:00 rts/GC: Use atomics - - - - - c6855d59 by Ben Gamari at 2020-12-01T12:48:54-05:00 rts: Use RELEASE ordering in unlockClosure - - - - - 84cf7ed6 by Ben Gamari at 2020-12-01T12:48:54-05:00 rts/Storage: Accept races on heap size counters - - - - - f9480f50 by Ben Gamari at 2020-12-01T12:48:54-05:00 rts: Join to concurrent mark thread during shutdown Previously we would take all capabilities but fail to join on the thread itself, potentially resulting in a leaked thread. - - - - - 0ea9a980 by GHC GitLab CI at 2020-12-01T12:48:54-05:00 rts: Fix race in GC CPU time accounting Ensure that the GC leader synchronizes with workers before calling stat_endGC. - - - - - e97ed920 by Ben Gamari at 2020-12-01T12:48:54-05:00 rts/SpinLock: Separate out slow path Not only is this in general a good idea, but it turns out that GCC unrolls the retry loop, resulting is massive code bloat in critical parts of the RTS (e.g. `evacuate`). - - - - - e0bf6738 by Ben Gamari at 2020-12-01T12:48:54-05:00 rts: Use relaxed ordering on spinlock counters - - - - - 48054cf2 by Ben Gamari at 2020-12-01T12:48:54-05:00 rts: Annotate hopefully "benign" races in freeGroup - - - - - dddd97ec by Ben Gamari at 2020-12-01T12:48:54-05:00 Strengthen ordering in releaseGCThreads - - - - - bfe39b7f by Ben Gamari at 2020-12-01T12:48:54-05:00 rts/WSDeque: Rewrite with proper atomics After a few attempts at shoring up the previous implementation, I ended up turning to the literature and now use the proven implementation, > N.M. Lê, A. Pop, A.Cohen, and F.Z. Nardelli. "Correct and Efficient > Work-Stealing for Weak Memory Models". PPoPP'13, February 2013, > ACM 978-1-4503-1922/13/02. Note only is this approach formally proven correct under C11 semantics but it is also proved to be a bit faster in practice. - - - - - f9ed0fd2 by Ben Gamari at 2020-12-01T12:48:54-05:00 rts: Use relaxed atomics for whitehole spin stats - - - - - 211af4a1 by Ben Gamari at 2020-12-01T12:48:54-05:00 rts: Avoid lock order inversion during fork Fixes #17275. - - - - - 7131d341 by GHC GitLab CI at 2020-12-01T12:48:54-05:00 rts: Use proper relaxe operations in getCurrentThreadCPUTime Here we are doing lazy initialization; it's okay if we do the check more than once, hence relaxed operation is fine. - - - - - 20178cde by Ben Gamari at 2020-12-01T12:48:54-05:00 rts/STM: Use atomics This fixes a potentially harmful race where we failed to synchronize before looking at a TVar's current_value. Also did a bit of refactoring to avoid abstract over management of max_commits. - - - - - 8894b402 by Ben Gamari at 2020-12-01T12:48:54-05:00 rts/stm: Strengthen orderings to SEQ_CST instead of volatile Previously the `current_value`, `first_watch_queue_entry`, and `num_updates` fields of `StgTVar` were marked as `volatile` in an attempt to provide strong ordering. Of course, this isn't sufficient. We now use proper atomic operations. In most of these cases I strengthen the ordering all the way to SEQ_CST although it's possible that some could be weakened with some thought. - - - - - 81a9029b by Ben Gamari at 2020-12-01T12:48:54-05:00 Mitigate data races in event manager startup/shutdown - - - - - 9801d049 by Ben Gamari at 2020-12-01T12:48:54-05:00 Suppress data race due to close This suppresses the other side of a race during shutdown. - - - - - 9b5bd302 by Ben Gamari at 2020-12-01T12:48:54-05:00 rts: Accept benign races in Proftimer - - - - - 25b9c7f9 by Ben Gamari at 2020-12-01T12:48:54-05:00 rts: Pause timer while changing capability count This avoids #17289. - - - - - a433c908 by Ben Gamari at 2020-12-01T12:48:54-05:00 Fix #17289 - - - - - 2161aed8 by Ben Gamari at 2020-12-01T12:48:54-05:00 suppress #17289 (ticker) race - - - - - c93f11fe by Ben Gamari at 2020-12-01T12:48:54-05:00 rts: Fix timer initialization Previously `initScheduler` would attempt to pause the ticker and in so doing acquire the ticker mutex. However, initTicker, which is responsible for initializing said mutex, hadn't been called yet. - - - - - 1ada18d2 by Ben Gamari at 2020-12-01T12:48:54-05:00 rts: Fix races in Pthread timer backend shudown We can generally be pretty relaxed in the barriers here since the timer thread is a loop. - - - - - d315985a by Ben Gamari at 2020-12-01T12:48:54-05:00 rts/Stats: Hide a few unused unnecessarily global functions - - - - - 953de20f by Ben Gamari at 2020-12-01T12:48:55-05:00 rts/Stats: Protect with mutex While on face value this seems a bit heavy, I think it's far better than enforcing ordering on every access. - - - - - 9ad6e1f1 by Ben Gamari at 2020-12-01T12:48:55-05:00 rts: Tear down stats_mutex after exitHeapProfiling Since the latter wants to call getRTSStats. - - - - - 0f28389c by Ben Gamari at 2020-12-01T12:48:55-05:00 rts/Stats: Reintroduce mut_user_time Fix the previous backport; this function was dead code in master but is still needed due to ProfHeap.c in ghc-8.10. - - - - - 30 changed files: - .gitlab-ci.yml - hadrian/hadrian.cabal - hadrian/src/Flavour.hs - hadrian/src/Settings.hs - + hadrian/src/Settings/Flavours/ThreadSanitizer.hs - includes/Rts.h - includes/rts/OSThreads.h - includes/rts/SpinLock.h - includes/rts/StablePtr.h - + includes/rts/TSANUtils.h - includes/rts/storage/ClosureMacros.h - includes/rts/storage/Closures.h - includes/rts/storage/GC.h - includes/stg/SMP.h - libraries/base/GHC/Event/Control.hs - + rts/.tsan-suppressions - rts/Capability.c - rts/Capability.h - rts/Messages.c - rts/Proftimer.c - rts/RaiseAsync.c - rts/RtsStartup.c - rts/SMPClosureOps.h - rts/STM.c - rts/Schedule.c - rts/Schedule.h - rts/Sparks.c - + rts/SpinLock.c - rts/StablePtr.c - rts/Stats.c The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/65ed2fdca2e0d0e8f3535b31f94dcdc1424e5cf2...0f28389c783a54a74c472f176c250ddf7a9c4bf4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/65ed2fdca2e0d0e8f3535b31f94dcdc1424e5cf2...0f28389c783a54a74c472f176c250ddf7a9c4bf4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 2 12:31:29 2020 From: gitlab at gitlab.haskell.org (Andreas Klebinger) Date: Wed, 02 Dec 2020 07:31:29 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/andreask/bump_time Message-ID: <5fc78921e6e91_86c1574150c132332d@gitlab.mail> Andreas Klebinger pushed new branch wip/andreask/bump_time at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/andreask/bump_time You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 2 14:11:58 2020 From: gitlab at gitlab.haskell.org (Andreas Klebinger) Date: Wed, 02 Dec 2020 09:11:58 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/andreask/ppr_foreign_labels Message-ID: <5fc7a0aeac9ea_86cf574568133715e@gitlab.mail> Andreas Klebinger pushed new branch wip/andreask/ppr_foreign_labels at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/andreask/ppr_foreign_labels You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 2 16:18:55 2020 From: gitlab at gitlab.haskell.org (John Ericson) Date: Wed, 02 Dec 2020 11:18:55 -0500 Subject: [Git][ghc/ghc][wip/primop-naming-consistency] 33 commits: withTimings: Emit allocations counter Message-ID: <5fc7be6fab0eb_86c3fc69b8e147013458cc@gitlab.mail> John Ericson pushed to branch wip/primop-naming-consistency at Glasgow Haskell Compiler / GHC Commits: 1bc104b0 by Ben Gamari at 2020-11-29T15:33:18-05:00 withTimings: Emit allocations counter This will allow us to back out the allocations per compiler pass from the eventlog. Note that we dump the allocation counter rather than the difference since this will allow us to determine how much work is done *between* `withTiming` blocks. - - - - - e992ea84 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 ThreadPaused: Don't zero slop until free vars are pushed When threadPaused blackholes a thunk it calls `OVERWRITING_CLOSURE` to zero the slop for the benefit of the sanity checker. Previously this was done *before* pushing the thunk's free variables to the update remembered set. Consequently we would pull zero'd pointers to the update remembered set. - - - - - e82cd140 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Fix regression from TSAN work The TSAN rework (specifically aad1f803) introduced a subtle regression in GC.c, swapping `g0` in place of `gen`. Whoops! Fixes #18997. - - - - - 35a5207e by GHC GitLab CI at 2020-11-29T15:33:54-05:00 rts/Messages: Add missing write barrier in THROWTO message update After a THROWTO message has been handle the message closure is overwritten by a NULL message. We must ensure that the original closure's pointers continue to be visible to the nonmoving GC. - - - - - 0120829f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Add missing write barrier in shrinkSmallByteArray - - - - - 8a4d8fb6 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 Updates: Don't zero slop until closure has been pushed Ensure that the the free variables have been pushed to the update remembered set before we zero the slop. - - - - - 2793cfdc by GHC GitLab CI at 2020-11-29T15:33:54-05:00 OSThreads: Fix error code checking pthread_join returns its error code and apparently doesn't set errno. - - - - - e391a16f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Don't join to mark_thread on shutdown The mark thread is not joinable as we detach from it on creation. - - - - - 60d088ab by Ben Gamari at 2020-11-29T15:33:54-05:00 nonmoving: Add reference to Ueno 2016 - - - - - 3aa60362 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Ensure that evacuated large objects are marked See Note [Non-moving GC: Marking evacuated objects]. - - - - - 8d304a99 by Ben Gamari at 2020-11-30T10:15:22-05:00 rts/m32: Refactor handling of allocator seeding Previously, in an attempt to reduce fragmentation, each new allocator would map a region of M32_MAX_PAGES fresh pages to seed itself. However, this ends up being extremely wasteful since it turns out that we often use fewer than this. Consequently, these pages end up getting freed which, ends up fragmenting our address space more than than we would have if we had naively allocated pages on-demand. Here we refactor m32 to avoid this waste while achieving the fragmentation mitigation previously desired. In particular, we move all page allocation into the global m32_alloc_page, which will pull a page from the free page pool. If the free page pool is empty we then refill it by allocating a region of M32_MAP_PAGES and adding them to the pool. Furthermore, we do away with the initial seeding entirely. That is, the allocator starts with no active pages: pages are rather allocated on an as-needed basis. On the whole this ends up being a pleasingly simple change, simultaneously making m32 more efficient, more robust, and simpler. Fixes #18980. - - - - - b6629289 by Ben Gamari at 2020-11-30T10:15:58-05:00 rts: Use CHECK instead of assert Use the GHC wrappers instead of <assert.h>. - - - - - 9f4efa6a by Ben Gamari at 2020-11-30T10:15:58-05:00 rts/linker: Replace some ASSERTs with CHECK In the past some people have confused ASSERT, which is for checking internal invariants, which CHECK, which should be used when checking things that might fail due to bad input (and therefore should be enabled even in the release compiler). Change some of these cases in the linker to use CHECK. - - - - - 0f8a4655 by Ryan Scott at 2020-11-30T10:16:34-05:00 Allow deploy:pages job to fail See #18973. - - - - - 49ebe369 by chessai at 2020-11-30T19:47:40-05:00 Optimisations in Data.Foldable (T17867) This PR concerns the following functions from `Data.Foldable`: * minimum * maximum * sum * product * minimumBy * maximumBy - Default implementations of these functions now use `foldl'` or `foldMap'`. - All have been marked with INLINEABLE to make room for further optimisations. - - - - - 4d79ef65 by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - 6af074ce by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - ab334262 by Viktor Dukhovni at 2020-11-30T19:48:17-05:00 dirty MVAR after mutating TSO queue head While the original head and tail of the TSO queue may be in the same generation as the MVAR, interior elements of the queue could be younger after a GC run and may then be exposed by putMVar operation that updates the queue head. Resolves #18919 - - - - - 5eb163f3 by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Don't allow shared libraries to be loaded multiple times - - - - - 490aa14d by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Initialise CCSs from native shared objects - - - - - 6ac3db5f by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Move shared library loading logic into Elf.c - - - - - b6698d73 by GHC GitLab CI at 2020-11-30T19:48:53-05:00 rts/linker: Don't declare dynamic objects with image_mapped This previously resulted in warnings due to spurious unmap failures. - - - - - b94a65af by jneira at 2020-11-30T19:49:31-05:00 Include tried paths in findToolDir error - - - - - 72a87fbc by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Move core flattening algorithm to Core.Unify This sets the stage for a later change, where this algorithm will be needed from GHC.Core.InstEnv. This commit also splits GHC.Core.Map into GHC.Core.Map.Type and GHC.Core.Map.Expr, in order to avoid module import cycles with GHC.Core. - - - - - 0dd45d0a by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Bump the # of commits searched for perf baseline The previous value of 75 meant that a feature branch with more than 75 commits would get spurious CI passes. This affects #18692, but does not fix that ticket, because if a baseline cannot be found, we should fail, not succeed. - - - - - 8bb52d91 by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Remove flattening variables This patch redesigns the flattener to simplify type family applications directly instead of using flattening meta-variables and skolems. The key new innovation is the CanEqLHS type and the new CEqCan constraint (Ct). A CanEqLHS is either a type variable or exactly-saturated type family application; either can now be rewritten using a CEqCan constraint in the inert set. Because the flattener no longer reduces all type family applications to variables, there was some performance degradation if a lengthy type family application is now flattened over and over (not making progress). To compensate, this patch contains some extra optimizations in the flattener, leading to a number of performance improvements. Close #18875. Close #18910. There are many extra parts of the compiler that had to be affected in writing this patch: * The family-application cache (formerly the flat-cache) sometimes stores coercions built from Given inerts. When these inerts get kicked out, we must kick out from the cache as well. (This was, I believe, true previously, but somehow never caused trouble.) Kicking out from the cache requires adding a filterTM function to TrieMap. * This patch obviates the need to distinguish "blocking" coercion holes from non-blocking ones (which, previously, arose from CFunEqCans). There is thus some simplification around coercion holes. * Extra commentary throughout parts of the code I read through, to preserve the knowledge I gained while working. * A change in the pure unifier around unifying skolems with other types. Unifying a skolem now leads to SurelyApart, not MaybeApart, as documented in Note [Binding when looking up instances] in GHC.Core.InstEnv. * Some more use of MCoercion where appropriate. * Previously, class-instance lookup automatically noticed that e.g. C Int was a "unifier" to a target [W] C (F Bool), because the F Bool was flattened to a variable. Now, a little more care must be taken around checking for unifying instances. * Previously, tcSplitTyConApp_maybe would split (Eq a => a). This is silly, because (=>) is not a tycon in Haskell. Fixed now, but there are some knock-on changes in e.g. TrieMap code and in the canonicaliser. * New function anyFreeVarsOf{Type,Co} to check whether a free variable satisfies a certain predicate. * Type synonyms now remember whether or not they are "forgetful"; a forgetful synonym drops at least one argument. This is useful when flattening; see flattenView. * The pattern-match completeness checker invokes the solver. This invocation might need to look through newtypes when checking representational equality. Thus, the desugarer needs to keep track of the in-scope variables to know what newtype constructors are in scope. I bet this bug was around before but never noticed. * Extra-constraints wildcards are no longer simplified before printing. See Note [Do not simplify ConstraintHoles] in GHC.Tc.Solver. * Whether or not there are Given equalities has become slightly subtler. See the new HasGivenEqs datatype. * Note [Type variable cycles in Givens] in GHC.Tc.Solver.Canonical explains a significant new wrinkle in the new approach. * See Note [What might match later?] in GHC.Tc.Solver.Interact, which explains the fix to #18910. * The inert_count field of InertCans wasn't actually used, so I removed it. Though I (Richard) did the implementation, Simon PJ was very involved in design and review. This updates the Haddock submodule to avoid #18932 by adding a type signature. ------------------------- Metric Decrease: T12227 T5030 T9872a T9872b T9872c Metric Increase: T9872d ------------------------- - - - - - d66660ba by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Rename the flattener to become the rewriter. Now that flattening doesn't produce flattening variables, it's not really flattening anything: it's rewriting. This change also means that the rewriter can no longer be confused the core flattener (in GHC.Core.Unify), which is sometimes used during type-checking. - - - - - add0aeae by Ben Gamari at 2020-12-01T19:58:17-05:00 rts: Introduce mmapAnonForLinker Previously most of the uses of mmapForLinker were mapping anonymous memory, resulting in a great deal of unnecessary repetition. Factor this out into a new helper. Also fixes a few places where error checking was missing or suboptimal. - - - - - 97d71646 by Ben Gamari at 2020-12-01T19:58:17-05:00 rts/linker: Introduce munmapForLinker Consolidates munmap calls to ensure consistent error handling. - - - - - d8872af0 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/Linker: Introduce Windows implementations for mmapForLinker, et al. - - - - - c35d0e03 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/m32: Introduce NEEDS_M32 macro Instead of relying on RTS_LINKER_USE_MMAP - - - - - 41c64eb5 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/linker: Use m32 to allocate symbol extras in PEi386 - - - - - 409bbd76 by John Ericson at 2020-12-02T16:12:04+00:00 Cleanup number primop conversion names Don't use "extend" or "narrow" in some of the user-facing primops names for conversions. - Names like `narrowInt32#` are misleading when `Int` is 32-bits. - Names like `extendInt64#` are flat-out wrong when `Int is 32-bits. - `narrow{Int,Word}<N>#` however map a type to itself, and so don't suffer from this problem. They are left as-is. Bumps the array, bytestring, text, and binary submodules - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Axiom.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FamInstEnv.hs - compiler/GHC/Core/InstEnv.hs - + compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Map.hs → compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/Opt/CSE.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/TyCon/Env.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/Maybe.hs - compiler/GHC/Data/TrieMap.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - compiler/GHC/HsToCore/Types.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a1ac041835e2c6aa4a4e10727015a6c0604360e7...409bbd76fbc3182ca5f004f8ba54f2767721dad3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a1ac041835e2c6aa4a4e10727015a6c0604360e7...409bbd76fbc3182ca5f004f8ba54f2767721dad3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 2 16:19:37 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Wed, 02 Dec 2020 11:19:37 -0500 Subject: [Git][ghc/ghc][wip/T18891] 110 commits: rts/linker: Fix relocation overflow in PE linker Message-ID: <5fc7be999e5d2_86c3fc6ab857f4413479ac@gitlab.mail> Simon Peyton Jones pushed to branch wip/T18891 at Glasgow Haskell Compiler / GHC Commits: d445cf05 by Ben Gamari at 2020-11-10T10:26:20-05:00 rts/linker: Fix relocation overflow in PE linker Previously the overflow check for the IMAGE_REL_AMD64_ADDR32NB relocation failed to account for the signed nature of the value. Specifically, the overflow check was: uint64_t v; v = S + A; if (v >> 32) { ... } However, `v` ultimately needs to fit into 32-bits as a signed value. Consequently, values `v > 2^31` in fact overflow yet this is not caught by the existing overflow check. Here we rewrite the overflow check to rather ensure that `INT32_MIN <= v <= INT32_MAX`. There is now quite a bit of repetition between the `IMAGE_REL_AMD64_REL32` and `IMAGE_REL_AMD64_ADDR32` cases but I am leaving fixing this for future work. This bug was first noticed by @awson. Fixes #15808. - - - - - 4c407f6e by Sylvain Henry at 2020-11-10T10:27:00-05:00 Export SPEC from GHC.Exts (#13681) - - - - - 7814cd5b by David Eichmann at 2020-11-10T10:27:35-05:00 ghc-heap: expose decoding from heap representation Co-authored-by: Sven Tennie <sven.tennie at gmail.com> Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> Co-authored-by: Ben Gamari <bgamari.foss at gmail.com> - - - - - fa344d33 by Richard Eisenberg at 2020-11-10T10:28:10-05:00 Add test case for #17186. This got fixed sometime recently; not worth it trying to figure out which commit. - - - - - 2e63a0fb by David Eichmann at 2020-11-10T10:28:46-05:00 Add code comments for StgInfoTable and StgStack structs - - - - - fcfda909 by Ben Gamari at 2020-11-11T03:19:59-05:00 nativeGen: Make makeImportsDoc take an NCGConfig rather than DynFlags It appears this was an oversight as there is no reason the full DynFlags is necessary. - - - - - 6e23695e by Ben Gamari at 2020-11-11T03:19:59-05:00 Move this_module into NCGConfig In various places in the NCG we need the Module currently being compiled. Let's move this into the environment instead of chewing threw another register. - - - - - c6264a2d by Ben Gamari at 2020-11-11T03:20:00-05:00 codeGen: Produce local symbols for module-internal functions It turns out that some important native debugging/profiling tools (e.g. perf) rely only on symbol tables for function name resolution (as opposed to using DWARF DIEs). However, previously GHC would emit temporary symbols (e.g. `.La42b`) to identify module-internal entities. Such symbols are dropped during linking and therefore not visible to runtime tools (in addition to having rather un-helpful unique names). For instance, `perf report` would often end up attributing all cost to the libc `frame_dummy` symbol since Haskell code was no covered by any proper symbol (see #17605). We now rather follow the model of C compilers and emit descriptively-named local symbols for module internal things. Since this will increase object file size this behavior can be disabled with the `-fno-expose-internal-symbols` flag. With this `perf record` can finally be used against Haskell executables. Even more, with `-g3` `perf annotate` provides inline source code. - - - - - 584058dd by Ben Gamari at 2020-11-11T03:20:00-05:00 Enable -fexpose-internal-symbols when debug level >=2 This seems like a reasonable default as the object file size increases by around 5%. - - - - - c34a4b98 by Ömer Sinan Ağacan at 2020-11-11T03:20:35-05:00 Fix and enable object unloading in GHCi Fixes #16525 by tracking dependencies between object file symbols and marking symbol liveness during garbage collection See Note [Object unloading] in CheckUnload.c for details. - - - - - 2782487f by Ray Shih at 2020-11-11T03:20:35-05:00 Add loadNativeObj and unloadNativeObj (This change is originally written by niteria) This adds two functions: * `loadNativeObj` * `unloadNativeObj` and implements them for Linux. They are useful if you want to load a shared object with Haskell code using the system linker and have GHC call dlclose() after the code is no longer referenced from the heap. Using the system linker allows you to load the shared object above outside the low-mem region. It also loads the DWARF sections in a way that `perf` understands. `dl_iterate_phdr` is what makes this implementation Linux specific. - - - - - 7a65f9e1 by GHC GitLab CI at 2020-11-11T03:20:35-05:00 rts: Introduce highMemDynamic - - - - - e9e1b2e7 by GHC GitLab CI at 2020-11-11T03:20:35-05:00 Introduce test for dynamic library unloading This uses the highMemDynamic flag introduced earlier to verify that dynamic objects are properly unloaded. - - - - - 5506f134 by Krzysztof Gogolewski at 2020-11-11T03:21:14-05:00 Force argument in setIdMult (#18925) - - - - - 787e93ae by Ben Gamari at 2020-11-11T23:14:11-05:00 testsuite: Add testcase for #18733 - - - - - 5353fd50 by Ben Gamari at 2020-11-12T10:05:30-05:00 compiler: Fix recompilation checking In ticket #18733 we noticed a rather serious deficiency in the current fingerprinting logic for recursive groups. I have described the old fingerprinting story and its problems in Note [Fingerprinting recursive groups] and have reworked the story accordingly to avoid these issues. Fixes #18733. - - - - - 63fa3997 by Sebastian Graf at 2020-11-13T14:29:39-05:00 Arity: Rework `ArityType` to fix monotonicity (#18870) As we found out in #18870, `andArityType` is not monotone, with potentially severe consequences for termination of fixed-point iteration. That showed in an abundance of "Exciting arity" DEBUG messages that are emitted whenever we do more than one step in fixed-point iteration. The solution necessitates also recording `OneShotInfo` info for `ABot` arity type. Thus we get the following definition for `ArityType`: ``` data ArityType = AT [OneShotInfo] Divergence ``` The majority of changes in this patch are the result of refactoring use sites of `ArityType` to match the new definition. The regression test `T18870` asserts that we indeed don't emit any DEBUG output anymore for a function where we previously would have. Similarly, there's a regression test `T18937` for #18937, which we expect to be broken for now. Fixes #18870. - - - - - 197d59fa by Sebastian Graf at 2020-11-13T14:29:39-05:00 Arity: Emit "Exciting arity" warning only after second iteration (#18937) See Note [Exciting arity] why we emit the warning at all and why we only do after the second iteration now. Fixes #18937. - - - - - de7ec9dd by David Eichmann at 2020-11-13T14:30:16-05:00 Add rts_listThreads and rts_listMiscRoots to RtsAPI.h These are used to find the current roots of the garbage collector. Co-authored-by: Sven Tennie's avatarSven Tennie <sven.tennie at gmail.com> Co-authored-by: Matthew Pickering's avatarMatthew Pickering <matthewtpickering at gmail.com> Co-authored-by: default avatarBen Gamari <bgamari.foss at gmail.com> - - - - - 24a86f09 by Ben Gamari at 2020-11-13T14:30:51-05:00 gitlab-ci: Cache cabal store in linting job - - - - - 0a7e592c by Ben Gamari at 2020-11-15T03:35:45-05:00 nativeGen/dwarf: Fix procedure end addresses Previously the `.debug_aranges` and `.debug_info` (DIE) DWARF information would claim that procedures (represented with a `DW_TAG_subprogram` DIE) would only span the range covered by their entry block. This omitted all of the continuation blocks (represented by `DW_TAG_lexical_block` DIEs), confusing `perf`. Fix this by introducing a end-of-procedure label and using this as the `DW_AT_high_pc` of procedure `DW_TAG_subprogram` DIEs Fixes #17605. - - - - - 1e19183d by Ben Gamari at 2020-11-15T03:35:45-05:00 nativeGen/dwarf: Only produce DW_AT_source_note DIEs in -g3 Standard debugging tools don't know how to understand these so let's not produce them unless asked. - - - - - ad73370f by Ben Gamari at 2020-11-15T03:35:45-05:00 nativeGen/dwarf: Use DW_AT_linkage instead of DW_AT_MIPS_linkage - - - - - a2539650 by Ben Gamari at 2020-11-15T03:35:45-05:00 gitlab-ci: Add DWARF release jobs for Debian 10, Fedora27 - - - - - d61adb3d by Ryan Scott at 2020-11-15T03:36:21-05:00 Name (tc)SplitForAll- functions more consistently There is a zoo of `splitForAll-` functions in `GHC.Core.Type` (as well as `tcSplitForAll-` functions in `GHC.Tc.Utils.TcType`) that all do very similar things, but vary in the particular form of type variable that they return. To make things worse, the names of these functions are often quite misleading. Some particularly egregious examples: * `splitForAllTys` returns `TyCoVar`s, but `splitSomeForAllTys` returns `VarBndr`s. * `splitSomeForAllTys` returns `VarBndr`s, but `tcSplitSomeForAllTys` returns `TyVar`s. * `splitForAllTys` returns `TyCoVar`s, but `splitForAllTysInvis` returns `InvisTVBinder`s. (This in particular arose in the context of #18939, and this finally motivated me to bite the bullet and improve the status quo vis-à-vis how we name these functions.) In an attempt to bring some sanity to how these functions are named, I have opted to rename most of these functions en masse to use consistent suffixes that describe the particular form of type variable that each function returns. In concrete terms, this amounts to: * Functions that return a `TyVar` now use the suffix `-TyVar`. This caused the following functions to be renamed: * `splitTyVarForAllTys` -> `splitForAllTyVars` * `splitForAllTy_ty_maybe` -> `splitForAllTyVar_maybe` * `tcSplitForAllTys` -> `tcSplitForAllTyVars` * `tcSplitSomeForAllTys` -> `tcSplitSomeForAllTyVars` * Functions that return a `CoVar` now use the suffix `-CoVar`. This caused the following functions to be renamed: * `splitForAllTy_co_maybe` -> `splitForAllCoVar_maybe` * Functions that return a `TyCoVar` now use the suffix `-TyCoVar`. This caused the following functions to be renamed: * `splitForAllTy` -> `splitForAllTyCoVar` * `splitForAllTys` -> `splitForAllTyCoVars` * `splitForAllTys'` -> `splitForAllTyCoVars'` * `splitForAllTy_maybe` -> `splitForAllTyCoVar_maybe` * Functions that return a `VarBndr` now use the suffix corresponding to the most relevant type synonym. This caused the following functions to be renamed: * `splitForAllVarBndrs` -> `splitForAllTyCoVarBinders` * `splitForAllTysInvis` -> `splitForAllInvisTVBinders` * `splitForAllTysReq` -> `splitForAllReqTVBinders` * `splitSomeForAllTys` -> `splitSomeForAllTyCoVarBndrs` * `tcSplitForAllVarBndrs` -> `tcSplitForAllTyVarBinders` * `tcSplitForAllTysInvis` -> `tcSplitForAllInvisTVBinders` * `tcSplitForAllTysReq` -> `tcSplitForAllReqTVBinders` * `tcSplitForAllTy_maybe` -> `tcSplitForAllTyVarBinder_maybe` Note that I left the following functions alone: * Functions that split apart things besides `ForAllTy`s, such as `splitFunTys` or `splitPiTys`. Thankfully, there are far fewer of these functions than there are functions that split apart `ForAllTy`s, so there isn't much of a pressing need to apply the new naming convention elsewhere. * Functions that split apart `ForAllCo`s in `Coercion`s, such as `GHC.Core.Coercion.splitForAllCo_maybe`. We could theoretically apply the new naming convention here, but then we'd have to figure out how to disambiguate `Type`-splitting functions from `Coercion`-splitting functions. Ultimately, the `Coercion`-splitting functions aren't used nearly as much as the `Type`-splitting functions, so I decided to leave the former alone. This is purely refactoring and should cause no change in behavior. - - - - - 645444af by Ryan Scott at 2020-11-15T03:36:21-05:00 Use tcSplitForAllInvisTyVars (not tcSplitForAllTyVars) in more places The use of `tcSplitForAllTyVars` in `tcDataFamInstHeader` was the immediate cause of #18939, and replacing it with a new `tcSplitForAllInvisTyVars` function (which behaves like `tcSplitForAllTyVars` but only splits invisible type variables) fixes the issue. However, this led me to realize that _most_ uses of `tcSplitForAllTyVars` in GHC really ought to be `tcSplitForAllInvisTyVars` instead. While I was in town, I opted to replace most uses of `tcSplitForAllTys` with `tcSplitForAllTysInvis` to reduce the likelihood of such bugs in the future. I say "most uses" above since there is one notable place where we _do_ want to use `tcSplitForAllTyVars`: in `GHC.Tc.Validity.forAllTyErr`, which produces the "`Illegal polymorphic type`" error message if you try to use a higher-rank `forall` without having `RankNTypes` enabled. Here, we really do want to split all `forall`s, not just invisible ones, or we run the risk of giving an inaccurate error message in the newly added `T18939_Fail` test case. I debated at some length whether I wanted to name the new function `tcSplitForAllInvisTyVars` or `tcSplitForAllTyVarsInvisible`, but in the end, I decided that I liked the former better. For consistency's sake, I opted to rename the existing `splitPiTysInvisible` and `splitPiTysInvisibleN` functions to `splitInvisPiTys` and `splitPiTysInvisN`, respectively, so that they use the same naming convention. As a consequence, this ended up requiring a `haddock` submodule bump. Fixes #18939. - - - - - 8887102f by Moritz Angermann at 2020-11-15T03:36:56-05:00 AArch64/arm64 adjustments This addes the necessary logic to support aarch64 on elf, as well as aarch64 on mach-o, which Apple calls arm64. We change architecture name to AArch64, which is the official arm naming scheme. - - - - - fc644b1a by Ben Gamari at 2020-11-15T03:37:31-05:00 ghc-bin: Build with eventlogging by default We now have all sorts of great facilities using the eventlog which were previously unavailable without building a custom GHC. Fix this by linking with `-eventlog` by default. - - - - - 52114fa0 by Sylvain Henry at 2020-11-16T11:48:47+01:00 Add Addr# atomic primops (#17751) This reuses the codegen used for ByteArray#'s atomic primops. - - - - - 8150f654 by Sebastian Graf at 2020-11-18T23:38:40-05:00 PmCheck: Print types of uncovered patterns (#18932) In order to avoid confusion as in #18932, we display the type of the match variables in the non-exhaustiveness warning, e.g. ``` T18932.hs:14:1: warning: [-Wincomplete-patterns] Pattern match(es) are non-exhaustive In an equation for ‘g’: Patterns of type ‘T a’, ‘T a’, ‘T a’ not matched: (MkT2 _) (MkT1 _) (MkT1 _) (MkT2 _) (MkT1 _) (MkT2 _) (MkT2 _) (MkT2 _) (MkT1 _) (MkT2 _) (MkT2 _) (MkT2 _) ... | 14 | g (MkT1 x) (MkT1 _) (MkT1 _) = x | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ``` It also allows us to omit the type signature on wildcard matches which we previously showed in only some situations, particularly `-XEmptyCase`. Fixes #18932. - - - - - 165352a2 by Krzysztof Gogolewski at 2020-11-20T02:08:36-05:00 Export indexError from GHC.Ix (#18579) - - - - - b57845c3 by Kamil Dworakowski at 2020-11-20T02:09:16-05:00 Clarify interruptible FFI wrt masking state - - - - - 321d1bd8 by Sebastian Graf at 2020-11-20T02:09:51-05:00 Fix strictness signatures of `prefetchValue*#` primops Their strictness signatures said the primops are strict in their first argument, which is wrong: Handing it a thunk will prefetch the pointer to the thunk, but not evaluate it. Hence not strict. The regression test `T8256` actually tests for laziness in the first argument, so GHC apparently never exploited the strictness signature. See also https://gitlab.haskell.org/ghc/ghc/-/issues/8256#note_310867, where this came up. - - - - - 0aec78b6 by Sebastian Graf at 2020-11-20T02:09:51-05:00 Demand: Interleave usage and strictness demands (#18903) As outlined in #18903, interleaving usage and strictness demands not only means a more compact demand representation, but also allows us to express demands that we weren't easily able to express before. Call demands are *relative* in the sense that a call demand `Cn(cd)` on `g` says "`g` is called `n` times. *Whenever `g` is called*, the result is used according to `cd`". Example from #18903: ```hs h :: Int -> Int h m = let g :: Int -> (Int,Int) g 1 = (m, 0) g n = (2 * n, 2 `div` n) {-# NOINLINE g #-} in case m of 1 -> 0 2 -> snd (g m) _ -> uncurry (+) (g m) ``` Without the interleaved representation, we would just get `L` for the strictness demand on `g`. Now we are able to express that whenever `g` is called, its second component is used strictly in denoting `g` by `1C1(P(1P(U),SP(U)))`. This would allow Nested CPR to unbox the division, for example. Fixes #18903. While fixing regressions, I also discovered and fixed #18957. Metric Decrease: T13253-spj - - - - - 3a55b3a2 by Sebastian Graf at 2020-11-20T02:09:51-05:00 Update user's guide entry on demand analysis and worker/wrapper The demand signature notation has been undocumented for a long time. The only source to understand it, apart from reading the `Outputable` instance, has been an outdated wiki page. Since the previous commits have reworked the demand lattice, I took it as an opportunity to also write some documentation about notation. - - - - - fc963932 by Greg Steuck at 2020-11-20T02:10:31-05:00 Find hadrian location more reliably in cabal-install output Fix #18944 - - - - - 9f40cf6c by Ben Gamari at 2020-11-20T02:11:07-05:00 rts/linker: Align bssSize to page size when mapping symbol extras We place symbol_extras right after bss. We also need to ensure that symbol_extras can be mprotect'd independently from the rest of the image. To ensure this we round up the size of bss to a page boundary, thus ensuring that symbol_extras is also page-aligned. - - - - - b739c319 by Ben Gamari at 2020-11-20T02:11:43-05:00 gitlab-ci: Add usage message to ci.sh - - - - - 802e9180 by Ben Gamari at 2020-11-20T02:11:43-05:00 gitlab-ci: Add VERBOSE environment variable And change the make build system's default behavior to V=0, greatly reducing build log sizes. - - - - - 2a8a979c by Ben Gamari at 2020-11-21T01:13:26-05:00 users-guide: A bit of clean-up in profiling flag documentation - - - - - 56804e33 by Ben Gamari at 2020-11-21T01:13:26-05:00 testsuite: Refactor CountParserDeps - - - - - 53ad67ea by Ben Gamari at 2020-11-21T01:13:26-05:00 Introduce -fprof-callers flag This introducing a new compiler flag to provide a convenient way to introduce profiler cost-centers on all occurrences of the named identifier. Closes #18566. - - - - - ecfd0278 by Sylvain Henry at 2020-11-21T01:14:09-05:00 Move Plugins into HscEnv (#17957) Loaded plugins have nothing to do in DynFlags so this patch moves them into HscEnv (session state). "DynFlags plugins" become "Driver plugins" to still be able to register static plugins. Bump haddock submodule - - - - - 72f2257c by Sylvain Henry at 2020-11-21T01:14:09-05:00 Don't initialize plugins in the Core2Core pipeline Some plugins can be added via TH (cf addCorePlugin). Initialize them in the driver instead of in the Core2Core pipeline. - - - - - ddbeeb3c by Ryan Scott at 2020-11-21T01:14:44-05:00 Add regression test for #10504 This issue was fixed at some point between GHC 8.0 and 8.2. Let's add a regression test to ensure that it stays fixed. Fixes #10504. - - - - - a4a6dc2a by Ben Gamari at 2020-11-21T01:15:21-05:00 dwarf: Apply info table offset consistently Previously we failed to apply the info table offset to the aranges and DIEs, meaning that we often failed to unwind in gdb. For some reason this only seemed to manifest in the RTS's Cmm closures. Nevertheless, now we can unwind completely up to `main` - - - - - 69bfbc21 by Ben Gamari at 2020-11-21T01:15:56-05:00 hadrian: Disable stripping when debug information is enabled - - - - - 7e93ae8b by Ben Gamari at 2020-11-21T13:13:29-05:00 rts: Post ticky entry counts to the eventlog We currently only post the entry counters, not the other global counters as in my experience the former are more useful. We use the heap profiler's census period to decide when to dump. Also spruces up the documentation surrounding ticky-ticky a bit. - - - - - bc9c3916 by Ben Gamari at 2020-11-22T06:28:10-05:00 Implement -ddump-c-backend argument To dump output of the C backend. - - - - - 901bc220 by Ben Gamari at 2020-11-22T12:39:02-05:00 Bump time submodule to 1.11.1 Also bumps directory, Cabal, hpc, time, and unix submodules. Closes #18847. - - - - - 92c0afbf by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Dump STG when ticky is enabled This changes the "ticky" modifier to enable dumping of final STG as this is generally needed to make sense of the ticky profiles. - - - - - d23fef68 by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Introduce notion of flavour transformers This extends Hadrian's notion of "flavour", as described in #18942. - - - - - 179d0bec by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Add a viaLlvmBackend modifier Note that this also slightly changes the semantics of these flavours as we only use LLVM for >= stage1 builds. - - - - - d4d95e51 by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Add profiled_ghc and no_dynamic_ghc modifiers - - - - - 6815603f by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Drop redundant flavour definitions Drop the profiled, LLVM, and ThreadSanitizer flavour definitions as these can now be realized with flavour transformers. - - - - - f88f4339 by Ben Gamari at 2020-11-24T02:43:20-05:00 rts: Flush eventlog buffers from flushEventLog As noted in #18043, flushTrace failed flush anything beyond the writer. This means that a significant amount of data sitting in capability-local event buffers may never get flushed, despite the users' pleads for us to flush. Fix this by making flushEventLog flush all of the event buffers before flushing the writer. Fixes #18043. - - - - - 7c03cc50 by Ben Gamari at 2020-11-24T02:43:55-05:00 gitlab-ci: Run LLVM job on appropriately-labelled MRs Namely, those marked with the ~"LLVM backend" label - - - - - 9b95d815 by Ben Gamari at 2020-11-24T02:43:55-05:00 gitlab-ci: Run LLVM builds on Debian 10 The current Debian 9 image doesn't provide LLVM 7. - - - - - 2ed3e6c0 by Ben Gamari at 2020-11-24T02:43:55-05:00 CmmToLlvm: Declare signature for memcmp Otherwise `opt` fails with: error: use of undefined value '@memcmp$def' - - - - - be5d74ca by Moritz Angermann at 2020-11-26T16:00:32-05:00 [Sized Cmm] properly retain sizes. This replaces all Word<N> = W<N># Word# and Int<N> = I<N># Int# with Word<N> = W<N># Word<N># and Int<N> = I<N># Int<N>#, thus providing us with properly sized primitives in the codegenerator instead of pretending they are all full machine words. This came up when implementing darwinpcs for arm64. The darwinpcs reqires us to pack function argugments in excess of registers on the stack. While most procedure call standards (pcs) assume arguments are just passed in 8 byte slots; and thus the caller does not know the exact signature to make the call, darwinpcs requires us to adhere to the prototype, and thus have the correct sizes. If we specify CInt in the FFI call, it should correspond to the C int, and not just be Word sized, when it's only half the size. This does change the expected output of T16402 but the new result is no less correct as it eliminates the narrowing (instead of the `and` as was previously done). Bumps the array, bytestring, text, and binary submodules. Co-Authored-By: Ben Gamari <ben at well-typed.com> Metric Increase: T13701 T14697 - - - - - a84e53f9 by Andreas Klebinger at 2020-11-26T16:00:32-05:00 RTS: Fix failed inlining of copy_tag. On windows using gcc-10 gcc failed to inline copy_tag into evacuate. To fix this we now set the always_inline attribute for the various copy* functions in Evac.c. The main motivation here is not the overhead of the function call, but rather that this allows the code to "specialize" for the size of the closure we copy which is often known at compile time. An earlier commit also tried to avoid evacuate_large inlining. But didn't quite succeed. So I also marked evacuate_large as noinline. Fixes #12416 - - - - - cdbd16f5 by Sylvain Henry at 2020-11-26T16:00:33-05:00 Fix toArgRep to support 64-bit reps on all systems [This is @Ericson2314 writing a commit message for @hsyl20's patch.] (Progress towards #11953, #17377, #17375) `Int64Rep` and `Word64Rep` are currently broken on 64-bit systems. This is because they should use "native arg rep" but instead use "large arg rep" as they do on 32-bit systems, which is either a non-concept or a 128-bit rep depending on one's vantage point. Now, these reps currently aren't used during 64-bit compilation, so the brokenness isn't observed, but I don't think that constitutes reasons not to fix it. Firstly, the linked issues there is a clearly expressed desire to use explicit-bitwidth constructs in more places. Secondly, per [1], there are other bugs that *do* manifest from not threading explicit-bitwidth information all the way through the compilation pipeline. One can therefore view this as one piece of the larger effort to do that, improve ergnomics, and squash remaining bugs. Also, this is needed for !3658. I could just merge this as part of that, but I'm keen on merging fixes "as they are ready" so the fixes that aren't ready are isolated and easier to debug. [1]: https://mail.haskell.org/pipermail/ghc-devs/2020-October/019332.html - - - - - a9378e69 by Tim Barnes at 2020-11-26T16:00:34-05:00 Set dynamic users-guide TOC spacing (fixes #18554) - - - - - 86a59d93 by Ben Gamari at 2020-11-26T16:00:34-05:00 rts: Use RTS_LIKELY in CHECK Most compilers probably already infer that `barf` diverges but it nevertheless doesn't hurt to be explicit. - - - - - 5757e82b by Matthew Pickering at 2020-11-26T16:00:35-05:00 Remove special case for GHC.ByteCode.Instr This was added in https://github.com/nomeata/ghc-heap-view/commit/34935206e51b9c86902481d84d2f368a6fd93423 GHC.ByteCode.Instr.BreakInfo no longer exists so the special case is dead code. Any check like this can be easily dealt with in client code. - - - - - d9c8b5b4 by Matthew Pickering at 2020-11-26T16:00:35-05:00 Split Up getClosureDataFromHeapRep Motivation 1. Don't enforce the repeated decoding of an info table, when the client can cache it (ghc-debug) 2. Allow the constructor information decoding to be overridden, this casues segfaults in ghc-debug - - - - - 3e3555cc by Andreas Klebinger at 2020-11-26T16:00:35-05:00 RegAlloc: Add missing raPlatformfield to RegAllocStatsSpill Fixes #18994 Co-Author: Benjamin Maurer <maurer.benjamin at gmail.com> - - - - - a1a75aa9 by Ben Gamari at 2020-11-27T06:20:41-05:00 rts: Allocate MBlocks with MAP_TOP_DOWN on Windows As noted in #18991, we would previously allocate heap in low memory. Due to this the linker, which typically *needs* low memory, would end up competing with the heap. In longer builds we end up running out of low memory entirely, leading to linking failures. - - - - - 75fc1ed5 by Sylvain Henry at 2020-11-28T15:40:23-05:00 Hadrian: fix detection of ghc-pkg for cross-compilers - - - - - 7cb5df96 by Sylvain Henry at 2020-11-28T15:40:23-05:00 hadrian: fix ghc-pkg uses (#17601) Make sure ghc-pkg doesn't read the compiler "settings" file by passing --no-user-package-db. - - - - - e3fd4226 by Ben Gamari at 2020-11-28T15:40:23-05:00 gitlab-ci: Introduce a nightly cross-compilation job This adds a job to test cross-compilation from x86-64 to AArch64 with Hadrian. Fixes #18234 - - - - - 698d3d96 by Ben Gamari at 2020-11-28T15:41:00-05:00 gitlab-ci: Only deploy GitLab Pages in ghc/ghc> The deployments are quite large and yet are currently only served for the ghc/ghc> project. - - - - - 625726f9 by David Eichmann at 2020-11-28T15:41:37-05:00 ghc-heap: partial TSO/STACK decoding Co-authored-by: Sven Tennie <sven.tennie at gmail.com> Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> Co-authored-by: Ben Gamari <bgamari.foss at gmail.com> - - - - - 22ea9c29 by Andreas Klebinger at 2020-11-28T15:42:13-05:00 Small optimization to CmmSink. Inside `regsUsedIn` we can avoid some thunks by specializing the recursion. In particular we avoid the thunk for `(f e z)` in the MachOp/Load branches, where we know this will evaluate to z. Reduces allocations for T3294 by ~1%. - - - - - bba42c62 by John Ericson at 2020-11-28T15:42:49-05:00 Make primop handler indentation more consistent - - - - - c82bc8e9 by John Ericson at 2020-11-28T15:42:49-05:00 Cleanup some primop constructor names Harmonize the internal (big sum type) names of the native vs fixed-sized number primops a bit. (Mainly by renaming the former.) No user-facing names are changed. - - - - - ae14f160 by Ben Gamari at 2020-11-28T15:43:25-05:00 testsuite: Mark T14702 as fragile on Windows Due to #18953. - - - - - 1bc104b0 by Ben Gamari at 2020-11-29T15:33:18-05:00 withTimings: Emit allocations counter This will allow us to back out the allocations per compiler pass from the eventlog. Note that we dump the allocation counter rather than the difference since this will allow us to determine how much work is done *between* `withTiming` blocks. - - - - - e992ea84 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 ThreadPaused: Don't zero slop until free vars are pushed When threadPaused blackholes a thunk it calls `OVERWRITING_CLOSURE` to zero the slop for the benefit of the sanity checker. Previously this was done *before* pushing the thunk's free variables to the update remembered set. Consequently we would pull zero'd pointers to the update remembered set. - - - - - e82cd140 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Fix regression from TSAN work The TSAN rework (specifically aad1f803) introduced a subtle regression in GC.c, swapping `g0` in place of `gen`. Whoops! Fixes #18997. - - - - - 35a5207e by GHC GitLab CI at 2020-11-29T15:33:54-05:00 rts/Messages: Add missing write barrier in THROWTO message update After a THROWTO message has been handle the message closure is overwritten by a NULL message. We must ensure that the original closure's pointers continue to be visible to the nonmoving GC. - - - - - 0120829f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Add missing write barrier in shrinkSmallByteArray - - - - - 8a4d8fb6 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 Updates: Don't zero slop until closure has been pushed Ensure that the the free variables have been pushed to the update remembered set before we zero the slop. - - - - - 2793cfdc by GHC GitLab CI at 2020-11-29T15:33:54-05:00 OSThreads: Fix error code checking pthread_join returns its error code and apparently doesn't set errno. - - - - - e391a16f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Don't join to mark_thread on shutdown The mark thread is not joinable as we detach from it on creation. - - - - - 60d088ab by Ben Gamari at 2020-11-29T15:33:54-05:00 nonmoving: Add reference to Ueno 2016 - - - - - 3aa60362 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Ensure that evacuated large objects are marked See Note [Non-moving GC: Marking evacuated objects]. - - - - - 8d304a99 by Ben Gamari at 2020-11-30T10:15:22-05:00 rts/m32: Refactor handling of allocator seeding Previously, in an attempt to reduce fragmentation, each new allocator would map a region of M32_MAX_PAGES fresh pages to seed itself. However, this ends up being extremely wasteful since it turns out that we often use fewer than this. Consequently, these pages end up getting freed which, ends up fragmenting our address space more than than we would have if we had naively allocated pages on-demand. Here we refactor m32 to avoid this waste while achieving the fragmentation mitigation previously desired. In particular, we move all page allocation into the global m32_alloc_page, which will pull a page from the free page pool. If the free page pool is empty we then refill it by allocating a region of M32_MAP_PAGES and adding them to the pool. Furthermore, we do away with the initial seeding entirely. That is, the allocator starts with no active pages: pages are rather allocated on an as-needed basis. On the whole this ends up being a pleasingly simple change, simultaneously making m32 more efficient, more robust, and simpler. Fixes #18980. - - - - - b6629289 by Ben Gamari at 2020-11-30T10:15:58-05:00 rts: Use CHECK instead of assert Use the GHC wrappers instead of <assert.h>. - - - - - 9f4efa6a by Ben Gamari at 2020-11-30T10:15:58-05:00 rts/linker: Replace some ASSERTs with CHECK In the past some people have confused ASSERT, which is for checking internal invariants, which CHECK, which should be used when checking things that might fail due to bad input (and therefore should be enabled even in the release compiler). Change some of these cases in the linker to use CHECK. - - - - - 0f8a4655 by Ryan Scott at 2020-11-30T10:16:34-05:00 Allow deploy:pages job to fail See #18973. - - - - - 49ebe369 by chessai at 2020-11-30T19:47:40-05:00 Optimisations in Data.Foldable (T17867) This PR concerns the following functions from `Data.Foldable`: * minimum * maximum * sum * product * minimumBy * maximumBy - Default implementations of these functions now use `foldl'` or `foldMap'`. - All have been marked with INLINEABLE to make room for further optimisations. - - - - - 4d79ef65 by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - 6af074ce by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - ab334262 by Viktor Dukhovni at 2020-11-30T19:48:17-05:00 dirty MVAR after mutating TSO queue head While the original head and tail of the TSO queue may be in the same generation as the MVAR, interior elements of the queue could be younger after a GC run and may then be exposed by putMVar operation that updates the queue head. Resolves #18919 - - - - - 5eb163f3 by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Don't allow shared libraries to be loaded multiple times - - - - - 490aa14d by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Initialise CCSs from native shared objects - - - - - 6ac3db5f by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Move shared library loading logic into Elf.c - - - - - b6698d73 by GHC GitLab CI at 2020-11-30T19:48:53-05:00 rts/linker: Don't declare dynamic objects with image_mapped This previously resulted in warnings due to spurious unmap failures. - - - - - b94a65af by jneira at 2020-11-30T19:49:31-05:00 Include tried paths in findToolDir error - - - - - 72a87fbc by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Move core flattening algorithm to Core.Unify This sets the stage for a later change, where this algorithm will be needed from GHC.Core.InstEnv. This commit also splits GHC.Core.Map into GHC.Core.Map.Type and GHC.Core.Map.Expr, in order to avoid module import cycles with GHC.Core. - - - - - 0dd45d0a by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Bump the # of commits searched for perf baseline The previous value of 75 meant that a feature branch with more than 75 commits would get spurious CI passes. This affects #18692, but does not fix that ticket, because if a baseline cannot be found, we should fail, not succeed. - - - - - 8bb52d91 by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Remove flattening variables This patch redesigns the flattener to simplify type family applications directly instead of using flattening meta-variables and skolems. The key new innovation is the CanEqLHS type and the new CEqCan constraint (Ct). A CanEqLHS is either a type variable or exactly-saturated type family application; either can now be rewritten using a CEqCan constraint in the inert set. Because the flattener no longer reduces all type family applications to variables, there was some performance degradation if a lengthy type family application is now flattened over and over (not making progress). To compensate, this patch contains some extra optimizations in the flattener, leading to a number of performance improvements. Close #18875. Close #18910. There are many extra parts of the compiler that had to be affected in writing this patch: * The family-application cache (formerly the flat-cache) sometimes stores coercions built from Given inerts. When these inerts get kicked out, we must kick out from the cache as well. (This was, I believe, true previously, but somehow never caused trouble.) Kicking out from the cache requires adding a filterTM function to TrieMap. * This patch obviates the need to distinguish "blocking" coercion holes from non-blocking ones (which, previously, arose from CFunEqCans). There is thus some simplification around coercion holes. * Extra commentary throughout parts of the code I read through, to preserve the knowledge I gained while working. * A change in the pure unifier around unifying skolems with other types. Unifying a skolem now leads to SurelyApart, not MaybeApart, as documented in Note [Binding when looking up instances] in GHC.Core.InstEnv. * Some more use of MCoercion where appropriate. * Previously, class-instance lookup automatically noticed that e.g. C Int was a "unifier" to a target [W] C (F Bool), because the F Bool was flattened to a variable. Now, a little more care must be taken around checking for unifying instances. * Previously, tcSplitTyConApp_maybe would split (Eq a => a). This is silly, because (=>) is not a tycon in Haskell. Fixed now, but there are some knock-on changes in e.g. TrieMap code and in the canonicaliser. * New function anyFreeVarsOf{Type,Co} to check whether a free variable satisfies a certain predicate. * Type synonyms now remember whether or not they are "forgetful"; a forgetful synonym drops at least one argument. This is useful when flattening; see flattenView. * The pattern-match completeness checker invokes the solver. This invocation might need to look through newtypes when checking representational equality. Thus, the desugarer needs to keep track of the in-scope variables to know what newtype constructors are in scope. I bet this bug was around before but never noticed. * Extra-constraints wildcards are no longer simplified before printing. See Note [Do not simplify ConstraintHoles] in GHC.Tc.Solver. * Whether or not there are Given equalities has become slightly subtler. See the new HasGivenEqs datatype. * Note [Type variable cycles in Givens] in GHC.Tc.Solver.Canonical explains a significant new wrinkle in the new approach. * See Note [What might match later?] in GHC.Tc.Solver.Interact, which explains the fix to #18910. * The inert_count field of InertCans wasn't actually used, so I removed it. Though I (Richard) did the implementation, Simon PJ was very involved in design and review. This updates the Haddock submodule to avoid #18932 by adding a type signature. ------------------------- Metric Decrease: T12227 T5030 T9872a T9872b T9872c Metric Increase: T9872d ------------------------- - - - - - d66660ba by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Rename the flattener to become the rewriter. Now that flattening doesn't produce flattening variables, it's not really flattening anything: it's rewriting. This change also means that the rewriter can no longer be confused the core flattener (in GHC.Core.Unify), which is sometimes used during type-checking. - - - - - add0aeae by Ben Gamari at 2020-12-01T19:58:17-05:00 rts: Introduce mmapAnonForLinker Previously most of the uses of mmapForLinker were mapping anonymous memory, resulting in a great deal of unnecessary repetition. Factor this out into a new helper. Also fixes a few places where error checking was missing or suboptimal. - - - - - 97d71646 by Ben Gamari at 2020-12-01T19:58:17-05:00 rts/linker: Introduce munmapForLinker Consolidates munmap calls to ensure consistent error handling. - - - - - d8872af0 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/Linker: Introduce Windows implementations for mmapForLinker, et al. - - - - - c35d0e03 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/m32: Introduce NEEDS_M32 macro Instead of relying on RTS_LINKER_USE_MMAP - - - - - 41c64eb5 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/linker: Use m32 to allocate symbol extras in PEi386 - - - - - e941b550 by Simon Peyton Jones at 2020-12-02T10:27:47+00:00 Fix kind inference for data types. Again. This patch improves kcConDecls, when we are inferring the kind of a data type decl. Specifically * In kcConDecls/kcConDecl make it clear that the tc_res_kind argument is only used in the H98 case; and in that case there is not result kind signature; and hence no need for the disgusting splitPiTys in kcConDecls (now thankfully gone). The GADT case is a bit different to before, and much nicer. This is what fixes #18891. See Note [kcConDecls: kind-checking data type decls] * Do not look at the constructor decls of a data/newtype instance in tcDataFamInstanceHeader. See new Note [Kind inference for data family instances] This causes a few knock-on effects in the tests suite, because we require more information than before in the instance /header/. New user-manual material about this in "Kind inference in data type declarations" and "Kind inference for data/newtype instance declarations". * Minor improvement in kcTyClDecl, combining GADT and H98 case. * Further fixes to kind checking type decls In particular, fix #14111 and #8707 Fixes #18891 - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - aclocal.m4 - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/Config.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/Dwarf/Constants.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/Monad.hs - compiler/GHC/CmmToAsm/PIC.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/Reg/Graph.hs - compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs - compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs - compiler/GHC/CmmToAsm/Reg/Linear.hs - compiler/GHC/CmmToAsm/Reg/Linear/FreeRegs.hs - compiler/GHC/CmmToAsm/Reg/Target.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4bdd70d9ad7b4de288341e0797d314c1166dd2ce...e941b550a1c6a0519dce65fdd93cbae8dbe0907e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4bdd70d9ad7b4de288341e0797d314c1166dd2ce...e941b550a1c6a0519dce65fdd93cbae8dbe0907e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 2 17:08:58 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Wed, 02 Dec 2020 12:08:58 -0500 Subject: [Git][ghc/ghc][wip/T18894] 2 commits: DmdAnal: Annotate top-level function bindings with demands (#18894) Message-ID: <5fc7ca2ae65c3_86c3fc6ab857f44136052f@gitlab.mail> Sebastian Graf pushed to branch wip/T18894 at Glasgow Haskell Compiler / GHC Commits: 376834e2 by Sebastian Graf at 2020-12-02T18:08:48+01:00 DmdAnal: Annotate top-level function bindings with demands (#18894) It's useful to annotate a non-exported top-level function like `g` in ```hs module Lib (h) where g :: Int -> Int -> (Int,Int) g m 1 = (m, 0) g m n = (2 * m, 2 `div` n) {-# NOINLINE g #-} h :: Int -> Int h 1 = 0 h m | odd m = snd (g m 2) | otherwise = uncurry (+) (g 2 m) ``` with its demand `UCU(CS(P(1P(U),SP(U))`, which tells us that whenever `g` was called, the second component of the returned pair was evaluated strictly. Since #18903 we do so for local functions, where we can see all calls. For top-level functions, we can assume that all *exported* functions are demanded according to `topDmd` and thus get sound demands for non-exported top-level functions. The demand on `g` is crucial information for Nested CPR, which may the go on and unbox `g` for the second pair component. That is true even if that pair component may diverge, as is the case for the call site `g 13 0`, which throws a div-by-zero exception. We only track bindings of function type in order not to risk huge compile-time regressions, see `isInterestingTopLevelFn`. Fixes #18894. - - - - - 46e64ccd by Sebastian Graf at 2020-12-02T18:08:49+01:00 Demand: Simplify `CU(U)` to `U` (#19005) Both sub-demands encode the same information. This is a trivial change and already affects a few regression tests (e.g. `T5075`), so no separate regression test is necessary. - - - - - 13 changed files: - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Types/Demand.hs - compiler/GHC/Types/Id/Info.hs - testsuite/tests/arityanal/should_compile/Arity11.stderr - testsuite/tests/arityanal/should_compile/Arity16.stderr - + testsuite/tests/stranal/should_compile/T18894.hs - + testsuite/tests/stranal/should_compile/T18894.stderr - testsuite/tests/stranal/should_compile/all.T - testsuite/tests/stranal/sigs/T5075.stderr Changes: ===================================== compiler/GHC/Core/FVs.hs ===================================== @@ -525,12 +525,11 @@ ruleLhsFVIds (Rule { ru_bndrs = bndrs, ru_args = args }) = filterFV isLocalId $ addBndrs bndrs (exprs_fvs args) ruleRhsFreeIds :: CoreRule -> VarSet --- ^ This finds all locally-defined free Ids on the left hand side of a rule +-- ^ This finds all locally-defined free Ids on the right hand side of a rule -- and returns them as a non-deterministic set ruleRhsFreeIds (BuiltinRule {}) = emptyVarSet -ruleRhsFreeIds (Rule { ru_bndrs = bndrs, ru_args = args }) - = fvVarSet $ filterFV isLocalId $ - addBndrs bndrs $ exprs_fvs args +ruleRhsFreeIds (Rule { ru_bndrs = bndrs, ru_rhs = rhs }) + = fvVarSet $ filterFV isLocalId $ addBndrs bndrs $ expr_fvs rhs {- Note [Rule free var hack] (Not a hack any more) ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -37,6 +37,7 @@ import GHC.Core.Type import GHC.Core.FVs ( exprFreeIds, ruleRhsFreeIds ) import GHC.Core.Coercion ( Coercion, coVarsOfCo ) import GHC.Core.FamInstEnv +import GHC.Core.Opt.Arity ( typeArity ) import GHC.Utils.Misc import GHC.Utils.Panic import GHC.Data.Maybe ( isJust ) @@ -64,28 +65,54 @@ data DmdAnalOpts = DmdAnalOpts -- -- Note: use `seqBinds` on the result to avoid leaks due to lazyness (cf Note -- [Stamp out space leaks in demand analysis]) -dmdAnalProgram :: DmdAnalOpts -> FamInstEnvs -> CoreProgram -> CoreProgram -dmdAnalProgram opts fam_envs binds = binds_plus_dmds - where - env = emptyAnalEnv opts fam_envs - binds_plus_dmds = snd $ mapAccumL dmdAnalTopBind env binds - --- Analyse a (group of) top-level binding(s) -dmdAnalTopBind :: AnalEnv - -> CoreBind - -> (AnalEnv, CoreBind) -dmdAnalTopBind env (NonRec id rhs) - = ( extendAnalEnv TopLevel env id sig - , NonRec (setIdStrictness id sig) rhs') +dmdAnalProgram :: DmdAnalOpts -> FamInstEnvs -> [CoreRule] -> CoreProgram -> CoreProgram +dmdAnalProgram opts fam_envs rules binds + = snd $ go (emptyAnalEnv opts fam_envs) binds where - ( _, sig, rhs') = dmdAnalRhsLetDown Nothing env topSubDmd id rhs - -dmdAnalTopBind env (Rec pairs) - = (env', Rec pairs') - where - (env', _, pairs') = dmdFix TopLevel env topSubDmd pairs - -- We get two iterations automatically - -- c.f. the NonRec case above + -- See Note [Analysing top-level bindings] + -- TLDR; We analyse them like + -- let ex1 = ... in (ex1, let nex1 = ... in let ex2 = ... in (ex2, ...))) + -- where ex* are exported (or RULE mentions) and nex* are not. + go _ [] = (nopDmdType, []) + go env (b:bs) = cons_up $ dmdAnalBind TopLevel env topSubDmd b anal_body + where + anal_body env' + | (body_ty, bs') <- go env' bs + = (add_exported_uses env' body_ty (bindersOf b), bs') + + cons_up :: (a, b, [b]) -> (a, [b]) + cons_up (dmd_ty, b', bs') = (dmd_ty, b':bs') + + add_exported_uses :: AnalEnv -> DmdType -> [Id] -> DmdType + add_exported_uses env = foldl' (add_exported_use env) + + -- | If @e@ is denoted by @dmd_ty@, then @add_exported_use _ dmd_ty id@ + -- corresponds to the demand type of @(id, e)@, but is a lot more direct. + -- See Note [Analysing top-level bindings]. + add_exported_use :: AnalEnv -> DmdType -> Id -> DmdType + add_exported_use env dmd_ty id + | isExportedId id || elemVarSet id rule_fvs + -- See Note [Absence analysis for stable unfoldings and RULES] + = dmd_ty `plusDmdType` fst (dmdAnalStar env topDmd (Var id)) + | otherwise = dmd_ty + + rule_fvs :: IdSet + rule_fvs = foldr (unionVarSet . ruleRhsFreeIds) emptyVarSet rules + +-- | Whether we want to store demands on a top-level Id or just default +-- to 'topDmd'. +-- +-- Basically, we want to now how top-level *functions* are *used* +-- (e.g. called), but aren't interested in whether they were called strictly +-- or not. Other top-level bindings are boring. +isInterestingTopLevelFn :: Id -> Bool +-- SG tried to set this to True and got a +2% ghc/alloc regression in T5642 +-- (which is dominated by the Simplifier) at no gain in analysis precision. +-- If there was a gain, that regression might be acceptable. +-- Plus, we could use LetUp for thunks and share some code with local let +-- bindings. +isInterestingTopLevelFn id = + typeArity (idType id) `lengthExceeds` 0 {- Note [Stamp out space leaks in demand analysis] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -105,8 +132,56 @@ generation would hold on to an extra copy of the Core program, via unforced thunks in demand or strictness information; and it is the most memory-intensive part of the compilation process, so this added seqBinds makes a big difference in peak memory usage. --} +Note [Analysing top-level bindings] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider a CoreProgram like + e1 = ... + n1 = ... + e2 = \a b -> ... fst (n1 a b) ... + n2 = \c d -> ... snd (e2 c d) ... + ... +where e* are exported, but n* are not. +Intuitively, we can see that @n1@ is only ever called with two arguments +and in every call site, the first component of the result of the call +is evaluated. Thus, we'd like it to have idDemandInfo @UCU(C1(P(SU,A))@. + +(This can be exploited by a Nested CPR pass which may then unbox the +first component of the pair returned from @n1 at . Or if @n1@ had arity +1 before, we may now eta-expand to arity 2.) + +NB: We may *not* give e2 a similar annotation, because it is exported and +external callers might use it in arbitrary ways, expressed by 'topDmd'. + +How do we get this result? Answer: By analysing the program as if it was a let +expression of this form: + let e1 = ... in + (e1, let n1 = ... in + ( let e2 = ... in + (e2, let n2 = ... in + ( ...)))) +E.g. putting all bindings in nested lets, where whenever it binds an exported +binding, the body is a *pair* of an occurrence of the exported binder and +the other nested lets. Of course, we will not actually build that CoreExpr! +Instead we faithfully simulate analysis of said expression by adding the +free variable 'DmdEnv' of @e*@'s strictness signatures to the 'DmdType' we +get from analysing the nested bindings. + +You might also wonder why we didn't analyse in terms of the simpler + let e1 = ... in + let n1 = ... in + let e2 = ... in + let n2 = ... in + (e1,e2, ...) +The reason is analysis performance: If @e1@ uses many free variables, we'll +unnecessarily carry their demands around with us from the moment we analyse +the pair to the moment we bubble back up to the binding for @e1 at . +This blows up e.g. @T10370 at . + +A final note about variables occuring free in RULE RHSs: They are to be handled +pretty much like exported Ids. +See also Note [Absence analysis for stable unfoldings and RULES] +-} {- ************************************************************************ @@ -114,7 +189,103 @@ seqBinds makes a big difference in peak memory usage. \subsection{The analyser itself} * * ************************************************************************ +-} + +-- | Analyse a binding group and its \"body\", e.g. where it is in scope. +-- +-- It calls a function that knows how to analyse this \"body\" given +-- an 'AnalEnv' with updated demand signatures for the binding group +-- (reflecting their 'idStrictnessInfo') and expects to receive a +-- 'DmdType' in return, which it uses to annotate the binding group with their +-- 'idDemandInfo'. +dmdAnalBind + :: TopLevelFlag + -> AnalEnv + -> SubDemand -- ^ Demand put on the "body" + -- (important for join points) + -> CoreBind + -> (AnalEnv -> (DmdType, a)) -- ^ How to analyse the "body", e.g. + -- where the binding is in scope + -> (DmdType, CoreBind, a) +dmdAnalBind top_lvl env dmd bind anal_body = case bind of + NonRec id rhs + | useLetUp top_lvl id + -> dmdAnalBindLetUp top_lvl env id rhs anal_body + _ -> dmdAnalBindLetDown top_lvl env dmd bind anal_body + +-- | Annotates uninteresting top level functions ('isInterestingTopLevelFn') +-- with 'topDmd', the rest with the given demand. +setBindIdDemandInfo :: TopLevelFlag -> Id -> Demand -> Id +setBindIdDemandInfo top_lvl id dmd = setIdDemandInfo id $ case top_lvl of + TopLevel | not (isInterestingTopLevelFn id) -> topDmd + _ -> dmd + +-- | Let bindings can be processed in two ways: +-- Down (RHS before body) or Up (body before RHS). +-- This function handles the up variant. +-- +-- It is very simple. For let x = rhs in body +-- * Demand-analyse 'body' in the current environment +-- * Find the demand, 'rhs_dmd' placed on 'x' by 'body' +-- * Demand-analyse 'rhs' in 'rhs_dmd' +-- +-- This is used for a non-recursive local let without manifest lambdas (see +-- 'useLetUp'). +-- +-- This is the LetUp rule in the paper “Higher-Order Cardinality Analysis”. +dmdAnalBindLetUp :: TopLevelFlag -> AnalEnv -> Id -> CoreExpr -> (AnalEnv -> (DmdType, a)) -> (DmdType, CoreBind, a) +dmdAnalBindLetUp top_lvl env id rhs anal_body = (final_ty, NonRec id' rhs', body') + where + (body_ty, body') = anal_body env + (body_ty', id_dmd) = findBndrDmd env notArgOfDfun body_ty id + id' = setBindIdDemandInfo top_lvl id id_dmd + (rhs_ty, rhs') = dmdAnalStar env (dmdTransformThunkDmd rhs id_dmd) rhs + final_ty = body_ty' `plusDmdType` rhs_ty + +-- | Let bindings can be processed in two ways: +-- Down (RHS before body) or Up (body before RHS). +-- This function handles the down variant. +-- +-- It computes a demand signature (by means of 'dmdAnalRhsSig') and uses +-- that at call sites in the body. +-- +-- It is used for toplevel definitions, recursive definitions and local +-- non-recursive definitions that have manifest lambdas (cf. 'useLetUp'). +-- Local non-recursive definitions without a lambda are handled with LetUp. +-- +-- This is the LetDown rule in the paper “Higher-Order Cardinality Analysis”. +dmdAnalBindLetDown :: TopLevelFlag -> AnalEnv -> SubDemand -> CoreBind -> (AnalEnv -> (DmdType, a)) -> (DmdType, CoreBind, a) +dmdAnalBindLetDown top_lvl env dmd bind anal_body = case bind of + NonRec id rhs + | (env', lazy_fv, id1, rhs1) <- + dmdAnalRhsSig top_lvl NonRecursive env dmd id rhs + -> do_rest env' lazy_fv [(id1, rhs1)] (\[(id2, rhs2)] -> NonRec id2 rhs2) + Rec pairs + | (env', lazy_fv, pairs') <- dmdFix top_lvl env dmd pairs + -> do_rest env' lazy_fv pairs' Rec + where + do_rest env' lazy_fv pairs1 build_bind = (final_ty, build_bind pairs2, body') + where + (body_ty, body') = anal_body env' + -- see Note [Lazy and unleashable free variables] + dmd_ty = addLazyFVs body_ty lazy_fv + (!final_ty, id_dmds) = findBndrsDmds env' dmd_ty (map fst pairs1) + pairs2 = zipWith do_one pairs2 id_dmds + do_one (id', rhs') dmd = (setBindIdDemandInfo top_lvl id' dmd, rhs') + -- If the actual demand is better than the vanilla call + -- demand, you might think that we might do better to re-analyse + -- the RHS with the stronger demand. + -- But (a) That seldom happens, because it means that *every* path in + -- the body of the let has to use that stronger demand + -- (b) It often happens temporarily in when fixpointing, because + -- the recursive function at first seems to place a massive demand. + -- But we don't want to go to extra work when the function will + -- probably iterate to something less demanding. + -- In practice, all the times the actual demand on id2 is more than + -- the vanilla call demand seem to be due to (b). So we don't + -- bother to re-analyse the RHS. +{- Note [Ensure demand is strict] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ It's important not to analyse e with a lazy demand because @@ -194,7 +365,7 @@ dmdAnal' env dmd (App fun arg) -- Crucially, coercions /are/ handled here, because they are -- value arguments (#10288) let - call_dmd = mkCallDmd dmd + call_dmd = mkCalledOnceDmd dmd (fun_ty, fun') = dmdAnal env call_dmd fun (arg_dmd, res_ty) = splitDmdTy fun_ty (arg_ty, arg') = dmdAnalStar env (dmdTransformThunkDmd arg arg_dmd) arg @@ -295,60 +466,11 @@ dmdAnal' env dmd (Case scrut case_bndr ty alts) -- , text "res_ty" <+> ppr res_ty ]) $ (res_ty, Case scrut' case_bndr' ty alts') --- Let bindings can be processed in two ways: --- Down (RHS before body) or Up (body before RHS). --- The following case handle the up variant. --- --- It is very simple. For let x = rhs in body --- * Demand-analyse 'body' in the current environment --- * Find the demand, 'rhs_dmd' placed on 'x' by 'body' --- * Demand-analyse 'rhs' in 'rhs_dmd' --- --- This is used for a non-recursive local let without manifest lambdas. --- This is the LetUp rule in the paper “Higher-Order Cardinality Analysis”. -dmdAnal' env dmd (Let (NonRec id rhs) body) - | useLetUp id - = (final_ty, Let (NonRec id' rhs') body') +dmdAnal' env dmd (Let bind body) + = (final_ty, Let bind' body') where - (body_ty, body') = dmdAnal env dmd body - (body_ty', id_dmd) = findBndrDmd env notArgOfDfun body_ty id - id' = setIdDemandInfo id id_dmd - - (rhs_ty, rhs') = dmdAnalStar env (dmdTransformThunkDmd rhs id_dmd) rhs - final_ty = body_ty' `plusDmdType` rhs_ty - -dmdAnal' env dmd (Let (NonRec id rhs) body) - = (body_ty2, Let (NonRec id2 rhs') body') - where - (lazy_fv, sig, rhs') = dmdAnalRhsLetDown Nothing env dmd id rhs - id1 = setIdStrictness id sig - env1 = extendAnalEnv NotTopLevel env id sig - (body_ty, body') = dmdAnal env1 dmd body - (body_ty1, id2) = annotateBndr env body_ty id1 - body_ty2 = addLazyFVs body_ty1 lazy_fv -- see Note [Lazy and unleashable free variables] - - -- If the actual demand is better than the vanilla call - -- demand, you might think that we might do better to re-analyse - -- the RHS with the stronger demand. - -- But (a) That seldom happens, because it means that *every* path in - -- the body of the let has to use that stronger demand - -- (b) It often happens temporarily in when fixpointing, because - -- the recursive function at first seems to place a massive demand. - -- But we don't want to go to extra work when the function will - -- probably iterate to something less demanding. - -- In practice, all the times the actual demand on id2 is more than - -- the vanilla call demand seem to be due to (b). So we don't - -- bother to re-analyse the RHS. - -dmdAnal' env dmd (Let (Rec pairs) body) - = let - (env', lazy_fv, pairs') = dmdFix NotTopLevel env dmd pairs - (body_ty, body') = dmdAnal env' dmd body - body_ty1 = deleteFVs body_ty (map fst pairs) - body_ty2 = addLazyFVs body_ty1 lazy_fv -- see Note [Lazy and unleashable free variables] - in - body_ty2 `seq` - (body_ty2, Let (Rec pairs') body') + (final_ty, bind', body') = dmdAnalBind NotTopLevel env dmd bind go' + go' env' = dmdAnal env' dmd body -- | A simple, syntactic analysis of whether an expression MAY throw a precise -- exception when evaluated. It's always sound to return 'True'. @@ -582,9 +704,13 @@ dmdTransform env var dmd | Just (sig, top_lvl) <- lookupSigEnv env var , let fn_ty = dmdTransformSig sig dmd = -- pprTrace "dmdTransform:LetDown" (vcat [ppr var, ppr sig, ppr dmd, ppr fn_ty]) $ - if isTopLevel top_lvl - then fn_ty -- Don't record demand on top-level things - else addVarDmd fn_ty var (C_11 :* dmd) + case top_lvl of + NotTopLevel -> addVarDmd fn_ty var (C_11 :* dmd) + TopLevel + | isInterestingTopLevelFn var + -> addVarDmd fn_ty var (C_0N `multDmd` (C_11 :* dmd)) -- discard strictness + | otherwise + -> fn_ty -- don't bother tracking; just annotate with 'topDmd' later -- Everything else: -- * Local let binders for which we use LetUp (cf. 'useLetUp') -- * Lambda binders @@ -599,46 +725,46 @@ dmdTransform env var dmd * * ********************************************************************* -} --- Let bindings can be processed in two ways: --- Down (RHS before body) or Up (body before RHS). --- dmdAnalRhsLetDown implements the Down variant: --- * assuming a demand of +-- | @dmdAnalRhsSig@ analyses the given RHS to compute a demand signature +-- for the LetDown rule. It works as follows: +-- +-- * assuming a demand of -- * looking at the definition -- * determining a strictness signature -- --- It is used for toplevel definition, recursive definitions and local --- non-recursive definitions that have manifest lambdas. --- Local non-recursive definitions without a lambda are handled with LetUp. --- --- This is the LetDown rule in the paper “Higher-Order Cardinality Analysis”. -dmdAnalRhsLetDown - :: Maybe [Id] -- Just bs <=> recursive, Nothing <=> non-recursive +-- Since it assumed a demand of , the resulting signature is applicable at +-- any call site. +dmdAnalRhsSig + :: TopLevelFlag + -> RecFlag -> AnalEnv -> SubDemand -> Id -> CoreExpr - -> (DmdEnv, StrictSig, CoreExpr) + -> (AnalEnv, DmdEnv, Id, CoreExpr) -- Process the RHS of the binding, add the strictness signature -- to the Id, and augment the environment with the signature as well. -- See Note [NOINLINE and strictness] -dmdAnalRhsLetDown rec_flag env let_dmd id rhs - = -- pprTrace "dmdAnalRhsLetDown" (ppr id $$ ppr let_dmd $$ ppr sig $$ ppr lazy_fv) $ - (lazy_fv, sig, rhs') +dmdAnalRhsSig top_lvl rec_flag env let_dmd id rhs + = -- pprTrace "dmdAnalRhsSig" (ppr id $$ ppr let_dmd $$ ppr sig $$ ppr lazy_fv) $ + (env', lazy_fv, id', rhs') where rhs_arity = idArity id + -- See Note [Demand signatures are computed for a threshold demand based on idArity] rhs_dmd -- See Note [Demand analysis for join points] -- See Note [Invariants on join points] invariant 2b, in GHC.Core -- rhs_arity matches the join arity of the join point | isJoinId id - = mkCallDmds rhs_arity let_dmd + = mkCalledOnceDmds rhs_arity let_dmd | otherwise - -- NB: rhs_arity - -- See Note [Demand signatures are computed for a threshold demand based on idArity] - = mkRhsDmd env rhs_arity rhs + = mkCalledOnceDmds rhs_arity topSubDmd (rhs_dmd_ty, rhs') = dmdAnal env rhs_dmd rhs DmdType rhs_fv rhs_dmds rhs_div = rhs_dmd_ty sig = mkStrictSigForArity rhs_arity (DmdType sig_fv rhs_dmds rhs_div) + id' = id `setIdStrictness` sig + env' = extendAnalEnv top_lvl env id' sig + -- See Note [Aggregated demand for cardinality] -- FIXME: That Note doesn't explain the following lines at all. The reason -- is really much different: When we have a recursive function, we'd @@ -651,8 +777,8 @@ dmdAnalRhsLetDown rec_flag env let_dmd id rhs -- we'd have to do an additional iteration. reuseEnv makes sure that -- we never get used-once info for FVs of recursive functions. rhs_fv1 = case rec_flag of - Just bs -> reuseEnv (delVarEnvList rhs_fv bs) - Nothing -> rhs_fv + Recursive -> reuseEnv rhs_fv + NonRecursive -> rhs_fv rhs_fv2 = rhs_fv1 `keepAliveDmdEnv` extra_fvs -- Find the RHS free vars of the unfoldings and RULES @@ -669,13 +795,6 @@ dmdAnalRhsLetDown rec_flag env let_dmd id rhs = exprFreeIds unf_body | otherwise = emptyVarSet --- | @mkRhsDmd env rhs_arity rhs@ creates a 'SubDemand' for --- unleashing on the given function's @rhs@, by creating --- a call demand of @rhs_arity@ --- See Historical Note [Product demands for function body] -mkRhsDmd :: AnalEnv -> Arity -> CoreExpr -> SubDemand -mkRhsDmd _env rhs_arity _rhs = mkCallDmds rhs_arity topSubDmd - -- | If given the (local, non-recursive) let-bound 'Id', 'useLetUp' determines -- whether we should process the binding up (body before rhs) or down (rhs -- before body). @@ -720,8 +839,8 @@ mkRhsDmd _env rhs_arity _rhs = mkCallDmds rhs_arity topSubDmd -- * For a more convincing example with join points, see Note [Demand analysis -- for join points]. -- -useLetUp :: Var -> Bool -useLetUp f = idArity f == 0 && not (isJoinId f) +useLetUp :: TopLevelFlag -> Var -> Bool +useLetUp top_lvl f = isNotTopLevel top_lvl && idArity f == 0 && not (isJoinId f) {- Note [Demand analysis for join points] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -939,8 +1058,6 @@ dmdFix :: TopLevelFlag dmdFix top_lvl env let_dmd orig_pairs = loop 1 initial_pairs where - bndrs = map fst orig_pairs - -- See Note [Initialising strictness] initial_pairs | ae_virgin env = [(setIdStrictness id botSig, rhs) | (id, rhs) <- orig_pairs ] | otherwise = orig_pairs @@ -990,10 +1107,8 @@ dmdFix top_lvl env let_dmd orig_pairs = -- pprTrace "my_downRhs" (ppr id $$ ppr (idStrictness id) $$ ppr sig) $ ((env', lazy_fv'), (id', rhs')) where - (lazy_fv1, sig, rhs') = dmdAnalRhsLetDown (Just bndrs) env let_dmd id rhs - lazy_fv' = plusVarEnv_C plusDmd lazy_fv lazy_fv1 - env' = extendAnalEnv top_lvl env id sig - id' = setIdStrictness id sig + (env', lazy_fv1, id', rhs') = dmdAnalRhsSig top_lvl Recursive env let_dmd id rhs + lazy_fv' = plusVarEnv_C plusDmd lazy_fv lazy_fv1 zapIdStrictness :: [(Id, CoreExpr)] -> [(Id, CoreExpr)] zapIdStrictness pairs = [(setIdStrictness id nopSig, rhs) | (id, rhs) <- pairs ] @@ -1090,7 +1205,7 @@ addLazyFVs dmd_ty lazy_fvs -- demand with the bottom coming up from 'error' -- -- I got a loop in the fixpointer without this, due to an interaction - -- with the lazy_fv filtering in dmdAnalRhsLetDown. Roughly, it was + -- with the lazy_fv filtering in dmdAnalRhsSig. Roughly, it was -- letrec f n x -- = letrec g y = x `fatbar` -- letrec h z = z + ...g... @@ -1156,10 +1271,6 @@ annotateLamIdBndr env arg_of_dfun dmd_ty id main_ty = addDemand dmd dmd_ty' (dmd_ty', dmd) = findBndrDmd env arg_of_dfun dmd_ty id -deleteFVs :: DmdType -> [Var] -> DmdType -deleteFVs (DmdType fvs dmds res) bndrs - = DmdType (delVarEnvList fvs bndrs) dmds res - {- Note [NOINLINE and strictness] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Core/Opt/Pipeline.hs ===================================== @@ -65,6 +65,7 @@ import GHC.Types.SrcLoc import GHC.Types.Id import GHC.Types.Id.Info import GHC.Types.Basic +import GHC.Types.Demand ( zapDmdEnvSig ) import GHC.Types.Var.Set import GHC.Types.Var.Env import GHC.Types.Unique.Supply ( UniqSupply, mkSplitUniqSupply, splitUniqSupply ) @@ -495,7 +496,7 @@ doCorePass CoreDoExitify = {-# SCC "Exitify" #-} doPass exitifyProgram doCorePass CoreDoDemand = {-# SCC "DmdAnal" #-} - doPassDFM dmdAnal + doPassDFRM dmdAnal doCorePass CoreDoCpr = {-# SCC "CprAnal" #-} doPassDFM cprAnalProgram @@ -575,6 +576,13 @@ doPassDFM do_pass guts = do let fam_envs = (p_fam_env, mg_fam_inst_env guts) doPassM (liftIO . do_pass dflags fam_envs) guts +doPassDFRM :: (DynFlags -> FamInstEnvs -> [CoreRule] -> CoreProgram -> IO CoreProgram) -> ModGuts -> CoreM ModGuts +doPassDFRM do_pass guts = do + dflags <- getDynFlags + p_fam_env <- getPackageFamInstEnv + let fam_envs = (p_fam_env, mg_fam_inst_env guts) + doPassM (liftIO . do_pass dflags fam_envs (mg_rules guts)) guts + doPassDFU :: (DynFlags -> FamInstEnvs -> UniqSupply -> CoreProgram -> CoreProgram) -> ModGuts -> CoreM ModGuts doPassDFU do_pass guts = do dflags <- getDynFlags @@ -1088,13 +1096,13 @@ transferIdInfo exported_id local_id -dmdAnal :: DynFlags -> FamInstEnvs -> CoreProgram -> IO CoreProgram -dmdAnal dflags fam_envs binds = do +dmdAnal :: DynFlags -> FamInstEnvs -> [CoreRule] -> CoreProgram -> IO CoreProgram +dmdAnal dflags fam_envs rules binds = do let opts = DmdAnalOpts { dmd_strict_dicts = gopt Opt_DictsStrict dflags } - binds_plus_dmds = dmdAnalProgram opts fam_envs binds + binds_plus_dmds = dmdAnalProgram opts fam_envs rules binds Err.dumpIfSet_dyn dflags Opt_D_dump_str_signatures "Strictness signatures" FormatText $ - dumpIdInfoOfProgram (ppr . strictnessInfo) binds_plus_dmds + dumpIdInfoOfProgram (ppr . zapDmdEnvSig . strictnessInfo) binds_plus_dmds -- See Note [Stamp out space leaks in demand analysis] in GHC.Core.Opt.DmdAnal seqBinds binds_plus_dmds `seq` return binds_plus_dmds ===================================== compiler/GHC/Core/Opt/WorkWrap/Utils.hs ===================================== @@ -1275,10 +1275,14 @@ mk_absent_let dflags fam_envs arg abs_rhs = mkAbsentErrorApp arg_ty msg msg = showSDoc (gopt_set dflags Opt_SuppressUniques) - (ppr arg <+> ppr (idType arg) <+> file_msg) + (vcat + [ text "Arg:" <+> ppr arg + , text "Type:" <+> ppr arg_ty + , file_msg + ]) file_msg = case outputFile dflags of Nothing -> empty - Just f -> text "in output file " <+> quotes (text f) + Just f -> text "In output file " <+> quotes (text f) -- We need to suppress uniques here because otherwise they'd -- end up in the generated code as strings. This is bad for -- determinism, because with different uniques the strings ===================================== compiler/GHC/Core/Tidy.hs ===================================== @@ -21,7 +21,7 @@ import GHC.Core import GHC.Core.Seq ( seqUnfolding ) import GHC.Types.Id import GHC.Types.Id.Info -import GHC.Types.Demand ( zapUsageEnvSig ) +import GHC.Types.Demand ( zapDmdEnvSig ) import GHC.Core.Type ( tidyType, tidyVarBndr ) import GHC.Core.Coercion ( tidyCo ) import GHC.Types.Var @@ -206,7 +206,7 @@ tidyLetBndr rec_tidy_env env@(tidy_env, var_env) id new_info = vanillaIdInfo `setOccInfo` occInfo old_info `setArityInfo` arityInfo old_info - `setStrictnessInfo` zapUsageEnvSig (strictnessInfo old_info) + `setStrictnessInfo` zapDmdEnvSig (strictnessInfo old_info) `setDemandInfo` demandInfo old_info `setInlinePragInfo` inlinePragInfo old_info `setUnfoldingInfo` new_unf ===================================== compiler/GHC/Types/Demand.hs ===================================== @@ -34,7 +34,7 @@ module GHC.Types.Demand ( lazyApply1Dmd, lazyApply2Dmd, strictOnceApply1Dmd, strictManyApply1Dmd, -- ** Other @Demand@ operations oneifyCard, oneifyDmd, strictifyDmd, strictifyDictDmd, mkWorkerDemand, - peelCallDmd, peelManyCalls, mkCallDmd, mkCallDmds, + peelCallDmd, peelManyCalls, mkCalledOnceDmd, mkCalledOnceDmds, addCaseBndrDmd, -- ** Extracting one-shot information argOneShots, argsOneShots, saturatedByOneShots, @@ -73,7 +73,7 @@ module GHC.Types.Demand ( seqDemand, seqDemandList, seqDmdType, seqStrictSig, -- * Zapping usage information - zapUsageDemand, zapUsageEnvSig, zapUsedOnceDemand, zapUsedOnceSig + zapUsageDemand, zapDmdEnvSig, zapUsedOnceDemand, zapUsedOnceSig ) where #include "HsVersions.h" @@ -278,7 +278,8 @@ data SubDemand -- ^ @Call n sd@ describes the evaluation context of @n@ function -- applications, where every individual result is evaluated according to @sd at . -- @sd@ is /relative/ to a single call, cf. Note [Call demands are relative]. - -- Used only for values of function type. + -- Used only for values of function type. Use the smart constructor 'mkCall' + -- whenever possible! | Prod ![Demand] -- ^ @Prod ds@ describes the evaluation context of a case scrutinisation -- on an expression of product type, where the product components are @@ -306,7 +307,7 @@ polyDmd C_1N = C_1N :* poly1N polyDmd C_10 = C_10 :* poly10 -- | A smart constructor for 'Prod', applying rewrite rules along the semantic --- equalities @Prod [polyDmd n, ...] === polyDmd n@, simplifying to 'Poly' +-- equality @Prod [polyDmd n, ...] === polyDmd n@, simplifying to 'Poly' -- 'SubDemand's when possible. Note that this degrades boxity information! E.g. a -- polymorphic demand will never unbox. mkProd :: [Demand] -> SubDemand @@ -335,6 +336,13 @@ viewProd _ _ = Nothing {-# INLINE viewProd #-} -- we want to fuse away the replicate and the allocation -- for Arity. Otherwise, #18304 bites us. +-- | A smart constructor for 'Call', applying rewrite rules along the semantic +-- equality @Call n (Poly n) === Poly n@, simplifying to 'Poly' 'SubDemand's +-- when possible. +mkCall :: Card -> SubDemand -> SubDemand +mkCall n cd@(Poly m) | n == m = cd +mkCall n cd = Call n cd + -- | @viewCall sd@ interprets @sd@ as a 'Call', expanding 'Poly' demands as -- necessary. viewCall :: SubDemand -> Maybe (Card, SubDemand) @@ -356,8 +364,8 @@ lubSubDmd (Prod ds1) (viewProd (length ds1) -> Just ds2) = -- Handle Call lubSubDmd (Call n1 d1) (viewCall -> Just (n2, d2)) -- See Note [Call demands are relative] - | isAbs n2 = Call (lubCard n1 n2) (lubSubDmd d1 botSubDmd) - | otherwise = Call (lubCard n1 n2) (lubSubDmd d1 d2) + | isAbs n2 = mkCall (lubCard n1 n2) (lubSubDmd d1 botSubDmd) + | otherwise = mkCall (lubCard n1 n2) (lubSubDmd d1 d2) -- Handle Poly lubSubDmd (Poly n1) (Poly n2) = Poly (lubCard n1 n2) -- Make use of reflexivity (so we'll match the Prod or Call cases again). @@ -377,8 +385,8 @@ plusSubDmd (Prod ds1) (viewProd (length ds1) -> Just ds2) = -- Handle Call plusSubDmd (Call n1 d1) (viewCall -> Just (n2, d2)) -- See Note [Call demands are relative] - | isAbs n2 = Call (plusCard n1 n2) (lubSubDmd d1 botSubDmd) - | otherwise = Call (plusCard n1 n2) (lubSubDmd d1 d2) + | isAbs n2 = mkCall (plusCard n1 n2) (lubSubDmd d1 botSubDmd) + | otherwise = mkCall (plusCard n1 n2) (lubSubDmd d1 d2) -- Handle Poly plusSubDmd (Poly n1) (Poly n2) = Poly (plusCard n1 n2) -- Make use of reflexivity (so we'll match the Prod or Call cases again). @@ -407,7 +415,7 @@ multSubDmd :: Card -> SubDemand -> SubDemand multSubDmd n sd | Just sd' <- multTrivial n seqSubDmd sd = sd' multSubDmd n (Poly n') = Poly (multCard n n') -multSubDmd n (Call n' sd) = Call (multCard n n') sd -- See Note [Call demands are relative] +multSubDmd n (Call n' sd) = mkCall (multCard n n') sd -- See Note [Call demands are relative] multSubDmd n (Prod ds) = Prod (map (multDmd n) ds) multDmd :: Card -> Demand -> Demand @@ -457,22 +465,22 @@ evalDmd = C_1N :* topSubDmd -- | First argument of 'GHC.Exts.maskAsyncExceptions#': @SCS(U)@. -- Called exactly once. strictOnceApply1Dmd :: Demand -strictOnceApply1Dmd = C_11 :* Call C_11 topSubDmd +strictOnceApply1Dmd = C_11 :* mkCall C_11 topSubDmd -- | First argument of 'GHC.Exts.atomically#': @MCM(U)@. -- Called at least once, possibly many times. strictManyApply1Dmd :: Demand -strictManyApply1Dmd = C_1N :* Call C_1N topSubDmd +strictManyApply1Dmd = C_1N :* mkCall C_1N topSubDmd -- | First argument of catch#: @1C1(U)@. -- Evaluates its arg lazily, but then applies it exactly once to one argument. lazyApply1Dmd :: Demand -lazyApply1Dmd = C_01 :* Call C_01 topSubDmd +lazyApply1Dmd = C_01 :* mkCall C_01 topSubDmd -- | Second argument of catch#: @1C1(CS(U))@. -- Calls its arg lazily, but then applies it exactly once to an additional argument. lazyApply2Dmd :: Demand -lazyApply2Dmd = C_01 :* Call C_01 (Call C_11 topSubDmd) +lazyApply2Dmd = C_01 :* mkCall C_01 (mkCall C_11 topSubDmd) -- | Make a 'Demand' evaluated at-most-once. oneifyDmd :: Demand -> Demand @@ -512,12 +520,12 @@ strictifyDictDmd ty (n :* Prod ds) strictifyDictDmd _ dmd = dmd -- | Wraps the 'SubDemand' with a one-shot call demand: @d@ -> @CS(d)@. -mkCallDmd :: SubDemand -> SubDemand -mkCallDmd sd = Call C_11 sd +mkCalledOnceDmd :: SubDemand -> SubDemand +mkCalledOnceDmd sd = mkCall C_11 sd --- | @mkCallDmds n d@ returns @CS(CS...(CS d))@ where there are @n@ @CS@'s. -mkCallDmds :: Arity -> SubDemand -> SubDemand -mkCallDmds arity sd = iterate mkCallDmd sd !! arity +-- | @mkCalledOnceDmds n d@ returns @CS(CS...(CS d))@ where there are @n@ @CS@'s. +mkCalledOnceDmds :: Arity -> SubDemand -> SubDemand +mkCalledOnceDmds arity sd = iterate mkCalledOnceDmd sd !! arity -- | Peels one call level from the sub-demand, and also returns how many -- times we entered the lambda body. @@ -669,7 +677,7 @@ This is needed even for non-product types, in case the case-binder is used but the components of the case alternative are not. Note [Don't optimise UP(U,U,...) to U] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ These two SubDemands: UP(U,U) (@Prod [topDmd, topDmd]@) and U (@topSubDmd@) are semantically equivalent, but we do not turn the former into @@ -1571,9 +1579,9 @@ This is weird, so I'm not worried about whether this optimises brilliantly; but it should not fall over. -} -zapUsageEnvSig :: StrictSig -> StrictSig --- Remove the usage environment from the demand -zapUsageEnvSig (StrictSig (DmdType _ ds r)) = mkClosedStrictSig ds r +-- | Remove the demand environment from the signature. +zapDmdEnvSig :: StrictSig -> StrictSig +zapDmdEnvSig (StrictSig (DmdType _ ds r)) = mkClosedStrictSig ds r zapUsageDemand :: Demand -> Demand -- Remove the usage info, but not the strictness info, from the demand @@ -1615,8 +1623,8 @@ kill_usage kfs (n :* sd) = kill_usage_card kfs n :* kill_usage_sd kfs sd kill_usage_sd :: KillFlags -> SubDemand -> SubDemand kill_usage_sd kfs (Call n sd) - | kf_called_once kfs = Call (lubCard C_1N n) (kill_usage_sd kfs sd) - | otherwise = Call n (kill_usage_sd kfs sd) + | kf_called_once kfs = mkCall (lubCard C_1N n) (kill_usage_sd kfs sd) + | otherwise = mkCall n (kill_usage_sd kfs sd) kill_usage_sd kfs (Prod ds) = Prod (map (kill_usage kfs) ds) kill_usage_sd _ sd = sd @@ -1640,7 +1648,7 @@ trimToType (n :* sd) ts where go (Prod ds) (TsProd tss) | equalLength ds tss = Prod (zipWith trimToType ds tss) - go (Call n sd) (TsFun ts) = Call n (go sd ts) + go (Call n sd) (TsFun ts) = mkCall n (go sd ts) go sd at Poly{} _ = sd go _ _ = topSubDmd @@ -1804,7 +1812,7 @@ instance Binary SubDemand where h <- getByte bh case h of 0 -> Poly <$> get bh - 1 -> Call <$> get bh <*> get bh + 1 -> mkCall <$> get bh <*> get bh 2 -> Prod <$> get bh _ -> pprPanic "Binary:SubDemand" (ppr (fromIntegral h :: Int)) ===================================== compiler/GHC/Types/Id/Info.hs ===================================== @@ -650,7 +650,7 @@ zapUsageInfo info = Just (info {demandInfo = zapUsageDemand (demandInfo info)}) zapUsageEnvInfo :: IdInfo -> Maybe IdInfo zapUsageEnvInfo info | hasDemandEnvSig (strictnessInfo info) - = Just (info {strictnessInfo = zapUsageEnvSig (strictnessInfo info)}) + = Just (info {strictnessInfo = zapDmdEnvSig (strictnessInfo info)}) | otherwise = Nothing ===================================== testsuite/tests/arityanal/should_compile/Arity11.stderr ===================================== @@ -35,7 +35,7 @@ end Rec } -- RHS size: {terms: 52, types: 28, coercions: 0, joins: 0/5} F11.$wfib [InlPrag=[2]] :: forall {a} {p}. (a -> a -> Bool) -> (Num a, Num p) => a -> p -[GblId, Arity=4, Str=, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 150 60 0] 460 0}] +[GblId, Arity=4, Str=, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 150 60 0] 460 0}] F11.$wfib = \ (@a) (@p) (ww :: a -> a -> Bool) (w :: Num a) (w1 :: Num p) (w2 :: a) -> let { @@ -73,7 +73,7 @@ F11.$wfib fib [InlPrag=[2]] :: forall {a} {p}. (Eq a, Num a, Num p) => a -> p [GblId, Arity=4, - Str=, + Str=, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=4,unsat_ok=True,boring_ok=False) Tmpl= \ (@a) (@p) (w [Occ=Once1!] :: Eq a) (w1 [Occ=Once1] :: Num a) (w2 [Occ=Once1] :: Num p) (w3 [Occ=Once1] :: a) -> case w of { GHC.Classes.C:Eq ww1 [Occ=Once1] _ [Occ=Dead] -> F11.$wfib @a @p ww1 w1 w2 w3 }}] fib = \ (@a) (@p) (w :: Eq a) (w1 :: Num a) (w2 :: Num p) (w3 :: a) -> case w of { GHC.Classes.C:Eq ww1 ww2 -> F11.$wfib @a @p ww1 w1 w2 w3 } ===================================== testsuite/tests/arityanal/should_compile/Arity16.stderr ===================================== @@ -5,7 +5,7 @@ Result size of Tidy Core = {terms: 52, types: 87, coercions: 0, joins: 0/0} Rec { -- RHS size: {terms: 15, types: 17, coercions: 0, joins: 0/0} map2 [Occ=LoopBreaker] :: forall {t} {a}. (t -> a) -> [t] -> [a] -[GblId, Arity=2, Str=, Unf=OtherCon []] +[GblId, Arity=2, Str=, Unf=OtherCon []] map2 = \ (@t) (@a) (f :: t -> a) (ds :: [t]) -> case ds of { ===================================== testsuite/tests/stranal/should_compile/T18894.hs ===================================== @@ -0,0 +1,28 @@ +{-# OPTIONS_GHC -O2 -fforce-recomp #-} + +-- | The point of this test is that @g*@ get's a demand that says +-- "whenever @g*@ is called, the second component of the pair is evaluated strictly". +module T18894 (h1, h2) where + +g1 :: Int -> (Int,Int) +g1 1 = (15, 0) +g1 n = (2 * n, 2 `div` n) +{-# NOINLINE g1 #-} + +h1 :: Int -> Int +h1 1 = 0 +-- Sadly, the @g1 2@ subexpression will be floated to top-level, where we +-- don't see the specific demand placed on it by @snd at . Tracked in #19001. +h1 2 = snd (g1 2) +h1 m = uncurry (+) (g1 m) + +g2 :: Int -> Int -> (Int,Int) +g2 m 1 = (m, 0) +g2 m n = (2 * m, 2 `div` n) +{-# NOINLINE g2 #-} + +h2 :: Int -> Int +h2 1 = 0 +h2 m + | odd m = snd (g2 m 2) + | otherwise = uncurry (+) (g2 2 m) ===================================== testsuite/tests/stranal/should_compile/T18894.stderr ===================================== @@ -0,0 +1,404 @@ + +==================== Demand analysis ==================== +Result size of Demand analysis + = {terms: 177, types: 97, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 36, types: 16, coercions: 0, joins: 0/0} +g2 [InlPrag=NOINLINE, Dmd=UCU(CS(P(1P(U),SP(U))))] + :: Int -> Int -> (Int, Int) +[LclId, + Arity=2, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20 20] 161 20}] +g2 + = \ (m [Dmd=UP(U)] :: Int) (ds [Dmd=SP(SU)] :: Int) -> + case ds of { GHC.Types.I# ds [Dmd=SU] -> + case ds of ds [Dmd=1U] { + __DEFAULT -> + (case m of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.*# 2# y) }, + case ds of wild { + __DEFAULT -> + case GHC.Classes.divInt# 2# wild of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> GHC.Types.I# -2#; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + }); + 1# -> (m, lvl) + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 36, types: 19, coercions: 0, joins: 0/0} +h2 :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 162 10}] +h2 + = \ (ds [Dmd=SP(MU)] :: Int) -> + case ds of wild [Dmd=UP(U)] { GHC.Types.I# ds [Dmd=MU] -> + case ds of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> + case g2 wild lvl of { (ds1 [Dmd=A], y [Dmd=SU]) -> y }; + 0# -> + case g2 lvl wild of { (x [Dmd=SP(U)], ds [Dmd=SP(U)]) -> + case x of { GHC.Types.I# x -> + case ds of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + } + }; + 1# -> lvl + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 15# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +lvl :: (Int, Int) +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = (lvl, lvl) + +-- RHS size: {terms: 30, types: 11, coercions: 0, joins: 0/0} +g1 [InlPrag=NOINLINE, Dmd=UCU(P(UP(U),UP(U)))] :: Int -> (Int, Int) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 141 10}] +g1 + = \ (ds [Dmd=SP(SU)] :: Int) -> + case ds of { GHC.Types.I# ds [Dmd=SU] -> + case ds of ds { + __DEFAULT -> + (GHC.Types.I# (GHC.Prim.*# 2# ds), + case ds of wild { + __DEFAULT -> + case GHC.Classes.divInt# 2# wild of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> GHC.Types.I# -2#; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + }); + 1# -> lvl + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +lvl :: (Int, Int) +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=False, ConLike=False, + WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 30 0}] +lvl = g1 (GHC.Types.I# 2#) + +-- RHS size: {terms: 28, types: 18, coercions: 0, joins: 0/0} +h1 :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 111 10}] +h1 + = \ (ds [Dmd=SP(MU)] :: Int) -> + case ds of wild [Dmd=1P(1U)] { GHC.Types.I# ds [Dmd=MU] -> + case ds of { + __DEFAULT -> + case g1 wild of { (x [Dmd=SP(U)], ds [Dmd=SP(U)]) -> + case x of { GHC.Types.I# x -> + case ds of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + }; + 1# -> lvl; + 2# -> case lvl of { (ds1 [Dmd=A], y [Dmd=SU]) -> y } + } + } + + + + +==================== Demand analysis ==================== +Result size of Demand analysis + = {terms: 171, types: 120, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# -2# + +-- RHS size: {terms: 32, types: 18, coercions: 0, joins: 0/0} +$wg2 [InlPrag=NOINLINE, Dmd=UCU(CS(P(1P(U),SP(U))))] + :: Int -> GHC.Prim.Int# -> (# Int, Int #) +[LclId, + Arity=2, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20 30] 121 20}] +$wg2 + = \ (w [Dmd=UP(U)] :: Int) (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + (# case w of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.*# 2# y) }, + case ds of { + __DEFAULT -> + case GHC.Classes.divInt# 2# ds of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> lvl; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + } #); + 1# -> (# w, lvl #) + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 34, types: 21, coercions: 0, joins: 0/0} +$wh2 [InlPrag=[2]] :: GHC.Prim.Int# -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 162 10}] +$wh2 + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> + case $wg2 (GHC.Types.I# ds) 2# of + { (# ww [Dmd=A], ww [Dmd=SU] #) -> + ww + }; + 0# -> + case $wg2 lvl ds of { (# ww [Dmd=SP(U)], ww [Dmd=SP(U)] #) -> + case ww of { GHC.Types.I# x -> + case ww of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + } + }; + 1# -> lvl + } + +-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} +h2 [InlPrag=[2]] :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (w [Occ=Once1!] :: Int) -> + case w of { GHC.Types.I# ww [Occ=Once1, Dmd=MU] -> $wh2 ww }}] +h2 + = \ (w [Dmd=SP(SU)] :: Int) -> + case w of { GHC.Types.I# ww [Dmd=SU] -> $wh2 ww } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 15# + +-- RHS size: {terms: 28, types: 15, coercions: 0, joins: 0/0} +$wg1 [InlPrag=NOINLINE, Dmd=UCU(P(UP(U),UP(U)))] + :: GHC.Prim.Int# -> (# Int, Int #) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 111 20}] +$wg1 + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + (# GHC.Types.I# (GHC.Prim.*# 2# ds), + case ds of { + __DEFAULT -> + case GHC.Classes.divInt# 2# ds of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> lvl; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + } #); + 1# -> (# lvl, lvl #) + } + +-- RHS size: {terms: 7, types: 9, coercions: 0, joins: 0/0} +lvl :: (Int, Int) +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=False, ConLike=False, + WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 40 10}] +lvl = case $wg1 2# of { (# ww, ww #) -> (ww, ww) } + +-- RHS size: {terms: 25, types: 18, coercions: 0, joins: 0/0} +$wh1 [InlPrag=[2]] :: GHC.Prim.Int# -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [50] 101 10}] +$wh1 + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds [Dmd=1U] { + __DEFAULT -> + case $wg1 ds of { (# ww [Dmd=SP(U)], ww [Dmd=SP(U)] #) -> + case ww of { GHC.Types.I# x -> + case ww of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + }; + 1# -> lvl; + 2# -> case lvl of { (ds1 [Dmd=A], y [Dmd=SU]) -> y } + } + +-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} +h1 [InlPrag=[2]] :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (w [Occ=Once1!] :: Int) -> + case w of { GHC.Types.I# ww [Occ=Once1, Dmd=MU] -> $wh1 ww }}] +h1 + = \ (w [Dmd=SP(SU)] :: Int) -> + case w of { GHC.Types.I# ww [Dmd=SU] -> $wh1 ww } + + + ===================================== testsuite/tests/stranal/should_compile/all.T ===================================== @@ -58,3 +58,5 @@ test('T18122', [ grep_errmsg(r'wfoo =') ], compile, ['-ddump-simpl']) # We care about the call demand on $wg test('T18903', [ grep_errmsg(r'Dmd=\S+C\S+') ], compile, ['-ddump-simpl -dsuppress-uniques']) +# We care about the call demand on $wg1 and $wg2 +test('T18894', [ grep_errmsg(r'Dmd=\S+C\S+') ], compile, ['-ddump-stranal -dsuppress-uniques']) ===================================== testsuite/tests/stranal/sigs/T5075.stderr ===================================== @@ -1,7 +1,7 @@ ==================== Strictness signatures ==================== T5075.$trModule: -T5075.loop: +T5075.loop: @@ -13,6 +13,6 @@ T5075.loop: ==================== Strictness signatures ==================== T5075.$trModule: -T5075.loop: +T5075.loop: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3a7344fb01f296a88e8136de47a81a5d2448d795...46e64ccd4cd1e139f3fe1f6b579f590703c91d99 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3a7344fb01f296a88e8136de47a81a5d2448d795...46e64ccd4cd1e139f3fe1f6b579f590703c91d99 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 2 18:21:03 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 02 Dec 2020 13:21:03 -0500 Subject: [Git][ghc/ghc][wip/keepAlive-the-return-of-the-primop] 2 commits: GHC.Event.IntTable: Use unsafeWithForeignPtr Message-ID: <5fc7db0f3ee2b_86cf5745681365411@gitlab.mail> Ben Gamari pushed to branch wip/keepAlive-the-return-of-the-primop at Glasgow Haskell Compiler / GHC Commits: 97aa7d1f by Ben Gamari at 2020-12-01T12:15:29-05:00 GHC.Event.IntTable: Use unsafeWithForeignPtr - - - - - 29a1a41c by Ben Gamari at 2020-12-02T13:20:38-05:00 testsuite fixes - - - - - 3 changed files: - libraries/base/GHC/Event/IntTable.hs - testsuite/tests/ghci/should_run/T16012.script - testsuite/tests/ghci/should_run/T16012.stdout Changes: ===================================== libraries/base/GHC/Event/IntTable.hs ===================================== @@ -17,7 +17,8 @@ module GHC.Event.IntTable import Data.Bits ((.&.), shiftL, shiftR) import Data.IORef (IORef, newIORef, readIORef, writeIORef) import Data.Maybe (Maybe(..), isJust) -import Foreign.ForeignPtr (ForeignPtr, mallocForeignPtr, withForeignPtr) +import Foreign.ForeignPtr (ForeignPtr, mallocForeignPtr) +import GHC.ForeignPtr (unsafeWithForeignPtr) import Foreign.Storable (peek, poke) import GHC.Base (Monad(..), (=<<), ($), ($!), const, liftM, otherwise, when) import GHC.Classes (Eq(..), Ord(..)) @@ -62,7 +63,7 @@ new_ :: Int -> IO (IT a) new_ capacity = do arr <- Arr.new Empty capacity size <- mallocForeignPtr - withForeignPtr size $ \ptr -> poke ptr 0 + unsafeWithForeignPtr size $ \ptr -> poke ptr 0 return IT { tabArr = arr , tabSize = size } @@ -81,7 +82,7 @@ grow oldit ref size = do copyBucket (m+1) bucketNext copyBucket n =<< Arr.read (tabArr oldit) i copySlot 0 0 - withForeignPtr (tabSize newit) $ \ptr -> poke ptr size + unsafeWithForeignPtr (tabSize newit) $ \ptr -> poke ptr size writeIORef ref newit -- | @insertWith f k v table@ inserts @k@ into @table@ with value @v at . @@ -100,7 +101,7 @@ insertWith f k v inttable@(IntTable ref) = do Arr.write tabArr idx (Bucket k v' next) return (Just bucketValue) | otherwise = go bkt { bucketNext = seen } bucketNext - go seen _ = withForeignPtr tabSize $ \ptr -> do + go seen _ = unsafeWithForeignPtr tabSize $ \ptr -> do size <- peek ptr if size + 1 >= Arr.size tabArr - (Arr.size tabArr `shiftR` 2) then grow it ref size >> insertWith f k v inttable @@ -139,7 +140,7 @@ updateWith f k (IntTable ref) = do when (isJust oldVal) $ do Arr.write tabArr idx newBucket when del $ - withForeignPtr tabSize $ \ptr -> do + unsafeWithForeignPtr tabSize $ \ptr -> do size <- peek ptr poke ptr (size - 1) return oldVal ===================================== testsuite/tests/ghci/should_run/T16012.script ===================================== @@ -3,4 +3,4 @@ -- should always return a reasonably low result. n <- System.Mem.getAllocationCounter -if (n < 0 && n >= -160000) then putStrLn "Alloction counter in expected range" else (putStrLn $ "Unexpected allocation counter result:" ++ show n) +if (n < 0 && n >= -200000) then putStrLn "Allocation counter in expected range" else (putStrLn $ "Unexpected allocation counter result:" ++ show n) ===================================== testsuite/tests/ghci/should_run/T16012.stdout ===================================== @@ -1 +1 @@ -Alloction counter in expected range +Allocation counter in expected range View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e11f088bf1f36cd8889ece8dd59c5d8964b8a2eb...29a1a41cac433c9b7eadfc03aceadd5ac69a4999 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e11f088bf1f36cd8889ece8dd59c5d8964b8a2eb...29a1a41cac433c9b7eadfc03aceadd5ac69a4999 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 2 21:23:10 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Wed, 02 Dec 2020 16:23:10 -0500 Subject: [Git][ghc/ghc][wip/T18894] 2 commits: DmdAnal: Annotate top-level function bindings with demands (#18894) Message-ID: <5fc805be42877_86c13315e80137521b@gitlab.mail> Sebastian Graf pushed to branch wip/T18894 at Glasgow Haskell Compiler / GHC Commits: ad874c06 by Sebastian Graf at 2020-12-02T22:22:59+01:00 DmdAnal: Annotate top-level function bindings with demands (#18894) It's useful to annotate a non-exported top-level function like `g` in ```hs module Lib (h) where g :: Int -> Int -> (Int,Int) g m 1 = (m, 0) g m n = (2 * m, 2 `div` n) {-# NOINLINE g #-} h :: Int -> Int h 1 = 0 h m | odd m = snd (g m 2) | otherwise = uncurry (+) (g 2 m) ``` with its demand `UCU(CS(P(1P(U),SP(U))`, which tells us that whenever `g` was called, the second component of the returned pair was evaluated strictly. Since #18903 we do so for local functions, where we can see all calls. For top-level functions, we can assume that all *exported* functions are demanded according to `topDmd` and thus get sound demands for non-exported top-level functions. The demand on `g` is crucial information for Nested CPR, which may the go on and unbox `g` for the second pair component. That is true even if that pair component may diverge, as is the case for the call site `g 13 0`, which throws a div-by-zero exception. In `T18894b`, you can even see the new demand annotation enabling us to eta-expand a function that we wouldn't be able to eta-expand without Call Arity. We only track bindings of function type in order not to risk huge compile-time regressions, see `isInterestingTopLevelFn`. Fixes #18894. - - - - - 829ecab3 by Sebastian Graf at 2020-12-02T22:22:59+01:00 Demand: Simplify `CU(U)` to `U` (#19005) Both sub-demands encode the same information. This is a trivial change and already affects a few regression tests (e.g. `T5075`), so no separate regression test is necessary. - - - - - 15 changed files: - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Types/Demand.hs - compiler/GHC/Types/Id/Info.hs - testsuite/tests/arityanal/should_compile/Arity11.stderr - testsuite/tests/arityanal/should_compile/Arity16.stderr - + testsuite/tests/stranal/should_compile/T18894.hs - + testsuite/tests/stranal/should_compile/T18894.stderr - + testsuite/tests/stranal/should_compile/T18894b.hs - + testsuite/tests/stranal/should_compile/T18894b.stderr - testsuite/tests/stranal/should_compile/all.T - testsuite/tests/stranal/sigs/T5075.stderr Changes: ===================================== compiler/GHC/Core/FVs.hs ===================================== @@ -525,12 +525,11 @@ ruleLhsFVIds (Rule { ru_bndrs = bndrs, ru_args = args }) = filterFV isLocalId $ addBndrs bndrs (exprs_fvs args) ruleRhsFreeIds :: CoreRule -> VarSet --- ^ This finds all locally-defined free Ids on the left hand side of a rule +-- ^ This finds all locally-defined free Ids on the right hand side of a rule -- and returns them as a non-deterministic set ruleRhsFreeIds (BuiltinRule {}) = emptyVarSet -ruleRhsFreeIds (Rule { ru_bndrs = bndrs, ru_args = args }) - = fvVarSet $ filterFV isLocalId $ - addBndrs bndrs $ exprs_fvs args +ruleRhsFreeIds (Rule { ru_bndrs = bndrs, ru_rhs = rhs }) + = fvVarSet $ filterFV isLocalId $ addBndrs bndrs $ expr_fvs rhs {- Note [Rule free var hack] (Not a hack any more) ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -37,6 +37,7 @@ import GHC.Core.Type import GHC.Core.FVs ( exprFreeIds, ruleRhsFreeIds ) import GHC.Core.Coercion ( Coercion, coVarsOfCo ) import GHC.Core.FamInstEnv +import GHC.Core.Opt.Arity ( typeArity ) import GHC.Utils.Misc import GHC.Utils.Panic import GHC.Data.Maybe ( isJust ) @@ -64,28 +65,54 @@ data DmdAnalOpts = DmdAnalOpts -- -- Note: use `seqBinds` on the result to avoid leaks due to lazyness (cf Note -- [Stamp out space leaks in demand analysis]) -dmdAnalProgram :: DmdAnalOpts -> FamInstEnvs -> CoreProgram -> CoreProgram -dmdAnalProgram opts fam_envs binds = binds_plus_dmds - where - env = emptyAnalEnv opts fam_envs - binds_plus_dmds = snd $ mapAccumL dmdAnalTopBind env binds - --- Analyse a (group of) top-level binding(s) -dmdAnalTopBind :: AnalEnv - -> CoreBind - -> (AnalEnv, CoreBind) -dmdAnalTopBind env (NonRec id rhs) - = ( extendAnalEnv TopLevel env id sig - , NonRec (setIdStrictness id sig) rhs') +dmdAnalProgram :: DmdAnalOpts -> FamInstEnvs -> [CoreRule] -> CoreProgram -> CoreProgram +dmdAnalProgram opts fam_envs rules binds + = snd $ go (emptyAnalEnv opts fam_envs) binds where - ( _, sig, rhs') = dmdAnalRhsLetDown Nothing env topSubDmd id rhs - -dmdAnalTopBind env (Rec pairs) - = (env', Rec pairs') - where - (env', _, pairs') = dmdFix TopLevel env topSubDmd pairs - -- We get two iterations automatically - -- c.f. the NonRec case above + -- See Note [Analysing top-level bindings] + -- TLDR; We analyse them like + -- let ex1 = ... in (ex1, let nex1 = ... in let ex2 = ... in (ex2, ...))) + -- where ex* are exported (or RULE mentions) and nex* are not. + go _ [] = (nopDmdType, []) + go env (b:bs) = cons_up $ dmdAnalBind TopLevel env topSubDmd b anal_body + where + anal_body env' + | (body_ty, bs') <- go env' bs + = (add_exported_uses env' body_ty (bindersOf b), bs') + + cons_up :: (a, b, [b]) -> (a, [b]) + cons_up (dmd_ty, b', bs') = (dmd_ty, b':bs') + + add_exported_uses :: AnalEnv -> DmdType -> [Id] -> DmdType + add_exported_uses env = foldl' (add_exported_use env) + + -- | If @e@ is denoted by @dmd_ty@, then @add_exported_use _ dmd_ty id@ + -- corresponds to the demand type of @(id, e)@, but is a lot more direct. + -- See Note [Analysing top-level bindings]. + add_exported_use :: AnalEnv -> DmdType -> Id -> DmdType + add_exported_use env dmd_ty id + | isExportedId id || elemVarSet id rule_fvs + -- See Note [Absence analysis for stable unfoldings and RULES] + = dmd_ty `plusDmdType` fst (dmdAnalStar env topDmd (Var id)) + | otherwise = dmd_ty + + rule_fvs :: IdSet + rule_fvs = foldr (unionVarSet . ruleRhsFreeIds) emptyVarSet rules + +-- | Whether we want to store demands on a top-level Id or just default +-- to 'topDmd'. +-- +-- Basically, we want to now how top-level *functions* are *used* +-- (e.g. called), but aren't interested in whether they were called strictly +-- or not. Other top-level bindings are boring. +isInterestingTopLevelFn :: Id -> Bool +-- SG tried to set this to True and got a +2% ghc/alloc regression in T5642 +-- (which is dominated by the Simplifier) at no gain in analysis precision. +-- If there was a gain, that regression might be acceptable. +-- Plus, we could use LetUp for thunks and share some code with local let +-- bindings. +isInterestingTopLevelFn id = + typeArity (idType id) `lengthExceeds` 0 {- Note [Stamp out space leaks in demand analysis] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -105,8 +132,56 @@ generation would hold on to an extra copy of the Core program, via unforced thunks in demand or strictness information; and it is the most memory-intensive part of the compilation process, so this added seqBinds makes a big difference in peak memory usage. --} +Note [Analysing top-level bindings] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider a CoreProgram like + e1 = ... + n1 = ... + e2 = \a b -> ... fst (n1 a b) ... + n2 = \c d -> ... snd (e2 c d) ... + ... +where e* are exported, but n* are not. +Intuitively, we can see that @n1@ is only ever called with two arguments +and in every call site, the first component of the result of the call +is evaluated. Thus, we'd like it to have idDemandInfo @UCU(C1(P(SU,A))@. + +(This can be exploited by a Nested CPR pass which may then unbox the +first component of the pair returned from @n1 at . Or if @n1@ had arity +1 before, we may now eta-expand to arity 2.) + +NB: We may *not* give e2 a similar annotation, because it is exported and +external callers might use it in arbitrary ways, expressed by 'topDmd'. + +How do we get this result? Answer: By analysing the program as if it was a let +expression of this form: + let e1 = ... in + (e1, let n1 = ... in + ( let e2 = ... in + (e2, let n2 = ... in + ( ...)))) +E.g. putting all bindings in nested lets, where whenever it binds an exported +binding, the body is a *pair* of an occurrence of the exported binder and +the other nested lets. Of course, we will not actually build that CoreExpr! +Instead we faithfully simulate analysis of said expression by adding the +free variable 'DmdEnv' of @e*@'s strictness signatures to the 'DmdType' we +get from analysing the nested bindings. + +You might also wonder why we didn't analyse in terms of the simpler + let e1 = ... in + let n1 = ... in + let e2 = ... in + let n2 = ... in + (e1,e2, ...) +The reason is analysis performance: If @e1@ uses many free variables, we'll +unnecessarily carry their demands around with us from the moment we analyse +the pair to the moment we bubble back up to the binding for @e1 at . +This blows up e.g. @T10370 at . + +A final note about variables occuring free in RULE RHSs: They are to be handled +pretty much like exported Ids. +See also Note [Absence analysis for stable unfoldings and RULES] +-} {- ************************************************************************ @@ -114,7 +189,103 @@ seqBinds makes a big difference in peak memory usage. \subsection{The analyser itself} * * ************************************************************************ +-} + +-- | Analyse a binding group and its \"body\", e.g. where it is in scope. +-- +-- It calls a function that knows how to analyse this \"body\" given +-- an 'AnalEnv' with updated demand signatures for the binding group +-- (reflecting their 'idStrictnessInfo') and expects to receive a +-- 'DmdType' in return, which it uses to annotate the binding group with their +-- 'idDemandInfo'. +dmdAnalBind + :: TopLevelFlag + -> AnalEnv + -> SubDemand -- ^ Demand put on the "body" + -- (important for join points) + -> CoreBind + -> (AnalEnv -> (DmdType, a)) -- ^ How to analyse the "body", e.g. + -- where the binding is in scope + -> (DmdType, CoreBind, a) +dmdAnalBind top_lvl env dmd bind anal_body = case bind of + NonRec id rhs + | useLetUp top_lvl id + -> dmdAnalBindLetUp top_lvl env id rhs anal_body + _ -> dmdAnalBindLetDown top_lvl env dmd bind anal_body + +-- | Annotates uninteresting top level functions ('isInterestingTopLevelFn') +-- with 'topDmd', the rest with the given demand. +setBindIdDemandInfo :: TopLevelFlag -> Id -> Demand -> Id +setBindIdDemandInfo top_lvl id dmd = setIdDemandInfo id $ case top_lvl of + TopLevel | not (isInterestingTopLevelFn id) -> topDmd + _ -> dmd + +-- | Let bindings can be processed in two ways: +-- Down (RHS before body) or Up (body before RHS). +-- This function handles the up variant. +-- +-- It is very simple. For let x = rhs in body +-- * Demand-analyse 'body' in the current environment +-- * Find the demand, 'rhs_dmd' placed on 'x' by 'body' +-- * Demand-analyse 'rhs' in 'rhs_dmd' +-- +-- This is used for a non-recursive local let without manifest lambdas (see +-- 'useLetUp'). +-- +-- This is the LetUp rule in the paper “Higher-Order Cardinality Analysis”. +dmdAnalBindLetUp :: TopLevelFlag -> AnalEnv -> Id -> CoreExpr -> (AnalEnv -> (DmdType, a)) -> (DmdType, CoreBind, a) +dmdAnalBindLetUp top_lvl env id rhs anal_body = (final_ty, NonRec id' rhs', body') + where + (body_ty, body') = anal_body env + (body_ty', id_dmd) = findBndrDmd env notArgOfDfun body_ty id + id' = setBindIdDemandInfo top_lvl id id_dmd + (rhs_ty, rhs') = dmdAnalStar env (dmdTransformThunkDmd rhs id_dmd) rhs + final_ty = body_ty' `plusDmdType` rhs_ty + +-- | Let bindings can be processed in two ways: +-- Down (RHS before body) or Up (body before RHS). +-- This function handles the down variant. +-- +-- It computes a demand signature (by means of 'dmdAnalRhsSig') and uses +-- that at call sites in the body. +-- +-- It is used for toplevel definitions, recursive definitions and local +-- non-recursive definitions that have manifest lambdas (cf. 'useLetUp'). +-- Local non-recursive definitions without a lambda are handled with LetUp. +-- +-- This is the LetDown rule in the paper “Higher-Order Cardinality Analysis”. +dmdAnalBindLetDown :: TopLevelFlag -> AnalEnv -> SubDemand -> CoreBind -> (AnalEnv -> (DmdType, a)) -> (DmdType, CoreBind, a) +dmdAnalBindLetDown top_lvl env dmd bind anal_body = case bind of + NonRec id rhs + | (env', lazy_fv, id1, rhs1) <- + dmdAnalRhsSig top_lvl NonRecursive env dmd id rhs + -> do_rest env' lazy_fv [(id1, rhs1)] (\[(id2, rhs2)] -> NonRec id2 rhs2) + Rec pairs + | (env', lazy_fv, pairs') <- dmdFix top_lvl env dmd pairs + -> do_rest env' lazy_fv pairs' Rec + where + do_rest env' lazy_fv pairs1 build_bind = (final_ty, build_bind pairs2, body') + where + (body_ty, body') = anal_body env' + -- see Note [Lazy and unleashable free variables] + dmd_ty = addLazyFVs body_ty lazy_fv + (!final_ty, id_dmds) = findBndrsDmds env' dmd_ty (map fst pairs1) + pairs2 = zipWith do_one pairs1 id_dmds + do_one (id', rhs') dmd = (setBindIdDemandInfo top_lvl id' dmd, rhs') + -- If the actual demand is better than the vanilla call + -- demand, you might think that we might do better to re-analyse + -- the RHS with the stronger demand. + -- But (a) That seldom happens, because it means that *every* path in + -- the body of the let has to use that stronger demand + -- (b) It often happens temporarily in when fixpointing, because + -- the recursive function at first seems to place a massive demand. + -- But we don't want to go to extra work when the function will + -- probably iterate to something less demanding. + -- In practice, all the times the actual demand on id2 is more than + -- the vanilla call demand seem to be due to (b). So we don't + -- bother to re-analyse the RHS. +{- Note [Ensure demand is strict] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ It's important not to analyse e with a lazy demand because @@ -194,7 +365,7 @@ dmdAnal' env dmd (App fun arg) -- Crucially, coercions /are/ handled here, because they are -- value arguments (#10288) let - call_dmd = mkCallDmd dmd + call_dmd = mkCalledOnceDmd dmd (fun_ty, fun') = dmdAnal env call_dmd fun (arg_dmd, res_ty) = splitDmdTy fun_ty (arg_ty, arg') = dmdAnalStar env (dmdTransformThunkDmd arg arg_dmd) arg @@ -295,60 +466,11 @@ dmdAnal' env dmd (Case scrut case_bndr ty alts) -- , text "res_ty" <+> ppr res_ty ]) $ (res_ty, Case scrut' case_bndr' ty alts') --- Let bindings can be processed in two ways: --- Down (RHS before body) or Up (body before RHS). --- The following case handle the up variant. --- --- It is very simple. For let x = rhs in body --- * Demand-analyse 'body' in the current environment --- * Find the demand, 'rhs_dmd' placed on 'x' by 'body' --- * Demand-analyse 'rhs' in 'rhs_dmd' --- --- This is used for a non-recursive local let without manifest lambdas. --- This is the LetUp rule in the paper “Higher-Order Cardinality Analysis”. -dmdAnal' env dmd (Let (NonRec id rhs) body) - | useLetUp id - = (final_ty, Let (NonRec id' rhs') body') +dmdAnal' env dmd (Let bind body) + = (final_ty, Let bind' body') where - (body_ty, body') = dmdAnal env dmd body - (body_ty', id_dmd) = findBndrDmd env notArgOfDfun body_ty id - id' = setIdDemandInfo id id_dmd - - (rhs_ty, rhs') = dmdAnalStar env (dmdTransformThunkDmd rhs id_dmd) rhs - final_ty = body_ty' `plusDmdType` rhs_ty - -dmdAnal' env dmd (Let (NonRec id rhs) body) - = (body_ty2, Let (NonRec id2 rhs') body') - where - (lazy_fv, sig, rhs') = dmdAnalRhsLetDown Nothing env dmd id rhs - id1 = setIdStrictness id sig - env1 = extendAnalEnv NotTopLevel env id sig - (body_ty, body') = dmdAnal env1 dmd body - (body_ty1, id2) = annotateBndr env body_ty id1 - body_ty2 = addLazyFVs body_ty1 lazy_fv -- see Note [Lazy and unleashable free variables] - - -- If the actual demand is better than the vanilla call - -- demand, you might think that we might do better to re-analyse - -- the RHS with the stronger demand. - -- But (a) That seldom happens, because it means that *every* path in - -- the body of the let has to use that stronger demand - -- (b) It often happens temporarily in when fixpointing, because - -- the recursive function at first seems to place a massive demand. - -- But we don't want to go to extra work when the function will - -- probably iterate to something less demanding. - -- In practice, all the times the actual demand on id2 is more than - -- the vanilla call demand seem to be due to (b). So we don't - -- bother to re-analyse the RHS. - -dmdAnal' env dmd (Let (Rec pairs) body) - = let - (env', lazy_fv, pairs') = dmdFix NotTopLevel env dmd pairs - (body_ty, body') = dmdAnal env' dmd body - body_ty1 = deleteFVs body_ty (map fst pairs) - body_ty2 = addLazyFVs body_ty1 lazy_fv -- see Note [Lazy and unleashable free variables] - in - body_ty2 `seq` - (body_ty2, Let (Rec pairs') body') + (final_ty, bind', body') = dmdAnalBind NotTopLevel env dmd bind go' + go' env' = dmdAnal env' dmd body -- | A simple, syntactic analysis of whether an expression MAY throw a precise -- exception when evaluated. It's always sound to return 'True'. @@ -582,9 +704,13 @@ dmdTransform env var dmd | Just (sig, top_lvl) <- lookupSigEnv env var , let fn_ty = dmdTransformSig sig dmd = -- pprTrace "dmdTransform:LetDown" (vcat [ppr var, ppr sig, ppr dmd, ppr fn_ty]) $ - if isTopLevel top_lvl - then fn_ty -- Don't record demand on top-level things - else addVarDmd fn_ty var (C_11 :* dmd) + case top_lvl of + NotTopLevel -> addVarDmd fn_ty var (C_11 :* dmd) + TopLevel + | isInterestingTopLevelFn var + -> addVarDmd fn_ty var (C_0N `multDmd` (C_11 :* dmd)) -- discard strictness + | otherwise + -> fn_ty -- don't bother tracking; just annotate with 'topDmd' later -- Everything else: -- * Local let binders for which we use LetUp (cf. 'useLetUp') -- * Lambda binders @@ -599,46 +725,46 @@ dmdTransform env var dmd * * ********************************************************************* -} --- Let bindings can be processed in two ways: --- Down (RHS before body) or Up (body before RHS). --- dmdAnalRhsLetDown implements the Down variant: --- * assuming a demand of +-- | @dmdAnalRhsSig@ analyses the given RHS to compute a demand signature +-- for the LetDown rule. It works as follows: +-- +-- * assuming a demand of -- * looking at the definition -- * determining a strictness signature -- --- It is used for toplevel definition, recursive definitions and local --- non-recursive definitions that have manifest lambdas. --- Local non-recursive definitions without a lambda are handled with LetUp. --- --- This is the LetDown rule in the paper “Higher-Order Cardinality Analysis”. -dmdAnalRhsLetDown - :: Maybe [Id] -- Just bs <=> recursive, Nothing <=> non-recursive +-- Since it assumed a demand of , the resulting signature is applicable at +-- any call site. +dmdAnalRhsSig + :: TopLevelFlag + -> RecFlag -> AnalEnv -> SubDemand -> Id -> CoreExpr - -> (DmdEnv, StrictSig, CoreExpr) + -> (AnalEnv, DmdEnv, Id, CoreExpr) -- Process the RHS of the binding, add the strictness signature -- to the Id, and augment the environment with the signature as well. -- See Note [NOINLINE and strictness] -dmdAnalRhsLetDown rec_flag env let_dmd id rhs - = -- pprTrace "dmdAnalRhsLetDown" (ppr id $$ ppr let_dmd $$ ppr sig $$ ppr lazy_fv) $ - (lazy_fv, sig, rhs') +dmdAnalRhsSig top_lvl rec_flag env let_dmd id rhs + = -- pprTrace "dmdAnalRhsSig" (ppr id $$ ppr let_dmd $$ ppr sig $$ ppr lazy_fv) $ + (env', lazy_fv, id', rhs') where rhs_arity = idArity id + -- See Note [Demand signatures are computed for a threshold demand based on idArity] rhs_dmd -- See Note [Demand analysis for join points] -- See Note [Invariants on join points] invariant 2b, in GHC.Core -- rhs_arity matches the join arity of the join point | isJoinId id - = mkCallDmds rhs_arity let_dmd + = mkCalledOnceDmds rhs_arity let_dmd | otherwise - -- NB: rhs_arity - -- See Note [Demand signatures are computed for a threshold demand based on idArity] - = mkRhsDmd env rhs_arity rhs + = mkCalledOnceDmds rhs_arity topSubDmd (rhs_dmd_ty, rhs') = dmdAnal env rhs_dmd rhs DmdType rhs_fv rhs_dmds rhs_div = rhs_dmd_ty sig = mkStrictSigForArity rhs_arity (DmdType sig_fv rhs_dmds rhs_div) + id' = id `setIdStrictness` sig + env' = extendAnalEnv top_lvl env id' sig + -- See Note [Aggregated demand for cardinality] -- FIXME: That Note doesn't explain the following lines at all. The reason -- is really much different: When we have a recursive function, we'd @@ -651,8 +777,8 @@ dmdAnalRhsLetDown rec_flag env let_dmd id rhs -- we'd have to do an additional iteration. reuseEnv makes sure that -- we never get used-once info for FVs of recursive functions. rhs_fv1 = case rec_flag of - Just bs -> reuseEnv (delVarEnvList rhs_fv bs) - Nothing -> rhs_fv + Recursive -> reuseEnv rhs_fv + NonRecursive -> rhs_fv rhs_fv2 = rhs_fv1 `keepAliveDmdEnv` extra_fvs -- Find the RHS free vars of the unfoldings and RULES @@ -669,13 +795,6 @@ dmdAnalRhsLetDown rec_flag env let_dmd id rhs = exprFreeIds unf_body | otherwise = emptyVarSet --- | @mkRhsDmd env rhs_arity rhs@ creates a 'SubDemand' for --- unleashing on the given function's @rhs@, by creating --- a call demand of @rhs_arity@ --- See Historical Note [Product demands for function body] -mkRhsDmd :: AnalEnv -> Arity -> CoreExpr -> SubDemand -mkRhsDmd _env rhs_arity _rhs = mkCallDmds rhs_arity topSubDmd - -- | If given the (local, non-recursive) let-bound 'Id', 'useLetUp' determines -- whether we should process the binding up (body before rhs) or down (rhs -- before body). @@ -720,8 +839,8 @@ mkRhsDmd _env rhs_arity _rhs = mkCallDmds rhs_arity topSubDmd -- * For a more convincing example with join points, see Note [Demand analysis -- for join points]. -- -useLetUp :: Var -> Bool -useLetUp f = idArity f == 0 && not (isJoinId f) +useLetUp :: TopLevelFlag -> Var -> Bool +useLetUp top_lvl f = isNotTopLevel top_lvl && idArity f == 0 && not (isJoinId f) {- Note [Demand analysis for join points] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -939,8 +1058,6 @@ dmdFix :: TopLevelFlag dmdFix top_lvl env let_dmd orig_pairs = loop 1 initial_pairs where - bndrs = map fst orig_pairs - -- See Note [Initialising strictness] initial_pairs | ae_virgin env = [(setIdStrictness id botSig, rhs) | (id, rhs) <- orig_pairs ] | otherwise = orig_pairs @@ -990,10 +1107,8 @@ dmdFix top_lvl env let_dmd orig_pairs = -- pprTrace "my_downRhs" (ppr id $$ ppr (idStrictness id) $$ ppr sig) $ ((env', lazy_fv'), (id', rhs')) where - (lazy_fv1, sig, rhs') = dmdAnalRhsLetDown (Just bndrs) env let_dmd id rhs - lazy_fv' = plusVarEnv_C plusDmd lazy_fv lazy_fv1 - env' = extendAnalEnv top_lvl env id sig - id' = setIdStrictness id sig + (env', lazy_fv1, id', rhs') = dmdAnalRhsSig top_lvl Recursive env let_dmd id rhs + lazy_fv' = plusVarEnv_C plusDmd lazy_fv lazy_fv1 zapIdStrictness :: [(Id, CoreExpr)] -> [(Id, CoreExpr)] zapIdStrictness pairs = [(setIdStrictness id nopSig, rhs) | (id, rhs) <- pairs ] @@ -1090,7 +1205,7 @@ addLazyFVs dmd_ty lazy_fvs -- demand with the bottom coming up from 'error' -- -- I got a loop in the fixpointer without this, due to an interaction - -- with the lazy_fv filtering in dmdAnalRhsLetDown. Roughly, it was + -- with the lazy_fv filtering in dmdAnalRhsSig. Roughly, it was -- letrec f n x -- = letrec g y = x `fatbar` -- letrec h z = z + ...g... @@ -1156,10 +1271,6 @@ annotateLamIdBndr env arg_of_dfun dmd_ty id main_ty = addDemand dmd dmd_ty' (dmd_ty', dmd) = findBndrDmd env arg_of_dfun dmd_ty id -deleteFVs :: DmdType -> [Var] -> DmdType -deleteFVs (DmdType fvs dmds res) bndrs - = DmdType (delVarEnvList fvs bndrs) dmds res - {- Note [NOINLINE and strictness] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Core/Opt/Pipeline.hs ===================================== @@ -65,6 +65,7 @@ import GHC.Types.SrcLoc import GHC.Types.Id import GHC.Types.Id.Info import GHC.Types.Basic +import GHC.Types.Demand ( zapDmdEnvSig ) import GHC.Types.Var.Set import GHC.Types.Var.Env import GHC.Types.Unique.Supply ( UniqSupply, mkSplitUniqSupply, splitUniqSupply ) @@ -495,7 +496,7 @@ doCorePass CoreDoExitify = {-# SCC "Exitify" #-} doPass exitifyProgram doCorePass CoreDoDemand = {-# SCC "DmdAnal" #-} - doPassDFM dmdAnal + doPassDFRM dmdAnal doCorePass CoreDoCpr = {-# SCC "CprAnal" #-} doPassDFM cprAnalProgram @@ -575,6 +576,13 @@ doPassDFM do_pass guts = do let fam_envs = (p_fam_env, mg_fam_inst_env guts) doPassM (liftIO . do_pass dflags fam_envs) guts +doPassDFRM :: (DynFlags -> FamInstEnvs -> [CoreRule] -> CoreProgram -> IO CoreProgram) -> ModGuts -> CoreM ModGuts +doPassDFRM do_pass guts = do + dflags <- getDynFlags + p_fam_env <- getPackageFamInstEnv + let fam_envs = (p_fam_env, mg_fam_inst_env guts) + doPassM (liftIO . do_pass dflags fam_envs (mg_rules guts)) guts + doPassDFU :: (DynFlags -> FamInstEnvs -> UniqSupply -> CoreProgram -> CoreProgram) -> ModGuts -> CoreM ModGuts doPassDFU do_pass guts = do dflags <- getDynFlags @@ -1088,13 +1096,13 @@ transferIdInfo exported_id local_id -dmdAnal :: DynFlags -> FamInstEnvs -> CoreProgram -> IO CoreProgram -dmdAnal dflags fam_envs binds = do +dmdAnal :: DynFlags -> FamInstEnvs -> [CoreRule] -> CoreProgram -> IO CoreProgram +dmdAnal dflags fam_envs rules binds = do let opts = DmdAnalOpts { dmd_strict_dicts = gopt Opt_DictsStrict dflags } - binds_plus_dmds = dmdAnalProgram opts fam_envs binds + binds_plus_dmds = dmdAnalProgram opts fam_envs rules binds Err.dumpIfSet_dyn dflags Opt_D_dump_str_signatures "Strictness signatures" FormatText $ - dumpIdInfoOfProgram (ppr . strictnessInfo) binds_plus_dmds + dumpIdInfoOfProgram (ppr . zapDmdEnvSig . strictnessInfo) binds_plus_dmds -- See Note [Stamp out space leaks in demand analysis] in GHC.Core.Opt.DmdAnal seqBinds binds_plus_dmds `seq` return binds_plus_dmds ===================================== compiler/GHC/Core/Opt/WorkWrap/Utils.hs ===================================== @@ -1275,10 +1275,14 @@ mk_absent_let dflags fam_envs arg abs_rhs = mkAbsentErrorApp arg_ty msg msg = showSDoc (gopt_set dflags Opt_SuppressUniques) - (ppr arg <+> ppr (idType arg) <+> file_msg) + (vcat + [ text "Arg:" <+> ppr arg + , text "Type:" <+> ppr arg_ty + , file_msg + ]) file_msg = case outputFile dflags of Nothing -> empty - Just f -> text "in output file " <+> quotes (text f) + Just f -> text "In output file " <+> quotes (text f) -- We need to suppress uniques here because otherwise they'd -- end up in the generated code as strings. This is bad for -- determinism, because with different uniques the strings ===================================== compiler/GHC/Core/Tidy.hs ===================================== @@ -21,7 +21,7 @@ import GHC.Core import GHC.Core.Seq ( seqUnfolding ) import GHC.Types.Id import GHC.Types.Id.Info -import GHC.Types.Demand ( zapUsageEnvSig ) +import GHC.Types.Demand ( zapDmdEnvSig ) import GHC.Core.Type ( tidyType, tidyVarBndr ) import GHC.Core.Coercion ( tidyCo ) import GHC.Types.Var @@ -206,7 +206,7 @@ tidyLetBndr rec_tidy_env env@(tidy_env, var_env) id new_info = vanillaIdInfo `setOccInfo` occInfo old_info `setArityInfo` arityInfo old_info - `setStrictnessInfo` zapUsageEnvSig (strictnessInfo old_info) + `setStrictnessInfo` zapDmdEnvSig (strictnessInfo old_info) `setDemandInfo` demandInfo old_info `setInlinePragInfo` inlinePragInfo old_info `setUnfoldingInfo` new_unf ===================================== compiler/GHC/Types/Demand.hs ===================================== @@ -34,7 +34,7 @@ module GHC.Types.Demand ( lazyApply1Dmd, lazyApply2Dmd, strictOnceApply1Dmd, strictManyApply1Dmd, -- ** Other @Demand@ operations oneifyCard, oneifyDmd, strictifyDmd, strictifyDictDmd, mkWorkerDemand, - peelCallDmd, peelManyCalls, mkCallDmd, mkCallDmds, + peelCallDmd, peelManyCalls, mkCalledOnceDmd, mkCalledOnceDmds, addCaseBndrDmd, -- ** Extracting one-shot information argOneShots, argsOneShots, saturatedByOneShots, @@ -73,7 +73,7 @@ module GHC.Types.Demand ( seqDemand, seqDemandList, seqDmdType, seqStrictSig, -- * Zapping usage information - zapUsageDemand, zapUsageEnvSig, zapUsedOnceDemand, zapUsedOnceSig + zapUsageDemand, zapDmdEnvSig, zapUsedOnceDemand, zapUsedOnceSig ) where #include "HsVersions.h" @@ -278,7 +278,8 @@ data SubDemand -- ^ @Call n sd@ describes the evaluation context of @n@ function -- applications, where every individual result is evaluated according to @sd at . -- @sd@ is /relative/ to a single call, cf. Note [Call demands are relative]. - -- Used only for values of function type. + -- Used only for values of function type. Use the smart constructor 'mkCall' + -- whenever possible! | Prod ![Demand] -- ^ @Prod ds@ describes the evaluation context of a case scrutinisation -- on an expression of product type, where the product components are @@ -306,7 +307,7 @@ polyDmd C_1N = C_1N :* poly1N polyDmd C_10 = C_10 :* poly10 -- | A smart constructor for 'Prod', applying rewrite rules along the semantic --- equalities @Prod [polyDmd n, ...] === polyDmd n@, simplifying to 'Poly' +-- equality @Prod [polyDmd n, ...] === polyDmd n@, simplifying to 'Poly' -- 'SubDemand's when possible. Note that this degrades boxity information! E.g. a -- polymorphic demand will never unbox. mkProd :: [Demand] -> SubDemand @@ -335,6 +336,13 @@ viewProd _ _ = Nothing {-# INLINE viewProd #-} -- we want to fuse away the replicate and the allocation -- for Arity. Otherwise, #18304 bites us. +-- | A smart constructor for 'Call', applying rewrite rules along the semantic +-- equality @Call n (Poly n) === Poly n@, simplifying to 'Poly' 'SubDemand's +-- when possible. +mkCall :: Card -> SubDemand -> SubDemand +mkCall n cd@(Poly m) | n == m = cd +mkCall n cd = Call n cd + -- | @viewCall sd@ interprets @sd@ as a 'Call', expanding 'Poly' demands as -- necessary. viewCall :: SubDemand -> Maybe (Card, SubDemand) @@ -356,8 +364,8 @@ lubSubDmd (Prod ds1) (viewProd (length ds1) -> Just ds2) = -- Handle Call lubSubDmd (Call n1 d1) (viewCall -> Just (n2, d2)) -- See Note [Call demands are relative] - | isAbs n2 = Call (lubCard n1 n2) (lubSubDmd d1 botSubDmd) - | otherwise = Call (lubCard n1 n2) (lubSubDmd d1 d2) + | isAbs n2 = mkCall (lubCard n1 n2) (lubSubDmd d1 botSubDmd) + | otherwise = mkCall (lubCard n1 n2) (lubSubDmd d1 d2) -- Handle Poly lubSubDmd (Poly n1) (Poly n2) = Poly (lubCard n1 n2) -- Make use of reflexivity (so we'll match the Prod or Call cases again). @@ -377,8 +385,8 @@ plusSubDmd (Prod ds1) (viewProd (length ds1) -> Just ds2) = -- Handle Call plusSubDmd (Call n1 d1) (viewCall -> Just (n2, d2)) -- See Note [Call demands are relative] - | isAbs n2 = Call (plusCard n1 n2) (lubSubDmd d1 botSubDmd) - | otherwise = Call (plusCard n1 n2) (lubSubDmd d1 d2) + | isAbs n2 = mkCall (plusCard n1 n2) (lubSubDmd d1 botSubDmd) + | otherwise = mkCall (plusCard n1 n2) (lubSubDmd d1 d2) -- Handle Poly plusSubDmd (Poly n1) (Poly n2) = Poly (plusCard n1 n2) -- Make use of reflexivity (so we'll match the Prod or Call cases again). @@ -407,7 +415,7 @@ multSubDmd :: Card -> SubDemand -> SubDemand multSubDmd n sd | Just sd' <- multTrivial n seqSubDmd sd = sd' multSubDmd n (Poly n') = Poly (multCard n n') -multSubDmd n (Call n' sd) = Call (multCard n n') sd -- See Note [Call demands are relative] +multSubDmd n (Call n' sd) = mkCall (multCard n n') sd -- See Note [Call demands are relative] multSubDmd n (Prod ds) = Prod (map (multDmd n) ds) multDmd :: Card -> Demand -> Demand @@ -457,22 +465,22 @@ evalDmd = C_1N :* topSubDmd -- | First argument of 'GHC.Exts.maskAsyncExceptions#': @SCS(U)@. -- Called exactly once. strictOnceApply1Dmd :: Demand -strictOnceApply1Dmd = C_11 :* Call C_11 topSubDmd +strictOnceApply1Dmd = C_11 :* mkCall C_11 topSubDmd -- | First argument of 'GHC.Exts.atomically#': @MCM(U)@. -- Called at least once, possibly many times. strictManyApply1Dmd :: Demand -strictManyApply1Dmd = C_1N :* Call C_1N topSubDmd +strictManyApply1Dmd = C_1N :* mkCall C_1N topSubDmd -- | First argument of catch#: @1C1(U)@. -- Evaluates its arg lazily, but then applies it exactly once to one argument. lazyApply1Dmd :: Demand -lazyApply1Dmd = C_01 :* Call C_01 topSubDmd +lazyApply1Dmd = C_01 :* mkCall C_01 topSubDmd -- | Second argument of catch#: @1C1(CS(U))@. -- Calls its arg lazily, but then applies it exactly once to an additional argument. lazyApply2Dmd :: Demand -lazyApply2Dmd = C_01 :* Call C_01 (Call C_11 topSubDmd) +lazyApply2Dmd = C_01 :* mkCall C_01 (mkCall C_11 topSubDmd) -- | Make a 'Demand' evaluated at-most-once. oneifyDmd :: Demand -> Demand @@ -512,12 +520,12 @@ strictifyDictDmd ty (n :* Prod ds) strictifyDictDmd _ dmd = dmd -- | Wraps the 'SubDemand' with a one-shot call demand: @d@ -> @CS(d)@. -mkCallDmd :: SubDemand -> SubDemand -mkCallDmd sd = Call C_11 sd +mkCalledOnceDmd :: SubDemand -> SubDemand +mkCalledOnceDmd sd = mkCall C_11 sd --- | @mkCallDmds n d@ returns @CS(CS...(CS d))@ where there are @n@ @CS@'s. -mkCallDmds :: Arity -> SubDemand -> SubDemand -mkCallDmds arity sd = iterate mkCallDmd sd !! arity +-- | @mkCalledOnceDmds n d@ returns @CS(CS...(CS d))@ where there are @n@ @CS@'s. +mkCalledOnceDmds :: Arity -> SubDemand -> SubDemand +mkCalledOnceDmds arity sd = iterate mkCalledOnceDmd sd !! arity -- | Peels one call level from the sub-demand, and also returns how many -- times we entered the lambda body. @@ -669,7 +677,7 @@ This is needed even for non-product types, in case the case-binder is used but the components of the case alternative are not. Note [Don't optimise UP(U,U,...) to U] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ These two SubDemands: UP(U,U) (@Prod [topDmd, topDmd]@) and U (@topSubDmd@) are semantically equivalent, but we do not turn the former into @@ -1571,9 +1579,9 @@ This is weird, so I'm not worried about whether this optimises brilliantly; but it should not fall over. -} -zapUsageEnvSig :: StrictSig -> StrictSig --- Remove the usage environment from the demand -zapUsageEnvSig (StrictSig (DmdType _ ds r)) = mkClosedStrictSig ds r +-- | Remove the demand environment from the signature. +zapDmdEnvSig :: StrictSig -> StrictSig +zapDmdEnvSig (StrictSig (DmdType _ ds r)) = mkClosedStrictSig ds r zapUsageDemand :: Demand -> Demand -- Remove the usage info, but not the strictness info, from the demand @@ -1615,8 +1623,8 @@ kill_usage kfs (n :* sd) = kill_usage_card kfs n :* kill_usage_sd kfs sd kill_usage_sd :: KillFlags -> SubDemand -> SubDemand kill_usage_sd kfs (Call n sd) - | kf_called_once kfs = Call (lubCard C_1N n) (kill_usage_sd kfs sd) - | otherwise = Call n (kill_usage_sd kfs sd) + | kf_called_once kfs = mkCall (lubCard C_1N n) (kill_usage_sd kfs sd) + | otherwise = mkCall n (kill_usage_sd kfs sd) kill_usage_sd kfs (Prod ds) = Prod (map (kill_usage kfs) ds) kill_usage_sd _ sd = sd @@ -1640,7 +1648,7 @@ trimToType (n :* sd) ts where go (Prod ds) (TsProd tss) | equalLength ds tss = Prod (zipWith trimToType ds tss) - go (Call n sd) (TsFun ts) = Call n (go sd ts) + go (Call n sd) (TsFun ts) = mkCall n (go sd ts) go sd at Poly{} _ = sd go _ _ = topSubDmd @@ -1804,7 +1812,7 @@ instance Binary SubDemand where h <- getByte bh case h of 0 -> Poly <$> get bh - 1 -> Call <$> get bh <*> get bh + 1 -> mkCall <$> get bh <*> get bh 2 -> Prod <$> get bh _ -> pprPanic "Binary:SubDemand" (ppr (fromIntegral h :: Int)) ===================================== compiler/GHC/Types/Id/Info.hs ===================================== @@ -650,7 +650,7 @@ zapUsageInfo info = Just (info {demandInfo = zapUsageDemand (demandInfo info)}) zapUsageEnvInfo :: IdInfo -> Maybe IdInfo zapUsageEnvInfo info | hasDemandEnvSig (strictnessInfo info) - = Just (info {strictnessInfo = zapUsageEnvSig (strictnessInfo info)}) + = Just (info {strictnessInfo = zapDmdEnvSig (strictnessInfo info)}) | otherwise = Nothing ===================================== testsuite/tests/arityanal/should_compile/Arity11.stderr ===================================== @@ -35,7 +35,7 @@ end Rec } -- RHS size: {terms: 52, types: 28, coercions: 0, joins: 0/5} F11.$wfib [InlPrag=[2]] :: forall {a} {p}. (a -> a -> Bool) -> (Num a, Num p) => a -> p -[GblId, Arity=4, Str=, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 150 60 0] 460 0}] +[GblId, Arity=4, Str=, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 150 60 0] 460 0}] F11.$wfib = \ (@a) (@p) (ww :: a -> a -> Bool) (w :: Num a) (w1 :: Num p) (w2 :: a) -> let { @@ -73,7 +73,7 @@ F11.$wfib fib [InlPrag=[2]] :: forall {a} {p}. (Eq a, Num a, Num p) => a -> p [GblId, Arity=4, - Str=, + Str=, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=4,unsat_ok=True,boring_ok=False) Tmpl= \ (@a) (@p) (w [Occ=Once1!] :: Eq a) (w1 [Occ=Once1] :: Num a) (w2 [Occ=Once1] :: Num p) (w3 [Occ=Once1] :: a) -> case w of { GHC.Classes.C:Eq ww1 [Occ=Once1] _ [Occ=Dead] -> F11.$wfib @a @p ww1 w1 w2 w3 }}] fib = \ (@a) (@p) (w :: Eq a) (w1 :: Num a) (w2 :: Num p) (w3 :: a) -> case w of { GHC.Classes.C:Eq ww1 ww2 -> F11.$wfib @a @p ww1 w1 w2 w3 } ===================================== testsuite/tests/arityanal/should_compile/Arity16.stderr ===================================== @@ -5,7 +5,7 @@ Result size of Tidy Core = {terms: 52, types: 87, coercions: 0, joins: 0/0} Rec { -- RHS size: {terms: 15, types: 17, coercions: 0, joins: 0/0} map2 [Occ=LoopBreaker] :: forall {t} {a}. (t -> a) -> [t] -> [a] -[GblId, Arity=2, Str=, Unf=OtherCon []] +[GblId, Arity=2, Str=, Unf=OtherCon []] map2 = \ (@t) (@a) (f :: t -> a) (ds :: [t]) -> case ds of { ===================================== testsuite/tests/stranal/should_compile/T18894.hs ===================================== @@ -0,0 +1,28 @@ +{-# OPTIONS_GHC -O2 -fforce-recomp #-} + +-- | The point of this test is that @g*@ get's a demand that says +-- "whenever @g*@ is called, the second component of the pair is evaluated strictly". +module T18894 (h1, h2) where + +g1 :: Int -> (Int,Int) +g1 1 = (15, 0) +g1 n = (2 * n, 2 `div` n) +{-# NOINLINE g1 #-} + +h1 :: Int -> Int +h1 1 = 0 +-- Sadly, the @g1 2@ subexpression will be floated to top-level, where we +-- don't see the specific demand placed on it by @snd at . Tracked in #19001. +h1 2 = snd (g1 2) +h1 m = uncurry (+) (g1 m) + +g2 :: Int -> Int -> (Int,Int) +g2 m 1 = (m, 0) +g2 m n = (2 * m, 2 `div` n) +{-# NOINLINE g2 #-} + +h2 :: Int -> Int +h2 1 = 0 +h2 m + | odd m = snd (g2 m 2) + | otherwise = uncurry (+) (g2 2 m) ===================================== testsuite/tests/stranal/should_compile/T18894.stderr ===================================== @@ -0,0 +1,404 @@ + +==================== Demand analysis ==================== +Result size of Demand analysis + = {terms: 177, types: 97, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 36, types: 16, coercions: 0, joins: 0/0} +g2 [InlPrag=NOINLINE, Dmd=UCU(CS(P(1P(U),SP(U))))] + :: Int -> Int -> (Int, Int) +[LclId, + Arity=2, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20 20] 161 20}] +g2 + = \ (m [Dmd=UP(U)] :: Int) (ds [Dmd=SP(SU)] :: Int) -> + case ds of { GHC.Types.I# ds [Dmd=SU] -> + case ds of ds [Dmd=1U] { + __DEFAULT -> + (case m of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.*# 2# y) }, + case ds of wild { + __DEFAULT -> + case GHC.Classes.divInt# 2# wild of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> GHC.Types.I# -2#; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + }); + 1# -> (m, lvl) + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 36, types: 19, coercions: 0, joins: 0/0} +h2 :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 162 10}] +h2 + = \ (ds [Dmd=SP(MU)] :: Int) -> + case ds of wild [Dmd=UP(U)] { GHC.Types.I# ds [Dmd=MU] -> + case ds of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> + case g2 wild lvl of { (ds1 [Dmd=A], y [Dmd=SU]) -> y }; + 0# -> + case g2 lvl wild of { (x [Dmd=SP(U)], ds [Dmd=SP(U)]) -> + case x of { GHC.Types.I# x -> + case ds of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + } + }; + 1# -> lvl + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 15# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +lvl :: (Int, Int) +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = (lvl, lvl) + +-- RHS size: {terms: 30, types: 11, coercions: 0, joins: 0/0} +g1 [InlPrag=NOINLINE, Dmd=UCU(P(UP(U),UP(U)))] :: Int -> (Int, Int) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 141 10}] +g1 + = \ (ds [Dmd=SP(SU)] :: Int) -> + case ds of { GHC.Types.I# ds [Dmd=SU] -> + case ds of ds { + __DEFAULT -> + (GHC.Types.I# (GHC.Prim.*# 2# ds), + case ds of wild { + __DEFAULT -> + case GHC.Classes.divInt# 2# wild of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> GHC.Types.I# -2#; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + }); + 1# -> lvl + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +lvl :: (Int, Int) +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=False, ConLike=False, + WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 30 0}] +lvl = g1 (GHC.Types.I# 2#) + +-- RHS size: {terms: 28, types: 18, coercions: 0, joins: 0/0} +h1 :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 111 10}] +h1 + = \ (ds [Dmd=SP(MU)] :: Int) -> + case ds of wild [Dmd=1P(1U)] { GHC.Types.I# ds [Dmd=MU] -> + case ds of { + __DEFAULT -> + case g1 wild of { (x [Dmd=SP(U)], ds [Dmd=SP(U)]) -> + case x of { GHC.Types.I# x -> + case ds of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + }; + 1# -> lvl; + 2# -> case lvl of { (ds1 [Dmd=A], y [Dmd=SU]) -> y } + } + } + + + + +==================== Demand analysis ==================== +Result size of Demand analysis + = {terms: 171, types: 120, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# -2# + +-- RHS size: {terms: 32, types: 18, coercions: 0, joins: 0/0} +$wg2 [InlPrag=NOINLINE, Dmd=UCU(CS(P(1P(U),SP(U))))] + :: Int -> GHC.Prim.Int# -> (# Int, Int #) +[LclId, + Arity=2, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20 30] 121 20}] +$wg2 + = \ (w [Dmd=UP(U)] :: Int) (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + (# case w of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.*# 2# y) }, + case ds of { + __DEFAULT -> + case GHC.Classes.divInt# 2# ds of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> lvl; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + } #); + 1# -> (# w, lvl #) + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 34, types: 21, coercions: 0, joins: 0/0} +$wh2 [InlPrag=[2]] :: GHC.Prim.Int# -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 162 10}] +$wh2 + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> + case $wg2 (GHC.Types.I# ds) 2# of + { (# ww [Dmd=A], ww [Dmd=SU] #) -> + ww + }; + 0# -> + case $wg2 lvl ds of { (# ww [Dmd=SP(U)], ww [Dmd=SP(U)] #) -> + case ww of { GHC.Types.I# x -> + case ww of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + } + }; + 1# -> lvl + } + +-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} +h2 [InlPrag=[2]] :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (w [Occ=Once1!] :: Int) -> + case w of { GHC.Types.I# ww [Occ=Once1, Dmd=MU] -> $wh2 ww }}] +h2 + = \ (w [Dmd=SP(SU)] :: Int) -> + case w of { GHC.Types.I# ww [Dmd=SU] -> $wh2 ww } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 15# + +-- RHS size: {terms: 28, types: 15, coercions: 0, joins: 0/0} +$wg1 [InlPrag=NOINLINE, Dmd=UCU(P(UP(U),UP(U)))] + :: GHC.Prim.Int# -> (# Int, Int #) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 111 20}] +$wg1 + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + (# GHC.Types.I# (GHC.Prim.*# 2# ds), + case ds of { + __DEFAULT -> + case GHC.Classes.divInt# 2# ds of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> lvl; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + } #); + 1# -> (# lvl, lvl #) + } + +-- RHS size: {terms: 7, types: 9, coercions: 0, joins: 0/0} +lvl :: (Int, Int) +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=False, ConLike=False, + WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 40 10}] +lvl = case $wg1 2# of { (# ww, ww #) -> (ww, ww) } + +-- RHS size: {terms: 25, types: 18, coercions: 0, joins: 0/0} +$wh1 [InlPrag=[2]] :: GHC.Prim.Int# -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [50] 101 10}] +$wh1 + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds [Dmd=1U] { + __DEFAULT -> + case $wg1 ds of { (# ww [Dmd=SP(U)], ww [Dmd=SP(U)] #) -> + case ww of { GHC.Types.I# x -> + case ww of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + }; + 1# -> lvl; + 2# -> case lvl of { (ds1 [Dmd=A], y [Dmd=SU]) -> y } + } + +-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} +h1 [InlPrag=[2]] :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (w [Occ=Once1!] :: Int) -> + case w of { GHC.Types.I# ww [Occ=Once1, Dmd=MU] -> $wh1 ww }}] +h1 + = \ (w [Dmd=SP(SU)] :: Int) -> + case w of { GHC.Types.I# ww [Dmd=SU] -> $wh1 ww } + + + ===================================== testsuite/tests/stranal/should_compile/T18894b.hs ===================================== @@ -0,0 +1,20 @@ +{-# OPTIONS_GHC -O -fno-call-arity -fforce-recomp #-} + +module T18894 (f) where + +expensive :: Int -> (Int, Int) +expensive n = (n+1, n+2) +{-# NOINLINE expensive #-} + +-- arity 1 by itself, but not exported, thus can be eta-expanded based on usage +eta :: Int -> Int -> Int +eta x = if fst (expensive x) == 13 + then \y -> x + y + else \y -> x * y +{-# NOINLINE eta #-} + +f :: Int -> Int +f 1 = 0 +f m + | odd m = eta m 2 + | otherwise = eta 2 m ===================================== testsuite/tests/stranal/should_compile/T18894b.stderr ===================================== @@ -0,0 +1,187 @@ + +==================== Demand analysis ==================== +Result size of Demand analysis = {terms: 83, types: 40, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 16, types: 7, coercions: 0, joins: 0/0} +expensive [InlPrag=NOINLINE, Dmd=UCU(P(SP(SU),A))] :: Int -> (Int, Int) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [40] 52 10}] +expensive + = \ (n [Dmd=UP(U)] :: Int) -> + (case n of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 1#) }, case n of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 2#) }) + +-- RHS size: {terms: 20, types: 11, coercions: 0, joins: 0/0} +eta [InlPrag=NOINLINE, Dmd=UCU(CS(U))] :: Int -> Int -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [0] 140 120}] +eta + = \ (x [Dmd=UP(U)] :: Int) -> + case expensive x of { (x [Dmd=SP(SU)], ds1 [Dmd=A]) -> + case x of { GHC.Types.I# x [Dmd=SU] -> + case x of { + __DEFAULT -> \ (y [Dmd=SP(U)] :: Int) -> GHC.Num.$fNumInt_$c* x y; + 13# -> \ (y [Dmd=SP(U)] :: Int) -> GHC.Num.$fNumInt_$c+ x y + } + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 21, types: 5, coercions: 0, joins: 0/0} +f :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 111 0}] +f = \ (ds [Dmd=SP(MU)] :: Int) -> + case ds of wild [Dmd=UP(U)] { GHC.Types.I# ds [Dmd=MU] -> + case ds of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> eta wild lvl; + 0# -> eta lvl wild + }; + 1# -> lvl + } + } + + + + +==================== Demand analysis ==================== +Result size of Demand analysis = {terms: 85, types: 47, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 16, types: 9, coercions: 0, joins: 0/0} +$wexpensive [InlPrag=NOINLINE, Dmd=UCU(P(SP(SU),A))] :: Int -> (# Int, Int #) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [40] 42 10}] +$wexpensive + = \ (w [Dmd=UP(U)] :: Int) -> + (# case w of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 1#) }, + case w of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 2#) } #) + +-- RHS size: {terms: 19, types: 12, coercions: 0, joins: 0/0} +eta [InlPrag=NOINLINE, Dmd=UCU(CS(U))] :: Int -> Int -> Int +[LclId, + Arity=2, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [0 0] 120 0}] +eta + = \ (x [Dmd=MP(U)] :: Int) (eta [Dmd=SP(U), OS=OneShot] :: Int) -> + case $wexpensive x of { (# ww [Dmd=SP(SU)], ww [Dmd=A] #) -> + case ww of { GHC.Types.I# x [Dmd=SU] -> + case x of { + __DEFAULT -> GHC.Num.$fNumInt_$c* x eta; + 13# -> GHC.Num.$fNumInt_$c+ x eta + } + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 20, types: 3, coercions: 0, joins: 0/0} +$wf [InlPrag=[2]] :: GHC.Prim.Int# -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 121 0}] +$wf + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> eta (GHC.Types.I# ds) lvl; + 0# -> eta lvl (GHC.Types.I# ds) + }; + 1# -> lvl + } + +-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} +f [InlPrag=[2]] :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (w [Occ=Once1!] :: Int) -> case w of { GHC.Types.I# ww [Occ=Once1, Dmd=MU] -> $wf ww }}] +f = \ (w [Dmd=SP(SU)] :: Int) -> case w of { GHC.Types.I# ww [Dmd=SU] -> $wf ww } + + + ===================================== testsuite/tests/stranal/should_compile/all.T ===================================== @@ -58,3 +58,7 @@ test('T18122', [ grep_errmsg(r'wfoo =') ], compile, ['-ddump-simpl']) # We care about the call demand on $wg test('T18903', [ grep_errmsg(r'Dmd=\S+C\S+') ], compile, ['-ddump-simpl -dsuppress-uniques']) +# We care about the call demand on $wg1 and $wg2 +test('T18894', [ grep_errmsg(r'Dmd=\S+C\S+') ], compile, ['-ddump-stranal -dsuppress-uniques']) +# We care about the Arity 2 on eta, as a result of the annotated Dmd +test('T18894b', [ grep_errmsg(r'Arity=2') ], compile, ['-ddump-stranal -dsuppress-uniques -fno-call-arity -dppr-cols=200']) ===================================== testsuite/tests/stranal/sigs/T5075.stderr ===================================== @@ -1,7 +1,7 @@ ==================== Strictness signatures ==================== T5075.$trModule: -T5075.loop: +T5075.loop: @@ -13,6 +13,6 @@ T5075.loop: ==================== Strictness signatures ==================== T5075.$trModule: -T5075.loop: +T5075.loop: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/46e64ccd4cd1e139f3fe1f6b579f590703c91d99...829ecab3f489cd8a0785fccdcc089f4ad42f3a22 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/46e64ccd4cd1e139f3fe1f6b579f590703c91d99...829ecab3f489cd8a0785fccdcc089f4ad42f3a22 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 2 22:57:04 2020 From: gitlab at gitlab.haskell.org (Adam Gundry) Date: Wed, 02 Dec 2020 17:57:04 -0500 Subject: [Git][ghc/ghc][wip/amg/fieldselectors] 12 commits: Simplify definition of AvailInfo Message-ID: <5fc81bc0d9e22_6a09391d425319@gitlab.mail> Adam Gundry pushed to branch wip/amg/fieldselectors at Glasgow Haskell Compiler / GHC Commits: 655acd4d by Adam Gundry at 2020-12-01T09:30:11+00:00 Simplify definition of AvailInfo This bumps the haddock submodule. - - - - - 7542d353 by Adam Gundry at 2020-12-02T22:55:54+00:00 Simplify IncorrectParent - - - - - 913a5076 by Adam Gundry at 2020-12-02T22:55:54+00:00 Clean up now that #18452 is fixed - - - - - 3505bb1a by Simon Hafner at 2020-12-02T22:55:54+00:00 Implement NoFieldSelectors extension (ghc-proposals 160) Record field selectors created under NoFieldSelectors are not accessible as functions, but users are still able to use them for record construction, pattern matching and updates. Co-authored-by: Fumiaki Kinoshita <fumiexcel at gmail.com> Co-authored-by: Adam Gundry <adam at well-typed.com> - - - - - 005033cf by Adam Gundry at 2020-12-02T22:55:54+00:00 Exclude NoFieldSelectors GREs from similarNameSuggestions - - - - - b1ad37fe by Adam Gundry at 2020-12-02T22:55:54+00:00 Hackily correct for T11941 - - - - - fa29fe74 by Adam Gundry at 2020-12-02T22:55:54+00:00 Correct NoFieldSelectors tests - - - - - 7289c59c by Adam Gundry at 2020-12-02T22:55:54+00:00 Refactor and clean up GHC.Rename.Env - - - - - 6c279604 by Adam Gundry at 2020-12-02T22:55:54+00:00 Tweak fieldSelectorSuggestions message - - - - - 489db05a by Adam Gundry at 2020-12-02T22:55:54+00:00 Slightly clean up rnExpr - - - - - 316db0a0 by Adam Gundry at 2020-12-02T22:55:54+00:00 Call keepAlive when HasField uses a record selector - - - - - ebef58c4 by Adam Gundry at 2020-12-02T22:55:54+00:00 Add test of -Wunused-top-binds with HasField - - - - - 30 changed files: - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Rename.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/Rename/Unbound.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Types/Avail.hs - compiler/GHC/Types/FieldLabel.hs - compiler/GHC/Types/Name/Reader.hs - compiler/GHC/Types/Name/Shape.hs - compiler/GHC/Types/TyThing.hs - + docs/users_guide/exts/field_selectors.rst - docs/users_guide/exts/records.rst - libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs - testsuite/tests/driver/T4437.hs - + testsuite/tests/ghci/GHCiDRF/GHCiDRF.T - + testsuite/tests/ghci/GHCiDRF/GHCiDRF.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/162738d2f027c54ea7fe081c2308ed5f10a535d7...ebef58c4553d4b8c18a25af3bdcf0ac01d7aa552 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/162738d2f027c54ea7fe081c2308ed5f10a535d7...ebef58c4553d4b8c18a25af3bdcf0ac01d7aa552 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 2 22:57:46 2020 From: gitlab at gitlab.haskell.org (Adam Gundry) Date: Wed, 02 Dec 2020 17:57:46 -0500 Subject: [Git][ghc/ghc][wip/amg/renamer-refactor] 2 commits: Simplify IncorrectParent Message-ID: <5fc81bea35ea2_6a09391d4255b@gitlab.mail> Adam Gundry pushed to branch wip/amg/renamer-refactor at Glasgow Haskell Compiler / GHC Commits: 7542d353 by Adam Gundry at 2020-12-02T22:55:54+00:00 Simplify IncorrectParent - - - - - 913a5076 by Adam Gundry at 2020-12-02T22:55:54+00:00 Clean up now that #18452 is fixed - - - - - 3 changed files: - compiler/GHC/Rename/Env.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Gen/Head.hs Changes: ===================================== compiler/GHC/Rename/Env.hs ===================================== @@ -644,14 +644,13 @@ lookupSubBndrOcc_helper must_have_parent warn_if_deprec parent rdr_name case original_gres of [] -> return NameNotFound [g] -> return $ IncorrectParent parent - (gre_name g) (ppr $ gre_name g) + (gre_child g) [p | Just p <- [getParent g]] gss@(g:_:_) -> if all isRecFldGRE gss && overload_ok then return $ IncorrectParent parent - (gre_name g) - (ppr $ expectJust "noMatchingParentErr" (greLabel g)) + (gre_child g) [p | x <- gss, Just p <- [getParent x]] else mkNameClashErr gss @@ -731,8 +730,7 @@ instance Monoid DisambigInfo where data ChildLookupResult = NameNotFound -- We couldn't find a suitable name | IncorrectParent Name -- Parent - Name -- Name of thing we were looking for - SDoc -- How to print the name + Child -- Child we were looking for [Name] -- List of possible parents | FoundChild Parent Child -- We resolved to a child @@ -748,8 +746,8 @@ combineChildLookupResult (x:xs) = do instance Outputable ChildLookupResult where ppr NameNotFound = text "NameNotFound" ppr (FoundChild p n) = text "Found:" <+> ppr p <+> ppr n - ppr (IncorrectParent p n td ns) = text "IncorrectParent" - <+> hsep [ppr p, ppr n, td, ppr ns] + ppr (IncorrectParent p n ns) = text "IncorrectParent" + <+> hsep [ppr p, ppr n, ppr ns] lookupSubBndrOcc :: Bool -> Name -- Parent ===================================== compiler/GHC/Tc/Gen/Export.hs ===================================== @@ -525,7 +525,7 @@ lookupChildrenExport spec_parent rdr_items = ChildField fl -> Right (L (getLoc n) fl) ChildName name -> Left (replaceLWrappedName n name) } - IncorrectParent p g td gs -> failWithDcErr p g td gs + IncorrectParent p c gs -> failWithDcErr p c gs -- Note: [Typing Pattern Synonym Exports] @@ -613,7 +613,7 @@ checkPatSynParent parent NoParent child AConLike (PatSynCon p) -> handle_pat_syn (psErr p) parent_ty_con p - _ -> failWithDcErr parent mpat_syn (ppr child) [] } + _ -> failWithDcErr parent child [] } where psErr = exportErrCtxt "pattern synonym" selErr = exportErrCtxt "pattern synonym record selector" @@ -805,11 +805,11 @@ dcErrMsg ty_con what_is thing parents = [_] -> text "Parent:" _ -> text "Parents:") <+> fsep (punctuate comma parents) -failWithDcErr :: Name -> Name -> SDoc -> [Name] -> TcM a -failWithDcErr parent thing thing_doc parents = do - ty_thing <- tcLookupGlobal thing +failWithDcErr :: Name -> Child -> [Name] -> TcM a +failWithDcErr parent child parents = do + ty_thing <- tcLookupGlobal (childName child) failWithTc $ dcErrMsg parent (tyThingCategory' ty_thing) - thing_doc (map ppr parents) + (ppr child) (map ppr parents) where tyThingCategory' :: TyThing -> String tyThingCategory' (AnId i) ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -493,11 +493,12 @@ tc_rec_sel_id lbl sel_name = do { thing <- tcLookup sel_name ; case thing of ATcId { tct_id = id } - -> do { check_local_id occ id + -> do { check_naughty occ id + ; check_local_id id ; return id } AGlobal (AnId id) - -> do { check_global_id occ id + -> do { check_naughty occ id ; return id } -- A global cannot possibly be ill-staged -- nor does it need the 'lifting' treatment @@ -758,12 +759,14 @@ tc_infer_id id_name ; global_env <- getGlobalRdrEnv ; case thing of ATcId { tct_id = id } - -> do { check_local_id occ id + -> do { check_local_id id ; return_id id } AGlobal (AnId id) - -> do { check_global_id occ id - ; return_id id } + -> return_id id + -- A global cannot possibly be ill-staged + -- nor does it need the 'lifting' treatment + -- Hence no checkTh stuff here AGlobal (AConLike cl) -> case cl of RealDataCon con -> return_data_con con @@ -798,8 +801,6 @@ tc_infer_id id_name = text "Illegal term-level use of the type constructor" <+> quotes (ppr (tyConName ty_con)) - occ = nameOccName id_name - return_id id = return (HsVar noExtField (noLoc id), idType id) return_data_con con @@ -845,19 +846,11 @@ tc_infer_id id_name , mkInvisForAllTys tvs $ mkInvisFunTysMany theta $ mkVisFunTys scaled_arg_tys res) } -check_local_id :: OccName -> Id -> TcM () -check_local_id occ id - = do { check_naughty occ id -- See Note [HsVar: naughty record selectors] - ; checkThLocalId id +check_local_id :: Id -> TcM () +check_local_id id + = do { checkThLocalId id ; tcEmitBindingUsage $ unitUE (idName id) One } -check_global_id :: OccName -> Id -> TcM () -check_global_id occ id - = check_naughty occ id -- See Note [HsVar: naughty record selectors] - -- A global cannot possibly be ill-staged - -- nor does it need the 'lifting' treatment - -- Hence no checkTh stuff here - check_naughty :: OccName -> TcId -> TcM () check_naughty lbl id | isNaughtyRecordSelector id = failWithTc (naughtyRecordSel lbl) @@ -868,15 +861,7 @@ nonBidirectionalErr name = failWithTc $ text "non-bidirectional pattern synonym" <+> quotes (ppr name) <+> text "used in an expression" -{- Note [HsVar: naughty record selectors] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -All record selectors should really be HsRecFld (ambiguous or -unambiguous), but currently not all of them are: see #18452. So we -need to check for naughty record selectors in tc_infer_id, as well as -in tc_rec_sel_id. - -Remove this code when fixing #18452. - +{- Note [Linear fields generalization] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ As per Note [Polymorphisation of linear fields], linear field of data View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/655acd4deacffc5432d9b6615ff30cb9c6bc9f33...913a5076f54face20f249a224599ba7a1f50fbcd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/655acd4deacffc5432d9b6615ff30cb9c6bc9f33...913a5076f54face20f249a224599ba7a1f50fbcd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 2 23:04:28 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Wed, 02 Dec 2020 18:04:28 -0500 Subject: [Git][ghc/ghc][wip/T18894] 2 commits: DmdAnal: Annotate top-level function bindings with demands (#18894) Message-ID: <5fc81d7cd491b_6a093933c31631@gitlab.mail> Sebastian Graf pushed to branch wip/T18894 at Glasgow Haskell Compiler / GHC Commits: cbf75591 by Sebastian Graf at 2020-12-03T00:04:18+01:00 DmdAnal: Annotate top-level function bindings with demands (#18894) It's useful to annotate a non-exported top-level function like `g` in ```hs module Lib (h) where g :: Int -> Int -> (Int,Int) g m 1 = (m, 0) g m n = (2 * m, 2 `div` n) {-# NOINLINE g #-} h :: Int -> Int h 1 = 0 h m | odd m = snd (g m 2) | otherwise = uncurry (+) (g 2 m) ``` with its demand `UCU(CS(P(1P(U),SP(U))`, which tells us that whenever `g` was called, the second component of the returned pair was evaluated strictly. Since #18903 we do so for local functions, where we can see all calls. For top-level functions, we can assume that all *exported* functions are demanded according to `topDmd` and thus get sound demands for non-exported top-level functions. The demand on `g` is crucial information for Nested CPR, which may the go on and unbox `g` for the second pair component. That is true even if that pair component may diverge, as is the case for the call site `g 13 0`, which throws a div-by-zero exception. In `T18894b`, you can even see the new demand annotation enabling us to eta-expand a function that we wouldn't be able to eta-expand without Call Arity. We only track bindings of function type in order not to risk huge compile-time regressions, see `isInterestingTopLevelFn`. Fixes #18894. - - - - - 044d0f13 by Sebastian Graf at 2020-12-03T00:04:18+01:00 Demand: Simplify `CU(U)` to `U` (#19005) Both sub-demands encode the same information. This is a trivial change and already affects a few regression tests (e.g. `T5075`), so no separate regression test is necessary. - - - - - 16 changed files: - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Types/Demand.hs - compiler/GHC/Types/Id/Info.hs - testsuite/tests/arityanal/should_compile/Arity11.stderr - testsuite/tests/arityanal/should_compile/Arity16.stderr - + testsuite/tests/stranal/should_compile/T18894.hs - + testsuite/tests/stranal/should_compile/T18894.stderr - + testsuite/tests/stranal/should_compile/T18894b.hs - + testsuite/tests/stranal/should_compile/T18894b.stderr - testsuite/tests/stranal/should_compile/all.T - testsuite/tests/stranal/sigs/T5075.stderr Changes: ===================================== compiler/GHC/Core/FVs.hs ===================================== @@ -525,12 +525,11 @@ ruleLhsFVIds (Rule { ru_bndrs = bndrs, ru_args = args }) = filterFV isLocalId $ addBndrs bndrs (exprs_fvs args) ruleRhsFreeIds :: CoreRule -> VarSet --- ^ This finds all locally-defined free Ids on the left hand side of a rule +-- ^ This finds all locally-defined free Ids on the right hand side of a rule -- and returns them as a non-deterministic set ruleRhsFreeIds (BuiltinRule {}) = emptyVarSet -ruleRhsFreeIds (Rule { ru_bndrs = bndrs, ru_args = args }) - = fvVarSet $ filterFV isLocalId $ - addBndrs bndrs $ exprs_fvs args +ruleRhsFreeIds (Rule { ru_bndrs = bndrs, ru_rhs = rhs }) + = fvVarSet $ filterFV isLocalId $ addBndrs bndrs $ expr_fvs rhs {- Note [Rule free var hack] (Not a hack any more) ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -623,11 +623,12 @@ lintLetBind top_lvl rec_flag binder rhs rhs_ty || exprIsTickedString rhs) (badBndrTyMsg binder (text "unlifted")) - -- Check that if the binder is top-level or recursive, it's not + -- Check that if the binder is top-level or recursive thunk, it's not -- demanded. Primitive string literals are exempt as there is no -- computation to perform, see Note [Core top-level string literals]. ; checkL (not (isStrictId binder) - || (isNonRec rec_flag && not (isTopLevel top_lvl)) + || idArity binder > 0 -- we're OK if it's not a thunk + || (isNonRec rec_flag && isNotTopLevel top_lvl) || exprIsTickedString rhs) (mkStrictMsg binder) @@ -3121,7 +3122,7 @@ badBndrTyMsg binder what mkStrictMsg :: Id -> MsgDoc mkStrictMsg binder - = vcat [hsep [text "Recursive or top-level binder has strict demand info:", + = vcat [hsep [text "Recursive or top-level thunk has strict demand info:", ppr binder], hsep [text "Binder's demand info:", ppr (idDemandInfo binder)] ] ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -37,6 +37,7 @@ import GHC.Core.Type import GHC.Core.FVs ( exprFreeIds, ruleRhsFreeIds ) import GHC.Core.Coercion ( Coercion, coVarsOfCo ) import GHC.Core.FamInstEnv +import GHC.Core.Opt.Arity ( typeArity ) import GHC.Utils.Misc import GHC.Utils.Panic import GHC.Data.Maybe ( isJust ) @@ -64,28 +65,54 @@ data DmdAnalOpts = DmdAnalOpts -- -- Note: use `seqBinds` on the result to avoid leaks due to lazyness (cf Note -- [Stamp out space leaks in demand analysis]) -dmdAnalProgram :: DmdAnalOpts -> FamInstEnvs -> CoreProgram -> CoreProgram -dmdAnalProgram opts fam_envs binds = binds_plus_dmds - where - env = emptyAnalEnv opts fam_envs - binds_plus_dmds = snd $ mapAccumL dmdAnalTopBind env binds - --- Analyse a (group of) top-level binding(s) -dmdAnalTopBind :: AnalEnv - -> CoreBind - -> (AnalEnv, CoreBind) -dmdAnalTopBind env (NonRec id rhs) - = ( extendAnalEnv TopLevel env id sig - , NonRec (setIdStrictness id sig) rhs') +dmdAnalProgram :: DmdAnalOpts -> FamInstEnvs -> [CoreRule] -> CoreProgram -> CoreProgram +dmdAnalProgram opts fam_envs rules binds + = snd $ go (emptyAnalEnv opts fam_envs) binds where - ( _, sig, rhs') = dmdAnalRhsLetDown Nothing env topSubDmd id rhs - -dmdAnalTopBind env (Rec pairs) - = (env', Rec pairs') - where - (env', _, pairs') = dmdFix TopLevel env topSubDmd pairs - -- We get two iterations automatically - -- c.f. the NonRec case above + -- See Note [Analysing top-level bindings] + -- TLDR; We analyse them like + -- let ex1 = ... in (ex1, let nex1 = ... in let ex2 = ... in (ex2, ...))) + -- where ex* are exported (or RULE mentions) and nex* are not. + go _ [] = (nopDmdType, []) + go env (b:bs) = cons_up $ dmdAnalBind TopLevel env topSubDmd b anal_body + where + anal_body env' + | (body_ty, bs') <- go env' bs + = (add_exported_uses env' body_ty (bindersOf b), bs') + + cons_up :: (a, b, [b]) -> (a, [b]) + cons_up (dmd_ty, b', bs') = (dmd_ty, b':bs') + + add_exported_uses :: AnalEnv -> DmdType -> [Id] -> DmdType + add_exported_uses env = foldl' (add_exported_use env) + + -- | If @e@ is denoted by @dmd_ty@, then @add_exported_use _ dmd_ty id@ + -- corresponds to the demand type of @(id, e)@, but is a lot more direct. + -- See Note [Analysing top-level bindings]. + add_exported_use :: AnalEnv -> DmdType -> Id -> DmdType + add_exported_use env dmd_ty id + | isExportedId id || elemVarSet id rule_fvs + -- See Note [Absence analysis for stable unfoldings and RULES] + = dmd_ty `plusDmdType` fst (dmdAnalStar env topDmd (Var id)) + | otherwise = dmd_ty + + rule_fvs :: IdSet + rule_fvs = foldr (unionVarSet . ruleRhsFreeIds) emptyVarSet rules + +-- | Whether we want to store demands on a top-level Id or just default +-- to 'topDmd'. +-- +-- Basically, we want to now how top-level *functions* are *used* +-- (e.g. called), but aren't interested in whether they were called strictly +-- or not. Other top-level bindings are boring. +isInterestingTopLevelFn :: Id -> Bool +-- SG tried to set this to True and got a +2% ghc/alloc regression in T5642 +-- (which is dominated by the Simplifier) at no gain in analysis precision. +-- If there was a gain, that regression might be acceptable. +-- Plus, we could use LetUp for thunks and share some code with local let +-- bindings. +isInterestingTopLevelFn id = + typeArity (idType id) `lengthExceeds` 0 {- Note [Stamp out space leaks in demand analysis] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -105,8 +132,56 @@ generation would hold on to an extra copy of the Core program, via unforced thunks in demand or strictness information; and it is the most memory-intensive part of the compilation process, so this added seqBinds makes a big difference in peak memory usage. --} +Note [Analysing top-level bindings] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider a CoreProgram like + e1 = ... + n1 = ... + e2 = \a b -> ... fst (n1 a b) ... + n2 = \c d -> ... snd (e2 c d) ... + ... +where e* are exported, but n* are not. +Intuitively, we can see that @n1@ is only ever called with two arguments +and in every call site, the first component of the result of the call +is evaluated. Thus, we'd like it to have idDemandInfo @UCU(C1(P(SU,A))@. + +(This can be exploited by a Nested CPR pass which may then unbox the +first component of the pair returned from @n1 at . Or if @n1@ had arity +1 before, we may now eta-expand to arity 2.) + +NB: We may *not* give e2 a similar annotation, because it is exported and +external callers might use it in arbitrary ways, expressed by 'topDmd'. + +How do we get this result? Answer: By analysing the program as if it was a let +expression of this form: + let e1 = ... in + (e1, let n1 = ... in + ( let e2 = ... in + (e2, let n2 = ... in + ( ...)))) +E.g. putting all bindings in nested lets, where whenever it binds an exported +binding, the body is a *pair* of an occurrence of the exported binder and +the other nested lets. Of course, we will not actually build that CoreExpr! +Instead we faithfully simulate analysis of said expression by adding the +free variable 'DmdEnv' of @e*@'s strictness signatures to the 'DmdType' we +get from analysing the nested bindings. + +You might also wonder why we didn't analyse in terms of the simpler + let e1 = ... in + let n1 = ... in + let e2 = ... in + let n2 = ... in + (e1,e2, ...) +The reason is analysis performance: If @e1@ uses many free variables, we'll +unnecessarily carry their demands around with us from the moment we analyse +the pair to the moment we bubble back up to the binding for @e1 at . +This blows up e.g. @T10370 at . + +A final note about variables occuring free in RULE RHSs: They are to be handled +pretty much like exported Ids. +See also Note [Absence analysis for stable unfoldings and RULES] +-} {- ************************************************************************ @@ -114,7 +189,103 @@ seqBinds makes a big difference in peak memory usage. \subsection{The analyser itself} * * ************************************************************************ +-} + +-- | Analyse a binding group and its \"body\", e.g. where it is in scope. +-- +-- It calls a function that knows how to analyse this \"body\" given +-- an 'AnalEnv' with updated demand signatures for the binding group +-- (reflecting their 'idStrictnessInfo') and expects to receive a +-- 'DmdType' in return, which it uses to annotate the binding group with their +-- 'idDemandInfo'. +dmdAnalBind + :: TopLevelFlag + -> AnalEnv + -> SubDemand -- ^ Demand put on the "body" + -- (important for join points) + -> CoreBind + -> (AnalEnv -> (DmdType, a)) -- ^ How to analyse the "body", e.g. + -- where the binding is in scope + -> (DmdType, CoreBind, a) +dmdAnalBind top_lvl env dmd bind anal_body = case bind of + NonRec id rhs + | useLetUp top_lvl id + -> dmdAnalBindLetUp top_lvl env id rhs anal_body + _ -> dmdAnalBindLetDown top_lvl env dmd bind anal_body + +-- | Annotates uninteresting top level functions ('isInterestingTopLevelFn') +-- with 'topDmd', the rest with the given demand. +setBindIdDemandInfo :: TopLevelFlag -> Id -> Demand -> Id +setBindIdDemandInfo top_lvl id dmd = setIdDemandInfo id $ case top_lvl of + TopLevel | not (isInterestingTopLevelFn id) -> topDmd + _ -> dmd + +-- | Let bindings can be processed in two ways: +-- Down (RHS before body) or Up (body before RHS). +-- This function handles the up variant. +-- +-- It is very simple. For let x = rhs in body +-- * Demand-analyse 'body' in the current environment +-- * Find the demand, 'rhs_dmd' placed on 'x' by 'body' +-- * Demand-analyse 'rhs' in 'rhs_dmd' +-- +-- This is used for a non-recursive local let without manifest lambdas (see +-- 'useLetUp'). +-- +-- This is the LetUp rule in the paper “Higher-Order Cardinality Analysis”. +dmdAnalBindLetUp :: TopLevelFlag -> AnalEnv -> Id -> CoreExpr -> (AnalEnv -> (DmdType, a)) -> (DmdType, CoreBind, a) +dmdAnalBindLetUp top_lvl env id rhs anal_body = (final_ty, NonRec id' rhs', body') + where + (body_ty, body') = anal_body env + (body_ty', id_dmd) = findBndrDmd env notArgOfDfun body_ty id + id' = setBindIdDemandInfo top_lvl id id_dmd + (rhs_ty, rhs') = dmdAnalStar env (dmdTransformThunkDmd rhs id_dmd) rhs + final_ty = body_ty' `plusDmdType` rhs_ty + +-- | Let bindings can be processed in two ways: +-- Down (RHS before body) or Up (body before RHS). +-- This function handles the down variant. +-- +-- It computes a demand signature (by means of 'dmdAnalRhsSig') and uses +-- that at call sites in the body. +-- +-- It is used for toplevel definitions, recursive definitions and local +-- non-recursive definitions that have manifest lambdas (cf. 'useLetUp'). +-- Local non-recursive definitions without a lambda are handled with LetUp. +-- +-- This is the LetDown rule in the paper “Higher-Order Cardinality Analysis”. +dmdAnalBindLetDown :: TopLevelFlag -> AnalEnv -> SubDemand -> CoreBind -> (AnalEnv -> (DmdType, a)) -> (DmdType, CoreBind, a) +dmdAnalBindLetDown top_lvl env dmd bind anal_body = case bind of + NonRec id rhs + | (env', lazy_fv, id1, rhs1) <- + dmdAnalRhsSig top_lvl NonRecursive env dmd id rhs + -> do_rest env' lazy_fv [(id1, rhs1)] (\[(id2, rhs2)] -> NonRec id2 rhs2) + Rec pairs + | (env', lazy_fv, pairs') <- dmdFix top_lvl env dmd pairs + -> do_rest env' lazy_fv pairs' Rec + where + do_rest env' lazy_fv pairs1 build_bind = (final_ty, build_bind pairs2, body') + where + (body_ty, body') = anal_body env' + -- see Note [Lazy and unleashable free variables] + dmd_ty = addLazyFVs body_ty lazy_fv + (!final_ty, id_dmds) = findBndrsDmds env' dmd_ty (map fst pairs1) + pairs2 = zipWith do_one pairs1 id_dmds + do_one (id', rhs') dmd = (setBindIdDemandInfo top_lvl id' dmd, rhs') + -- If the actual demand is better than the vanilla call + -- demand, you might think that we might do better to re-analyse + -- the RHS with the stronger demand. + -- But (a) That seldom happens, because it means that *every* path in + -- the body of the let has to use that stronger demand + -- (b) It often happens temporarily in when fixpointing, because + -- the recursive function at first seems to place a massive demand. + -- But we don't want to go to extra work when the function will + -- probably iterate to something less demanding. + -- In practice, all the times the actual demand on id2 is more than + -- the vanilla call demand seem to be due to (b). So we don't + -- bother to re-analyse the RHS. +{- Note [Ensure demand is strict] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ It's important not to analyse e with a lazy demand because @@ -194,7 +365,7 @@ dmdAnal' env dmd (App fun arg) -- Crucially, coercions /are/ handled here, because they are -- value arguments (#10288) let - call_dmd = mkCallDmd dmd + call_dmd = mkCalledOnceDmd dmd (fun_ty, fun') = dmdAnal env call_dmd fun (arg_dmd, res_ty) = splitDmdTy fun_ty (arg_ty, arg') = dmdAnalStar env (dmdTransformThunkDmd arg arg_dmd) arg @@ -295,60 +466,11 @@ dmdAnal' env dmd (Case scrut case_bndr ty alts) -- , text "res_ty" <+> ppr res_ty ]) $ (res_ty, Case scrut' case_bndr' ty alts') --- Let bindings can be processed in two ways: --- Down (RHS before body) or Up (body before RHS). --- The following case handle the up variant. --- --- It is very simple. For let x = rhs in body --- * Demand-analyse 'body' in the current environment --- * Find the demand, 'rhs_dmd' placed on 'x' by 'body' --- * Demand-analyse 'rhs' in 'rhs_dmd' --- --- This is used for a non-recursive local let without manifest lambdas. --- This is the LetUp rule in the paper “Higher-Order Cardinality Analysis”. -dmdAnal' env dmd (Let (NonRec id rhs) body) - | useLetUp id - = (final_ty, Let (NonRec id' rhs') body') +dmdAnal' env dmd (Let bind body) + = (final_ty, Let bind' body') where - (body_ty, body') = dmdAnal env dmd body - (body_ty', id_dmd) = findBndrDmd env notArgOfDfun body_ty id - id' = setIdDemandInfo id id_dmd - - (rhs_ty, rhs') = dmdAnalStar env (dmdTransformThunkDmd rhs id_dmd) rhs - final_ty = body_ty' `plusDmdType` rhs_ty - -dmdAnal' env dmd (Let (NonRec id rhs) body) - = (body_ty2, Let (NonRec id2 rhs') body') - where - (lazy_fv, sig, rhs') = dmdAnalRhsLetDown Nothing env dmd id rhs - id1 = setIdStrictness id sig - env1 = extendAnalEnv NotTopLevel env id sig - (body_ty, body') = dmdAnal env1 dmd body - (body_ty1, id2) = annotateBndr env body_ty id1 - body_ty2 = addLazyFVs body_ty1 lazy_fv -- see Note [Lazy and unleashable free variables] - - -- If the actual demand is better than the vanilla call - -- demand, you might think that we might do better to re-analyse - -- the RHS with the stronger demand. - -- But (a) That seldom happens, because it means that *every* path in - -- the body of the let has to use that stronger demand - -- (b) It often happens temporarily in when fixpointing, because - -- the recursive function at first seems to place a massive demand. - -- But we don't want to go to extra work when the function will - -- probably iterate to something less demanding. - -- In practice, all the times the actual demand on id2 is more than - -- the vanilla call demand seem to be due to (b). So we don't - -- bother to re-analyse the RHS. - -dmdAnal' env dmd (Let (Rec pairs) body) - = let - (env', lazy_fv, pairs') = dmdFix NotTopLevel env dmd pairs - (body_ty, body') = dmdAnal env' dmd body - body_ty1 = deleteFVs body_ty (map fst pairs) - body_ty2 = addLazyFVs body_ty1 lazy_fv -- see Note [Lazy and unleashable free variables] - in - body_ty2 `seq` - (body_ty2, Let (Rec pairs') body') + (final_ty, bind', body') = dmdAnalBind NotTopLevel env dmd bind go' + go' env' = dmdAnal env' dmd body -- | A simple, syntactic analysis of whether an expression MAY throw a precise -- exception when evaluated. It's always sound to return 'True'. @@ -582,9 +704,13 @@ dmdTransform env var dmd | Just (sig, top_lvl) <- lookupSigEnv env var , let fn_ty = dmdTransformSig sig dmd = -- pprTrace "dmdTransform:LetDown" (vcat [ppr var, ppr sig, ppr dmd, ppr fn_ty]) $ - if isTopLevel top_lvl - then fn_ty -- Don't record demand on top-level things - else addVarDmd fn_ty var (C_11 :* dmd) + case top_lvl of + NotTopLevel -> addVarDmd fn_ty var (C_11 :* dmd) + TopLevel + | isInterestingTopLevelFn var + -> addVarDmd fn_ty var (C_0N `multDmd` (C_11 :* dmd)) -- discard strictness + | otherwise + -> fn_ty -- don't bother tracking; just annotate with 'topDmd' later -- Everything else: -- * Local let binders for which we use LetUp (cf. 'useLetUp') -- * Lambda binders @@ -599,46 +725,46 @@ dmdTransform env var dmd * * ********************************************************************* -} --- Let bindings can be processed in two ways: --- Down (RHS before body) or Up (body before RHS). --- dmdAnalRhsLetDown implements the Down variant: --- * assuming a demand of +-- | @dmdAnalRhsSig@ analyses the given RHS to compute a demand signature +-- for the LetDown rule. It works as follows: +-- +-- * assuming a demand of -- * looking at the definition -- * determining a strictness signature -- --- It is used for toplevel definition, recursive definitions and local --- non-recursive definitions that have manifest lambdas. --- Local non-recursive definitions without a lambda are handled with LetUp. --- --- This is the LetDown rule in the paper “Higher-Order Cardinality Analysis”. -dmdAnalRhsLetDown - :: Maybe [Id] -- Just bs <=> recursive, Nothing <=> non-recursive +-- Since it assumed a demand of , the resulting signature is applicable at +-- any call site. +dmdAnalRhsSig + :: TopLevelFlag + -> RecFlag -> AnalEnv -> SubDemand -> Id -> CoreExpr - -> (DmdEnv, StrictSig, CoreExpr) + -> (AnalEnv, DmdEnv, Id, CoreExpr) -- Process the RHS of the binding, add the strictness signature -- to the Id, and augment the environment with the signature as well. -- See Note [NOINLINE and strictness] -dmdAnalRhsLetDown rec_flag env let_dmd id rhs - = -- pprTrace "dmdAnalRhsLetDown" (ppr id $$ ppr let_dmd $$ ppr sig $$ ppr lazy_fv) $ - (lazy_fv, sig, rhs') +dmdAnalRhsSig top_lvl rec_flag env let_dmd id rhs + = -- pprTrace "dmdAnalRhsSig" (ppr id $$ ppr let_dmd $$ ppr sig $$ ppr lazy_fv) $ + (env', lazy_fv, id', rhs') where rhs_arity = idArity id + -- See Note [Demand signatures are computed for a threshold demand based on idArity] rhs_dmd -- See Note [Demand analysis for join points] -- See Note [Invariants on join points] invariant 2b, in GHC.Core -- rhs_arity matches the join arity of the join point | isJoinId id - = mkCallDmds rhs_arity let_dmd + = mkCalledOnceDmds rhs_arity let_dmd | otherwise - -- NB: rhs_arity - -- See Note [Demand signatures are computed for a threshold demand based on idArity] - = mkRhsDmd env rhs_arity rhs + = mkCalledOnceDmds rhs_arity topSubDmd (rhs_dmd_ty, rhs') = dmdAnal env rhs_dmd rhs DmdType rhs_fv rhs_dmds rhs_div = rhs_dmd_ty sig = mkStrictSigForArity rhs_arity (DmdType sig_fv rhs_dmds rhs_div) + id' = id `setIdStrictness` sig + env' = extendAnalEnv top_lvl env id' sig + -- See Note [Aggregated demand for cardinality] -- FIXME: That Note doesn't explain the following lines at all. The reason -- is really much different: When we have a recursive function, we'd @@ -651,8 +777,8 @@ dmdAnalRhsLetDown rec_flag env let_dmd id rhs -- we'd have to do an additional iteration. reuseEnv makes sure that -- we never get used-once info for FVs of recursive functions. rhs_fv1 = case rec_flag of - Just bs -> reuseEnv (delVarEnvList rhs_fv bs) - Nothing -> rhs_fv + Recursive -> reuseEnv rhs_fv + NonRecursive -> rhs_fv rhs_fv2 = rhs_fv1 `keepAliveDmdEnv` extra_fvs -- Find the RHS free vars of the unfoldings and RULES @@ -669,13 +795,6 @@ dmdAnalRhsLetDown rec_flag env let_dmd id rhs = exprFreeIds unf_body | otherwise = emptyVarSet --- | @mkRhsDmd env rhs_arity rhs@ creates a 'SubDemand' for --- unleashing on the given function's @rhs@, by creating --- a call demand of @rhs_arity@ --- See Historical Note [Product demands for function body] -mkRhsDmd :: AnalEnv -> Arity -> CoreExpr -> SubDemand -mkRhsDmd _env rhs_arity _rhs = mkCallDmds rhs_arity topSubDmd - -- | If given the (local, non-recursive) let-bound 'Id', 'useLetUp' determines -- whether we should process the binding up (body before rhs) or down (rhs -- before body). @@ -720,8 +839,8 @@ mkRhsDmd _env rhs_arity _rhs = mkCallDmds rhs_arity topSubDmd -- * For a more convincing example with join points, see Note [Demand analysis -- for join points]. -- -useLetUp :: Var -> Bool -useLetUp f = idArity f == 0 && not (isJoinId f) +useLetUp :: TopLevelFlag -> Var -> Bool +useLetUp top_lvl f = isNotTopLevel top_lvl && idArity f == 0 && not (isJoinId f) {- Note [Demand analysis for join points] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -939,8 +1058,6 @@ dmdFix :: TopLevelFlag dmdFix top_lvl env let_dmd orig_pairs = loop 1 initial_pairs where - bndrs = map fst orig_pairs - -- See Note [Initialising strictness] initial_pairs | ae_virgin env = [(setIdStrictness id botSig, rhs) | (id, rhs) <- orig_pairs ] | otherwise = orig_pairs @@ -990,10 +1107,8 @@ dmdFix top_lvl env let_dmd orig_pairs = -- pprTrace "my_downRhs" (ppr id $$ ppr (idStrictness id) $$ ppr sig) $ ((env', lazy_fv'), (id', rhs')) where - (lazy_fv1, sig, rhs') = dmdAnalRhsLetDown (Just bndrs) env let_dmd id rhs - lazy_fv' = plusVarEnv_C plusDmd lazy_fv lazy_fv1 - env' = extendAnalEnv top_lvl env id sig - id' = setIdStrictness id sig + (env', lazy_fv1, id', rhs') = dmdAnalRhsSig top_lvl Recursive env let_dmd id rhs + lazy_fv' = plusVarEnv_C plusDmd lazy_fv lazy_fv1 zapIdStrictness :: [(Id, CoreExpr)] -> [(Id, CoreExpr)] zapIdStrictness pairs = [(setIdStrictness id nopSig, rhs) | (id, rhs) <- pairs ] @@ -1090,7 +1205,7 @@ addLazyFVs dmd_ty lazy_fvs -- demand with the bottom coming up from 'error' -- -- I got a loop in the fixpointer without this, due to an interaction - -- with the lazy_fv filtering in dmdAnalRhsLetDown. Roughly, it was + -- with the lazy_fv filtering in dmdAnalRhsSig. Roughly, it was -- letrec f n x -- = letrec g y = x `fatbar` -- letrec h z = z + ...g... @@ -1156,10 +1271,6 @@ annotateLamIdBndr env arg_of_dfun dmd_ty id main_ty = addDemand dmd dmd_ty' (dmd_ty', dmd) = findBndrDmd env arg_of_dfun dmd_ty id -deleteFVs :: DmdType -> [Var] -> DmdType -deleteFVs (DmdType fvs dmds res) bndrs - = DmdType (delVarEnvList fvs bndrs) dmds res - {- Note [NOINLINE and strictness] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Core/Opt/Pipeline.hs ===================================== @@ -65,6 +65,7 @@ import GHC.Types.SrcLoc import GHC.Types.Id import GHC.Types.Id.Info import GHC.Types.Basic +import GHC.Types.Demand ( zapDmdEnvSig ) import GHC.Types.Var.Set import GHC.Types.Var.Env import GHC.Types.Unique.Supply ( UniqSupply, mkSplitUniqSupply, splitUniqSupply ) @@ -495,7 +496,7 @@ doCorePass CoreDoExitify = {-# SCC "Exitify" #-} doPass exitifyProgram doCorePass CoreDoDemand = {-# SCC "DmdAnal" #-} - doPassDFM dmdAnal + doPassDFRM dmdAnal doCorePass CoreDoCpr = {-# SCC "CprAnal" #-} doPassDFM cprAnalProgram @@ -575,6 +576,13 @@ doPassDFM do_pass guts = do let fam_envs = (p_fam_env, mg_fam_inst_env guts) doPassM (liftIO . do_pass dflags fam_envs) guts +doPassDFRM :: (DynFlags -> FamInstEnvs -> [CoreRule] -> CoreProgram -> IO CoreProgram) -> ModGuts -> CoreM ModGuts +doPassDFRM do_pass guts = do + dflags <- getDynFlags + p_fam_env <- getPackageFamInstEnv + let fam_envs = (p_fam_env, mg_fam_inst_env guts) + doPassM (liftIO . do_pass dflags fam_envs (mg_rules guts)) guts + doPassDFU :: (DynFlags -> FamInstEnvs -> UniqSupply -> CoreProgram -> CoreProgram) -> ModGuts -> CoreM ModGuts doPassDFU do_pass guts = do dflags <- getDynFlags @@ -1088,13 +1096,13 @@ transferIdInfo exported_id local_id -dmdAnal :: DynFlags -> FamInstEnvs -> CoreProgram -> IO CoreProgram -dmdAnal dflags fam_envs binds = do +dmdAnal :: DynFlags -> FamInstEnvs -> [CoreRule] -> CoreProgram -> IO CoreProgram +dmdAnal dflags fam_envs rules binds = do let opts = DmdAnalOpts { dmd_strict_dicts = gopt Opt_DictsStrict dflags } - binds_plus_dmds = dmdAnalProgram opts fam_envs binds + binds_plus_dmds = dmdAnalProgram opts fam_envs rules binds Err.dumpIfSet_dyn dflags Opt_D_dump_str_signatures "Strictness signatures" FormatText $ - dumpIdInfoOfProgram (ppr . strictnessInfo) binds_plus_dmds + dumpIdInfoOfProgram (ppr . zapDmdEnvSig . strictnessInfo) binds_plus_dmds -- See Note [Stamp out space leaks in demand analysis] in GHC.Core.Opt.DmdAnal seqBinds binds_plus_dmds `seq` return binds_plus_dmds ===================================== compiler/GHC/Core/Opt/WorkWrap/Utils.hs ===================================== @@ -1275,10 +1275,14 @@ mk_absent_let dflags fam_envs arg abs_rhs = mkAbsentErrorApp arg_ty msg msg = showSDoc (gopt_set dflags Opt_SuppressUniques) - (ppr arg <+> ppr (idType arg) <+> file_msg) + (vcat + [ text "Arg:" <+> ppr arg + , text "Type:" <+> ppr arg_ty + , file_msg + ]) file_msg = case outputFile dflags of Nothing -> empty - Just f -> text "in output file " <+> quotes (text f) + Just f -> text "In output file " <+> quotes (text f) -- We need to suppress uniques here because otherwise they'd -- end up in the generated code as strings. This is bad for -- determinism, because with different uniques the strings ===================================== compiler/GHC/Core/Tidy.hs ===================================== @@ -21,7 +21,7 @@ import GHC.Core import GHC.Core.Seq ( seqUnfolding ) import GHC.Types.Id import GHC.Types.Id.Info -import GHC.Types.Demand ( zapUsageEnvSig ) +import GHC.Types.Demand ( zapDmdEnvSig ) import GHC.Core.Type ( tidyType, tidyVarBndr ) import GHC.Core.Coercion ( tidyCo ) import GHC.Types.Var @@ -206,7 +206,7 @@ tidyLetBndr rec_tidy_env env@(tidy_env, var_env) id new_info = vanillaIdInfo `setOccInfo` occInfo old_info `setArityInfo` arityInfo old_info - `setStrictnessInfo` zapUsageEnvSig (strictnessInfo old_info) + `setStrictnessInfo` zapDmdEnvSig (strictnessInfo old_info) `setDemandInfo` demandInfo old_info `setInlinePragInfo` inlinePragInfo old_info `setUnfoldingInfo` new_unf ===================================== compiler/GHC/Types/Demand.hs ===================================== @@ -34,7 +34,7 @@ module GHC.Types.Demand ( lazyApply1Dmd, lazyApply2Dmd, strictOnceApply1Dmd, strictManyApply1Dmd, -- ** Other @Demand@ operations oneifyCard, oneifyDmd, strictifyDmd, strictifyDictDmd, mkWorkerDemand, - peelCallDmd, peelManyCalls, mkCallDmd, mkCallDmds, + peelCallDmd, peelManyCalls, mkCalledOnceDmd, mkCalledOnceDmds, addCaseBndrDmd, -- ** Extracting one-shot information argOneShots, argsOneShots, saturatedByOneShots, @@ -73,7 +73,7 @@ module GHC.Types.Demand ( seqDemand, seqDemandList, seqDmdType, seqStrictSig, -- * Zapping usage information - zapUsageDemand, zapUsageEnvSig, zapUsedOnceDemand, zapUsedOnceSig + zapUsageDemand, zapDmdEnvSig, zapUsedOnceDemand, zapUsedOnceSig ) where #include "HsVersions.h" @@ -278,7 +278,8 @@ data SubDemand -- ^ @Call n sd@ describes the evaluation context of @n@ function -- applications, where every individual result is evaluated according to @sd at . -- @sd@ is /relative/ to a single call, cf. Note [Call demands are relative]. - -- Used only for values of function type. + -- Used only for values of function type. Use the smart constructor 'mkCall' + -- whenever possible! | Prod ![Demand] -- ^ @Prod ds@ describes the evaluation context of a case scrutinisation -- on an expression of product type, where the product components are @@ -306,7 +307,7 @@ polyDmd C_1N = C_1N :* poly1N polyDmd C_10 = C_10 :* poly10 -- | A smart constructor for 'Prod', applying rewrite rules along the semantic --- equalities @Prod [polyDmd n, ...] === polyDmd n@, simplifying to 'Poly' +-- equality @Prod [polyDmd n, ...] === polyDmd n@, simplifying to 'Poly' -- 'SubDemand's when possible. Note that this degrades boxity information! E.g. a -- polymorphic demand will never unbox. mkProd :: [Demand] -> SubDemand @@ -335,6 +336,13 @@ viewProd _ _ = Nothing {-# INLINE viewProd #-} -- we want to fuse away the replicate and the allocation -- for Arity. Otherwise, #18304 bites us. +-- | A smart constructor for 'Call', applying rewrite rules along the semantic +-- equality @Call n (Poly n) === Poly n@, simplifying to 'Poly' 'SubDemand's +-- when possible. +mkCall :: Card -> SubDemand -> SubDemand +mkCall n cd@(Poly m) | n == m = cd +mkCall n cd = Call n cd + -- | @viewCall sd@ interprets @sd@ as a 'Call', expanding 'Poly' demands as -- necessary. viewCall :: SubDemand -> Maybe (Card, SubDemand) @@ -356,8 +364,8 @@ lubSubDmd (Prod ds1) (viewProd (length ds1) -> Just ds2) = -- Handle Call lubSubDmd (Call n1 d1) (viewCall -> Just (n2, d2)) -- See Note [Call demands are relative] - | isAbs n2 = Call (lubCard n1 n2) (lubSubDmd d1 botSubDmd) - | otherwise = Call (lubCard n1 n2) (lubSubDmd d1 d2) + | isAbs n2 = mkCall (lubCard n1 n2) (lubSubDmd d1 botSubDmd) + | otherwise = mkCall (lubCard n1 n2) (lubSubDmd d1 d2) -- Handle Poly lubSubDmd (Poly n1) (Poly n2) = Poly (lubCard n1 n2) -- Make use of reflexivity (so we'll match the Prod or Call cases again). @@ -377,8 +385,8 @@ plusSubDmd (Prod ds1) (viewProd (length ds1) -> Just ds2) = -- Handle Call plusSubDmd (Call n1 d1) (viewCall -> Just (n2, d2)) -- See Note [Call demands are relative] - | isAbs n2 = Call (plusCard n1 n2) (lubSubDmd d1 botSubDmd) - | otherwise = Call (plusCard n1 n2) (lubSubDmd d1 d2) + | isAbs n2 = mkCall (plusCard n1 n2) (lubSubDmd d1 botSubDmd) + | otherwise = mkCall (plusCard n1 n2) (lubSubDmd d1 d2) -- Handle Poly plusSubDmd (Poly n1) (Poly n2) = Poly (plusCard n1 n2) -- Make use of reflexivity (so we'll match the Prod or Call cases again). @@ -407,7 +415,7 @@ multSubDmd :: Card -> SubDemand -> SubDemand multSubDmd n sd | Just sd' <- multTrivial n seqSubDmd sd = sd' multSubDmd n (Poly n') = Poly (multCard n n') -multSubDmd n (Call n' sd) = Call (multCard n n') sd -- See Note [Call demands are relative] +multSubDmd n (Call n' sd) = mkCall (multCard n n') sd -- See Note [Call demands are relative] multSubDmd n (Prod ds) = Prod (map (multDmd n) ds) multDmd :: Card -> Demand -> Demand @@ -457,22 +465,22 @@ evalDmd = C_1N :* topSubDmd -- | First argument of 'GHC.Exts.maskAsyncExceptions#': @SCS(U)@. -- Called exactly once. strictOnceApply1Dmd :: Demand -strictOnceApply1Dmd = C_11 :* Call C_11 topSubDmd +strictOnceApply1Dmd = C_11 :* mkCall C_11 topSubDmd -- | First argument of 'GHC.Exts.atomically#': @MCM(U)@. -- Called at least once, possibly many times. strictManyApply1Dmd :: Demand -strictManyApply1Dmd = C_1N :* Call C_1N topSubDmd +strictManyApply1Dmd = C_1N :* mkCall C_1N topSubDmd -- | First argument of catch#: @1C1(U)@. -- Evaluates its arg lazily, but then applies it exactly once to one argument. lazyApply1Dmd :: Demand -lazyApply1Dmd = C_01 :* Call C_01 topSubDmd +lazyApply1Dmd = C_01 :* mkCall C_01 topSubDmd -- | Second argument of catch#: @1C1(CS(U))@. -- Calls its arg lazily, but then applies it exactly once to an additional argument. lazyApply2Dmd :: Demand -lazyApply2Dmd = C_01 :* Call C_01 (Call C_11 topSubDmd) +lazyApply2Dmd = C_01 :* mkCall C_01 (mkCall C_11 topSubDmd) -- | Make a 'Demand' evaluated at-most-once. oneifyDmd :: Demand -> Demand @@ -512,12 +520,12 @@ strictifyDictDmd ty (n :* Prod ds) strictifyDictDmd _ dmd = dmd -- | Wraps the 'SubDemand' with a one-shot call demand: @d@ -> @CS(d)@. -mkCallDmd :: SubDemand -> SubDemand -mkCallDmd sd = Call C_11 sd +mkCalledOnceDmd :: SubDemand -> SubDemand +mkCalledOnceDmd sd = mkCall C_11 sd --- | @mkCallDmds n d@ returns @CS(CS...(CS d))@ where there are @n@ @CS@'s. -mkCallDmds :: Arity -> SubDemand -> SubDemand -mkCallDmds arity sd = iterate mkCallDmd sd !! arity +-- | @mkCalledOnceDmds n d@ returns @CS(CS...(CS d))@ where there are @n@ @CS@'s. +mkCalledOnceDmds :: Arity -> SubDemand -> SubDemand +mkCalledOnceDmds arity sd = iterate mkCalledOnceDmd sd !! arity -- | Peels one call level from the sub-demand, and also returns how many -- times we entered the lambda body. @@ -669,7 +677,7 @@ This is needed even for non-product types, in case the case-binder is used but the components of the case alternative are not. Note [Don't optimise UP(U,U,...) to U] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ These two SubDemands: UP(U,U) (@Prod [topDmd, topDmd]@) and U (@topSubDmd@) are semantically equivalent, but we do not turn the former into @@ -1571,9 +1579,9 @@ This is weird, so I'm not worried about whether this optimises brilliantly; but it should not fall over. -} -zapUsageEnvSig :: StrictSig -> StrictSig --- Remove the usage environment from the demand -zapUsageEnvSig (StrictSig (DmdType _ ds r)) = mkClosedStrictSig ds r +-- | Remove the demand environment from the signature. +zapDmdEnvSig :: StrictSig -> StrictSig +zapDmdEnvSig (StrictSig (DmdType _ ds r)) = mkClosedStrictSig ds r zapUsageDemand :: Demand -> Demand -- Remove the usage info, but not the strictness info, from the demand @@ -1615,8 +1623,8 @@ kill_usage kfs (n :* sd) = kill_usage_card kfs n :* kill_usage_sd kfs sd kill_usage_sd :: KillFlags -> SubDemand -> SubDemand kill_usage_sd kfs (Call n sd) - | kf_called_once kfs = Call (lubCard C_1N n) (kill_usage_sd kfs sd) - | otherwise = Call n (kill_usage_sd kfs sd) + | kf_called_once kfs = mkCall (lubCard C_1N n) (kill_usage_sd kfs sd) + | otherwise = mkCall n (kill_usage_sd kfs sd) kill_usage_sd kfs (Prod ds) = Prod (map (kill_usage kfs) ds) kill_usage_sd _ sd = sd @@ -1640,7 +1648,7 @@ trimToType (n :* sd) ts where go (Prod ds) (TsProd tss) | equalLength ds tss = Prod (zipWith trimToType ds tss) - go (Call n sd) (TsFun ts) = Call n (go sd ts) + go (Call n sd) (TsFun ts) = mkCall n (go sd ts) go sd at Poly{} _ = sd go _ _ = topSubDmd @@ -1804,7 +1812,7 @@ instance Binary SubDemand where h <- getByte bh case h of 0 -> Poly <$> get bh - 1 -> Call <$> get bh <*> get bh + 1 -> mkCall <$> get bh <*> get bh 2 -> Prod <$> get bh _ -> pprPanic "Binary:SubDemand" (ppr (fromIntegral h :: Int)) ===================================== compiler/GHC/Types/Id/Info.hs ===================================== @@ -650,7 +650,7 @@ zapUsageInfo info = Just (info {demandInfo = zapUsageDemand (demandInfo info)}) zapUsageEnvInfo :: IdInfo -> Maybe IdInfo zapUsageEnvInfo info | hasDemandEnvSig (strictnessInfo info) - = Just (info {strictnessInfo = zapUsageEnvSig (strictnessInfo info)}) + = Just (info {strictnessInfo = zapDmdEnvSig (strictnessInfo info)}) | otherwise = Nothing ===================================== testsuite/tests/arityanal/should_compile/Arity11.stderr ===================================== @@ -35,7 +35,7 @@ end Rec } -- RHS size: {terms: 52, types: 28, coercions: 0, joins: 0/5} F11.$wfib [InlPrag=[2]] :: forall {a} {p}. (a -> a -> Bool) -> (Num a, Num p) => a -> p -[GblId, Arity=4, Str=, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 150 60 0] 460 0}] +[GblId, Arity=4, Str=, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 150 60 0] 460 0}] F11.$wfib = \ (@a) (@p) (ww :: a -> a -> Bool) (w :: Num a) (w1 :: Num p) (w2 :: a) -> let { @@ -73,7 +73,7 @@ F11.$wfib fib [InlPrag=[2]] :: forall {a} {p}. (Eq a, Num a, Num p) => a -> p [GblId, Arity=4, - Str=, + Str=, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=4,unsat_ok=True,boring_ok=False) Tmpl= \ (@a) (@p) (w [Occ=Once1!] :: Eq a) (w1 [Occ=Once1] :: Num a) (w2 [Occ=Once1] :: Num p) (w3 [Occ=Once1] :: a) -> case w of { GHC.Classes.C:Eq ww1 [Occ=Once1] _ [Occ=Dead] -> F11.$wfib @a @p ww1 w1 w2 w3 }}] fib = \ (@a) (@p) (w :: Eq a) (w1 :: Num a) (w2 :: Num p) (w3 :: a) -> case w of { GHC.Classes.C:Eq ww1 ww2 -> F11.$wfib @a @p ww1 w1 w2 w3 } ===================================== testsuite/tests/arityanal/should_compile/Arity16.stderr ===================================== @@ -5,7 +5,7 @@ Result size of Tidy Core = {terms: 52, types: 87, coercions: 0, joins: 0/0} Rec { -- RHS size: {terms: 15, types: 17, coercions: 0, joins: 0/0} map2 [Occ=LoopBreaker] :: forall {t} {a}. (t -> a) -> [t] -> [a] -[GblId, Arity=2, Str=, Unf=OtherCon []] +[GblId, Arity=2, Str=, Unf=OtherCon []] map2 = \ (@t) (@a) (f :: t -> a) (ds :: [t]) -> case ds of { ===================================== testsuite/tests/stranal/should_compile/T18894.hs ===================================== @@ -0,0 +1,28 @@ +{-# OPTIONS_GHC -O2 -fforce-recomp #-} + +-- | The point of this test is that @g*@ get's a demand that says +-- "whenever @g*@ is called, the second component of the pair is evaluated strictly". +module T18894 (h1, h2) where + +g1 :: Int -> (Int,Int) +g1 1 = (15, 0) +g1 n = (2 * n, 2 `div` n) +{-# NOINLINE g1 #-} + +h1 :: Int -> Int +h1 1 = 0 +-- Sadly, the @g1 2@ subexpression will be floated to top-level, where we +-- don't see the specific demand placed on it by @snd at . Tracked in #19001. +h1 2 = snd (g1 2) +h1 m = uncurry (+) (g1 m) + +g2 :: Int -> Int -> (Int,Int) +g2 m 1 = (m, 0) +g2 m n = (2 * m, 2 `div` n) +{-# NOINLINE g2 #-} + +h2 :: Int -> Int +h2 1 = 0 +h2 m + | odd m = snd (g2 m 2) + | otherwise = uncurry (+) (g2 2 m) ===================================== testsuite/tests/stranal/should_compile/T18894.stderr ===================================== @@ -0,0 +1,404 @@ + +==================== Demand analysis ==================== +Result size of Demand analysis + = {terms: 177, types: 97, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 36, types: 16, coercions: 0, joins: 0/0} +g2 [InlPrag=NOINLINE, Dmd=UCU(CS(P(1P(U),SP(U))))] + :: Int -> Int -> (Int, Int) +[LclId, + Arity=2, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20 20] 161 20}] +g2 + = \ (m [Dmd=UP(U)] :: Int) (ds [Dmd=SP(SU)] :: Int) -> + case ds of { GHC.Types.I# ds [Dmd=SU] -> + case ds of ds [Dmd=1U] { + __DEFAULT -> + (case m of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.*# 2# y) }, + case ds of wild { + __DEFAULT -> + case GHC.Classes.divInt# 2# wild of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> GHC.Types.I# -2#; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + }); + 1# -> (m, lvl) + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 36, types: 19, coercions: 0, joins: 0/0} +h2 :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 162 10}] +h2 + = \ (ds [Dmd=SP(MU)] :: Int) -> + case ds of wild [Dmd=UP(U)] { GHC.Types.I# ds [Dmd=MU] -> + case ds of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> + case g2 wild lvl of { (ds1 [Dmd=A], y [Dmd=SU]) -> y }; + 0# -> + case g2 lvl wild of { (x [Dmd=SP(U)], ds [Dmd=SP(U)]) -> + case x of { GHC.Types.I# x -> + case ds of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + } + }; + 1# -> lvl + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 15# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +lvl :: (Int, Int) +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = (lvl, lvl) + +-- RHS size: {terms: 30, types: 11, coercions: 0, joins: 0/0} +g1 [InlPrag=NOINLINE, Dmd=UCU(P(UP(U),UP(U)))] :: Int -> (Int, Int) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 141 10}] +g1 + = \ (ds [Dmd=SP(SU)] :: Int) -> + case ds of { GHC.Types.I# ds [Dmd=SU] -> + case ds of ds { + __DEFAULT -> + (GHC.Types.I# (GHC.Prim.*# 2# ds), + case ds of wild { + __DEFAULT -> + case GHC.Classes.divInt# 2# wild of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> GHC.Types.I# -2#; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + }); + 1# -> lvl + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +lvl :: (Int, Int) +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=False, ConLike=False, + WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 30 0}] +lvl = g1 (GHC.Types.I# 2#) + +-- RHS size: {terms: 28, types: 18, coercions: 0, joins: 0/0} +h1 :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 111 10}] +h1 + = \ (ds [Dmd=SP(MU)] :: Int) -> + case ds of wild [Dmd=1P(1U)] { GHC.Types.I# ds [Dmd=MU] -> + case ds of { + __DEFAULT -> + case g1 wild of { (x [Dmd=SP(U)], ds [Dmd=SP(U)]) -> + case x of { GHC.Types.I# x -> + case ds of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + }; + 1# -> lvl; + 2# -> case lvl of { (ds1 [Dmd=A], y [Dmd=SU]) -> y } + } + } + + + + +==================== Demand analysis ==================== +Result size of Demand analysis + = {terms: 171, types: 120, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# -2# + +-- RHS size: {terms: 32, types: 18, coercions: 0, joins: 0/0} +$wg2 [InlPrag=NOINLINE, Dmd=UCU(CS(P(1P(U),SP(U))))] + :: Int -> GHC.Prim.Int# -> (# Int, Int #) +[LclId, + Arity=2, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20 30] 121 20}] +$wg2 + = \ (w [Dmd=UP(U)] :: Int) (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + (# case w of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.*# 2# y) }, + case ds of { + __DEFAULT -> + case GHC.Classes.divInt# 2# ds of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> lvl; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + } #); + 1# -> (# w, lvl #) + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 34, types: 21, coercions: 0, joins: 0/0} +$wh2 [InlPrag=[2]] :: GHC.Prim.Int# -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 162 10}] +$wh2 + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> + case $wg2 (GHC.Types.I# ds) 2# of + { (# ww [Dmd=A], ww [Dmd=SU] #) -> + ww + }; + 0# -> + case $wg2 lvl ds of { (# ww [Dmd=SP(U)], ww [Dmd=SP(U)] #) -> + case ww of { GHC.Types.I# x -> + case ww of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + } + }; + 1# -> lvl + } + +-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} +h2 [InlPrag=[2]] :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (w [Occ=Once1!] :: Int) -> + case w of { GHC.Types.I# ww [Occ=Once1, Dmd=MU] -> $wh2 ww }}] +h2 + = \ (w [Dmd=SP(SU)] :: Int) -> + case w of { GHC.Types.I# ww [Dmd=SU] -> $wh2 ww } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 15# + +-- RHS size: {terms: 28, types: 15, coercions: 0, joins: 0/0} +$wg1 [InlPrag=NOINLINE, Dmd=UCU(P(UP(U),UP(U)))] + :: GHC.Prim.Int# -> (# Int, Int #) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 111 20}] +$wg1 + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + (# GHC.Types.I# (GHC.Prim.*# 2# ds), + case ds of { + __DEFAULT -> + case GHC.Classes.divInt# 2# ds of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> lvl; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + } #); + 1# -> (# lvl, lvl #) + } + +-- RHS size: {terms: 7, types: 9, coercions: 0, joins: 0/0} +lvl :: (Int, Int) +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=False, ConLike=False, + WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 40 10}] +lvl = case $wg1 2# of { (# ww, ww #) -> (ww, ww) } + +-- RHS size: {terms: 25, types: 18, coercions: 0, joins: 0/0} +$wh1 [InlPrag=[2]] :: GHC.Prim.Int# -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [50] 101 10}] +$wh1 + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds [Dmd=1U] { + __DEFAULT -> + case $wg1 ds of { (# ww [Dmd=SP(U)], ww [Dmd=SP(U)] #) -> + case ww of { GHC.Types.I# x -> + case ww of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + }; + 1# -> lvl; + 2# -> case lvl of { (ds1 [Dmd=A], y [Dmd=SU]) -> y } + } + +-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} +h1 [InlPrag=[2]] :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (w [Occ=Once1!] :: Int) -> + case w of { GHC.Types.I# ww [Occ=Once1, Dmd=MU] -> $wh1 ww }}] +h1 + = \ (w [Dmd=SP(SU)] :: Int) -> + case w of { GHC.Types.I# ww [Dmd=SU] -> $wh1 ww } + + + ===================================== testsuite/tests/stranal/should_compile/T18894b.hs ===================================== @@ -0,0 +1,20 @@ +{-# OPTIONS_GHC -O -fno-call-arity -fforce-recomp #-} + +module T18894 (f) where + +expensive :: Int -> (Int, Int) +expensive n = (n+1, n+2) +{-# NOINLINE expensive #-} + +-- arity 1 by itself, but not exported, thus can be eta-expanded based on usage +eta :: Int -> Int -> Int +eta x = if fst (expensive x) == 13 + then \y -> x + y + else \y -> x * y +{-# NOINLINE eta #-} + +f :: Int -> Int +f 1 = 0 +f m + | odd m = eta m 2 + | otherwise = eta 2 m ===================================== testsuite/tests/stranal/should_compile/T18894b.stderr ===================================== @@ -0,0 +1,187 @@ + +==================== Demand analysis ==================== +Result size of Demand analysis = {terms: 83, types: 40, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 16, types: 7, coercions: 0, joins: 0/0} +expensive [InlPrag=NOINLINE, Dmd=UCU(P(SP(SU),A))] :: Int -> (Int, Int) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [40] 52 10}] +expensive + = \ (n [Dmd=UP(U)] :: Int) -> + (case n of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 1#) }, case n of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 2#) }) + +-- RHS size: {terms: 20, types: 11, coercions: 0, joins: 0/0} +eta [InlPrag=NOINLINE, Dmd=UCU(CS(U))] :: Int -> Int -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [0] 140 120}] +eta + = \ (x [Dmd=UP(U)] :: Int) -> + case expensive x of { (x [Dmd=SP(SU)], ds1 [Dmd=A]) -> + case x of { GHC.Types.I# x [Dmd=SU] -> + case x of { + __DEFAULT -> \ (y [Dmd=SP(U)] :: Int) -> GHC.Num.$fNumInt_$c* x y; + 13# -> \ (y [Dmd=SP(U)] :: Int) -> GHC.Num.$fNumInt_$c+ x y + } + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 21, types: 5, coercions: 0, joins: 0/0} +f :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 111 0}] +f = \ (ds [Dmd=SP(MU)] :: Int) -> + case ds of wild [Dmd=UP(U)] { GHC.Types.I# ds [Dmd=MU] -> + case ds of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> eta wild lvl; + 0# -> eta lvl wild + }; + 1# -> lvl + } + } + + + + +==================== Demand analysis ==================== +Result size of Demand analysis = {terms: 85, types: 47, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 16, types: 9, coercions: 0, joins: 0/0} +$wexpensive [InlPrag=NOINLINE, Dmd=UCU(P(SP(SU),A))] :: Int -> (# Int, Int #) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [40] 42 10}] +$wexpensive + = \ (w [Dmd=UP(U)] :: Int) -> + (# case w of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 1#) }, + case w of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 2#) } #) + +-- RHS size: {terms: 19, types: 12, coercions: 0, joins: 0/0} +eta [InlPrag=NOINLINE, Dmd=UCU(CS(U))] :: Int -> Int -> Int +[LclId, + Arity=2, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [0 0] 120 0}] +eta + = \ (x [Dmd=MP(U)] :: Int) (eta [Dmd=SP(U), OS=OneShot] :: Int) -> + case $wexpensive x of { (# ww [Dmd=SP(SU)], ww [Dmd=A] #) -> + case ww of { GHC.Types.I# x [Dmd=SU] -> + case x of { + __DEFAULT -> GHC.Num.$fNumInt_$c* x eta; + 13# -> GHC.Num.$fNumInt_$c+ x eta + } + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 20, types: 3, coercions: 0, joins: 0/0} +$wf [InlPrag=[2]] :: GHC.Prim.Int# -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 121 0}] +$wf + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> eta (GHC.Types.I# ds) lvl; + 0# -> eta lvl (GHC.Types.I# ds) + }; + 1# -> lvl + } + +-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} +f [InlPrag=[2]] :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (w [Occ=Once1!] :: Int) -> case w of { GHC.Types.I# ww [Occ=Once1, Dmd=MU] -> $wf ww }}] +f = \ (w [Dmd=SP(SU)] :: Int) -> case w of { GHC.Types.I# ww [Dmd=SU] -> $wf ww } + + + ===================================== testsuite/tests/stranal/should_compile/all.T ===================================== @@ -58,3 +58,7 @@ test('T18122', [ grep_errmsg(r'wfoo =') ], compile, ['-ddump-simpl']) # We care about the call demand on $wg test('T18903', [ grep_errmsg(r'Dmd=\S+C\S+') ], compile, ['-ddump-simpl -dsuppress-uniques']) +# We care about the call demand on $wg1 and $wg2 +test('T18894', [ grep_errmsg(r'Dmd=\S+C\S+') ], compile, ['-ddump-stranal -dsuppress-uniques']) +# We care about the Arity 2 on eta, as a result of the annotated Dmd +test('T18894b', [ grep_errmsg(r'Arity=2') ], compile, ['-ddump-stranal -dsuppress-uniques -fno-call-arity -dppr-cols=200']) ===================================== testsuite/tests/stranal/sigs/T5075.stderr ===================================== @@ -1,7 +1,7 @@ ==================== Strictness signatures ==================== T5075.$trModule: -T5075.loop: +T5075.loop: @@ -13,6 +13,6 @@ T5075.loop: ==================== Strictness signatures ==================== T5075.$trModule: -T5075.loop: +T5075.loop: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/829ecab3f489cd8a0785fccdcc089f4ad42f3a22...044d0f13ec8ebd531170dc752d9b0a6dea1d4c47 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/829ecab3f489cd8a0785fccdcc089f4ad42f3a22...044d0f13ec8ebd531170dc752d9b0a6dea1d4c47 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 2 23:28:03 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Wed, 02 Dec 2020 18:28:03 -0500 Subject: [Git][ghc/ghc][wip/T18891] Fix kind inference for data types. Again. Message-ID: <5fc82303ce945_6a09f30d4334ac@gitlab.mail> Simon Peyton Jones pushed to branch wip/T18891 at Glasgow Haskell Compiler / GHC Commits: 0b1f76fd by Simon Peyton Jones at 2020-12-02T23:26:53+00:00 Fix kind inference for data types. Again. This patch improves kcConDecls, when we are inferring the kind of a data type decl. Specifically * In kcConDecls/kcConDecl make it clear that the tc_res_kind argument is only used in the H98 case; and in that case there is not result kind signature; and hence no need for the disgusting splitPiTys in kcConDecls (now thankfully gone). The GADT case is a bit different to before, and much nicer. This is what fixes #18891. See Note [kcConDecls: kind-checking data type decls] * Do not look at the constructor decls of a data/newtype instance in tcDataFamInstanceHeader. See new Note [Kind inference for data family instances] This causes a few knock-on effects in the tests suite, because we require more information than before in the instance /header/. New user-manual material about this in "Kind inference in data type declarations" and "Kind inference for data/newtype instance declarations". * Minor improvement in kcTyClDecl, combining GADT and H98 case. * Further fixes to kind checking type decls In particular, fix #14111 and #8707 Fixes #18891 - - - - - 30 changed files: - compiler/GHC/Hs/Extension.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Instance.hs - docs/users_guide/9.2.1-notes.rst - docs/users_guide/exts/poly_kinds.rst - testsuite/tests/dependent/should_fail/T13780a.stderr - testsuite/tests/deriving/should_compile/T11416.hs - testsuite/tests/deriving/should_compile/T9359.hs - + testsuite/tests/indexed-types/should_compile/T14111.hs - + testsuite/tests/indexed-types/should_compile/T8707.hs - testsuite/tests/indexed-types/should_compile/all.T - testsuite/tests/indexed-types/should_fail/T8368.stderr - testsuite/tests/indexed-types/should_fail/T8368a.stderr - testsuite/tests/patsyn/should_fail/T15685.stderr - testsuite/tests/polykinds/T13659.stderr - testsuite/tests/polykinds/T16221a.stderr - testsuite/tests/th/T11145.stderr - testsuite/tests/th/T9692.hs - + testsuite/tests/typecheck/should_compile/T18891.hs - testsuite/tests/typecheck/should_compile/UnliftedNewtypesUnassociatedFamily.hs - testsuite/tests/typecheck/should_compile/UnliftedNewtypesUnifySig.hs - testsuite/tests/typecheck/should_compile/all.T - + testsuite/tests/typecheck/should_fail/T18891a.hs - + testsuite/tests/typecheck/should_fail/T18891a.stderr - testsuite/tests/typecheck/should_fail/UnliftedNewtypesFamilyKindFail2.stderr - + testsuite/tests/typecheck/should_fail/UnliftedNewtypesUnassociatedFamilyFail.hs - + testsuite/tests/typecheck/should_fail/UnliftedNewtypesUnassociatedFamilyFail.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/Hs/Extension.hs ===================================== @@ -253,9 +253,9 @@ sure that any uses of it as a field are strict. -- | Used as a data type index for the hsSyn AST; also serves -- as a singleton type for Pass data GhcPass (c :: Pass) where - GhcPs :: GhcPs - GhcRn :: GhcRn - GhcTc :: GhcTc + GhcPs :: GhcPass 'Parsed + GhcRn :: GhcPass 'Renamed + GhcTc :: GhcPass 'Typechecked -- This really should never be entered, but the data-deriving machinery -- needs the instance to exist. ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -2986,7 +2986,7 @@ bindOuterSigTKBndrs_Tv_M :: TcTyMode -> TcM a -> TcM (HsOuterSigTyVarBndrs GhcTc, a) -- Do not push level; do not make implication constraint; use Tvs -- Two major clients of this "bind-only" path are: --- Note [Kind-checking for GADTs] in TyCl +-- Note [Using TyVarTvs for kind-checking GADTs] in GHC.Tc.TyCl -- Note [Checking partial type signatures] bindOuterSigTKBndrs_Tv_M mode = bindOuterTKBndrsX (smVanilla { sm_clone = True, sm_tvtv = True @@ -3299,8 +3299,8 @@ When we /must/ clone. When kind-checking T, we give (a :: kappa1). Then: - In kcConDecl we make a TyVarTv unification variable kappa2 for k2 - (as described in Note [Kind-checking for GADTs], even though this - example is an existential) + (as described in Note [Using TyVarTvs for kind-checking GADTs], + even though this example is an existential) - So we get (b :: kappa2) via bindExplicitTKBndrs_Tv - We end up unifying kappa1 := kappa2, because of the (SameKind a b) ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -1885,7 +1885,7 @@ canDecomposableTyConAppOK ev eq_rel tc tys1 tys2 | bndr <- tyConBinders tc , let new_loc0 | isNamedTyConBinder bndr = toKindLoc loc | otherwise = loc - new_loc | isVisibleTyConBinder bndr + new_loc | isInvisibleTyConBinder bndr = updateCtLocOrigin new_loc0 toInvisibleOrigin | otherwise = new_loc0 ] ===================================== compiler/GHC/Tc/TyCl.hs ===================================== @@ -17,7 +17,8 @@ module GHC.Tc.TyCl ( -- Functions used by GHC.Tc.TyCl.Instance to check -- data/type family instance declarations - kcConDecls, tcConDecls, dataDeclChecks, checkValidTyCon, + kcConDecls, tcConDecls, DataDeclInfo(..), + dataDeclChecks, checkValidTyCon, tcFamTyPats, tcTyFamInstEqn, tcAddTyFamInstCtxt, tcMkDataFamInstCtxt, tcAddDataFamInstCtxt, unravelFamInstPats, addConsistencyConstraints, @@ -38,7 +39,7 @@ import GHC.Tc.Solver( pushLevelAndSolveEqualities, pushLevelAndSolveEqualitiesX , reportUnsolvedEqualities ) import GHC.Tc.Utils.Monad import GHC.Tc.Utils.Env -import GHC.Tc.Utils.Unify( emitResidualTvConstraint ) +import GHC.Tc.Utils.Unify( unifyType, emitResidualTvConstraint ) import GHC.Tc.Types.Constraint( emptyWC ) import GHC.Tc.Validity import GHC.Tc.Utils.Zonk @@ -1529,27 +1530,16 @@ kcTyClDecl :: TyClDecl GhcRn -> TcTyCon -> TcM () -- result kind signature have already been dealt with -- by inferInitialKind, so we can ignore them here. -kcTyClDecl (DataDecl { tcdLName = (L _ name) - , tcdDataDefn = defn }) tyCon - | HsDataDefn { dd_cons = cons@((L _ (ConDeclGADT {})) : _) - , dd_ctxt = (L _ []) - , dd_ND = new_or_data } <- defn - = -- See Note [Implementation of UnliftedNewtypes] STEP 2 - kcConDecls new_or_data (tyConResKind tyCon) cons - - -- hs_tvs and dd_kindSig already dealt with in inferInitialKind - -- This must be a GADT-style decl, - -- (see invariants of DataDefn declaration) - -- so (a) we don't need to bring the hs_tvs into scope, because the - -- ConDecls bind all their own variables - -- (b) dd_ctxt is not allowed for GADT-style decls, so we can ignore it - - | HsDataDefn { dd_ctxt = ctxt - , dd_cons = cons - , dd_ND = new_or_data } <- defn +kcTyClDecl (DataDecl { tcdLName = (L _ name), tcdDataDefn = defn }) tycon + | HsDataDefn { dd_ctxt = ctxt, dd_cons = cons, dd_ND = new_or_data } <- defn = bindTyClTyVars name $ \ _ _ _ -> - do { _ <- tcHsContext ctxt - ; kcConDecls new_or_data (tyConResKind tyCon) cons + -- NB: binding these tyvars isn't necessary for GADTs, but it does no + -- harm. For GADTs, each data con brings its own tyvars into scope, + -- and the ones from this bindTyClTyVars are either not mentioned or + -- (conceivably) shadowed. + do { traceTc "kcTyClDecl" (ppr tycon $$ ppr (tyConTyVars tycon) $$ ppr (tyConResKind tycon)) + ; _ <- tcHsContext ctxt + ; kcConDecls new_or_data (tyConResKind tycon) cons } kcTyClDecl (SynDecl { tcdLName = L _ name, tcdRhs = rhs }) _tycon @@ -1606,13 +1596,12 @@ kcConGADTArgs new_or_data res_kind con_args = case con_args of kcConDecls :: NewOrData -> Kind -- The result kind signature + -- Used only in H98 case -> [LConDecl GhcRn] -- The data constructors -> TcM () -kcConDecls new_or_data res_kind cons - = mapM_ (wrapLocM_ (kcConDecl new_or_data final_res_kind)) cons - where - (_, final_res_kind) = splitPiTys res_kind - -- See Note [kcConDecls result kind] +-- See Note [kcConDecls: kind-checking data type decls] +kcConDecls new_or_data tc_res_kind cons + = mapM_ (wrapLocM_ (kcConDecl new_or_data tc_res_kind)) cons -- Kind check a data constructor. In additional to the data constructor, -- we also need to know about whether or not its corresponding type was @@ -1623,82 +1612,69 @@ kcConDecl :: NewOrData -> Kind -- Result kind of the type constructor -- Usually Type but can be TYPE UnliftedRep -- or even TYPE r, in the case of unlifted newtype + -- Used only in H98 case -> ConDecl GhcRn -> TcM () -kcConDecl new_or_data res_kind (ConDeclH98 +kcConDecl new_or_data tc_res_kind (ConDeclH98 { con_name = name, con_ex_tvs = ex_tvs , con_mb_cxt = ex_ctxt, con_args = args }) - = addErrCtxt (dataConCtxtName [name]) $ + = addErrCtxt (dataConCtxt [name]) $ discardResult $ bindExplicitTKBndrs_Tv ex_tvs $ do { _ <- tcHsMbContext ex_ctxt - ; kcConH98Args new_or_data res_kind args + ; kcConH98Args new_or_data tc_res_kind args -- We don't need to check the telescope here, -- because that's done in tcConDecl } -kcConDecl new_or_data res_kind (ConDeclGADT +kcConDecl new_or_data + _tc_res_kind -- Not used in GADT case (and doesn't make sense) + (ConDeclGADT { con_names = names, con_bndrs = L _ outer_bndrs, con_mb_cxt = cxt , con_g_args = args, con_res_ty = res_ty }) - = -- Even though the GADT-style data constructor's type is closed, - -- we must still kind-check the type, because that may influence - -- the inferred kind of the /type/ constructor. Example: - -- data T f a where - -- MkT :: f a -> T f a - -- If we don't look at MkT we won't get the correct kind - -- for the type constructor T - addErrCtxt (dataConCtxtName names) $ + = -- See Note [kcConDecls: kind-checking data type decls] + addErrCtxt (dataConCtxt names) $ discardResult $ bindOuterSigTKBndrs_Tv outer_bndrs $ - -- Why "_Tv"? See Note [Kind-checking for GADTs] + -- Why "_Tv"? See Note [Using TyVarTvs for kind-checking GADTs] do { _ <- tcHsMbContext cxt - ; kcConGADTArgs new_or_data res_kind args - ; _ <- tcHsOpenType res_ty + ; traceTc "kcConDecl:GADT {" (ppr names $$ ppr res_ty) + ; con_res_kind <- newOpenTypeKind + ; _ <- tcCheckLHsType res_ty (TheKind con_res_kind) + ; kcConGADTArgs new_or_data con_res_kind args + ; traceTc "kcConDecl:GADT }" (ppr names $$ ppr con_res_kind) ; return () } -{- Note [kcConDecls result kind] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We might have e.g. - data T a :: Type -> Type where ... -or - newtype instance N a :: Type -> Type where .. -in which case, the 'res_kind' passed to kcConDecls will be - Type->Type - -We must look past those arrows, or even foralls, to the Type in the -corner, to pass to kcConDecl c.f. #16828. Hence the splitPiTys here. - -I am a bit concerned about tycons with a declaration like - data T a :: Type -> forall k. k -> Type where ... - -It does not have a CUSK, so kcInferDeclHeader will make a TcTyCon -with tyConResKind of Type -> forall k. k -> Type. Even that is fine: -the splitPiTys will look past the forall. But I'm bothered about -what if the type "in the corner" mentions k? This is incredibly -obscure but something like this could be bad: - data T a :: Type -> foral k. k -> TYPE (F k) where ... - -I bet we are not quite right here, but my brain suffered a buffer -overflow and I thought it best to nail the common cases right now. - -Note [Recursion and promoting data constructors] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We don't want to allow promotion in a strongly connected component -when kind checking. - -Consider: - data T f = K (f (K Any)) - -When kind checking the `data T' declaration the local env contains the -mappings: - T -> ATcTyCon - K -> APromotionErr - -APromotionErr is only used for DataCons, and only used during type checking -in tcTyClGroup. - -Note [Kind-checking for GADTs] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [kcConDecls: kind-checking data type decls] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +kcConDecls is used when we are inferring the kind of the type +constructor in a data type declaration. E.g. + data T f a = MkT (f a) +we want to infer the kind of 'f' and 'a'. The basic plan is described +in Note [Inferring kinds for type declarations]; here are doing Step 2. + +In the H98 case, for unlifted newtypes only, we need the result kind of +the TyCon, to unify with the argument kind. The tycon's result kind +is not used at all in the GADT case. + +In the GADT case we may have this: + data T f a where + MkT :: forall g b. g b -> T g b +Notice that the variables f,a, and g,b are quite distinct. +Nevertheless, this decl must still influence the kind T (which is, +remember Step 1, something like T :: kappa1 -> kappa2 -> Type), otherwise +we'd infer the bogus kind T :: forall k1 k2. k1 -> k2 -> Type. + +The data constructor type influences the kind of T simply by +kind-checking the result type (T g b), which will force 'f' and 'g' to +have the same kinds. This is the call to + tcCheckLHsType res_ty (TheKind con_res_kind) +Because this is the result type of an arrow, we know the kind must be +of form (TYPE rr), and we get better error messages if we enforce that +here (e.g. test gadt10). + +Note [Using TyVarTvs for kind-checking GADTs] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider data Proxy a where @@ -1708,26 +1684,27 @@ Consider It seems reasonable that this should be accepted. But something very strange is going on here: when we're kind-checking this declaration, we need to unify the kind of `a` with k and j -- even though k and j's scopes are local to the type of -MkProxy{1,2}. The best approach we've come up with is to use TyVarTvs during -the kind-checking pass. First off, note that it's OK if the kind-checking pass -is too permissive: we'll snag the problems in the type-checking pass later. -(This extra permissiveness might happen with something like +MkProxy{1,2}. + +In effect, we are simply gathering constraints on the shape of Proxy's +kind, with no skolemisation or implication constraints involved at all. + +The best approach we've come up with is to use TyVarTvs during the +kind-checking pass, rather than ordinary skolems. This is why we use +the "_Tv" variant, bindOuterSigTKBndrs_Tv. + +Our only goal is to gather constraints on the kind of the type constructor; +we do not certify that the data declaration is well-kinded. For example: data SameKind :: k -> k -> Type data Bad a where MkBad :: forall k1 k2 (a :: k1) (b :: k2). Bad (SameKind a b) -which would be accepted if k1 and k2 were TyVarTvs. This is correctly rejected -in the second pass, though. Test case: polykinds/TyVarTvKinds3) -Recall that the kind-checking pass exists solely to collect constraints -on the kinds and to power unification. - -To achieve the use of TyVarTvs, we must be careful to use specialized functions -that produce TyVarTvs, not ordinary skolems. This is why we need -kcExplicitTKBndrs and kcImplicitTKBndrs in GHC.Tc.Gen.HsType, separate from their -tc... variants. +which would be accepted by kcConDecl because k1 and k2 are +TyVarTvs. It is correctly rejected in the second pass, tcConDecl. +(Test case: polykinds/TyVarTvKinds3) -The drawback of this approach is sometimes it will accept a definition that +One drawback of this approach is sometimes it will accept a definition that a (hypothetical) declarative specification would likely reject. As a general rule, we don't want to allow polymorphic recursion without a CUSK. Indeed, the whole point of CUSKs is to allow polymorphic recursion. Yet, the TyVarTvs @@ -1746,6 +1723,23 @@ be rejected (without a CUSK). However, the accepted definitions are indeed well-kinded and any rejected definitions would be accepted with a CUSK, and so this wrinkle need not cause anyone to lose sleep. +Note [Recursion and promoting data constructors] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We don't want to allow promotion in a strongly connected component +when kind checking. + +Consider: + data T f = K (f (K Any)) + +When kind checking the `data T' declaration the local env contains the +mappings: + T -> ATcTyCon + K -> APromotionErr + +APromotionErr is only used for DataCons, and only used during type checking +in tcTyClGroup. + + ************************************************************************ * * \subsection{Type checking} @@ -2782,18 +2776,14 @@ tcDataDefn err_ctxt roles_info tc_name ; when (isJust mb_ksig) $ checkTc (kind_signatures) (badSigTyDecl tc_name) - ; tycon <- fixM $ \ tycon -> do + ; tycon <- fixM $ \ rec_tycon -> do { let final_bndrs = tycon_binders `chkAppend` extra_bndrs - res_ty = mkTyConApp tycon (mkTyVarTys (binderVars final_bndrs)) roles = roles_info tc_name ; data_cons <- tcConDecls - tycon - new_or_data - final_bndrs - final_res_kind - res_ty + new_or_data DDVanilla + rec_tycon final_bndrs final_res_kind cons - ; tc_rhs <- mk_tc_rhs hsc_src tycon data_cons + ; tc_rhs <- mk_tc_rhs hsc_src rec_tycon data_cons ; tc_rep_nm <- newTyConRepName tc_name ; return (mkAlgTyCon tc_name final_bndrs @@ -3195,36 +3185,51 @@ consUseGadtSyntax _ = False -- All constructors have same shape ----------------------------------- -tcConDecls :: KnotTied TyCon -> NewOrData - -> [TyConBinder] -> TcKind -- binders and result kind of tycon - -> KnotTied Type -> [LConDecl GhcRn] -> TcM [DataCon] -tcConDecls rep_tycon new_or_data tmpl_bndrs res_kind res_tmpl +data DataDeclInfo + = DDVanilla -- data T a b = T1 a | T2 b + | DDInstance -- data instance D [a] = D1 a | D2 + Type -- The header D [a] + +mkDDHeaderTy :: DataDeclInfo -> TyCon -> [TyConBinder] -> Type +mkDDHeaderTy dd_info rep_tycon tc_bndrs + = case dd_info of + DDVanilla -> mkTyConApp rep_tycon $ + mkTyVarTys (binderVars tc_bndrs) + DDInstance header_ty -> header_ty + +tcConDecls :: NewOrData + -> DataDeclInfo + -> KnotTied TyCon -- Representation TyCon + -> [TyConBinder] -- Binders of representation TyCon + -> TcKind -- Result kind + -> [LConDecl GhcRn] -> TcM [DataCon] +tcConDecls new_or_data dd_info rep_tycon tmpl_bndrs res_kind = concatMapM $ addLocM $ - tcConDecl rep_tycon (mkTyConTagMap rep_tycon) - tmpl_bndrs res_kind res_tmpl new_or_data - -- It's important that we pay for tag allocation here, once per TyCon, - -- See Note [Constructor tag allocation], fixes #14657 - -tcConDecl :: KnotTied TyCon -- Representation tycon. Knot-tied! + tcConDecl new_or_data dd_info rep_tycon tmpl_bndrs res_kind + (mkTyConTagMap rep_tycon) + -- mkTyConTagMap: it's important that we pay for tag allocation here, + -- once per TyCon. See Note [Constructor tag allocation], fixes #14657 + +tcConDecl :: NewOrData + -> DataDeclInfo + -> KnotTied TyCon -- Representation tycon. Knot-tied! + -> [TyConBinder] -- Binders of representation TyCon + -> TcKind -- Result kind -> NameEnv ConTag - -> [TyConBinder] -> TcKind -- tycon binders and result kind - -> KnotTied Type - -- Return type template (T tys), where T is the family TyCon - -> NewOrData -> ConDecl GhcRn -> TcM [DataCon] -tcConDecl rep_tycon tag_map tmpl_bndrs res_kind res_tmpl new_or_data +tcConDecl new_or_data dd_info rep_tycon tc_bndrs res_kind tag_map (ConDeclH98 { con_name = lname@(L _ name) , con_ex_tvs = explicit_tkv_nms , con_mb_cxt = hs_ctxt , con_args = hs_args }) - = addErrCtxt (dataConCtxtName [lname]) $ + = addErrCtxt (dataConCtxt [lname]) $ do { -- NB: the tyvars from the declaration header are in scope -- Get hold of the existential type variables -- e.g. data T a = forall k (b::k) f. MkT a (f b) - -- Here tmpl_bndrs = {a} + -- Here tc_bndrs = {a} -- hs_qvars = HsQTvs { hsq_implicit = {k} -- , hsq_explicit = {f,b} } @@ -3242,29 +3247,35 @@ tcConDecl rep_tycon tag_map tmpl_bndrs res_kind res_tmpl new_or_data } - ; let tmpl_tvs = binderVars tmpl_bndrs - ; let fake_ty = mkSpecForAllTys tmpl_tvs $ + ; let tc_tvs = binderVars tc_bndrs + fake_ty = mkSpecForAllTys tc_tvs $ mkInvisForAllTys exp_tvbndrs $ mkPhiTy ctxt $ mkVisFunTys arg_tys $ unitTy -- That type is a lie, of course. (It shouldn't end in ()!) -- And we could construct a proper result type from the info - -- at hand. But the result would mention only the tmpl_tvs, + -- at hand. But the result would mention only the univ_tvs, -- and so it just creates more work to do it right. Really, -- we're only doing this to find the right kind variables to -- quantify over, and this type is fine for that purpose. - -- exp_tvs have explicit, user-written binding sites + -- exp_tvbndrs have explicit, user-written binding sites -- the kvs below are those kind variables entirely unmentioned by the user -- and discovered only by generalization ; kvs <- kindGeneralizeAll fake_ty - ; let skol_tvs = kvs ++ tmpl_tvs + ; let skol_tvs = tc_tvs ++ kvs ++ binderVars exp_tvbndrs ; reportUnsolvedEqualities skol_info skol_tvs tclvl wanted - - -- Zonk to Types + -- The skol_info claims that all the variables are bound + -- by the data constructor decl, whereas actually the + -- univ_tvs are bound by the data type decl itself. It + -- would be better to have a doubly-nested implication. + -- But that just doesn't seem worth it. + -- See test dependent/should_fail/T13780a + + -- Zonk to Types ; (ze, qkvs) <- zonkTyBndrs kvs ; (ze, user_qtvbndrs) <- zonkTyVarBindersX ze exp_tvbndrs ; arg_tys <- zonkScaledTcTypesToTypesX ze arg_tys @@ -3272,15 +3283,14 @@ tcConDecl rep_tycon tag_map tmpl_bndrs res_kind res_tmpl new_or_data -- Can't print univ_tvs, arg_tys etc, because we are inside the knot here ; traceTc "tcConDecl 2" (ppr name $$ ppr field_lbls) - ; let - univ_tvbs = tyConInvisTVBinders tmpl_bndrs - univ_tvs = binderVars univ_tvbs - ex_tvbs = mkTyVarBinders InferredSpec qkvs ++ user_qtvbndrs - ex_tvs = binderVars ex_tvbs - -- For H98 datatypes, the user-written tyvar binders are precisely - -- the universals followed by the existentials. - -- See Note [DataCon user type variable binders] in GHC.Core.DataCon. - user_tvbs = univ_tvbs ++ ex_tvbs + ; let univ_tvbs = tyConInvisTVBinders tc_bndrs + ex_tvbs = mkTyVarBinders InferredSpec qkvs ++ user_qtvbndrs + ex_tvs = binderVars ex_tvbs + -- For H98 datatypes, the user-written tyvar binders are precisely + -- the universals followed by the existentials. + -- See Note [DataCon user type variable binders] in GHC.Core.DataCon. + user_tvbs = univ_tvbs ++ ex_tvbs + user_res_ty = mkDDHeaderTy dd_info rep_tycon tc_bndrs ; traceTc "tcConDecl 2" (ppr name) ; is_infix <- tcConIsInfixH98 name hs_args @@ -3288,9 +3298,9 @@ tcConDecl rep_tycon tag_map tmpl_bndrs res_kind res_tmpl new_or_data ; fam_envs <- tcGetFamInstEnvs ; dc <- buildDataCon fam_envs name is_infix rep_nm stricts Nothing field_lbls - univ_tvs ex_tvs user_tvbs + tc_tvs ex_tvs user_tvbs [{- no eq_preds -}] ctxt arg_tys - res_tmpl rep_tycon tag_map + user_res_ty rep_tycon tag_map -- NB: we put data_tc, the type constructor gotten from the -- constructor type signature into the data constructor; -- that way checkValidDataCon can complain if it's wrong. @@ -3299,14 +3309,14 @@ tcConDecl rep_tycon tag_map tmpl_bndrs res_kind res_tmpl new_or_data where skol_info = DataConSkol name -tcConDecl rep_tycon tag_map tmpl_bndrs _res_kind res_tmpl new_or_data +tcConDecl new_or_data dd_info rep_tycon tc_bndrs _res_kind tag_map -- NB: don't use res_kind here, as it's ill-scoped. Instead, -- we get the res_kind by typechecking the result type. (ConDeclGADT { con_names = names , con_bndrs = L _ outer_hs_bndrs , con_mb_cxt = cxt, con_g_args = hs_args , con_res_ty = hs_res_ty }) - = addErrCtxt (dataConCtxtName names) $ + = addErrCtxt (dataConCtxt names) $ do { traceTc "tcConDecl 1 gadt" (ppr names) ; let (L _ name : _) = names @@ -3317,10 +3327,23 @@ tcConDecl rep_tycon tag_map tmpl_bndrs _res_kind res_tmpl new_or_data ; (res_ty, res_kind) <- tcInferLHsTypeKind hs_res_ty -- See Note [GADT return kinds] + -- Ensure that the return type, res_ty, + -- is a substitution instance of the header + -- See Note [Return type in GADTs] + ; case dd_info of + DDVanilla -> return () + DDInstance hdr_ty -> + do { (subst, _meta_tvs) <- newMetaTyVars (binderVars tc_bndrs) + ; let head_shape = substTy subst hdr_ty + ; discardResult $ + popErrCtxt $ -- Drop dataConCtxt + addErrCtxt (dataConResCtxt names) $ + unifyType Nothing res_ty head_shape } + -- See Note [Datatype return kinds] ; let exp_kind = getArgExpKind new_or_data res_kind - ; btys <- tcConGADTArgs exp_kind hs_args + ; let (arg_tys, stricts) = unzip btys ; field_lbls <- lookupConstructorFields name ; return (ctxt, arg_tys, res_ty, field_lbls, stricts) @@ -3343,8 +3366,9 @@ tcConDecl rep_tycon tag_map tmpl_bndrs _res_kind res_tmpl new_or_data ; ctxt <- zonkTcTypesToTypesX ze ctxt ; res_ty <- zonkTcTypeToTypeX ze res_ty - ; let (univ_tvs, ex_tvs, tvbndrs', eq_preds, arg_subst) - = rejigConRes tmpl_bndrs res_tmpl tvbndrs res_ty + ; let res_tmpl = mkDDHeaderTy dd_info rep_tycon tc_bndrs + (univ_tvs, ex_tvs, tvbndrs', eq_preds, arg_subst) + = rejigConRes tc_bndrs res_tmpl tvbndrs res_ty -- See Note [Checking GADT return types] ctxt' = substTys arg_subst ctxt @@ -3372,8 +3396,43 @@ tcConDecl rep_tycon tag_map tmpl_bndrs _res_kind res_tmpl new_or_data where skol_info = DataConSkol (unLoc (head names)) -{- Note [GADT return kinds] +{- Note [GADT return types] ~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + data family T :: forall k. k -> Type + data instance T (a :: Type) where + MkT :: forall b. T b + +What kind does `b` have in the signature for MkT? +Since the return type must be an instance of the type in the header, +we must have (b :: Type), but you can't tell that by looking only at +the type of the data constructor; you have to look at the header too. +If you wrote it out fully, it'd look like + data instance T @Type (a :: Type) where + MkT :: forall (b::Type). T @Type b + +Now, we could reject the program, and expect the user to add kind +annotations to `MkT` to restrict the signature. But an easy, and +helpful alternative is this: simply instantiate the type from the +header with fresh unification variables, and unify with the return +type of `MkT`. At a single blow this check will: + + - Instantiates the invisible kinds in the above example + + - Ensures that the return type has the right type constructor. + E.g. this will be rejected + data instance T [x] wehre + MkT :: S [x] + + - Ensures that the return type is indeed an instance of the + header type. E.g. this will fail + data instance T [x] wehre + MkT :: T (Maybe x) + +Nice! + +Note [GADT return kinds] +~~~~~~~~~~~~~~~~~~~~~~~~ Consider type family Star where Star = Type data T :: Type where @@ -3532,9 +3591,9 @@ errors reported in one pass. See #7175, and #10836. -- TI :: forall b1 c1. (b1 ~ c1) => b1 -> :R7T b1 c1 -- In this case orig_res_ty = T (e,e) -rejigConRes :: [KnotTied TyConBinder] -> KnotTied Type -- Template for result type; e.g. - -- data instance T [a] b c ... - -- gives template ([a,b,c], T [a] b c) +rejigConRes :: [KnotTied TyConBinder] -- Template for result type; e.g. + -> KnotTied Type -- data instance T [a] b c ... + -- gives template ([a,b,c], T [a] b c) -> [InvisTVBinder] -- The constructor's type variables (both inferred and user-written) -> KnotTied Type -- res_ty -> ([TyVar], -- Universal @@ -3546,10 +3605,10 @@ rejigConRes :: [KnotTied TyConBinder] -> KnotTied Type -- Template for result -- We don't check that the TyCon given in the ResTy is -- the same as the parent tycon, because checkValidDataCon will do it -- NB: All arguments may potentially be knot-tied -rejigConRes tmpl_bndrs res_tmpl dc_tvbndrs res_ty +rejigConRes tc_tvbndrs res_tmpl dc_tvbndrs res_ty -- E.g. data T [a] b c where -- MkT :: forall x y z. T [(x,y)] z z - -- The {a,b,c} are the tmpl_tvs, and the {x,y,z} are the dc_tvs + -- The {a,b,c} are the tc_tvs, and the {x,y,z} are the dc_tvs -- (NB: unlike the H98 case, the dc_tvs are not all existential) -- Then we generate -- Univ tyvars Eq-spec @@ -3564,7 +3623,7 @@ rejigConRes tmpl_bndrs res_tmpl dc_tvbndrs res_ty -- , [], [x,y,z] -- , [a~(x,y),b~z], ) | Just subst <- tcMatchTy res_tmpl res_ty - = let (univ_tvs, raw_eqs, kind_subst) = mkGADTVars tmpl_tvs dc_tvs subst + = let (univ_tvs, raw_eqs, kind_subst) = mkGADTVars tc_tvs dc_tvs subst raw_ex_tvs = dc_tvs `minusList` univ_tvs (arg_subst, substed_ex_tvs) = substTyVarBndrs kind_subst raw_ex_tvs @@ -3591,10 +3650,10 @@ rejigConRes tmpl_bndrs res_tmpl dc_tvbndrs res_ty -- albeit bogus, relying on checkValidDataCon to check the -- bad-result-type error before seeing that the other fields look odd -- See Note [Checking GADT return types] - = (tmpl_tvs, dc_tvs `minusList` tmpl_tvs, dc_tvbndrs, [], emptyTCvSubst) + = (tc_tvs, dc_tvs `minusList` tc_tvs, dc_tvbndrs, [], emptyTCvSubst) where - dc_tvs = binderVars dc_tvbndrs - tmpl_tvs = binderVars tmpl_bndrs + dc_tvs = binderVars dc_tvbndrs + tc_tvs = binderVars tc_tvbndrs {- Note [mkGADTVars] ~~~~~~~~~~~~~~~~~~~~ @@ -4081,8 +4140,8 @@ checkFieldCompat fld con1 con2 res1 res2 fty1 fty2 ------------------------------- checkValidDataCon :: DynFlags -> Bool -> TyCon -> DataCon -> TcM () checkValidDataCon dflags existential_ok tc con - = setSrcSpan (getSrcSpan con) $ - addErrCtxt (dataConCtxt con) $ + = setSrcSpan con_loc $ + addErrCtxt (dataConCtxt [L con_loc con_name]) $ do { -- Check that the return type of the data constructor -- matches the type constructor; eg reject this: -- data T a where { MkT :: Bogus a } @@ -4205,7 +4264,9 @@ checkValidDataCon dflags existential_ok tc con Just (f, _) -> ppr (tyConBinders f) ] } where - ctxt = ConArgCtxt (dataConName con) + con_name = dataConName con + con_loc = nameSrcSpan con_name + ctxt = ConArgCtxt con_name is_strict = \case NoSrcStrict -> xopt LangExt.StrictData dflags bang -> isSrcStrict bang @@ -4869,14 +4930,17 @@ fieldTypeMisMatch field_name con1 con2 = sep [text "Constructors" <+> ppr con1 <+> text "and" <+> ppr con2, text "give different types for field", quotes (ppr field_name)] -dataConCtxtName :: [Located Name] -> SDoc -dataConCtxtName [con] - = text "In the definition of data constructor" <+> quotes (ppr con) -dataConCtxtName con - = text "In the definition of data constructors" <+> interpp'SP con +dataConCtxt :: [Located Name] -> SDoc +dataConCtxt cons = text "In the definition of data constructor" <> plural cons + <+> ppr_cons cons + +dataConResCtxt :: [Located Name] -> SDoc +dataConResCtxt cons = text "In the result type of data constructor" <> plural cons + <+> ppr_cons cons -dataConCtxt :: Outputable a => a -> SDoc -dataConCtxt con = text "In the definition of data constructor" <+> quotes (ppr con) +ppr_cons :: [Located Name] -> SDoc +ppr_cons [con] = quotes (ppr con) +ppr_cons cons = interpp'SP cons classOpCtxt :: Var -> Type -> SDoc classOpCtxt sel_id tau = sep [text "When checking the class method:", ===================================== compiler/GHC/Tc/TyCl/Instance.hs ===================================== @@ -688,9 +688,8 @@ tcDataFamInstDecl mb_clsinfo tv_skol_env -- Do /not/ check that the number of patterns = tyConArity fam_tc -- See [Arity of data families] in GHC.Core.FamInstEnv ; (qtvs, pats, res_kind, stupid_theta) - <- tcDataFamInstHeader mb_clsinfo fam_tc outer_bndrs - fixity hs_ctxt hs_pats m_ksig hs_cons - new_or_data + <- tcDataFamInstHeader mb_clsinfo fam_tc outer_bndrs fixity + hs_ctxt hs_pats m_ksig new_or_data -- Eta-reduce the axiom if possible -- Quite tricky: see Note [Implementing eta reduction for data families] @@ -740,8 +739,9 @@ tcDataFamInstDecl mb_clsinfo tv_skol_env do { data_cons <- tcExtendTyVarEnv qtvs $ -- For H98 decls, the tyvars scope -- over the data constructors - tcConDecls rec_rep_tc new_or_data ty_binders final_res_kind - orig_res_ty hs_cons + tcConDecls new_or_data (DDInstance orig_res_ty) + rec_rep_tc ty_binders final_res_kind + hs_cons ; rep_tc_name <- newFamInstTyConName lfam_name pats ; axiom_name <- newFamInstAxiomName lfam_name [pats] @@ -857,7 +857,7 @@ TyVarEnv will simply be empty, and there is nothing to worry about. tcDataFamInstHeader :: AssocInstInfo -> TyCon -> HsOuterFamEqnTyVarBndrs GhcRn -> LexicalFixity -> LHsContext GhcRn - -> HsTyPats GhcRn -> Maybe (LHsKind GhcRn) -> [LConDecl GhcRn] + -> HsTyPats GhcRn -> Maybe (LHsKind GhcRn) -> NewOrData -> TcM ([TyVar], [Type], Kind, ThetaType) -- The "header" of a data family instance is the part other than @@ -865,7 +865,7 @@ tcDataFamInstHeader -- e.g. data instance D [a] :: * -> * where ... -- Here the "header" is the bit before the "where" tcDataFamInstHeader mb_clsinfo fam_tc outer_bndrs fixity - hs_ctxt hs_pats m_ksig hs_cons new_or_data + hs_ctxt hs_pats m_ksig new_or_data = do { traceTc "tcDataFamInstHeader {" (ppr fam_tc <+> ppr hs_pats) ; (tclvl, wanted, (scoped_tvs, (stupid_theta, lhs_ty, master_res_kind, instance_res_kind))) <- pushLevelAndSolveEqualitiesX "tcDataFamInstHeader" $ @@ -884,8 +884,8 @@ tcDataFamInstHeader mb_clsinfo fam_tc outer_bndrs fixity -- Add constraints from the result signature ; res_kind <- tc_kind_sig m_ksig - -- Add constraints from the data constructors - ; kcConDecls new_or_data res_kind hs_cons + -- Do not add constraints from the data constructors + -- See Note [Kind inference for data family instances] -- Check that the result kind of the TyCon applied to its args -- is compatible with the explicit signature (or Type, if there @@ -1049,6 +1049,86 @@ however, so this Note aims to describe these subtleties: themselves. Heavy sigh. But not truly hard; that's what tcbVisibilities does. +Note [Kind inference for data family instances] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider this GADT-style data type declaration, where I have used +fresh variables in the data constructor's type, to stress that c,d are +quite distinct from a,b. + data T a b where + MkT :: forall c d. c d -> T c d + +Following Note [Inferring kinds for type declarations] in GHC.Tc.TyCl, +to infer T's kind, we initially give T :: kappa, a monomorpic kind, +gather constraints from the header and data constructors, and conclude + T :: (kappa1 -> type) -> kappa1 -> Type +Then we generalise, giving + T :: forall k. (k->Type) -> k -> Type + +Now what about a data /instance/ decl + data family T :: forall k. (k->Type) -> k -> Type + + data instance T p Int where ... + +No doubt here! The poly-kinded T is instantiated with k=Type, so the +header really looks like + data instance T @Type (p :: Type->Type) Int where ... + +But what about this? + data instance T p q where + MkT :: forall r. r Int -> T r Int + +So what kind do 'p' and 'q' have? No clues from the header, but from +the data constructor we can clearly see that (r :: Type->Type). Does +that mean that the the /entire data instance/ is instantiated at Type, +like this? + data instance T @Type (p :: Type->Type) (q :: Type) where + ... + +Not at all! This is a /GADT/-style decl, so the kind argument might +be specialised in this particular data constructor, thus: + data instance T @k (p :: k->Type) (q :: k) where + MkT :: forall (r :: Type -> Type). + r Int -> T @Type r Int +(and perhaps specialised differently in some other data +constructor MkT2). + +The key difference in this case and 'data T' at the top of this Note +is that we have no known kind for 'data T'. We thus forbid different +specialisations of T in its constructors, in an attempt to avoid +inferring polymorphic recursion. In data family T, however, there is +no problem with polymorphic recursion: we already /fully know/ T's +kind -- that came from the family declaration, and is not influenced +by the data instances -- and hence we /can/ specialise T's kind +differently in different GADT data constructors. + +SHORT SUMMARY: in a data instance decl, it's not clear whether kind +constraints arising from the data constructors should be considered +local to the (GADT) data /constructor/ or should apply to the entire +data instance. + +DESIGN CHOICE: in data/newtype family instance declarations, we ignore +the /data constructor/ declarations altogether, looking only at the +data instance /header/. + +Observations: +* This choice is simple to describe, as well as simple to implment. + For a data/newtype instance decl, the instance kinds are influenced + /only/ by the header. + +* We could treat Haskell-98 style data-instance decls differently, by + taking the data constructors into account, since there are no GADT + issues. But we don't, for simplicity, and because it means you can + understand the data type instance by looking only at the header. + +* Newtypes can be declared in GADT syntax, but they can't do GADT-style + specialisation, so like Haskell-98 definitions we could take the + data constructors into account. Again we don't, for the same reason. + +So for now at least, we keep the simplest choice. See #18891 and !4419 +for more discussion of this issue. + +Kind inference for data types (Xie et al) https://arxiv.org/abs/1911.06153 +takes a slightly different approach. -} ===================================== docs/users_guide/9.2.1-notes.rst ===================================== @@ -14,6 +14,11 @@ Language (Serrano et al, ICFP 2020). More information here: :ref:`impredicative-polymorphism`. This replaces the old (undefined, flaky) behaviour of the :extension:`ImpredicativeTypes` extension. +* Kind inference for data/newtype instance declarations is slightly + more restrictive than before. See the user manual :ref:`kind-inference-data-family-instances`. + This is a breaking change, albeit a fairly obscure one that corrects a specification bug. + + Compiler ~~~~~~~~ ===================================== docs/users_guide/exts/poly_kinds.rst ===================================== @@ -130,8 +130,45 @@ This rule has occasionally-surprising consequences (see The kind-polymorphism from the class declaration makes ``D1`` kind-polymorphic, but not so ``D2``; and similarly ``F1``, ``F2``. +Kind inference in type signatures +--------------------------------- + +When kind-checking a type, GHC considers only what is written in that +type when figuring out how to generalise the type's kind. + +For example, +consider these definitions (with :extension:`ScopedTypeVariables`): :: + + data Proxy a -- Proxy :: forall k. k -> Type + p :: forall a. Proxy a + p = Proxy :: Proxy (a :: Type) + +GHC reports an error, saying that the kind of ``a`` should be a kind variable +``k``, not ``Type``. This is because, by looking at the type signature +``forall a. Proxy a``, GHC assumes ``a``'s kind should be generalised, not +restricted to be ``Type``. The function definition is then rejected for being +more specific than its type signature. + +.. _explicit-kind-quantification: + +Explicit kind quantification +---------------------------- + +Enabled by :extension:`PolyKinds`, GHC supports explicit kind quantification, +as in these examples: :: + + data Proxy :: forall k. k -> Type + f :: (forall k (a :: k). Proxy a -> ()) -> Int + +Note that the second example has a ``forall`` that binds both a kind ``k`` and +a type variable ``a`` of kind ``k``. In general, there is no limit to how +deeply nested this sort of dependency can work. However, the dependency must +be well-scoped: ``forall (a :: k) k. ...`` is an error. + + .. _inferring-variable-order: + Inferring the order of variables in a type/class declaration ------------------------------------------------------------ @@ -490,41 +527,91 @@ This also applies to GADT-style data instances: :: -- • In the data instance declaration for ‘T’ -Kind inference in closed type families --------------------------------------- +Kind inference in data type declarations +---------------------------------------- -Although all open type families are considered to have a complete -user-supplied kind signature, we can relax this condition for closed -type families, where we have equations on which to perform kind -inference. GHC will infer kinds for the arguments and result types of a -closed type family. +Consider the declaration :: -GHC supports *kind-indexed* type families, where the family matches both -on the kind and type. GHC will *not* infer this behaviour without a -complete user-supplied kind signature, as doing so would sometimes infer -non-principal types. Indeed, we can see kind-indexing as a form -of polymorphic recursion, where a type is used at a kind other than -its most general in its own definition. + data T1 f a = MkT1 (f a) + data T2 f a where + MkT2 :: f a -> T f a -For example: :: +In both cases GHC looks at the data constructor declarations to +give constraints on the kind of ``T``, yielding :: - type family F1 a where - F1 True = False - F1 False = True - F1 x = x - -- F1 fails to compile: kind-indexing is not inferred + T1, T2 :: forall k. (k -> Type) -> k -> Type - type family F2 (a :: k) where - F2 True = False - F2 False = True - F2 x = x - -- F2 fails to compile: no complete signature +Consider the type :: + + data G (a :: k) where + GInt :: G Int + GMaybe :: G Maybe + +This datatype ``G`` is GADT-like in both its kind and its type. Suppose you +have ``g :: G a``, where ``a :: k``. Then pattern matching to discover that +``g`` is in fact ``GMaybe`` tells you both that ``k ~ (Type -> Type)`` and +``a ~ Maybe``. The definition for ``G`` requires that :extension:`PolyKinds` +be in effect, but pattern-matching on ``G`` requires no extension beyond +:extension:`GADTs`. That this works is actually a straightforward extension +of regular GADTs and a consequence of the fact that kinds and types are the +same. + +Note that the datatype ``G`` is used at different kinds in its body, and +therefore that kind-indexed GADTs use a form of polymorphic recursion. +It is thus only possible to use this feature if you have provided a +complete user-supplied kind signature (CUSK) +for the datatype (:ref:`complete-kind-signatures`), or a standalone +kind signature (:ref:`standalone-kind-signatures`); +in the case of ``G`` we have a CUSK. +If you wish to see the kind indexing explicitly, you can do so by enabling :ghc-flag:`-fprint-explicit-kinds` and querying ``G`` with GHCi's :ghci-cmd:`:info` command: :: + + > :set -fprint-explicit-kinds + > :info G + type role G nominal nominal + type G :: forall k. k -> Type + data G @k a where + GInt :: G @Type Int + GMaybe :: G @(Type -> Type) Maybe + +where you can see the GADT-like nature of the two constructors. + +.. _kind-inference-data-family-instances: + +Kind inference for data/newtype instance declarations +----------------------------------------------------- + +Consider these declarations :: + + data family T :: forall k. (k->Type) -> k -> Type + + data instance T p q where + MkT :: forall r. r Int -> T r Int + +Here ``T`` has an invisible kind argument; and perhaps it is instantiated +to ``Type`` in the instance, thus :: + + data instance T @Type (p :: Type->Type) (q :: Type) where + MkT :: forall r. r Int -> T r Int + +Or perhaps we intended the specialisation to be in the GADT data +constructor, thus :: + + data instance T @k (p :: k->Type) (q :: k) where + MkT :: forall r. r Int -> T @Type r Int + +It gets more complicated if there are multiple constructors. In +general, there is no principled way to tell which type specialisation +comes from the data instance, and which from the individual GADT data +constructors. + +So GHC implements this rule: in data/newtype instance declararations +(unlike ordinary data/newtype declarations) we do *not* look at the +constructor declarations when inferring the shape of the instance +header. The principle is that *the instantiation of the data instance +should be apparent from the header alone*. This principle makes the +program easier to understand, and avoids the swamp of complexity +indicated above. - type family F3 (a :: k) :: k where - F3 True = False - F3 False = True - F3 x = x - -- OK Kind inference in class instance declarations --------------------------------------------- @@ -555,43 +642,8 @@ infrastructure, and it's not clear the payoff is worth it. If you want to restrict ``b``\ 's kind in the instance above, just use a kind signature in the instance head. -Kind inference in type signatures ---------------------------------- - -When kind-checking a type, GHC considers only what is written in that -type when figuring out how to generalise the type's kind. - -For example, -consider these definitions (with :extension:`ScopedTypeVariables`): :: - - data Proxy a -- Proxy :: forall k. k -> Type - p :: forall a. Proxy a - p = Proxy :: Proxy (a :: Type) - -GHC reports an error, saying that the kind of ``a`` should be a kind variable -``k``, not ``Type``. This is because, by looking at the type signature -``forall a. Proxy a``, GHC assumes ``a``'s kind should be generalised, not -restricted to be ``Type``. The function definition is then rejected for being -more specific than its type signature. - -.. _explicit-kind-quantification: - -Explicit kind quantification ----------------------------- - -Enabled by :extension:`PolyKinds`, GHC supports explicit kind quantification, -as in these examples: :: - - data Proxy :: forall k. k -> Type - f :: (forall k (a :: k). Proxy a -> ()) -> Int - -Note that the second example has a ``forall`` that binds both a kind ``k`` and -a type variable ``a`` of kind ``k``. In general, there is no limit to how -deeply nested this sort of dependency can work. However, the dependency must -be well-scoped: ``forall (a :: k) k. ...`` is an error. - -Implicit quantification in type synonyms and type family instances ------------------------------------------------------------------- +Kind inference in type synonyms and type family instances +--------------------------------------------------------- Consider the scoping rules for type synonyms and type family instances, such as these:: @@ -706,29 +758,44 @@ kinds. Consequently, visible dependent quantifiers are rejected in any context that is unambiguously the type of a term. They are also rejected in the types of data constructors. -Kind-indexed GADTs ------------------- +Kind inference in closed type families +-------------------------------------- -Consider the type :: +Although all open type families are considered to have a complete +user-supplied kind signature (:ref:`complete-kind-signatures`), +we can relax this condition for closed +type families, where we have equations on which to perform kind +inference. GHC will infer kinds for the arguments and result types of a +closed type family. - data G (a :: k) where - GInt :: G Int - GMaybe :: G Maybe +GHC supports *kind-indexed* type families, where the family matches both +on the kind and type. GHC will *not* infer this behaviour without a +complete user-supplied kind signature or standalone kind +signature (see :ref:`standalone-kind-signatures`), +because doing so would sometimes infer +non-principal types. Indeed, we can see kind-indexing as a form +of polymorphic recursion, where a type is used at a kind other than +its most general in its own definition. -This datatype ``G`` is GADT-like in both its kind and its type. Suppose you -have ``g :: G a``, where ``a :: k``. Then pattern matching to discover that -``g`` is in fact ``GMaybe`` tells you both that ``k ~ (Type -> Type)`` and -``a ~ Maybe``. The definition for ``G`` requires that :extension:`PolyKinds` -be in effect, but pattern-matching on ``G`` requires no extension beyond -:extension:`GADTs`. That this works is actually a straightforward extension -of regular GADTs and a consequence of the fact that kinds and types are the -same. +For example: :: -Note that the datatype ``G`` is used at different kinds in its body, and -therefore that kind-indexed GADTs use a form of polymorphic recursion. -It is thus only possible to use this feature if you have provided a -complete user-supplied kind signature -for the datatype (:ref:`complete-kind-signatures`). + type family F1 a where + F1 True = False + F1 False = True + F1 x = x + -- F1 fails to compile: kind-indexing is not inferred + + type family F2 (a :: k) where + F2 True = False + F2 False = True + F2 x = x + -- F2 fails to compile: no complete signature + + type family F3 (a :: k) :: k where + F3 True = False + F3 False = True + F3 x = x + -- OK Higher-rank kinds ----------------- ===================================== testsuite/tests/dependent/should_fail/T13780a.stderr ===================================== @@ -3,7 +3,7 @@ T13780a.hs:9:40: error: • Couldn't match kind ‘a’ with ‘Bool’ Expected kind ‘Foo a’, but ‘MkFoo’ has kind ‘Foo Bool’ ‘a’ is a rigid type variable bound by - a family instance declaration + the data constructor ‘SMkFoo’ at T13780a.hs:9:20-31 • In the second argument of ‘(~)’, namely ‘MkFoo’ In the definition of data constructor ‘SMkFoo’ ===================================== testsuite/tests/deriving/should_compile/T11416.hs ===================================== @@ -12,9 +12,11 @@ newtype T f (a :: ConstantT Type f) = T (f a) deriving Functor data family TFam1 (f :: k1) (a :: k2) -newtype instance TFam1 f (ConstantT a f) = TFam1 (f a) +newtype instance TFam1 (f :: k -> Type) (ConstantT (a :: k) f) + = TFam1 (f a) deriving Functor data family TFam2 (f :: k1) (a :: k2) -newtype instance TFam2 f (a :: ConstantT Type f) = TFam2 (f a) +newtype instance TFam2 (f :: Type -> Type) (a :: ConstantT Type f) + = TFam2 (f a) deriving Functor ===================================== testsuite/tests/deriving/should_compile/T9359.hs ===================================== @@ -9,6 +9,5 @@ data Cmp a where deriving (Show, Eq) data family CmpInterval (a :: Cmp k) (b :: Cmp k) :: Type -data instance CmpInterval (V c) Sup = Starting c +data instance CmpInterval (V (c :: Type)) Sup = Starting c deriving( Show ) - ===================================== testsuite/tests/indexed-types/should_compile/T14111.hs ===================================== @@ -0,0 +1,24 @@ +{-# LANGUAGE MagicHash, UnboxedSums, NoImplicitPrelude #-} +{-# LANGUAGE TypeFamilies #-} +-- {-# LANGUAGE PolyKinds #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE GADTs ,ExplicitNamespaces#-} +{-# LANGUAGE UnboxedTuples #-} + +module T14111 where + +import GHC.Exts +import GHC.Types +import Prelude (undefined) +import Data.Kind +import Data.Void + +data family Maybe(x :: TYPE (r :: RuntimeRep)) + +data instance Maybe (a :: Type ) where + MaybeSum :: (# a | (# #) #) -> Maybe a + +data instance Maybe (x :: TYPE 'UnliftedRep) where + MaybeSumU :: (# x | (# #) #) -> Maybe x ===================================== testsuite/tests/indexed-types/should_compile/T8707.hs ===================================== @@ -0,0 +1,11 @@ +{-# LANGUAGE TypeFamilies, PolyKinds, DataKinds, GADTs #-} + +module T8707 where + +import Data.Kind + +data family SingDF (a :: (k, k2 -> Type)) +data Ctor :: k -> Type + +data instance SingDF (a :: (Bool, Bool -> Type)) where + SFalse :: SingDF '(False, Ctor) ===================================== testsuite/tests/indexed-types/should_compile/all.T ===================================== @@ -300,3 +300,5 @@ test('T18809', normal, compile, ['-O']) test('CEqCanOccursCheck', normal, compile, ['']) test('GivenLoop', normal, compile, ['']) test('T18875', normal, compile, ['']) +test('T8707', normal, compile, ['-O']) +test('T14111', normal, compile, ['-O']) ===================================== testsuite/tests/indexed-types/should_fail/T8368.stderr ===================================== @@ -1,6 +1,5 @@ -T8368.hs:9:3: - Data constructor ‘MkFam’ returns type ‘Foo’ - instead of an instance of its parent type ‘Fam a’ - In the definition of data constructor ‘MkFam’ - In the data instance declaration for ‘Fam’ +T8368.hs:9:3: error: + • Couldn't match expected type ‘Fam a0’ with actual type ‘Foo’ + • In the result type of data constructor ‘MkFam’ + In the data instance declaration for ‘Fam’ ===================================== testsuite/tests/indexed-types/should_fail/T8368a.stderr ===================================== @@ -1,6 +1,7 @@ -T8368a.hs:7:3: - Data constructor ‘MkFam’ returns type ‘Fam Bool b’ - instead of an instance of its parent type ‘Fam Int b’ - In the definition of data constructor ‘MkFam’ - In the data instance declaration for ‘Fam’ +T8368a.hs:7:3: error: + • Couldn't match type ‘Bool’ with ‘Int’ + Expected: Fam Int b + Actual: Fam Bool b + • In the result type of data constructor ‘MkFam’ + In the data instance declaration for ‘Fam’ ===================================== testsuite/tests/patsyn/should_fail/T15685.stderr ===================================== @@ -1,13 +1,13 @@ T15685.hs:13:24: error: - • Could not deduce: a ~ [k0] - from the context: as ~ (a1 : as1) + • Could not deduce: k ~ [k0] + from the context: as ~ (a : as1) bound by a pattern with constructor: - Here :: forall {a1} (f :: a1 -> *) (a2 :: a1) (as :: [a1]). - f a2 -> NS f (a2 : as), + Here :: forall {k} (f :: k -> *) (a :: k) (as :: [k]). + f a -> NS f (a : as), in a pattern synonym declaration at T15685.hs:13:19-26 - ‘a’ is a rigid type variable bound by + ‘k’ is a rigid type variable bound by the inferred type of HereNil :: NS f as at T15685.hs:13:9-15 Possible fix: add a type signature for ‘HereNil’ ===================================== testsuite/tests/polykinds/T13659.stderr ===================================== @@ -1,6 +1,6 @@ -T13659.hs:14:27: error: - • Expected a type, but ‘a’ has kind ‘[*]’ - • In the first argument of ‘Format’, namely ‘'[Int, a]’ - In the type ‘Format '[Int, a]’ +T13659.hs:14:15: error: + • Expected kind ‘[*]’, but ‘a’ has kind ‘*’ + • In the first argument of ‘Format’, namely ‘a’ + In the type ‘Format a’ In the definition of data constructor ‘I’ ===================================== testsuite/tests/polykinds/T16221a.stderr ===================================== @@ -1,7 +1,7 @@ T16221a.hs:6:49: error: - • Expected kind ‘k’, but ‘b’ has kind ‘k1’ - ‘k1’ is a rigid type variable bound by + • Expected kind ‘k’, but ‘b’ has kind ‘k2’ + ‘k2’ is a rigid type variable bound by an explicit forall k (b :: k) at T16221a.hs:6:20 ‘k’ is a rigid type variable bound by ===================================== testsuite/tests/th/T11145.stderr ===================================== @@ -1,8 +1,7 @@ T11145.hs:8:1: error: - • Data constructor ‘MkFuggle’ returns type ‘Fuggle - Int (Maybe Bool)’ - instead of an instance of its parent type ‘Fuggle - Int (Maybe (a, b))’ - • In the definition of data constructor ‘MkFuggle’ + • Couldn't match type ‘Bool’ with ‘(a0, b0)’ + Expected: Fuggle Int (Maybe (a0, b0)) + Actual: Fuggle Int (Maybe Bool) + • In the result type of data constructor ‘MkFuggle’ In the data instance declaration for ‘Fuggle’ ===================================== testsuite/tests/th/T9692.hs ===================================== @@ -12,7 +12,7 @@ class C a where data F a (b :: k) :: Type instance C Int where - data F Int x = FInt x + data F Int (x :: Type) = FInt x $( do info <- qReify (mkName "F") runIO $ putStrLn $ pprint info ===================================== testsuite/tests/typecheck/should_compile/T18891.hs ===================================== @@ -0,0 +1,16 @@ +{-# LANGUAGE GADTs, UnliftedNewtypes, StandaloneKindSignatures, RankNTypes, TypeFamilies, PolyKinds #-} + +module T18891 where + +import GHC.Exts( TYPE ) + +data family T2 (a :: k) +data instance T2 a where + MkT2 :: T2 Maybe + +newtype N3 :: forall k -> TYPE k where + MkN3 :: N3 m -> N3 m + +type N4 :: forall k -> TYPE k +newtype N4 :: forall k -> TYPE k where + MkN4 :: N4 m -> N4 m ===================================== testsuite/tests/typecheck/should_compile/UnliftedNewtypesUnassociatedFamily.hs ===================================== @@ -4,6 +4,8 @@ {-# LANGUAGE PolyKinds #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TypeApplications #-} module UnliftedNewtypesUnassociatedFamily where @@ -20,7 +22,16 @@ newtype instance DFT ('TupleRep '[ 'IntRep, 'WordRep]) data instance DFT 'LiftedRep = MkDFT4 | MkDFT5 data family DF :: TYPE (r :: RuntimeRep) -newtype instance DF = MkDF1 Int# -newtype instance DF = MkDF2 Word# -newtype instance DF = MkDF3 (# Int#, Word# #) + +-- Use a type application +newtype instance DF @IntRep = MkDF1 Int# + +-- Use a kind signature +newtype instance DF :: TYPE 'WordRep where + MkDF2 :: Word# -> DF + +-- Also uses a kind signature +newtype instance DF :: TYPE ('TupleRep '[ 'IntRep, 'WordRep ]) where + MkDF3 :: (# Int#, Word# #) -> DF + data instance DF = MkDF4 | MkDF5 ===================================== testsuite/tests/typecheck/should_compile/UnliftedNewtypesUnifySig.hs ===================================== @@ -10,14 +10,14 @@ module UnliftedNewtypesUnassociatedFamily where import GHC.Int (Int(I#)) -import GHC.Exts (Int#,Word#,RuntimeRep(IntRep)) +import GHC.Exts (Int#,Word#,RuntimeRep(IntRep,WordRep)) import GHC.Exts (TYPE) type KindOf (a :: TYPE k) = k data family D (a :: TYPE r) :: TYPE r -newtype instance D a = MkWordD Word# +newtype instance D (a :: TYPE 'WordRep) = MkWordD Word# -newtype instance D a :: TYPE (KindOf a) where - MkIntD :: forall a. Int# -> D a +newtype instance D (a :: TYPE 'IntRep) :: TYPE (KindOf a) where + MkIntD :: forall (b :: TYPE 'IntRep). Int# -> D b ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -736,3 +736,4 @@ test('InstanceGivenOverlap', normal, compile, ['']) test('InstanceGivenOverlap2', normal, compile, ['']) test('LocalGivenEqs', normal, compile, ['']) test('LocalGivenEqs2', normal, compile, ['']) +test('T18891', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_fail/T18891a.hs ===================================== @@ -0,0 +1,13 @@ +{-# LANGUAGE GADTs, UnliftedNewtypes, StandaloneKindSignatures, RankNTypes, TypeFamilies, PolyKinds #-} + +module T18891 where + +import GHC.Exts( TYPE ) + +newtype N1 :: forall k. TYPE k where + MkN1 :: N1 -> N1 + +type N2 :: forall k. TYPE k +newtype N2 :: forall k. TYPE k where + MkN2 :: N2 -> N2 + ===================================== testsuite/tests/typecheck/should_fail/T18891a.stderr ===================================== @@ -0,0 +1,12 @@ + +T18891a.hs:8:4: error: + • A newtype constructor must have a return type of form T a1 ... an + MkN1 :: N1 -> N1 + • In the definition of data constructor ‘MkN1’ + In the newtype declaration for ‘N1’ + +T18891a.hs:12:3: error: + • A newtype constructor must have a return type of form T a1 ... an + MkN2 :: N2 -> N2 + • In the definition of data constructor ‘MkN2’ + In the newtype declaration for ‘N2’ ===================================== testsuite/tests/typecheck/should_fail/UnliftedNewtypesFamilyKindFail2.stderr ===================================== @@ -1,11 +1,5 @@ -UnliftedNewtypesFamilyKindFail2.hs:12:20: - Expected a type, but ‘5’ has kind ‘GHC.Num.Natural.Natural’ - In the first argument of ‘F’, namely ‘5’ - In the newtype instance declaration for ‘F’ - -UnliftedNewtypesFamilyKindFail2.hs:12:31: - Expected a type, but ‘5’ has kind ‘GHC.Num.Natural.Natural’ - In the first argument of ‘F’, namely ‘5’ - In the type ‘(F 5)’ - In the definition of data constructor ‘MkF’ +UnliftedNewtypesFamilyKindFail2.hs:12:20: error: + • Expected a type, but ‘5’ has kind ‘GHC.Num.Natural.Natural’ + • In the first argument of ‘F’, namely ‘5’ + In the newtype instance declaration for ‘F’ ===================================== testsuite/tests/typecheck/should_fail/UnliftedNewtypesUnassociatedFamilyFail.hs ===================================== @@ -0,0 +1,23 @@ +{-# LANGUAGE UnliftedNewtypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE GADTs #-} + +module UnliftedNewtypesUnassociatedFamily where + +import GHC.Int (Int(I#)) +import GHC.Word (Word(W#)) +import GHC.Exts (Int#,Word#) +import GHC.Exts (TYPE,RuntimeRep(LiftedRep,IntRep,WordRep,TupleRep)) + +data family DF :: TYPE (r :: RuntimeRep) + +-- All these fail: see #18891 and !4419 +-- See Note [Kind inference for data family instances] +-- in GHC.Tc.TyCl.Instance +newtype instance DF = MkDF1a Int# +newtype instance DF = MkDF2a Word# +newtype instance DF = MkDF3a (# Int#, Word# #) ===================================== testsuite/tests/typecheck/should_fail/UnliftedNewtypesUnassociatedFamilyFail.stderr ===================================== @@ -0,0 +1,18 @@ + +UnliftedNewtypesUnassociatedFamilyFail.hs:21:30: error: + • Expecting a lifted type, but ‘Int#’ is unlifted + • In the type ‘Int#’ + In the definition of data constructor ‘MkDF1a’ + In the newtype instance declaration for ‘DF’ + +UnliftedNewtypesUnassociatedFamilyFail.hs:22:30: error: + • Expecting a lifted type, but ‘Word#’ is unlifted + • In the type ‘Word#’ + In the definition of data constructor ‘MkDF2a’ + In the newtype instance declaration for ‘DF’ + +UnliftedNewtypesUnassociatedFamilyFail.hs:23:30: error: + • Expecting a lifted type, but ‘(# Int#, Word# #)’ is unlifted + • In the type ‘(# Int#, Word# #)’ + In the definition of data constructor ‘MkDF3a’ + In the newtype instance declaration for ‘DF’ ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -546,6 +546,7 @@ test('UnliftedNewtypesConstraintFamily', normal, compile_fail, ['']) test('UnliftedNewtypesMismatchedKind', normal, compile_fail, ['']) test('UnliftedNewtypesMismatchedKindRecord', normal, compile_fail, ['']) test('UnliftedNewtypesMultiFieldGadt', normal, compile_fail, ['']) +test('UnliftedNewtypesUnassociatedFamilyFail', normal, compile_fail, ['']) test('T13834', normal, compile_fail, ['']) test('T17077', normal, compile_fail, ['']) test('T16512a', normal, compile_fail, ['']) @@ -591,3 +592,4 @@ test('T18640c', normal, compile_fail, ['']) test('T10709', normal, compile_fail, ['']) test('T10709b', normal, compile_fail, ['']) test('GivenForallLoop', normal, compile_fail, ['']) +test('T18891a', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0b1f76fd377abe59baf17aab750f520c824003e5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0b1f76fd377abe59baf17aab750f520c824003e5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 2 23:59:34 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Wed, 02 Dec 2020 18:59:34 -0500 Subject: [Git][ghc/ghc][wip/T18894] 2 commits: DmdAnal: Annotate top-level function bindings with demands (#18894) Message-ID: <5fc82a665fd00_6a0915872c344e0@gitlab.mail> Sebastian Graf pushed to branch wip/T18894 at Glasgow Haskell Compiler / GHC Commits: ef1b12d5 by Sebastian Graf at 2020-12-03T00:59:24+01:00 DmdAnal: Annotate top-level function bindings with demands (#18894) It's useful to annotate a non-exported top-level function like `g` in ```hs module Lib (h) where g :: Int -> Int -> (Int,Int) g m 1 = (m, 0) g m n = (2 * m, 2 `div` n) {-# NOINLINE g #-} h :: Int -> Int h 1 = 0 h m | odd m = snd (g m 2) | otherwise = uncurry (+) (g 2 m) ``` with its demand `UCU(CS(P(1P(U),SP(U))`, which tells us that whenever `g` was called, the second component of the returned pair was evaluated strictly. Since #18903 we do so for local functions, where we can see all calls. For top-level functions, we can assume that all *exported* functions are demanded according to `topDmd` and thus get sound demands for non-exported top-level functions. The demand on `g` is crucial information for Nested CPR, which may the go on and unbox `g` for the second pair component. That is true even if that pair component may diverge, as is the case for the call site `g 13 0`, which throws a div-by-zero exception. In `T18894b`, you can even see the new demand annotation enabling us to eta-expand a function that we wouldn't be able to eta-expand without Call Arity. We only track bindings of function type in order not to risk huge compile-time regressions, see `isInterestingTopLevelFn`. There was a CoreLint check that rejected strict demand annotations on recursive or top-level bindings, which seems completely unjustified. All the cases I investigated were fine, so I removed it. Fixes #18894. - - - - - 3aa79274 by Sebastian Graf at 2020-12-03T00:59:24+01:00 Demand: Simplify `CU(U)` to `U` (#19005) Both sub-demands encode the same information. This is a trivial change and already affects a few regression tests (e.g. `T5075`), so no separate regression test is necessary. - - - - - 16 changed files: - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Types/Demand.hs - compiler/GHC/Types/Id/Info.hs - testsuite/tests/arityanal/should_compile/Arity11.stderr - testsuite/tests/arityanal/should_compile/Arity16.stderr - + testsuite/tests/stranal/should_compile/T18894.hs - + testsuite/tests/stranal/should_compile/T18894.stderr - + testsuite/tests/stranal/should_compile/T18894b.hs - + testsuite/tests/stranal/should_compile/T18894b.stderr - testsuite/tests/stranal/should_compile/all.T - testsuite/tests/stranal/sigs/T5075.stderr Changes: ===================================== compiler/GHC/Core/FVs.hs ===================================== @@ -525,12 +525,11 @@ ruleLhsFVIds (Rule { ru_bndrs = bndrs, ru_args = args }) = filterFV isLocalId $ addBndrs bndrs (exprs_fvs args) ruleRhsFreeIds :: CoreRule -> VarSet --- ^ This finds all locally-defined free Ids on the left hand side of a rule +-- ^ This finds all locally-defined free Ids on the right hand side of a rule -- and returns them as a non-deterministic set ruleRhsFreeIds (BuiltinRule {}) = emptyVarSet -ruleRhsFreeIds (Rule { ru_bndrs = bndrs, ru_args = args }) - = fvVarSet $ filterFV isLocalId $ - addBndrs bndrs $ exprs_fvs args +ruleRhsFreeIds (Rule { ru_bndrs = bndrs, ru_rhs = rhs }) + = fvVarSet $ filterFV isLocalId $ addBndrs bndrs $ expr_fvs rhs {- Note [Rule free var hack] (Not a hack any more) ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -623,14 +623,6 @@ lintLetBind top_lvl rec_flag binder rhs rhs_ty || exprIsTickedString rhs) (badBndrTyMsg binder (text "unlifted")) - -- Check that if the binder is top-level or recursive, it's not - -- demanded. Primitive string literals are exempt as there is no - -- computation to perform, see Note [Core top-level string literals]. - ; checkL (not (isStrictId binder) - || (isNonRec rec_flag && not (isTopLevel top_lvl)) - || exprIsTickedString rhs) - (mkStrictMsg binder) - -- Check that if the binder is at the top level and has type Addr#, -- that it is a string literal, see -- Note [Core top-level string literals]. @@ -3121,7 +3113,7 @@ badBndrTyMsg binder what mkStrictMsg :: Id -> MsgDoc mkStrictMsg binder - = vcat [hsep [text "Recursive or top-level binder has strict demand info:", + = vcat [hsep [text "Recursive or top-level thunk has strict demand info:", ppr binder], hsep [text "Binder's demand info:", ppr (idDemandInfo binder)] ] ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -37,6 +37,7 @@ import GHC.Core.Type import GHC.Core.FVs ( exprFreeIds, ruleRhsFreeIds ) import GHC.Core.Coercion ( Coercion, coVarsOfCo ) import GHC.Core.FamInstEnv +import GHC.Core.Opt.Arity ( typeArity ) import GHC.Utils.Misc import GHC.Utils.Panic import GHC.Data.Maybe ( isJust ) @@ -64,28 +65,54 @@ data DmdAnalOpts = DmdAnalOpts -- -- Note: use `seqBinds` on the result to avoid leaks due to lazyness (cf Note -- [Stamp out space leaks in demand analysis]) -dmdAnalProgram :: DmdAnalOpts -> FamInstEnvs -> CoreProgram -> CoreProgram -dmdAnalProgram opts fam_envs binds = binds_plus_dmds - where - env = emptyAnalEnv opts fam_envs - binds_plus_dmds = snd $ mapAccumL dmdAnalTopBind env binds - --- Analyse a (group of) top-level binding(s) -dmdAnalTopBind :: AnalEnv - -> CoreBind - -> (AnalEnv, CoreBind) -dmdAnalTopBind env (NonRec id rhs) - = ( extendAnalEnv TopLevel env id sig - , NonRec (setIdStrictness id sig) rhs') +dmdAnalProgram :: DmdAnalOpts -> FamInstEnvs -> [CoreRule] -> CoreProgram -> CoreProgram +dmdAnalProgram opts fam_envs rules binds + = snd $ go (emptyAnalEnv opts fam_envs) binds where - ( _, sig, rhs') = dmdAnalRhsLetDown Nothing env topSubDmd id rhs - -dmdAnalTopBind env (Rec pairs) - = (env', Rec pairs') - where - (env', _, pairs') = dmdFix TopLevel env topSubDmd pairs - -- We get two iterations automatically - -- c.f. the NonRec case above + -- See Note [Analysing top-level bindings] + -- TLDR; We analyse them like + -- let ex1 = ... in (ex1, let nex1 = ... in let ex2 = ... in (ex2, ...))) + -- where ex* are exported (or RULE mentions) and nex* are not. + go _ [] = (nopDmdType, []) + go env (b:bs) = cons_up $ dmdAnalBind TopLevel env topSubDmd b anal_body + where + anal_body env' + | (body_ty, bs') <- go env' bs + = (add_exported_uses env' body_ty (bindersOf b), bs') + + cons_up :: (a, b, [b]) -> (a, [b]) + cons_up (dmd_ty, b', bs') = (dmd_ty, b':bs') + + add_exported_uses :: AnalEnv -> DmdType -> [Id] -> DmdType + add_exported_uses env = foldl' (add_exported_use env) + + -- | If @e@ is denoted by @dmd_ty@, then @add_exported_use _ dmd_ty id@ + -- corresponds to the demand type of @(id, e)@, but is a lot more direct. + -- See Note [Analysing top-level bindings]. + add_exported_use :: AnalEnv -> DmdType -> Id -> DmdType + add_exported_use env dmd_ty id + | isExportedId id || elemVarSet id rule_fvs + -- See Note [Absence analysis for stable unfoldings and RULES] + = dmd_ty `plusDmdType` fst (dmdAnalStar env topDmd (Var id)) + | otherwise = dmd_ty + + rule_fvs :: IdSet + rule_fvs = foldr (unionVarSet . ruleRhsFreeIds) emptyVarSet rules + +-- | Whether we want to store demands on a top-level Id or just default +-- to 'topDmd'. +-- +-- Basically, we want to now how top-level *functions* are *used* +-- (e.g. called), but aren't interested in whether they were called strictly +-- or not. Other top-level bindings are boring. +isInterestingTopLevelFn :: Id -> Bool +-- SG tried to set this to True and got a +2% ghc/alloc regression in T5642 +-- (which is dominated by the Simplifier) at no gain in analysis precision. +-- If there was a gain, that regression might be acceptable. +-- Plus, we could use LetUp for thunks and share some code with local let +-- bindings. +isInterestingTopLevelFn id = + typeArity (idType id) `lengthExceeds` 0 {- Note [Stamp out space leaks in demand analysis] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -105,8 +132,56 @@ generation would hold on to an extra copy of the Core program, via unforced thunks in demand or strictness information; and it is the most memory-intensive part of the compilation process, so this added seqBinds makes a big difference in peak memory usage. --} +Note [Analysing top-level bindings] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider a CoreProgram like + e1 = ... + n1 = ... + e2 = \a b -> ... fst (n1 a b) ... + n2 = \c d -> ... snd (e2 c d) ... + ... +where e* are exported, but n* are not. +Intuitively, we can see that @n1@ is only ever called with two arguments +and in every call site, the first component of the result of the call +is evaluated. Thus, we'd like it to have idDemandInfo @UCU(C1(P(SU,A))@. + +(This can be exploited by a Nested CPR pass which may then unbox the +first component of the pair returned from @n1 at . Or if @n1@ had arity +1 before, we may now eta-expand to arity 2.) + +NB: We may *not* give e2 a similar annotation, because it is exported and +external callers might use it in arbitrary ways, expressed by 'topDmd'. + +How do we get this result? Answer: By analysing the program as if it was a let +expression of this form: + let e1 = ... in + (e1, let n1 = ... in + ( let e2 = ... in + (e2, let n2 = ... in + ( ...)))) +E.g. putting all bindings in nested lets, where whenever it binds an exported +binding, the body is a *pair* of an occurrence of the exported binder and +the other nested lets. Of course, we will not actually build that CoreExpr! +Instead we faithfully simulate analysis of said expression by adding the +free variable 'DmdEnv' of @e*@'s strictness signatures to the 'DmdType' we +get from analysing the nested bindings. + +You might also wonder why we didn't analyse in terms of the simpler + let e1 = ... in + let n1 = ... in + let e2 = ... in + let n2 = ... in + (e1,e2, ...) +The reason is analysis performance: If @e1@ uses many free variables, we'll +unnecessarily carry their demands around with us from the moment we analyse +the pair to the moment we bubble back up to the binding for @e1 at . +This blows up e.g. @T10370 at . + +A final note about variables occuring free in RULE RHSs: They are to be handled +pretty much like exported Ids. +See also Note [Absence analysis for stable unfoldings and RULES] +-} {- ************************************************************************ @@ -114,7 +189,103 @@ seqBinds makes a big difference in peak memory usage. \subsection{The analyser itself} * * ************************************************************************ +-} + +-- | Analyse a binding group and its \"body\", e.g. where it is in scope. +-- +-- It calls a function that knows how to analyse this \"body\" given +-- an 'AnalEnv' with updated demand signatures for the binding group +-- (reflecting their 'idStrictnessInfo') and expects to receive a +-- 'DmdType' in return, which it uses to annotate the binding group with their +-- 'idDemandInfo'. +dmdAnalBind + :: TopLevelFlag + -> AnalEnv + -> SubDemand -- ^ Demand put on the "body" + -- (important for join points) + -> CoreBind + -> (AnalEnv -> (DmdType, a)) -- ^ How to analyse the "body", e.g. + -- where the binding is in scope + -> (DmdType, CoreBind, a) +dmdAnalBind top_lvl env dmd bind anal_body = case bind of + NonRec id rhs + | useLetUp top_lvl id + -> dmdAnalBindLetUp top_lvl env id rhs anal_body + _ -> dmdAnalBindLetDown top_lvl env dmd bind anal_body + +-- | Annotates uninteresting top level functions ('isInterestingTopLevelFn') +-- with 'topDmd', the rest with the given demand. +setBindIdDemandInfo :: TopLevelFlag -> Id -> Demand -> Id +setBindIdDemandInfo top_lvl id dmd = setIdDemandInfo id $ case top_lvl of + TopLevel | not (isInterestingTopLevelFn id) -> topDmd + _ -> dmd + +-- | Let bindings can be processed in two ways: +-- Down (RHS before body) or Up (body before RHS). +-- This function handles the up variant. +-- +-- It is very simple. For let x = rhs in body +-- * Demand-analyse 'body' in the current environment +-- * Find the demand, 'rhs_dmd' placed on 'x' by 'body' +-- * Demand-analyse 'rhs' in 'rhs_dmd' +-- +-- This is used for a non-recursive local let without manifest lambdas (see +-- 'useLetUp'). +-- +-- This is the LetUp rule in the paper “Higher-Order Cardinality Analysis”. +dmdAnalBindLetUp :: TopLevelFlag -> AnalEnv -> Id -> CoreExpr -> (AnalEnv -> (DmdType, a)) -> (DmdType, CoreBind, a) +dmdAnalBindLetUp top_lvl env id rhs anal_body = (final_ty, NonRec id' rhs', body') + where + (body_ty, body') = anal_body env + (body_ty', id_dmd) = findBndrDmd env notArgOfDfun body_ty id + id' = setBindIdDemandInfo top_lvl id id_dmd + (rhs_ty, rhs') = dmdAnalStar env (dmdTransformThunkDmd rhs id_dmd) rhs + final_ty = body_ty' `plusDmdType` rhs_ty + +-- | Let bindings can be processed in two ways: +-- Down (RHS before body) or Up (body before RHS). +-- This function handles the down variant. +-- +-- It computes a demand signature (by means of 'dmdAnalRhsSig') and uses +-- that at call sites in the body. +-- +-- It is used for toplevel definitions, recursive definitions and local +-- non-recursive definitions that have manifest lambdas (cf. 'useLetUp'). +-- Local non-recursive definitions without a lambda are handled with LetUp. +-- +-- This is the LetDown rule in the paper “Higher-Order Cardinality Analysis”. +dmdAnalBindLetDown :: TopLevelFlag -> AnalEnv -> SubDemand -> CoreBind -> (AnalEnv -> (DmdType, a)) -> (DmdType, CoreBind, a) +dmdAnalBindLetDown top_lvl env dmd bind anal_body = case bind of + NonRec id rhs + | (env', lazy_fv, id1, rhs1) <- + dmdAnalRhsSig top_lvl NonRecursive env dmd id rhs + -> do_rest env' lazy_fv [(id1, rhs1)] (\[(id2, rhs2)] -> NonRec id2 rhs2) + Rec pairs + | (env', lazy_fv, pairs') <- dmdFix top_lvl env dmd pairs + -> do_rest env' lazy_fv pairs' Rec + where + do_rest env' lazy_fv pairs1 build_bind = (final_ty, build_bind pairs2, body') + where + (body_ty, body') = anal_body env' + -- see Note [Lazy and unleashable free variables] + dmd_ty = addLazyFVs body_ty lazy_fv + (!final_ty, id_dmds) = findBndrsDmds env' dmd_ty (map fst pairs1) + pairs2 = zipWith do_one pairs1 id_dmds + do_one (id', rhs') dmd = (setBindIdDemandInfo top_lvl id' dmd, rhs') + -- If the actual demand is better than the vanilla call + -- demand, you might think that we might do better to re-analyse + -- the RHS with the stronger demand. + -- But (a) That seldom happens, because it means that *every* path in + -- the body of the let has to use that stronger demand + -- (b) It often happens temporarily in when fixpointing, because + -- the recursive function at first seems to place a massive demand. + -- But we don't want to go to extra work when the function will + -- probably iterate to something less demanding. + -- In practice, all the times the actual demand on id2 is more than + -- the vanilla call demand seem to be due to (b). So we don't + -- bother to re-analyse the RHS. +{- Note [Ensure demand is strict] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ It's important not to analyse e with a lazy demand because @@ -194,7 +365,7 @@ dmdAnal' env dmd (App fun arg) -- Crucially, coercions /are/ handled here, because they are -- value arguments (#10288) let - call_dmd = mkCallDmd dmd + call_dmd = mkCalledOnceDmd dmd (fun_ty, fun') = dmdAnal env call_dmd fun (arg_dmd, res_ty) = splitDmdTy fun_ty (arg_ty, arg') = dmdAnalStar env (dmdTransformThunkDmd arg arg_dmd) arg @@ -295,60 +466,11 @@ dmdAnal' env dmd (Case scrut case_bndr ty alts) -- , text "res_ty" <+> ppr res_ty ]) $ (res_ty, Case scrut' case_bndr' ty alts') --- Let bindings can be processed in two ways: --- Down (RHS before body) or Up (body before RHS). --- The following case handle the up variant. --- --- It is very simple. For let x = rhs in body --- * Demand-analyse 'body' in the current environment --- * Find the demand, 'rhs_dmd' placed on 'x' by 'body' --- * Demand-analyse 'rhs' in 'rhs_dmd' --- --- This is used for a non-recursive local let without manifest lambdas. --- This is the LetUp rule in the paper “Higher-Order Cardinality Analysis”. -dmdAnal' env dmd (Let (NonRec id rhs) body) - | useLetUp id - = (final_ty, Let (NonRec id' rhs') body') +dmdAnal' env dmd (Let bind body) + = (final_ty, Let bind' body') where - (body_ty, body') = dmdAnal env dmd body - (body_ty', id_dmd) = findBndrDmd env notArgOfDfun body_ty id - id' = setIdDemandInfo id id_dmd - - (rhs_ty, rhs') = dmdAnalStar env (dmdTransformThunkDmd rhs id_dmd) rhs - final_ty = body_ty' `plusDmdType` rhs_ty - -dmdAnal' env dmd (Let (NonRec id rhs) body) - = (body_ty2, Let (NonRec id2 rhs') body') - where - (lazy_fv, sig, rhs') = dmdAnalRhsLetDown Nothing env dmd id rhs - id1 = setIdStrictness id sig - env1 = extendAnalEnv NotTopLevel env id sig - (body_ty, body') = dmdAnal env1 dmd body - (body_ty1, id2) = annotateBndr env body_ty id1 - body_ty2 = addLazyFVs body_ty1 lazy_fv -- see Note [Lazy and unleashable free variables] - - -- If the actual demand is better than the vanilla call - -- demand, you might think that we might do better to re-analyse - -- the RHS with the stronger demand. - -- But (a) That seldom happens, because it means that *every* path in - -- the body of the let has to use that stronger demand - -- (b) It often happens temporarily in when fixpointing, because - -- the recursive function at first seems to place a massive demand. - -- But we don't want to go to extra work when the function will - -- probably iterate to something less demanding. - -- In practice, all the times the actual demand on id2 is more than - -- the vanilla call demand seem to be due to (b). So we don't - -- bother to re-analyse the RHS. - -dmdAnal' env dmd (Let (Rec pairs) body) - = let - (env', lazy_fv, pairs') = dmdFix NotTopLevel env dmd pairs - (body_ty, body') = dmdAnal env' dmd body - body_ty1 = deleteFVs body_ty (map fst pairs) - body_ty2 = addLazyFVs body_ty1 lazy_fv -- see Note [Lazy and unleashable free variables] - in - body_ty2 `seq` - (body_ty2, Let (Rec pairs') body') + (final_ty, bind', body') = dmdAnalBind NotTopLevel env dmd bind go' + go' env' = dmdAnal env' dmd body -- | A simple, syntactic analysis of whether an expression MAY throw a precise -- exception when evaluated. It's always sound to return 'True'. @@ -582,9 +704,13 @@ dmdTransform env var dmd | Just (sig, top_lvl) <- lookupSigEnv env var , let fn_ty = dmdTransformSig sig dmd = -- pprTrace "dmdTransform:LetDown" (vcat [ppr var, ppr sig, ppr dmd, ppr fn_ty]) $ - if isTopLevel top_lvl - then fn_ty -- Don't record demand on top-level things - else addVarDmd fn_ty var (C_11 :* dmd) + case top_lvl of + NotTopLevel -> addVarDmd fn_ty var (C_11 :* dmd) + TopLevel + | isInterestingTopLevelFn var + -> addVarDmd fn_ty var (C_0N `multDmd` (C_11 :* dmd)) -- discard strictness + | otherwise + -> fn_ty -- don't bother tracking; just annotate with 'topDmd' later -- Everything else: -- * Local let binders for which we use LetUp (cf. 'useLetUp') -- * Lambda binders @@ -599,46 +725,46 @@ dmdTransform env var dmd * * ********************************************************************* -} --- Let bindings can be processed in two ways: --- Down (RHS before body) or Up (body before RHS). --- dmdAnalRhsLetDown implements the Down variant: --- * assuming a demand of +-- | @dmdAnalRhsSig@ analyses the given RHS to compute a demand signature +-- for the LetDown rule. It works as follows: +-- +-- * assuming a demand of -- * looking at the definition -- * determining a strictness signature -- --- It is used for toplevel definition, recursive definitions and local --- non-recursive definitions that have manifest lambdas. --- Local non-recursive definitions without a lambda are handled with LetUp. --- --- This is the LetDown rule in the paper “Higher-Order Cardinality Analysis”. -dmdAnalRhsLetDown - :: Maybe [Id] -- Just bs <=> recursive, Nothing <=> non-recursive +-- Since it assumed a demand of , the resulting signature is applicable at +-- any call site. +dmdAnalRhsSig + :: TopLevelFlag + -> RecFlag -> AnalEnv -> SubDemand -> Id -> CoreExpr - -> (DmdEnv, StrictSig, CoreExpr) + -> (AnalEnv, DmdEnv, Id, CoreExpr) -- Process the RHS of the binding, add the strictness signature -- to the Id, and augment the environment with the signature as well. -- See Note [NOINLINE and strictness] -dmdAnalRhsLetDown rec_flag env let_dmd id rhs - = -- pprTrace "dmdAnalRhsLetDown" (ppr id $$ ppr let_dmd $$ ppr sig $$ ppr lazy_fv) $ - (lazy_fv, sig, rhs') +dmdAnalRhsSig top_lvl rec_flag env let_dmd id rhs + = -- pprTrace "dmdAnalRhsSig" (ppr id $$ ppr let_dmd $$ ppr sig $$ ppr lazy_fv) $ + (env', lazy_fv, id', rhs') where rhs_arity = idArity id + -- See Note [Demand signatures are computed for a threshold demand based on idArity] rhs_dmd -- See Note [Demand analysis for join points] -- See Note [Invariants on join points] invariant 2b, in GHC.Core -- rhs_arity matches the join arity of the join point | isJoinId id - = mkCallDmds rhs_arity let_dmd + = mkCalledOnceDmds rhs_arity let_dmd | otherwise - -- NB: rhs_arity - -- See Note [Demand signatures are computed for a threshold demand based on idArity] - = mkRhsDmd env rhs_arity rhs + = mkCalledOnceDmds rhs_arity topSubDmd (rhs_dmd_ty, rhs') = dmdAnal env rhs_dmd rhs DmdType rhs_fv rhs_dmds rhs_div = rhs_dmd_ty sig = mkStrictSigForArity rhs_arity (DmdType sig_fv rhs_dmds rhs_div) + id' = id `setIdStrictness` sig + env' = extendAnalEnv top_lvl env id' sig + -- See Note [Aggregated demand for cardinality] -- FIXME: That Note doesn't explain the following lines at all. The reason -- is really much different: When we have a recursive function, we'd @@ -651,8 +777,8 @@ dmdAnalRhsLetDown rec_flag env let_dmd id rhs -- we'd have to do an additional iteration. reuseEnv makes sure that -- we never get used-once info for FVs of recursive functions. rhs_fv1 = case rec_flag of - Just bs -> reuseEnv (delVarEnvList rhs_fv bs) - Nothing -> rhs_fv + Recursive -> reuseEnv rhs_fv + NonRecursive -> rhs_fv rhs_fv2 = rhs_fv1 `keepAliveDmdEnv` extra_fvs -- Find the RHS free vars of the unfoldings and RULES @@ -669,13 +795,6 @@ dmdAnalRhsLetDown rec_flag env let_dmd id rhs = exprFreeIds unf_body | otherwise = emptyVarSet --- | @mkRhsDmd env rhs_arity rhs@ creates a 'SubDemand' for --- unleashing on the given function's @rhs@, by creating --- a call demand of @rhs_arity@ --- See Historical Note [Product demands for function body] -mkRhsDmd :: AnalEnv -> Arity -> CoreExpr -> SubDemand -mkRhsDmd _env rhs_arity _rhs = mkCallDmds rhs_arity topSubDmd - -- | If given the (local, non-recursive) let-bound 'Id', 'useLetUp' determines -- whether we should process the binding up (body before rhs) or down (rhs -- before body). @@ -720,8 +839,8 @@ mkRhsDmd _env rhs_arity _rhs = mkCallDmds rhs_arity topSubDmd -- * For a more convincing example with join points, see Note [Demand analysis -- for join points]. -- -useLetUp :: Var -> Bool -useLetUp f = idArity f == 0 && not (isJoinId f) +useLetUp :: TopLevelFlag -> Var -> Bool +useLetUp top_lvl f = isNotTopLevel top_lvl && idArity f == 0 && not (isJoinId f) {- Note [Demand analysis for join points] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -939,8 +1058,6 @@ dmdFix :: TopLevelFlag dmdFix top_lvl env let_dmd orig_pairs = loop 1 initial_pairs where - bndrs = map fst orig_pairs - -- See Note [Initialising strictness] initial_pairs | ae_virgin env = [(setIdStrictness id botSig, rhs) | (id, rhs) <- orig_pairs ] | otherwise = orig_pairs @@ -990,10 +1107,8 @@ dmdFix top_lvl env let_dmd orig_pairs = -- pprTrace "my_downRhs" (ppr id $$ ppr (idStrictness id) $$ ppr sig) $ ((env', lazy_fv'), (id', rhs')) where - (lazy_fv1, sig, rhs') = dmdAnalRhsLetDown (Just bndrs) env let_dmd id rhs - lazy_fv' = plusVarEnv_C plusDmd lazy_fv lazy_fv1 - env' = extendAnalEnv top_lvl env id sig - id' = setIdStrictness id sig + (env', lazy_fv1, id', rhs') = dmdAnalRhsSig top_lvl Recursive env let_dmd id rhs + lazy_fv' = plusVarEnv_C plusDmd lazy_fv lazy_fv1 zapIdStrictness :: [(Id, CoreExpr)] -> [(Id, CoreExpr)] zapIdStrictness pairs = [(setIdStrictness id nopSig, rhs) | (id, rhs) <- pairs ] @@ -1090,7 +1205,7 @@ addLazyFVs dmd_ty lazy_fvs -- demand with the bottom coming up from 'error' -- -- I got a loop in the fixpointer without this, due to an interaction - -- with the lazy_fv filtering in dmdAnalRhsLetDown. Roughly, it was + -- with the lazy_fv filtering in dmdAnalRhsSig. Roughly, it was -- letrec f n x -- = letrec g y = x `fatbar` -- letrec h z = z + ...g... @@ -1156,10 +1271,6 @@ annotateLamIdBndr env arg_of_dfun dmd_ty id main_ty = addDemand dmd dmd_ty' (dmd_ty', dmd) = findBndrDmd env arg_of_dfun dmd_ty id -deleteFVs :: DmdType -> [Var] -> DmdType -deleteFVs (DmdType fvs dmds res) bndrs - = DmdType (delVarEnvList fvs bndrs) dmds res - {- Note [NOINLINE and strictness] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Core/Opt/Pipeline.hs ===================================== @@ -65,6 +65,7 @@ import GHC.Types.SrcLoc import GHC.Types.Id import GHC.Types.Id.Info import GHC.Types.Basic +import GHC.Types.Demand ( zapDmdEnvSig ) import GHC.Types.Var.Set import GHC.Types.Var.Env import GHC.Types.Unique.Supply ( UniqSupply, mkSplitUniqSupply, splitUniqSupply ) @@ -495,7 +496,7 @@ doCorePass CoreDoExitify = {-# SCC "Exitify" #-} doPass exitifyProgram doCorePass CoreDoDemand = {-# SCC "DmdAnal" #-} - doPassDFM dmdAnal + doPassDFRM dmdAnal doCorePass CoreDoCpr = {-# SCC "CprAnal" #-} doPassDFM cprAnalProgram @@ -575,6 +576,13 @@ doPassDFM do_pass guts = do let fam_envs = (p_fam_env, mg_fam_inst_env guts) doPassM (liftIO . do_pass dflags fam_envs) guts +doPassDFRM :: (DynFlags -> FamInstEnvs -> [CoreRule] -> CoreProgram -> IO CoreProgram) -> ModGuts -> CoreM ModGuts +doPassDFRM do_pass guts = do + dflags <- getDynFlags + p_fam_env <- getPackageFamInstEnv + let fam_envs = (p_fam_env, mg_fam_inst_env guts) + doPassM (liftIO . do_pass dflags fam_envs (mg_rules guts)) guts + doPassDFU :: (DynFlags -> FamInstEnvs -> UniqSupply -> CoreProgram -> CoreProgram) -> ModGuts -> CoreM ModGuts doPassDFU do_pass guts = do dflags <- getDynFlags @@ -1088,13 +1096,13 @@ transferIdInfo exported_id local_id -dmdAnal :: DynFlags -> FamInstEnvs -> CoreProgram -> IO CoreProgram -dmdAnal dflags fam_envs binds = do +dmdAnal :: DynFlags -> FamInstEnvs -> [CoreRule] -> CoreProgram -> IO CoreProgram +dmdAnal dflags fam_envs rules binds = do let opts = DmdAnalOpts { dmd_strict_dicts = gopt Opt_DictsStrict dflags } - binds_plus_dmds = dmdAnalProgram opts fam_envs binds + binds_plus_dmds = dmdAnalProgram opts fam_envs rules binds Err.dumpIfSet_dyn dflags Opt_D_dump_str_signatures "Strictness signatures" FormatText $ - dumpIdInfoOfProgram (ppr . strictnessInfo) binds_plus_dmds + dumpIdInfoOfProgram (ppr . zapDmdEnvSig . strictnessInfo) binds_plus_dmds -- See Note [Stamp out space leaks in demand analysis] in GHC.Core.Opt.DmdAnal seqBinds binds_plus_dmds `seq` return binds_plus_dmds ===================================== compiler/GHC/Core/Opt/WorkWrap/Utils.hs ===================================== @@ -1275,10 +1275,14 @@ mk_absent_let dflags fam_envs arg abs_rhs = mkAbsentErrorApp arg_ty msg msg = showSDoc (gopt_set dflags Opt_SuppressUniques) - (ppr arg <+> ppr (idType arg) <+> file_msg) + (vcat + [ text "Arg:" <+> ppr arg + , text "Type:" <+> ppr arg_ty + , file_msg + ]) file_msg = case outputFile dflags of Nothing -> empty - Just f -> text "in output file " <+> quotes (text f) + Just f -> text "In output file " <+> quotes (text f) -- We need to suppress uniques here because otherwise they'd -- end up in the generated code as strings. This is bad for -- determinism, because with different uniques the strings ===================================== compiler/GHC/Core/Tidy.hs ===================================== @@ -21,7 +21,7 @@ import GHC.Core import GHC.Core.Seq ( seqUnfolding ) import GHC.Types.Id import GHC.Types.Id.Info -import GHC.Types.Demand ( zapUsageEnvSig ) +import GHC.Types.Demand ( zapDmdEnvSig ) import GHC.Core.Type ( tidyType, tidyVarBndr ) import GHC.Core.Coercion ( tidyCo ) import GHC.Types.Var @@ -206,7 +206,7 @@ tidyLetBndr rec_tidy_env env@(tidy_env, var_env) id new_info = vanillaIdInfo `setOccInfo` occInfo old_info `setArityInfo` arityInfo old_info - `setStrictnessInfo` zapUsageEnvSig (strictnessInfo old_info) + `setStrictnessInfo` zapDmdEnvSig (strictnessInfo old_info) `setDemandInfo` demandInfo old_info `setInlinePragInfo` inlinePragInfo old_info `setUnfoldingInfo` new_unf ===================================== compiler/GHC/Types/Demand.hs ===================================== @@ -34,7 +34,7 @@ module GHC.Types.Demand ( lazyApply1Dmd, lazyApply2Dmd, strictOnceApply1Dmd, strictManyApply1Dmd, -- ** Other @Demand@ operations oneifyCard, oneifyDmd, strictifyDmd, strictifyDictDmd, mkWorkerDemand, - peelCallDmd, peelManyCalls, mkCallDmd, mkCallDmds, + peelCallDmd, peelManyCalls, mkCalledOnceDmd, mkCalledOnceDmds, addCaseBndrDmd, -- ** Extracting one-shot information argOneShots, argsOneShots, saturatedByOneShots, @@ -73,7 +73,7 @@ module GHC.Types.Demand ( seqDemand, seqDemandList, seqDmdType, seqStrictSig, -- * Zapping usage information - zapUsageDemand, zapUsageEnvSig, zapUsedOnceDemand, zapUsedOnceSig + zapUsageDemand, zapDmdEnvSig, zapUsedOnceDemand, zapUsedOnceSig ) where #include "HsVersions.h" @@ -278,7 +278,8 @@ data SubDemand -- ^ @Call n sd@ describes the evaluation context of @n@ function -- applications, where every individual result is evaluated according to @sd at . -- @sd@ is /relative/ to a single call, cf. Note [Call demands are relative]. - -- Used only for values of function type. + -- Used only for values of function type. Use the smart constructor 'mkCall' + -- whenever possible! | Prod ![Demand] -- ^ @Prod ds@ describes the evaluation context of a case scrutinisation -- on an expression of product type, where the product components are @@ -306,7 +307,7 @@ polyDmd C_1N = C_1N :* poly1N polyDmd C_10 = C_10 :* poly10 -- | A smart constructor for 'Prod', applying rewrite rules along the semantic --- equalities @Prod [polyDmd n, ...] === polyDmd n@, simplifying to 'Poly' +-- equality @Prod [polyDmd n, ...] === polyDmd n@, simplifying to 'Poly' -- 'SubDemand's when possible. Note that this degrades boxity information! E.g. a -- polymorphic demand will never unbox. mkProd :: [Demand] -> SubDemand @@ -335,6 +336,13 @@ viewProd _ _ = Nothing {-# INLINE viewProd #-} -- we want to fuse away the replicate and the allocation -- for Arity. Otherwise, #18304 bites us. +-- | A smart constructor for 'Call', applying rewrite rules along the semantic +-- equality @Call n (Poly n) === Poly n@, simplifying to 'Poly' 'SubDemand's +-- when possible. +mkCall :: Card -> SubDemand -> SubDemand +mkCall n cd@(Poly m) | n == m = cd +mkCall n cd = Call n cd + -- | @viewCall sd@ interprets @sd@ as a 'Call', expanding 'Poly' demands as -- necessary. viewCall :: SubDemand -> Maybe (Card, SubDemand) @@ -356,8 +364,8 @@ lubSubDmd (Prod ds1) (viewProd (length ds1) -> Just ds2) = -- Handle Call lubSubDmd (Call n1 d1) (viewCall -> Just (n2, d2)) -- See Note [Call demands are relative] - | isAbs n2 = Call (lubCard n1 n2) (lubSubDmd d1 botSubDmd) - | otherwise = Call (lubCard n1 n2) (lubSubDmd d1 d2) + | isAbs n2 = mkCall (lubCard n1 n2) (lubSubDmd d1 botSubDmd) + | otherwise = mkCall (lubCard n1 n2) (lubSubDmd d1 d2) -- Handle Poly lubSubDmd (Poly n1) (Poly n2) = Poly (lubCard n1 n2) -- Make use of reflexivity (so we'll match the Prod or Call cases again). @@ -377,8 +385,8 @@ plusSubDmd (Prod ds1) (viewProd (length ds1) -> Just ds2) = -- Handle Call plusSubDmd (Call n1 d1) (viewCall -> Just (n2, d2)) -- See Note [Call demands are relative] - | isAbs n2 = Call (plusCard n1 n2) (lubSubDmd d1 botSubDmd) - | otherwise = Call (plusCard n1 n2) (lubSubDmd d1 d2) + | isAbs n2 = mkCall (plusCard n1 n2) (lubSubDmd d1 botSubDmd) + | otherwise = mkCall (plusCard n1 n2) (lubSubDmd d1 d2) -- Handle Poly plusSubDmd (Poly n1) (Poly n2) = Poly (plusCard n1 n2) -- Make use of reflexivity (so we'll match the Prod or Call cases again). @@ -407,7 +415,7 @@ multSubDmd :: Card -> SubDemand -> SubDemand multSubDmd n sd | Just sd' <- multTrivial n seqSubDmd sd = sd' multSubDmd n (Poly n') = Poly (multCard n n') -multSubDmd n (Call n' sd) = Call (multCard n n') sd -- See Note [Call demands are relative] +multSubDmd n (Call n' sd) = mkCall (multCard n n') sd -- See Note [Call demands are relative] multSubDmd n (Prod ds) = Prod (map (multDmd n) ds) multDmd :: Card -> Demand -> Demand @@ -457,22 +465,22 @@ evalDmd = C_1N :* topSubDmd -- | First argument of 'GHC.Exts.maskAsyncExceptions#': @SCS(U)@. -- Called exactly once. strictOnceApply1Dmd :: Demand -strictOnceApply1Dmd = C_11 :* Call C_11 topSubDmd +strictOnceApply1Dmd = C_11 :* mkCall C_11 topSubDmd -- | First argument of 'GHC.Exts.atomically#': @MCM(U)@. -- Called at least once, possibly many times. strictManyApply1Dmd :: Demand -strictManyApply1Dmd = C_1N :* Call C_1N topSubDmd +strictManyApply1Dmd = C_1N :* mkCall C_1N topSubDmd -- | First argument of catch#: @1C1(U)@. -- Evaluates its arg lazily, but then applies it exactly once to one argument. lazyApply1Dmd :: Demand -lazyApply1Dmd = C_01 :* Call C_01 topSubDmd +lazyApply1Dmd = C_01 :* mkCall C_01 topSubDmd -- | Second argument of catch#: @1C1(CS(U))@. -- Calls its arg lazily, but then applies it exactly once to an additional argument. lazyApply2Dmd :: Demand -lazyApply2Dmd = C_01 :* Call C_01 (Call C_11 topSubDmd) +lazyApply2Dmd = C_01 :* mkCall C_01 (mkCall C_11 topSubDmd) -- | Make a 'Demand' evaluated at-most-once. oneifyDmd :: Demand -> Demand @@ -512,12 +520,12 @@ strictifyDictDmd ty (n :* Prod ds) strictifyDictDmd _ dmd = dmd -- | Wraps the 'SubDemand' with a one-shot call demand: @d@ -> @CS(d)@. -mkCallDmd :: SubDemand -> SubDemand -mkCallDmd sd = Call C_11 sd +mkCalledOnceDmd :: SubDemand -> SubDemand +mkCalledOnceDmd sd = mkCall C_11 sd --- | @mkCallDmds n d@ returns @CS(CS...(CS d))@ where there are @n@ @CS@'s. -mkCallDmds :: Arity -> SubDemand -> SubDemand -mkCallDmds arity sd = iterate mkCallDmd sd !! arity +-- | @mkCalledOnceDmds n d@ returns @CS(CS...(CS d))@ where there are @n@ @CS@'s. +mkCalledOnceDmds :: Arity -> SubDemand -> SubDemand +mkCalledOnceDmds arity sd = iterate mkCalledOnceDmd sd !! arity -- | Peels one call level from the sub-demand, and also returns how many -- times we entered the lambda body. @@ -669,7 +677,7 @@ This is needed even for non-product types, in case the case-binder is used but the components of the case alternative are not. Note [Don't optimise UP(U,U,...) to U] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ These two SubDemands: UP(U,U) (@Prod [topDmd, topDmd]@) and U (@topSubDmd@) are semantically equivalent, but we do not turn the former into @@ -1571,9 +1579,9 @@ This is weird, so I'm not worried about whether this optimises brilliantly; but it should not fall over. -} -zapUsageEnvSig :: StrictSig -> StrictSig --- Remove the usage environment from the demand -zapUsageEnvSig (StrictSig (DmdType _ ds r)) = mkClosedStrictSig ds r +-- | Remove the demand environment from the signature. +zapDmdEnvSig :: StrictSig -> StrictSig +zapDmdEnvSig (StrictSig (DmdType _ ds r)) = mkClosedStrictSig ds r zapUsageDemand :: Demand -> Demand -- Remove the usage info, but not the strictness info, from the demand @@ -1615,8 +1623,8 @@ kill_usage kfs (n :* sd) = kill_usage_card kfs n :* kill_usage_sd kfs sd kill_usage_sd :: KillFlags -> SubDemand -> SubDemand kill_usage_sd kfs (Call n sd) - | kf_called_once kfs = Call (lubCard C_1N n) (kill_usage_sd kfs sd) - | otherwise = Call n (kill_usage_sd kfs sd) + | kf_called_once kfs = mkCall (lubCard C_1N n) (kill_usage_sd kfs sd) + | otherwise = mkCall n (kill_usage_sd kfs sd) kill_usage_sd kfs (Prod ds) = Prod (map (kill_usage kfs) ds) kill_usage_sd _ sd = sd @@ -1640,7 +1648,7 @@ trimToType (n :* sd) ts where go (Prod ds) (TsProd tss) | equalLength ds tss = Prod (zipWith trimToType ds tss) - go (Call n sd) (TsFun ts) = Call n (go sd ts) + go (Call n sd) (TsFun ts) = mkCall n (go sd ts) go sd at Poly{} _ = sd go _ _ = topSubDmd @@ -1804,7 +1812,7 @@ instance Binary SubDemand where h <- getByte bh case h of 0 -> Poly <$> get bh - 1 -> Call <$> get bh <*> get bh + 1 -> mkCall <$> get bh <*> get bh 2 -> Prod <$> get bh _ -> pprPanic "Binary:SubDemand" (ppr (fromIntegral h :: Int)) ===================================== compiler/GHC/Types/Id/Info.hs ===================================== @@ -650,7 +650,7 @@ zapUsageInfo info = Just (info {demandInfo = zapUsageDemand (demandInfo info)}) zapUsageEnvInfo :: IdInfo -> Maybe IdInfo zapUsageEnvInfo info | hasDemandEnvSig (strictnessInfo info) - = Just (info {strictnessInfo = zapUsageEnvSig (strictnessInfo info)}) + = Just (info {strictnessInfo = zapDmdEnvSig (strictnessInfo info)}) | otherwise = Nothing ===================================== testsuite/tests/arityanal/should_compile/Arity11.stderr ===================================== @@ -35,7 +35,7 @@ end Rec } -- RHS size: {terms: 52, types: 28, coercions: 0, joins: 0/5} F11.$wfib [InlPrag=[2]] :: forall {a} {p}. (a -> a -> Bool) -> (Num a, Num p) => a -> p -[GblId, Arity=4, Str=, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 150 60 0] 460 0}] +[GblId, Arity=4, Str=, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 150 60 0] 460 0}] F11.$wfib = \ (@a) (@p) (ww :: a -> a -> Bool) (w :: Num a) (w1 :: Num p) (w2 :: a) -> let { @@ -73,7 +73,7 @@ F11.$wfib fib [InlPrag=[2]] :: forall {a} {p}. (Eq a, Num a, Num p) => a -> p [GblId, Arity=4, - Str=, + Str=, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=4,unsat_ok=True,boring_ok=False) Tmpl= \ (@a) (@p) (w [Occ=Once1!] :: Eq a) (w1 [Occ=Once1] :: Num a) (w2 [Occ=Once1] :: Num p) (w3 [Occ=Once1] :: a) -> case w of { GHC.Classes.C:Eq ww1 [Occ=Once1] _ [Occ=Dead] -> F11.$wfib @a @p ww1 w1 w2 w3 }}] fib = \ (@a) (@p) (w :: Eq a) (w1 :: Num a) (w2 :: Num p) (w3 :: a) -> case w of { GHC.Classes.C:Eq ww1 ww2 -> F11.$wfib @a @p ww1 w1 w2 w3 } ===================================== testsuite/tests/arityanal/should_compile/Arity16.stderr ===================================== @@ -5,7 +5,7 @@ Result size of Tidy Core = {terms: 52, types: 87, coercions: 0, joins: 0/0} Rec { -- RHS size: {terms: 15, types: 17, coercions: 0, joins: 0/0} map2 [Occ=LoopBreaker] :: forall {t} {a}. (t -> a) -> [t] -> [a] -[GblId, Arity=2, Str=, Unf=OtherCon []] +[GblId, Arity=2, Str=, Unf=OtherCon []] map2 = \ (@t) (@a) (f :: t -> a) (ds :: [t]) -> case ds of { ===================================== testsuite/tests/stranal/should_compile/T18894.hs ===================================== @@ -0,0 +1,28 @@ +{-# OPTIONS_GHC -O2 -fforce-recomp #-} + +-- | The point of this test is that @g*@ get's a demand that says +-- "whenever @g*@ is called, the second component of the pair is evaluated strictly". +module T18894 (h1, h2) where + +g1 :: Int -> (Int,Int) +g1 1 = (15, 0) +g1 n = (2 * n, 2 `div` n) +{-# NOINLINE g1 #-} + +h1 :: Int -> Int +h1 1 = 0 +-- Sadly, the @g1 2@ subexpression will be floated to top-level, where we +-- don't see the specific demand placed on it by @snd at . Tracked in #19001. +h1 2 = snd (g1 2) +h1 m = uncurry (+) (g1 m) + +g2 :: Int -> Int -> (Int,Int) +g2 m 1 = (m, 0) +g2 m n = (2 * m, 2 `div` n) +{-# NOINLINE g2 #-} + +h2 :: Int -> Int +h2 1 = 0 +h2 m + | odd m = snd (g2 m 2) + | otherwise = uncurry (+) (g2 2 m) ===================================== testsuite/tests/stranal/should_compile/T18894.stderr ===================================== @@ -0,0 +1,404 @@ + +==================== Demand analysis ==================== +Result size of Demand analysis + = {terms: 177, types: 97, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 36, types: 16, coercions: 0, joins: 0/0} +g2 [InlPrag=NOINLINE, Dmd=UCU(CS(P(1P(U),SP(U))))] + :: Int -> Int -> (Int, Int) +[LclId, + Arity=2, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20 20] 161 20}] +g2 + = \ (m [Dmd=UP(U)] :: Int) (ds [Dmd=SP(SU)] :: Int) -> + case ds of { GHC.Types.I# ds [Dmd=SU] -> + case ds of ds [Dmd=1U] { + __DEFAULT -> + (case m of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.*# 2# y) }, + case ds of wild { + __DEFAULT -> + case GHC.Classes.divInt# 2# wild of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> GHC.Types.I# -2#; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + }); + 1# -> (m, lvl) + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 36, types: 19, coercions: 0, joins: 0/0} +h2 :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 162 10}] +h2 + = \ (ds [Dmd=SP(MU)] :: Int) -> + case ds of wild [Dmd=UP(U)] { GHC.Types.I# ds [Dmd=MU] -> + case ds of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> + case g2 wild lvl of { (ds1 [Dmd=A], y [Dmd=SU]) -> y }; + 0# -> + case g2 lvl wild of { (x [Dmd=SP(U)], ds [Dmd=SP(U)]) -> + case x of { GHC.Types.I# x -> + case ds of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + } + }; + 1# -> lvl + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 15# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +lvl :: (Int, Int) +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = (lvl, lvl) + +-- RHS size: {terms: 30, types: 11, coercions: 0, joins: 0/0} +g1 [InlPrag=NOINLINE, Dmd=UCU(P(UP(U),UP(U)))] :: Int -> (Int, Int) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 141 10}] +g1 + = \ (ds [Dmd=SP(SU)] :: Int) -> + case ds of { GHC.Types.I# ds [Dmd=SU] -> + case ds of ds { + __DEFAULT -> + (GHC.Types.I# (GHC.Prim.*# 2# ds), + case ds of wild { + __DEFAULT -> + case GHC.Classes.divInt# 2# wild of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> GHC.Types.I# -2#; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + }); + 1# -> lvl + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +lvl :: (Int, Int) +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=False, ConLike=False, + WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 30 0}] +lvl = g1 (GHC.Types.I# 2#) + +-- RHS size: {terms: 28, types: 18, coercions: 0, joins: 0/0} +h1 :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 111 10}] +h1 + = \ (ds [Dmd=SP(MU)] :: Int) -> + case ds of wild [Dmd=1P(1U)] { GHC.Types.I# ds [Dmd=MU] -> + case ds of { + __DEFAULT -> + case g1 wild of { (x [Dmd=SP(U)], ds [Dmd=SP(U)]) -> + case x of { GHC.Types.I# x -> + case ds of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + }; + 1# -> lvl; + 2# -> case lvl of { (ds1 [Dmd=A], y [Dmd=SU]) -> y } + } + } + + + + +==================== Demand analysis ==================== +Result size of Demand analysis + = {terms: 171, types: 120, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# -2# + +-- RHS size: {terms: 32, types: 18, coercions: 0, joins: 0/0} +$wg2 [InlPrag=NOINLINE, Dmd=UCU(CS(P(1P(U),SP(U))))] + :: Int -> GHC.Prim.Int# -> (# Int, Int #) +[LclId, + Arity=2, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20 30] 121 20}] +$wg2 + = \ (w [Dmd=UP(U)] :: Int) (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + (# case w of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.*# 2# y) }, + case ds of { + __DEFAULT -> + case GHC.Classes.divInt# 2# ds of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> lvl; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + } #); + 1# -> (# w, lvl #) + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 34, types: 21, coercions: 0, joins: 0/0} +$wh2 [InlPrag=[2]] :: GHC.Prim.Int# -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 162 10}] +$wh2 + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> + case $wg2 (GHC.Types.I# ds) 2# of + { (# ww [Dmd=A], ww [Dmd=SU] #) -> + ww + }; + 0# -> + case $wg2 lvl ds of { (# ww [Dmd=SP(U)], ww [Dmd=SP(U)] #) -> + case ww of { GHC.Types.I# x -> + case ww of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + } + }; + 1# -> lvl + } + +-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} +h2 [InlPrag=[2]] :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (w [Occ=Once1!] :: Int) -> + case w of { GHC.Types.I# ww [Occ=Once1, Dmd=MU] -> $wh2 ww }}] +h2 + = \ (w [Dmd=SP(SU)] :: Int) -> + case w of { GHC.Types.I# ww [Dmd=SU] -> $wh2 ww } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 15# + +-- RHS size: {terms: 28, types: 15, coercions: 0, joins: 0/0} +$wg1 [InlPrag=NOINLINE, Dmd=UCU(P(UP(U),UP(U)))] + :: GHC.Prim.Int# -> (# Int, Int #) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 111 20}] +$wg1 + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + (# GHC.Types.I# (GHC.Prim.*# 2# ds), + case ds of { + __DEFAULT -> + case GHC.Classes.divInt# 2# ds of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> lvl; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + } #); + 1# -> (# lvl, lvl #) + } + +-- RHS size: {terms: 7, types: 9, coercions: 0, joins: 0/0} +lvl :: (Int, Int) +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=False, ConLike=False, + WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 40 10}] +lvl = case $wg1 2# of { (# ww, ww #) -> (ww, ww) } + +-- RHS size: {terms: 25, types: 18, coercions: 0, joins: 0/0} +$wh1 [InlPrag=[2]] :: GHC.Prim.Int# -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [50] 101 10}] +$wh1 + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds [Dmd=1U] { + __DEFAULT -> + case $wg1 ds of { (# ww [Dmd=SP(U)], ww [Dmd=SP(U)] #) -> + case ww of { GHC.Types.I# x -> + case ww of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + }; + 1# -> lvl; + 2# -> case lvl of { (ds1 [Dmd=A], y [Dmd=SU]) -> y } + } + +-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} +h1 [InlPrag=[2]] :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (w [Occ=Once1!] :: Int) -> + case w of { GHC.Types.I# ww [Occ=Once1, Dmd=MU] -> $wh1 ww }}] +h1 + = \ (w [Dmd=SP(SU)] :: Int) -> + case w of { GHC.Types.I# ww [Dmd=SU] -> $wh1 ww } + + + ===================================== testsuite/tests/stranal/should_compile/T18894b.hs ===================================== @@ -0,0 +1,20 @@ +{-# OPTIONS_GHC -O -fno-call-arity -fforce-recomp #-} + +module T18894 (f) where + +expensive :: Int -> (Int, Int) +expensive n = (n+1, n+2) +{-# NOINLINE expensive #-} + +-- arity 1 by itself, but not exported, thus can be eta-expanded based on usage +eta :: Int -> Int -> Int +eta x = if fst (expensive x) == 13 + then \y -> x + y + else \y -> x * y +{-# NOINLINE eta #-} + +f :: Int -> Int +f 1 = 0 +f m + | odd m = eta m 2 + | otherwise = eta 2 m ===================================== testsuite/tests/stranal/should_compile/T18894b.stderr ===================================== @@ -0,0 +1,187 @@ + +==================== Demand analysis ==================== +Result size of Demand analysis = {terms: 83, types: 40, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 16, types: 7, coercions: 0, joins: 0/0} +expensive [InlPrag=NOINLINE, Dmd=UCU(P(SP(SU),A))] :: Int -> (Int, Int) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [40] 52 10}] +expensive + = \ (n [Dmd=UP(U)] :: Int) -> + (case n of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 1#) }, case n of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 2#) }) + +-- RHS size: {terms: 20, types: 11, coercions: 0, joins: 0/0} +eta [InlPrag=NOINLINE, Dmd=UCU(CS(U))] :: Int -> Int -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [0] 140 120}] +eta + = \ (x [Dmd=UP(U)] :: Int) -> + case expensive x of { (x [Dmd=SP(SU)], ds1 [Dmd=A]) -> + case x of { GHC.Types.I# x [Dmd=SU] -> + case x of { + __DEFAULT -> \ (y [Dmd=SP(U)] :: Int) -> GHC.Num.$fNumInt_$c* x y; + 13# -> \ (y [Dmd=SP(U)] :: Int) -> GHC.Num.$fNumInt_$c+ x y + } + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 21, types: 5, coercions: 0, joins: 0/0} +f :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 111 0}] +f = \ (ds [Dmd=SP(MU)] :: Int) -> + case ds of wild [Dmd=UP(U)] { GHC.Types.I# ds [Dmd=MU] -> + case ds of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> eta wild lvl; + 0# -> eta lvl wild + }; + 1# -> lvl + } + } + + + + +==================== Demand analysis ==================== +Result size of Demand analysis = {terms: 85, types: 47, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 16, types: 9, coercions: 0, joins: 0/0} +$wexpensive [InlPrag=NOINLINE, Dmd=UCU(P(SP(SU),A))] :: Int -> (# Int, Int #) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [40] 42 10}] +$wexpensive + = \ (w [Dmd=UP(U)] :: Int) -> + (# case w of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 1#) }, + case w of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 2#) } #) + +-- RHS size: {terms: 19, types: 12, coercions: 0, joins: 0/0} +eta [InlPrag=NOINLINE, Dmd=UCU(CS(U))] :: Int -> Int -> Int +[LclId, + Arity=2, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [0 0] 120 0}] +eta + = \ (x [Dmd=MP(U)] :: Int) (eta [Dmd=SP(U), OS=OneShot] :: Int) -> + case $wexpensive x of { (# ww [Dmd=SP(SU)], ww [Dmd=A] #) -> + case ww of { GHC.Types.I# x [Dmd=SU] -> + case x of { + __DEFAULT -> GHC.Num.$fNumInt_$c* x eta; + 13# -> GHC.Num.$fNumInt_$c+ x eta + } + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 20, types: 3, coercions: 0, joins: 0/0} +$wf [InlPrag=[2]] :: GHC.Prim.Int# -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 121 0}] +$wf + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> eta (GHC.Types.I# ds) lvl; + 0# -> eta lvl (GHC.Types.I# ds) + }; + 1# -> lvl + } + +-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} +f [InlPrag=[2]] :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (w [Occ=Once1!] :: Int) -> case w of { GHC.Types.I# ww [Occ=Once1, Dmd=MU] -> $wf ww }}] +f = \ (w [Dmd=SP(SU)] :: Int) -> case w of { GHC.Types.I# ww [Dmd=SU] -> $wf ww } + + + ===================================== testsuite/tests/stranal/should_compile/all.T ===================================== @@ -58,3 +58,7 @@ test('T18122', [ grep_errmsg(r'wfoo =') ], compile, ['-ddump-simpl']) # We care about the call demand on $wg test('T18903', [ grep_errmsg(r'Dmd=\S+C\S+') ], compile, ['-ddump-simpl -dsuppress-uniques']) +# We care about the call demand on $wg1 and $wg2 +test('T18894', [ grep_errmsg(r'Dmd=\S+C\S+') ], compile, ['-ddump-stranal -dsuppress-uniques']) +# We care about the Arity 2 on eta, as a result of the annotated Dmd +test('T18894b', [ grep_errmsg(r'Arity=2') ], compile, ['-ddump-stranal -dsuppress-uniques -fno-call-arity -dppr-cols=200']) ===================================== testsuite/tests/stranal/sigs/T5075.stderr ===================================== @@ -1,7 +1,7 @@ ==================== Strictness signatures ==================== T5075.$trModule: -T5075.loop: +T5075.loop: @@ -13,6 +13,6 @@ T5075.loop: ==================== Strictness signatures ==================== T5075.$trModule: -T5075.loop: +T5075.loop: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/044d0f13ec8ebd531170dc752d9b0a6dea1d4c47...3aa7927431115f361f4e091dcb59e3f2a31898a6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/044d0f13ec8ebd531170dc752d9b0a6dea1d4c47...3aa7927431115f361f4e091dcb59e3f2a31898a6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 3 00:14:03 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Wed, 02 Dec 2020 19:14:03 -0500 Subject: [Git][ghc/ghc][wip/T18894] 2 commits: DmdAnal: Annotate top-level function bindings with demands (#18894) Message-ID: <5fc82dcbf0caa_6a09f34bc349d8@gitlab.mail> Sebastian Graf pushed to branch wip/T18894 at Glasgow Haskell Compiler / GHC Commits: 2d949bd0 by Sebastian Graf at 2020-12-03T01:13:54+01:00 DmdAnal: Annotate top-level function bindings with demands (#18894) It's useful to annotate a non-exported top-level function like `g` in ```hs module Lib (h) where g :: Int -> Int -> (Int,Int) g m 1 = (m, 0) g m n = (2 * m, 2 `div` n) {-# NOINLINE g #-} h :: Int -> Int h 1 = 0 h m | odd m = snd (g m 2) | otherwise = uncurry (+) (g 2 m) ``` with its demand `UCU(CS(P(1P(U),SP(U))`, which tells us that whenever `g` was called, the second component of the returned pair was evaluated strictly. Since #18903 we do so for local functions, where we can see all calls. For top-level functions, we can assume that all *exported* functions are demanded according to `topDmd` and thus get sound demands for non-exported top-level functions. The demand on `g` is crucial information for Nested CPR, which may the go on and unbox `g` for the second pair component. That is true even if that pair component may diverge, as is the case for the call site `g 13 0`, which throws a div-by-zero exception. In `T18894b`, you can even see the new demand annotation enabling us to eta-expand a function that we wouldn't be able to eta-expand without Call Arity. We only track bindings of function type in order not to risk huge compile-time regressions, see `isInterestingTopLevelFn`. There was a CoreLint check that rejected strict demand annotations on recursive or top-level bindings, which seems completely unjustified. All the cases I investigated were fine, so I removed it. Fixes #18894. - - - - - 26232493 by Sebastian Graf at 2020-12-03T01:13:54+01:00 Demand: Simplify `CU(U)` to `U` (#19005) Both sub-demands encode the same information. This is a trivial change and already affects a few regression tests (e.g. `T5075`), so no separate regression test is necessary. - - - - - 16 changed files: - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Types/Demand.hs - compiler/GHC/Types/Id/Info.hs - testsuite/tests/arityanal/should_compile/Arity11.stderr - testsuite/tests/arityanal/should_compile/Arity16.stderr - + testsuite/tests/stranal/should_compile/T18894.hs - + testsuite/tests/stranal/should_compile/T18894.stderr - + testsuite/tests/stranal/should_compile/T18894b.hs - + testsuite/tests/stranal/should_compile/T18894b.stderr - testsuite/tests/stranal/should_compile/all.T - testsuite/tests/stranal/sigs/T5075.stderr Changes: ===================================== compiler/GHC/Core/FVs.hs ===================================== @@ -525,12 +525,11 @@ ruleLhsFVIds (Rule { ru_bndrs = bndrs, ru_args = args }) = filterFV isLocalId $ addBndrs bndrs (exprs_fvs args) ruleRhsFreeIds :: CoreRule -> VarSet --- ^ This finds all locally-defined free Ids on the left hand side of a rule +-- ^ This finds all locally-defined free Ids on the right hand side of a rule -- and returns them as a non-deterministic set ruleRhsFreeIds (BuiltinRule {}) = emptyVarSet -ruleRhsFreeIds (Rule { ru_bndrs = bndrs, ru_args = args }) - = fvVarSet $ filterFV isLocalId $ - addBndrs bndrs $ exprs_fvs args +ruleRhsFreeIds (Rule { ru_bndrs = bndrs, ru_rhs = rhs }) + = fvVarSet $ filterFV isLocalId $ addBndrs bndrs $ expr_fvs rhs {- Note [Rule free var hack] (Not a hack any more) ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -623,14 +623,6 @@ lintLetBind top_lvl rec_flag binder rhs rhs_ty || exprIsTickedString rhs) (badBndrTyMsg binder (text "unlifted")) - -- Check that if the binder is top-level or recursive, it's not - -- demanded. Primitive string literals are exempt as there is no - -- computation to perform, see Note [Core top-level string literals]. - ; checkL (not (isStrictId binder) - || (isNonRec rec_flag && not (isTopLevel top_lvl)) - || exprIsTickedString rhs) - (mkStrictMsg binder) - -- Check that if the binder is at the top level and has type Addr#, -- that it is a string literal, see -- Note [Core top-level string literals]. @@ -3119,13 +3111,6 @@ badBndrTyMsg binder what = vcat [ text "The type of this binder is" <+> what <> colon <+> ppr binder , text "Binder's type:" <+> ppr (idType binder) ] -mkStrictMsg :: Id -> MsgDoc -mkStrictMsg binder - = vcat [hsep [text "Recursive or top-level binder has strict demand info:", - ppr binder], - hsep [text "Binder's demand info:", ppr (idDemandInfo binder)] - ] - mkNonTopExportedMsg :: Id -> MsgDoc mkNonTopExportedMsg binder = hsep [text "Non-top-level binder is marked as exported:", ppr binder] ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -37,6 +37,7 @@ import GHC.Core.Type import GHC.Core.FVs ( exprFreeIds, ruleRhsFreeIds ) import GHC.Core.Coercion ( Coercion, coVarsOfCo ) import GHC.Core.FamInstEnv +import GHC.Core.Opt.Arity ( typeArity ) import GHC.Utils.Misc import GHC.Utils.Panic import GHC.Data.Maybe ( isJust ) @@ -64,28 +65,54 @@ data DmdAnalOpts = DmdAnalOpts -- -- Note: use `seqBinds` on the result to avoid leaks due to lazyness (cf Note -- [Stamp out space leaks in demand analysis]) -dmdAnalProgram :: DmdAnalOpts -> FamInstEnvs -> CoreProgram -> CoreProgram -dmdAnalProgram opts fam_envs binds = binds_plus_dmds - where - env = emptyAnalEnv opts fam_envs - binds_plus_dmds = snd $ mapAccumL dmdAnalTopBind env binds - --- Analyse a (group of) top-level binding(s) -dmdAnalTopBind :: AnalEnv - -> CoreBind - -> (AnalEnv, CoreBind) -dmdAnalTopBind env (NonRec id rhs) - = ( extendAnalEnv TopLevel env id sig - , NonRec (setIdStrictness id sig) rhs') +dmdAnalProgram :: DmdAnalOpts -> FamInstEnvs -> [CoreRule] -> CoreProgram -> CoreProgram +dmdAnalProgram opts fam_envs rules binds + = snd $ go (emptyAnalEnv opts fam_envs) binds where - ( _, sig, rhs') = dmdAnalRhsLetDown Nothing env topSubDmd id rhs - -dmdAnalTopBind env (Rec pairs) - = (env', Rec pairs') - where - (env', _, pairs') = dmdFix TopLevel env topSubDmd pairs - -- We get two iterations automatically - -- c.f. the NonRec case above + -- See Note [Analysing top-level bindings] + -- TLDR; We analyse them like + -- let ex1 = ... in (ex1, let nex1 = ... in let ex2 = ... in (ex2, ...))) + -- where ex* are exported (or RULE mentions) and nex* are not. + go _ [] = (nopDmdType, []) + go env (b:bs) = cons_up $ dmdAnalBind TopLevel env topSubDmd b anal_body + where + anal_body env' + | (body_ty, bs') <- go env' bs + = (add_exported_uses env' body_ty (bindersOf b), bs') + + cons_up :: (a, b, [b]) -> (a, [b]) + cons_up (dmd_ty, b', bs') = (dmd_ty, b':bs') + + add_exported_uses :: AnalEnv -> DmdType -> [Id] -> DmdType + add_exported_uses env = foldl' (add_exported_use env) + + -- | If @e@ is denoted by @dmd_ty@, then @add_exported_use _ dmd_ty id@ + -- corresponds to the demand type of @(id, e)@, but is a lot more direct. + -- See Note [Analysing top-level bindings]. + add_exported_use :: AnalEnv -> DmdType -> Id -> DmdType + add_exported_use env dmd_ty id + | isExportedId id || elemVarSet id rule_fvs + -- See Note [Absence analysis for stable unfoldings and RULES] + = dmd_ty `plusDmdType` fst (dmdAnalStar env topDmd (Var id)) + | otherwise = dmd_ty + + rule_fvs :: IdSet + rule_fvs = foldr (unionVarSet . ruleRhsFreeIds) emptyVarSet rules + +-- | Whether we want to store demands on a top-level Id or just default +-- to 'topDmd'. +-- +-- Basically, we want to now how top-level *functions* are *used* +-- (e.g. called), but aren't interested in whether they were called strictly +-- or not. Other top-level bindings are boring. +isInterestingTopLevelFn :: Id -> Bool +-- SG tried to set this to True and got a +2% ghc/alloc regression in T5642 +-- (which is dominated by the Simplifier) at no gain in analysis precision. +-- If there was a gain, that regression might be acceptable. +-- Plus, we could use LetUp for thunks and share some code with local let +-- bindings. +isInterestingTopLevelFn id = + typeArity (idType id) `lengthExceeds` 0 {- Note [Stamp out space leaks in demand analysis] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -105,8 +132,56 @@ generation would hold on to an extra copy of the Core program, via unforced thunks in demand or strictness information; and it is the most memory-intensive part of the compilation process, so this added seqBinds makes a big difference in peak memory usage. --} +Note [Analysing top-level bindings] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider a CoreProgram like + e1 = ... + n1 = ... + e2 = \a b -> ... fst (n1 a b) ... + n2 = \c d -> ... snd (e2 c d) ... + ... +where e* are exported, but n* are not. +Intuitively, we can see that @n1@ is only ever called with two arguments +and in every call site, the first component of the result of the call +is evaluated. Thus, we'd like it to have idDemandInfo @UCU(C1(P(SU,A))@. + +(This can be exploited by a Nested CPR pass which may then unbox the +first component of the pair returned from @n1 at . Or if @n1@ had arity +1 before, we may now eta-expand to arity 2.) + +NB: We may *not* give e2 a similar annotation, because it is exported and +external callers might use it in arbitrary ways, expressed by 'topDmd'. + +How do we get this result? Answer: By analysing the program as if it was a let +expression of this form: + let e1 = ... in + (e1, let n1 = ... in + ( let e2 = ... in + (e2, let n2 = ... in + ( ...)))) +E.g. putting all bindings in nested lets, where whenever it binds an exported +binding, the body is a *pair* of an occurrence of the exported binder and +the other nested lets. Of course, we will not actually build that CoreExpr! +Instead we faithfully simulate analysis of said expression by adding the +free variable 'DmdEnv' of @e*@'s strictness signatures to the 'DmdType' we +get from analysing the nested bindings. + +You might also wonder why we didn't analyse in terms of the simpler + let e1 = ... in + let n1 = ... in + let e2 = ... in + let n2 = ... in + (e1,e2, ...) +The reason is analysis performance: If @e1@ uses many free variables, we'll +unnecessarily carry their demands around with us from the moment we analyse +the pair to the moment we bubble back up to the binding for @e1 at . +This blows up e.g. @T10370 at . + +A final note about variables occuring free in RULE RHSs: They are to be handled +pretty much like exported Ids. +See also Note [Absence analysis for stable unfoldings and RULES] +-} {- ************************************************************************ @@ -114,7 +189,103 @@ seqBinds makes a big difference in peak memory usage. \subsection{The analyser itself} * * ************************************************************************ +-} + +-- | Analyse a binding group and its \"body\", e.g. where it is in scope. +-- +-- It calls a function that knows how to analyse this \"body\" given +-- an 'AnalEnv' with updated demand signatures for the binding group +-- (reflecting their 'idStrictnessInfo') and expects to receive a +-- 'DmdType' in return, which it uses to annotate the binding group with their +-- 'idDemandInfo'. +dmdAnalBind + :: TopLevelFlag + -> AnalEnv + -> SubDemand -- ^ Demand put on the "body" + -- (important for join points) + -> CoreBind + -> (AnalEnv -> (DmdType, a)) -- ^ How to analyse the "body", e.g. + -- where the binding is in scope + -> (DmdType, CoreBind, a) +dmdAnalBind top_lvl env dmd bind anal_body = case bind of + NonRec id rhs + | useLetUp top_lvl id + -> dmdAnalBindLetUp top_lvl env id rhs anal_body + _ -> dmdAnalBindLetDown top_lvl env dmd bind anal_body + +-- | Annotates uninteresting top level functions ('isInterestingTopLevelFn') +-- with 'topDmd', the rest with the given demand. +setBindIdDemandInfo :: TopLevelFlag -> Id -> Demand -> Id +setBindIdDemandInfo top_lvl id dmd = setIdDemandInfo id $ case top_lvl of + TopLevel | not (isInterestingTopLevelFn id) -> topDmd + _ -> dmd + +-- | Let bindings can be processed in two ways: +-- Down (RHS before body) or Up (body before RHS). +-- This function handles the up variant. +-- +-- It is very simple. For let x = rhs in body +-- * Demand-analyse 'body' in the current environment +-- * Find the demand, 'rhs_dmd' placed on 'x' by 'body' +-- * Demand-analyse 'rhs' in 'rhs_dmd' +-- +-- This is used for a non-recursive local let without manifest lambdas (see +-- 'useLetUp'). +-- +-- This is the LetUp rule in the paper “Higher-Order Cardinality Analysis”. +dmdAnalBindLetUp :: TopLevelFlag -> AnalEnv -> Id -> CoreExpr -> (AnalEnv -> (DmdType, a)) -> (DmdType, CoreBind, a) +dmdAnalBindLetUp top_lvl env id rhs anal_body = (final_ty, NonRec id' rhs', body') + where + (body_ty, body') = anal_body env + (body_ty', id_dmd) = findBndrDmd env notArgOfDfun body_ty id + id' = setBindIdDemandInfo top_lvl id id_dmd + (rhs_ty, rhs') = dmdAnalStar env (dmdTransformThunkDmd rhs id_dmd) rhs + final_ty = body_ty' `plusDmdType` rhs_ty + +-- | Let bindings can be processed in two ways: +-- Down (RHS before body) or Up (body before RHS). +-- This function handles the down variant. +-- +-- It computes a demand signature (by means of 'dmdAnalRhsSig') and uses +-- that at call sites in the body. +-- +-- It is used for toplevel definitions, recursive definitions and local +-- non-recursive definitions that have manifest lambdas (cf. 'useLetUp'). +-- Local non-recursive definitions without a lambda are handled with LetUp. +-- +-- This is the LetDown rule in the paper “Higher-Order Cardinality Analysis”. +dmdAnalBindLetDown :: TopLevelFlag -> AnalEnv -> SubDemand -> CoreBind -> (AnalEnv -> (DmdType, a)) -> (DmdType, CoreBind, a) +dmdAnalBindLetDown top_lvl env dmd bind anal_body = case bind of + NonRec id rhs + | (env', lazy_fv, id1, rhs1) <- + dmdAnalRhsSig top_lvl NonRecursive env dmd id rhs + -> do_rest env' lazy_fv [(id1, rhs1)] (\[(id2, rhs2)] -> NonRec id2 rhs2) + Rec pairs + | (env', lazy_fv, pairs') <- dmdFix top_lvl env dmd pairs + -> do_rest env' lazy_fv pairs' Rec + where + do_rest env' lazy_fv pairs1 build_bind = (final_ty, build_bind pairs2, body') + where + (body_ty, body') = anal_body env' + -- see Note [Lazy and unleashable free variables] + dmd_ty = addLazyFVs body_ty lazy_fv + (!final_ty, id_dmds) = findBndrsDmds env' dmd_ty (map fst pairs1) + pairs2 = zipWith do_one pairs1 id_dmds + do_one (id', rhs') dmd = (setBindIdDemandInfo top_lvl id' dmd, rhs') + -- If the actual demand is better than the vanilla call + -- demand, you might think that we might do better to re-analyse + -- the RHS with the stronger demand. + -- But (a) That seldom happens, because it means that *every* path in + -- the body of the let has to use that stronger demand + -- (b) It often happens temporarily in when fixpointing, because + -- the recursive function at first seems to place a massive demand. + -- But we don't want to go to extra work when the function will + -- probably iterate to something less demanding. + -- In practice, all the times the actual demand on id2 is more than + -- the vanilla call demand seem to be due to (b). So we don't + -- bother to re-analyse the RHS. +{- Note [Ensure demand is strict] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ It's important not to analyse e with a lazy demand because @@ -194,7 +365,7 @@ dmdAnal' env dmd (App fun arg) -- Crucially, coercions /are/ handled here, because they are -- value arguments (#10288) let - call_dmd = mkCallDmd dmd + call_dmd = mkCalledOnceDmd dmd (fun_ty, fun') = dmdAnal env call_dmd fun (arg_dmd, res_ty) = splitDmdTy fun_ty (arg_ty, arg') = dmdAnalStar env (dmdTransformThunkDmd arg arg_dmd) arg @@ -295,60 +466,11 @@ dmdAnal' env dmd (Case scrut case_bndr ty alts) -- , text "res_ty" <+> ppr res_ty ]) $ (res_ty, Case scrut' case_bndr' ty alts') --- Let bindings can be processed in two ways: --- Down (RHS before body) or Up (body before RHS). --- The following case handle the up variant. --- --- It is very simple. For let x = rhs in body --- * Demand-analyse 'body' in the current environment --- * Find the demand, 'rhs_dmd' placed on 'x' by 'body' --- * Demand-analyse 'rhs' in 'rhs_dmd' --- --- This is used for a non-recursive local let without manifest lambdas. --- This is the LetUp rule in the paper “Higher-Order Cardinality Analysis”. -dmdAnal' env dmd (Let (NonRec id rhs) body) - | useLetUp id - = (final_ty, Let (NonRec id' rhs') body') +dmdAnal' env dmd (Let bind body) + = (final_ty, Let bind' body') where - (body_ty, body') = dmdAnal env dmd body - (body_ty', id_dmd) = findBndrDmd env notArgOfDfun body_ty id - id' = setIdDemandInfo id id_dmd - - (rhs_ty, rhs') = dmdAnalStar env (dmdTransformThunkDmd rhs id_dmd) rhs - final_ty = body_ty' `plusDmdType` rhs_ty - -dmdAnal' env dmd (Let (NonRec id rhs) body) - = (body_ty2, Let (NonRec id2 rhs') body') - where - (lazy_fv, sig, rhs') = dmdAnalRhsLetDown Nothing env dmd id rhs - id1 = setIdStrictness id sig - env1 = extendAnalEnv NotTopLevel env id sig - (body_ty, body') = dmdAnal env1 dmd body - (body_ty1, id2) = annotateBndr env body_ty id1 - body_ty2 = addLazyFVs body_ty1 lazy_fv -- see Note [Lazy and unleashable free variables] - - -- If the actual demand is better than the vanilla call - -- demand, you might think that we might do better to re-analyse - -- the RHS with the stronger demand. - -- But (a) That seldom happens, because it means that *every* path in - -- the body of the let has to use that stronger demand - -- (b) It often happens temporarily in when fixpointing, because - -- the recursive function at first seems to place a massive demand. - -- But we don't want to go to extra work when the function will - -- probably iterate to something less demanding. - -- In practice, all the times the actual demand on id2 is more than - -- the vanilla call demand seem to be due to (b). So we don't - -- bother to re-analyse the RHS. - -dmdAnal' env dmd (Let (Rec pairs) body) - = let - (env', lazy_fv, pairs') = dmdFix NotTopLevel env dmd pairs - (body_ty, body') = dmdAnal env' dmd body - body_ty1 = deleteFVs body_ty (map fst pairs) - body_ty2 = addLazyFVs body_ty1 lazy_fv -- see Note [Lazy and unleashable free variables] - in - body_ty2 `seq` - (body_ty2, Let (Rec pairs') body') + (final_ty, bind', body') = dmdAnalBind NotTopLevel env dmd bind go' + go' env' = dmdAnal env' dmd body -- | A simple, syntactic analysis of whether an expression MAY throw a precise -- exception when evaluated. It's always sound to return 'True'. @@ -582,9 +704,13 @@ dmdTransform env var dmd | Just (sig, top_lvl) <- lookupSigEnv env var , let fn_ty = dmdTransformSig sig dmd = -- pprTrace "dmdTransform:LetDown" (vcat [ppr var, ppr sig, ppr dmd, ppr fn_ty]) $ - if isTopLevel top_lvl - then fn_ty -- Don't record demand on top-level things - else addVarDmd fn_ty var (C_11 :* dmd) + case top_lvl of + NotTopLevel -> addVarDmd fn_ty var (C_11 :* dmd) + TopLevel + | isInterestingTopLevelFn var + -> addVarDmd fn_ty var (C_0N `multDmd` (C_11 :* dmd)) -- discard strictness + | otherwise + -> fn_ty -- don't bother tracking; just annotate with 'topDmd' later -- Everything else: -- * Local let binders for which we use LetUp (cf. 'useLetUp') -- * Lambda binders @@ -599,46 +725,46 @@ dmdTransform env var dmd * * ********************************************************************* -} --- Let bindings can be processed in two ways: --- Down (RHS before body) or Up (body before RHS). --- dmdAnalRhsLetDown implements the Down variant: --- * assuming a demand of +-- | @dmdAnalRhsSig@ analyses the given RHS to compute a demand signature +-- for the LetDown rule. It works as follows: +-- +-- * assuming a demand of -- * looking at the definition -- * determining a strictness signature -- --- It is used for toplevel definition, recursive definitions and local --- non-recursive definitions that have manifest lambdas. --- Local non-recursive definitions without a lambda are handled with LetUp. --- --- This is the LetDown rule in the paper “Higher-Order Cardinality Analysis”. -dmdAnalRhsLetDown - :: Maybe [Id] -- Just bs <=> recursive, Nothing <=> non-recursive +-- Since it assumed a demand of , the resulting signature is applicable at +-- any call site. +dmdAnalRhsSig + :: TopLevelFlag + -> RecFlag -> AnalEnv -> SubDemand -> Id -> CoreExpr - -> (DmdEnv, StrictSig, CoreExpr) + -> (AnalEnv, DmdEnv, Id, CoreExpr) -- Process the RHS of the binding, add the strictness signature -- to the Id, and augment the environment with the signature as well. -- See Note [NOINLINE and strictness] -dmdAnalRhsLetDown rec_flag env let_dmd id rhs - = -- pprTrace "dmdAnalRhsLetDown" (ppr id $$ ppr let_dmd $$ ppr sig $$ ppr lazy_fv) $ - (lazy_fv, sig, rhs') +dmdAnalRhsSig top_lvl rec_flag env let_dmd id rhs + = -- pprTrace "dmdAnalRhsSig" (ppr id $$ ppr let_dmd $$ ppr sig $$ ppr lazy_fv) $ + (env', lazy_fv, id', rhs') where rhs_arity = idArity id + -- See Note [Demand signatures are computed for a threshold demand based on idArity] rhs_dmd -- See Note [Demand analysis for join points] -- See Note [Invariants on join points] invariant 2b, in GHC.Core -- rhs_arity matches the join arity of the join point | isJoinId id - = mkCallDmds rhs_arity let_dmd + = mkCalledOnceDmds rhs_arity let_dmd | otherwise - -- NB: rhs_arity - -- See Note [Demand signatures are computed for a threshold demand based on idArity] - = mkRhsDmd env rhs_arity rhs + = mkCalledOnceDmds rhs_arity topSubDmd (rhs_dmd_ty, rhs') = dmdAnal env rhs_dmd rhs DmdType rhs_fv rhs_dmds rhs_div = rhs_dmd_ty sig = mkStrictSigForArity rhs_arity (DmdType sig_fv rhs_dmds rhs_div) + id' = id `setIdStrictness` sig + env' = extendAnalEnv top_lvl env id' sig + -- See Note [Aggregated demand for cardinality] -- FIXME: That Note doesn't explain the following lines at all. The reason -- is really much different: When we have a recursive function, we'd @@ -651,8 +777,8 @@ dmdAnalRhsLetDown rec_flag env let_dmd id rhs -- we'd have to do an additional iteration. reuseEnv makes sure that -- we never get used-once info for FVs of recursive functions. rhs_fv1 = case rec_flag of - Just bs -> reuseEnv (delVarEnvList rhs_fv bs) - Nothing -> rhs_fv + Recursive -> reuseEnv rhs_fv + NonRecursive -> rhs_fv rhs_fv2 = rhs_fv1 `keepAliveDmdEnv` extra_fvs -- Find the RHS free vars of the unfoldings and RULES @@ -669,13 +795,6 @@ dmdAnalRhsLetDown rec_flag env let_dmd id rhs = exprFreeIds unf_body | otherwise = emptyVarSet --- | @mkRhsDmd env rhs_arity rhs@ creates a 'SubDemand' for --- unleashing on the given function's @rhs@, by creating --- a call demand of @rhs_arity@ --- See Historical Note [Product demands for function body] -mkRhsDmd :: AnalEnv -> Arity -> CoreExpr -> SubDemand -mkRhsDmd _env rhs_arity _rhs = mkCallDmds rhs_arity topSubDmd - -- | If given the (local, non-recursive) let-bound 'Id', 'useLetUp' determines -- whether we should process the binding up (body before rhs) or down (rhs -- before body). @@ -720,8 +839,8 @@ mkRhsDmd _env rhs_arity _rhs = mkCallDmds rhs_arity topSubDmd -- * For a more convincing example with join points, see Note [Demand analysis -- for join points]. -- -useLetUp :: Var -> Bool -useLetUp f = idArity f == 0 && not (isJoinId f) +useLetUp :: TopLevelFlag -> Var -> Bool +useLetUp top_lvl f = isNotTopLevel top_lvl && idArity f == 0 && not (isJoinId f) {- Note [Demand analysis for join points] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -939,8 +1058,6 @@ dmdFix :: TopLevelFlag dmdFix top_lvl env let_dmd orig_pairs = loop 1 initial_pairs where - bndrs = map fst orig_pairs - -- See Note [Initialising strictness] initial_pairs | ae_virgin env = [(setIdStrictness id botSig, rhs) | (id, rhs) <- orig_pairs ] | otherwise = orig_pairs @@ -990,10 +1107,8 @@ dmdFix top_lvl env let_dmd orig_pairs = -- pprTrace "my_downRhs" (ppr id $$ ppr (idStrictness id) $$ ppr sig) $ ((env', lazy_fv'), (id', rhs')) where - (lazy_fv1, sig, rhs') = dmdAnalRhsLetDown (Just bndrs) env let_dmd id rhs - lazy_fv' = plusVarEnv_C plusDmd lazy_fv lazy_fv1 - env' = extendAnalEnv top_lvl env id sig - id' = setIdStrictness id sig + (env', lazy_fv1, id', rhs') = dmdAnalRhsSig top_lvl Recursive env let_dmd id rhs + lazy_fv' = plusVarEnv_C plusDmd lazy_fv lazy_fv1 zapIdStrictness :: [(Id, CoreExpr)] -> [(Id, CoreExpr)] zapIdStrictness pairs = [(setIdStrictness id nopSig, rhs) | (id, rhs) <- pairs ] @@ -1090,7 +1205,7 @@ addLazyFVs dmd_ty lazy_fvs -- demand with the bottom coming up from 'error' -- -- I got a loop in the fixpointer without this, due to an interaction - -- with the lazy_fv filtering in dmdAnalRhsLetDown. Roughly, it was + -- with the lazy_fv filtering in dmdAnalRhsSig. Roughly, it was -- letrec f n x -- = letrec g y = x `fatbar` -- letrec h z = z + ...g... @@ -1156,10 +1271,6 @@ annotateLamIdBndr env arg_of_dfun dmd_ty id main_ty = addDemand dmd dmd_ty' (dmd_ty', dmd) = findBndrDmd env arg_of_dfun dmd_ty id -deleteFVs :: DmdType -> [Var] -> DmdType -deleteFVs (DmdType fvs dmds res) bndrs - = DmdType (delVarEnvList fvs bndrs) dmds res - {- Note [NOINLINE and strictness] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Core/Opt/Pipeline.hs ===================================== @@ -65,6 +65,7 @@ import GHC.Types.SrcLoc import GHC.Types.Id import GHC.Types.Id.Info import GHC.Types.Basic +import GHC.Types.Demand ( zapDmdEnvSig ) import GHC.Types.Var.Set import GHC.Types.Var.Env import GHC.Types.Unique.Supply ( UniqSupply, mkSplitUniqSupply, splitUniqSupply ) @@ -495,7 +496,7 @@ doCorePass CoreDoExitify = {-# SCC "Exitify" #-} doPass exitifyProgram doCorePass CoreDoDemand = {-# SCC "DmdAnal" #-} - doPassDFM dmdAnal + doPassDFRM dmdAnal doCorePass CoreDoCpr = {-# SCC "CprAnal" #-} doPassDFM cprAnalProgram @@ -575,6 +576,13 @@ doPassDFM do_pass guts = do let fam_envs = (p_fam_env, mg_fam_inst_env guts) doPassM (liftIO . do_pass dflags fam_envs) guts +doPassDFRM :: (DynFlags -> FamInstEnvs -> [CoreRule] -> CoreProgram -> IO CoreProgram) -> ModGuts -> CoreM ModGuts +doPassDFRM do_pass guts = do + dflags <- getDynFlags + p_fam_env <- getPackageFamInstEnv + let fam_envs = (p_fam_env, mg_fam_inst_env guts) + doPassM (liftIO . do_pass dflags fam_envs (mg_rules guts)) guts + doPassDFU :: (DynFlags -> FamInstEnvs -> UniqSupply -> CoreProgram -> CoreProgram) -> ModGuts -> CoreM ModGuts doPassDFU do_pass guts = do dflags <- getDynFlags @@ -1088,13 +1096,13 @@ transferIdInfo exported_id local_id -dmdAnal :: DynFlags -> FamInstEnvs -> CoreProgram -> IO CoreProgram -dmdAnal dflags fam_envs binds = do +dmdAnal :: DynFlags -> FamInstEnvs -> [CoreRule] -> CoreProgram -> IO CoreProgram +dmdAnal dflags fam_envs rules binds = do let opts = DmdAnalOpts { dmd_strict_dicts = gopt Opt_DictsStrict dflags } - binds_plus_dmds = dmdAnalProgram opts fam_envs binds + binds_plus_dmds = dmdAnalProgram opts fam_envs rules binds Err.dumpIfSet_dyn dflags Opt_D_dump_str_signatures "Strictness signatures" FormatText $ - dumpIdInfoOfProgram (ppr . strictnessInfo) binds_plus_dmds + dumpIdInfoOfProgram (ppr . zapDmdEnvSig . strictnessInfo) binds_plus_dmds -- See Note [Stamp out space leaks in demand analysis] in GHC.Core.Opt.DmdAnal seqBinds binds_plus_dmds `seq` return binds_plus_dmds ===================================== compiler/GHC/Core/Opt/WorkWrap/Utils.hs ===================================== @@ -1275,10 +1275,14 @@ mk_absent_let dflags fam_envs arg abs_rhs = mkAbsentErrorApp arg_ty msg msg = showSDoc (gopt_set dflags Opt_SuppressUniques) - (ppr arg <+> ppr (idType arg) <+> file_msg) + (vcat + [ text "Arg:" <+> ppr arg + , text "Type:" <+> ppr arg_ty + , file_msg + ]) file_msg = case outputFile dflags of Nothing -> empty - Just f -> text "in output file " <+> quotes (text f) + Just f -> text "In output file " <+> quotes (text f) -- We need to suppress uniques here because otherwise they'd -- end up in the generated code as strings. This is bad for -- determinism, because with different uniques the strings ===================================== compiler/GHC/Core/Tidy.hs ===================================== @@ -21,7 +21,7 @@ import GHC.Core import GHC.Core.Seq ( seqUnfolding ) import GHC.Types.Id import GHC.Types.Id.Info -import GHC.Types.Demand ( zapUsageEnvSig ) +import GHC.Types.Demand ( zapDmdEnvSig ) import GHC.Core.Type ( tidyType, tidyVarBndr ) import GHC.Core.Coercion ( tidyCo ) import GHC.Types.Var @@ -206,7 +206,7 @@ tidyLetBndr rec_tidy_env env@(tidy_env, var_env) id new_info = vanillaIdInfo `setOccInfo` occInfo old_info `setArityInfo` arityInfo old_info - `setStrictnessInfo` zapUsageEnvSig (strictnessInfo old_info) + `setStrictnessInfo` zapDmdEnvSig (strictnessInfo old_info) `setDemandInfo` demandInfo old_info `setInlinePragInfo` inlinePragInfo old_info `setUnfoldingInfo` new_unf ===================================== compiler/GHC/Types/Demand.hs ===================================== @@ -34,7 +34,7 @@ module GHC.Types.Demand ( lazyApply1Dmd, lazyApply2Dmd, strictOnceApply1Dmd, strictManyApply1Dmd, -- ** Other @Demand@ operations oneifyCard, oneifyDmd, strictifyDmd, strictifyDictDmd, mkWorkerDemand, - peelCallDmd, peelManyCalls, mkCallDmd, mkCallDmds, + peelCallDmd, peelManyCalls, mkCalledOnceDmd, mkCalledOnceDmds, addCaseBndrDmd, -- ** Extracting one-shot information argOneShots, argsOneShots, saturatedByOneShots, @@ -73,7 +73,7 @@ module GHC.Types.Demand ( seqDemand, seqDemandList, seqDmdType, seqStrictSig, -- * Zapping usage information - zapUsageDemand, zapUsageEnvSig, zapUsedOnceDemand, zapUsedOnceSig + zapUsageDemand, zapDmdEnvSig, zapUsedOnceDemand, zapUsedOnceSig ) where #include "HsVersions.h" @@ -278,7 +278,8 @@ data SubDemand -- ^ @Call n sd@ describes the evaluation context of @n@ function -- applications, where every individual result is evaluated according to @sd at . -- @sd@ is /relative/ to a single call, cf. Note [Call demands are relative]. - -- Used only for values of function type. + -- Used only for values of function type. Use the smart constructor 'mkCall' + -- whenever possible! | Prod ![Demand] -- ^ @Prod ds@ describes the evaluation context of a case scrutinisation -- on an expression of product type, where the product components are @@ -306,7 +307,7 @@ polyDmd C_1N = C_1N :* poly1N polyDmd C_10 = C_10 :* poly10 -- | A smart constructor for 'Prod', applying rewrite rules along the semantic --- equalities @Prod [polyDmd n, ...] === polyDmd n@, simplifying to 'Poly' +-- equality @Prod [polyDmd n, ...] === polyDmd n@, simplifying to 'Poly' -- 'SubDemand's when possible. Note that this degrades boxity information! E.g. a -- polymorphic demand will never unbox. mkProd :: [Demand] -> SubDemand @@ -335,6 +336,13 @@ viewProd _ _ = Nothing {-# INLINE viewProd #-} -- we want to fuse away the replicate and the allocation -- for Arity. Otherwise, #18304 bites us. +-- | A smart constructor for 'Call', applying rewrite rules along the semantic +-- equality @Call n (Poly n) === Poly n@, simplifying to 'Poly' 'SubDemand's +-- when possible. +mkCall :: Card -> SubDemand -> SubDemand +mkCall n cd@(Poly m) | n == m = cd +mkCall n cd = Call n cd + -- | @viewCall sd@ interprets @sd@ as a 'Call', expanding 'Poly' demands as -- necessary. viewCall :: SubDemand -> Maybe (Card, SubDemand) @@ -356,8 +364,8 @@ lubSubDmd (Prod ds1) (viewProd (length ds1) -> Just ds2) = -- Handle Call lubSubDmd (Call n1 d1) (viewCall -> Just (n2, d2)) -- See Note [Call demands are relative] - | isAbs n2 = Call (lubCard n1 n2) (lubSubDmd d1 botSubDmd) - | otherwise = Call (lubCard n1 n2) (lubSubDmd d1 d2) + | isAbs n2 = mkCall (lubCard n1 n2) (lubSubDmd d1 botSubDmd) + | otherwise = mkCall (lubCard n1 n2) (lubSubDmd d1 d2) -- Handle Poly lubSubDmd (Poly n1) (Poly n2) = Poly (lubCard n1 n2) -- Make use of reflexivity (so we'll match the Prod or Call cases again). @@ -377,8 +385,8 @@ plusSubDmd (Prod ds1) (viewProd (length ds1) -> Just ds2) = -- Handle Call plusSubDmd (Call n1 d1) (viewCall -> Just (n2, d2)) -- See Note [Call demands are relative] - | isAbs n2 = Call (plusCard n1 n2) (lubSubDmd d1 botSubDmd) - | otherwise = Call (plusCard n1 n2) (lubSubDmd d1 d2) + | isAbs n2 = mkCall (plusCard n1 n2) (lubSubDmd d1 botSubDmd) + | otherwise = mkCall (plusCard n1 n2) (lubSubDmd d1 d2) -- Handle Poly plusSubDmd (Poly n1) (Poly n2) = Poly (plusCard n1 n2) -- Make use of reflexivity (so we'll match the Prod or Call cases again). @@ -407,7 +415,7 @@ multSubDmd :: Card -> SubDemand -> SubDemand multSubDmd n sd | Just sd' <- multTrivial n seqSubDmd sd = sd' multSubDmd n (Poly n') = Poly (multCard n n') -multSubDmd n (Call n' sd) = Call (multCard n n') sd -- See Note [Call demands are relative] +multSubDmd n (Call n' sd) = mkCall (multCard n n') sd -- See Note [Call demands are relative] multSubDmd n (Prod ds) = Prod (map (multDmd n) ds) multDmd :: Card -> Demand -> Demand @@ -457,22 +465,22 @@ evalDmd = C_1N :* topSubDmd -- | First argument of 'GHC.Exts.maskAsyncExceptions#': @SCS(U)@. -- Called exactly once. strictOnceApply1Dmd :: Demand -strictOnceApply1Dmd = C_11 :* Call C_11 topSubDmd +strictOnceApply1Dmd = C_11 :* mkCall C_11 topSubDmd -- | First argument of 'GHC.Exts.atomically#': @MCM(U)@. -- Called at least once, possibly many times. strictManyApply1Dmd :: Demand -strictManyApply1Dmd = C_1N :* Call C_1N topSubDmd +strictManyApply1Dmd = C_1N :* mkCall C_1N topSubDmd -- | First argument of catch#: @1C1(U)@. -- Evaluates its arg lazily, but then applies it exactly once to one argument. lazyApply1Dmd :: Demand -lazyApply1Dmd = C_01 :* Call C_01 topSubDmd +lazyApply1Dmd = C_01 :* mkCall C_01 topSubDmd -- | Second argument of catch#: @1C1(CS(U))@. -- Calls its arg lazily, but then applies it exactly once to an additional argument. lazyApply2Dmd :: Demand -lazyApply2Dmd = C_01 :* Call C_01 (Call C_11 topSubDmd) +lazyApply2Dmd = C_01 :* mkCall C_01 (mkCall C_11 topSubDmd) -- | Make a 'Demand' evaluated at-most-once. oneifyDmd :: Demand -> Demand @@ -512,12 +520,12 @@ strictifyDictDmd ty (n :* Prod ds) strictifyDictDmd _ dmd = dmd -- | Wraps the 'SubDemand' with a one-shot call demand: @d@ -> @CS(d)@. -mkCallDmd :: SubDemand -> SubDemand -mkCallDmd sd = Call C_11 sd +mkCalledOnceDmd :: SubDemand -> SubDemand +mkCalledOnceDmd sd = mkCall C_11 sd --- | @mkCallDmds n d@ returns @CS(CS...(CS d))@ where there are @n@ @CS@'s. -mkCallDmds :: Arity -> SubDemand -> SubDemand -mkCallDmds arity sd = iterate mkCallDmd sd !! arity +-- | @mkCalledOnceDmds n d@ returns @CS(CS...(CS d))@ where there are @n@ @CS@'s. +mkCalledOnceDmds :: Arity -> SubDemand -> SubDemand +mkCalledOnceDmds arity sd = iterate mkCalledOnceDmd sd !! arity -- | Peels one call level from the sub-demand, and also returns how many -- times we entered the lambda body. @@ -669,7 +677,7 @@ This is needed even for non-product types, in case the case-binder is used but the components of the case alternative are not. Note [Don't optimise UP(U,U,...) to U] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ These two SubDemands: UP(U,U) (@Prod [topDmd, topDmd]@) and U (@topSubDmd@) are semantically equivalent, but we do not turn the former into @@ -1571,9 +1579,9 @@ This is weird, so I'm not worried about whether this optimises brilliantly; but it should not fall over. -} -zapUsageEnvSig :: StrictSig -> StrictSig --- Remove the usage environment from the demand -zapUsageEnvSig (StrictSig (DmdType _ ds r)) = mkClosedStrictSig ds r +-- | Remove the demand environment from the signature. +zapDmdEnvSig :: StrictSig -> StrictSig +zapDmdEnvSig (StrictSig (DmdType _ ds r)) = mkClosedStrictSig ds r zapUsageDemand :: Demand -> Demand -- Remove the usage info, but not the strictness info, from the demand @@ -1615,8 +1623,8 @@ kill_usage kfs (n :* sd) = kill_usage_card kfs n :* kill_usage_sd kfs sd kill_usage_sd :: KillFlags -> SubDemand -> SubDemand kill_usage_sd kfs (Call n sd) - | kf_called_once kfs = Call (lubCard C_1N n) (kill_usage_sd kfs sd) - | otherwise = Call n (kill_usage_sd kfs sd) + | kf_called_once kfs = mkCall (lubCard C_1N n) (kill_usage_sd kfs sd) + | otherwise = mkCall n (kill_usage_sd kfs sd) kill_usage_sd kfs (Prod ds) = Prod (map (kill_usage kfs) ds) kill_usage_sd _ sd = sd @@ -1640,7 +1648,7 @@ trimToType (n :* sd) ts where go (Prod ds) (TsProd tss) | equalLength ds tss = Prod (zipWith trimToType ds tss) - go (Call n sd) (TsFun ts) = Call n (go sd ts) + go (Call n sd) (TsFun ts) = mkCall n (go sd ts) go sd at Poly{} _ = sd go _ _ = topSubDmd @@ -1804,7 +1812,7 @@ instance Binary SubDemand where h <- getByte bh case h of 0 -> Poly <$> get bh - 1 -> Call <$> get bh <*> get bh + 1 -> mkCall <$> get bh <*> get bh 2 -> Prod <$> get bh _ -> pprPanic "Binary:SubDemand" (ppr (fromIntegral h :: Int)) ===================================== compiler/GHC/Types/Id/Info.hs ===================================== @@ -650,7 +650,7 @@ zapUsageInfo info = Just (info {demandInfo = zapUsageDemand (demandInfo info)}) zapUsageEnvInfo :: IdInfo -> Maybe IdInfo zapUsageEnvInfo info | hasDemandEnvSig (strictnessInfo info) - = Just (info {strictnessInfo = zapUsageEnvSig (strictnessInfo info)}) + = Just (info {strictnessInfo = zapDmdEnvSig (strictnessInfo info)}) | otherwise = Nothing ===================================== testsuite/tests/arityanal/should_compile/Arity11.stderr ===================================== @@ -35,7 +35,7 @@ end Rec } -- RHS size: {terms: 52, types: 28, coercions: 0, joins: 0/5} F11.$wfib [InlPrag=[2]] :: forall {a} {p}. (a -> a -> Bool) -> (Num a, Num p) => a -> p -[GblId, Arity=4, Str=, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 150 60 0] 460 0}] +[GblId, Arity=4, Str=, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 150 60 0] 460 0}] F11.$wfib = \ (@a) (@p) (ww :: a -> a -> Bool) (w :: Num a) (w1 :: Num p) (w2 :: a) -> let { @@ -73,7 +73,7 @@ F11.$wfib fib [InlPrag=[2]] :: forall {a} {p}. (Eq a, Num a, Num p) => a -> p [GblId, Arity=4, - Str=, + Str=, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=4,unsat_ok=True,boring_ok=False) Tmpl= \ (@a) (@p) (w [Occ=Once1!] :: Eq a) (w1 [Occ=Once1] :: Num a) (w2 [Occ=Once1] :: Num p) (w3 [Occ=Once1] :: a) -> case w of { GHC.Classes.C:Eq ww1 [Occ=Once1] _ [Occ=Dead] -> F11.$wfib @a @p ww1 w1 w2 w3 }}] fib = \ (@a) (@p) (w :: Eq a) (w1 :: Num a) (w2 :: Num p) (w3 :: a) -> case w of { GHC.Classes.C:Eq ww1 ww2 -> F11.$wfib @a @p ww1 w1 w2 w3 } ===================================== testsuite/tests/arityanal/should_compile/Arity16.stderr ===================================== @@ -5,7 +5,7 @@ Result size of Tidy Core = {terms: 52, types: 87, coercions: 0, joins: 0/0} Rec { -- RHS size: {terms: 15, types: 17, coercions: 0, joins: 0/0} map2 [Occ=LoopBreaker] :: forall {t} {a}. (t -> a) -> [t] -> [a] -[GblId, Arity=2, Str=, Unf=OtherCon []] +[GblId, Arity=2, Str=, Unf=OtherCon []] map2 = \ (@t) (@a) (f :: t -> a) (ds :: [t]) -> case ds of { ===================================== testsuite/tests/stranal/should_compile/T18894.hs ===================================== @@ -0,0 +1,28 @@ +{-# OPTIONS_GHC -O2 -fforce-recomp #-} + +-- | The point of this test is that @g*@ get's a demand that says +-- "whenever @g*@ is called, the second component of the pair is evaluated strictly". +module T18894 (h1, h2) where + +g1 :: Int -> (Int,Int) +g1 1 = (15, 0) +g1 n = (2 * n, 2 `div` n) +{-# NOINLINE g1 #-} + +h1 :: Int -> Int +h1 1 = 0 +-- Sadly, the @g1 2@ subexpression will be floated to top-level, where we +-- don't see the specific demand placed on it by @snd at . Tracked in #19001. +h1 2 = snd (g1 2) +h1 m = uncurry (+) (g1 m) + +g2 :: Int -> Int -> (Int,Int) +g2 m 1 = (m, 0) +g2 m n = (2 * m, 2 `div` n) +{-# NOINLINE g2 #-} + +h2 :: Int -> Int +h2 1 = 0 +h2 m + | odd m = snd (g2 m 2) + | otherwise = uncurry (+) (g2 2 m) ===================================== testsuite/tests/stranal/should_compile/T18894.stderr ===================================== @@ -0,0 +1,404 @@ + +==================== Demand analysis ==================== +Result size of Demand analysis + = {terms: 177, types: 97, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 36, types: 16, coercions: 0, joins: 0/0} +g2 [InlPrag=NOINLINE, Dmd=UCU(CS(P(1P(U),SP(U))))] + :: Int -> Int -> (Int, Int) +[LclId, + Arity=2, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20 20] 161 20}] +g2 + = \ (m [Dmd=UP(U)] :: Int) (ds [Dmd=SP(SU)] :: Int) -> + case ds of { GHC.Types.I# ds [Dmd=SU] -> + case ds of ds [Dmd=1U] { + __DEFAULT -> + (case m of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.*# 2# y) }, + case ds of wild { + __DEFAULT -> + case GHC.Classes.divInt# 2# wild of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> GHC.Types.I# -2#; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + }); + 1# -> (m, lvl) + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 36, types: 19, coercions: 0, joins: 0/0} +h2 :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 162 10}] +h2 + = \ (ds [Dmd=SP(MU)] :: Int) -> + case ds of wild [Dmd=UP(U)] { GHC.Types.I# ds [Dmd=MU] -> + case ds of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> + case g2 wild lvl of { (ds1 [Dmd=A], y [Dmd=SU]) -> y }; + 0# -> + case g2 lvl wild of { (x [Dmd=SP(U)], ds [Dmd=SP(U)]) -> + case x of { GHC.Types.I# x -> + case ds of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + } + }; + 1# -> lvl + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 15# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +lvl :: (Int, Int) +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = (lvl, lvl) + +-- RHS size: {terms: 30, types: 11, coercions: 0, joins: 0/0} +g1 [InlPrag=NOINLINE, Dmd=UCU(P(UP(U),UP(U)))] :: Int -> (Int, Int) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 141 10}] +g1 + = \ (ds [Dmd=SP(SU)] :: Int) -> + case ds of { GHC.Types.I# ds [Dmd=SU] -> + case ds of ds { + __DEFAULT -> + (GHC.Types.I# (GHC.Prim.*# 2# ds), + case ds of wild { + __DEFAULT -> + case GHC.Classes.divInt# 2# wild of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> GHC.Types.I# -2#; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + }); + 1# -> lvl + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +lvl :: (Int, Int) +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=False, ConLike=False, + WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 30 0}] +lvl = g1 (GHC.Types.I# 2#) + +-- RHS size: {terms: 28, types: 18, coercions: 0, joins: 0/0} +h1 :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 111 10}] +h1 + = \ (ds [Dmd=SP(MU)] :: Int) -> + case ds of wild [Dmd=1P(1U)] { GHC.Types.I# ds [Dmd=MU] -> + case ds of { + __DEFAULT -> + case g1 wild of { (x [Dmd=SP(U)], ds [Dmd=SP(U)]) -> + case x of { GHC.Types.I# x -> + case ds of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + }; + 1# -> lvl; + 2# -> case lvl of { (ds1 [Dmd=A], y [Dmd=SU]) -> y } + } + } + + + + +==================== Demand analysis ==================== +Result size of Demand analysis + = {terms: 171, types: 120, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# -2# + +-- RHS size: {terms: 32, types: 18, coercions: 0, joins: 0/0} +$wg2 [InlPrag=NOINLINE, Dmd=UCU(CS(P(1P(U),SP(U))))] + :: Int -> GHC.Prim.Int# -> (# Int, Int #) +[LclId, + Arity=2, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20 30] 121 20}] +$wg2 + = \ (w [Dmd=UP(U)] :: Int) (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + (# case w of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.*# 2# y) }, + case ds of { + __DEFAULT -> + case GHC.Classes.divInt# 2# ds of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> lvl; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + } #); + 1# -> (# w, lvl #) + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 34, types: 21, coercions: 0, joins: 0/0} +$wh2 [InlPrag=[2]] :: GHC.Prim.Int# -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 162 10}] +$wh2 + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> + case $wg2 (GHC.Types.I# ds) 2# of + { (# ww [Dmd=A], ww [Dmd=SU] #) -> + ww + }; + 0# -> + case $wg2 lvl ds of { (# ww [Dmd=SP(U)], ww [Dmd=SP(U)] #) -> + case ww of { GHC.Types.I# x -> + case ww of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + } + }; + 1# -> lvl + } + +-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} +h2 [InlPrag=[2]] :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (w [Occ=Once1!] :: Int) -> + case w of { GHC.Types.I# ww [Occ=Once1, Dmd=MU] -> $wh2 ww }}] +h2 + = \ (w [Dmd=SP(SU)] :: Int) -> + case w of { GHC.Types.I# ww [Dmd=SU] -> $wh2 ww } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 15# + +-- RHS size: {terms: 28, types: 15, coercions: 0, joins: 0/0} +$wg1 [InlPrag=NOINLINE, Dmd=UCU(P(UP(U),UP(U)))] + :: GHC.Prim.Int# -> (# Int, Int #) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 111 20}] +$wg1 + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + (# GHC.Types.I# (GHC.Prim.*# 2# ds), + case ds of { + __DEFAULT -> + case GHC.Classes.divInt# 2# ds of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> lvl; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + } #); + 1# -> (# lvl, lvl #) + } + +-- RHS size: {terms: 7, types: 9, coercions: 0, joins: 0/0} +lvl :: (Int, Int) +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=False, ConLike=False, + WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 40 10}] +lvl = case $wg1 2# of { (# ww, ww #) -> (ww, ww) } + +-- RHS size: {terms: 25, types: 18, coercions: 0, joins: 0/0} +$wh1 [InlPrag=[2]] :: GHC.Prim.Int# -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [50] 101 10}] +$wh1 + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds [Dmd=1U] { + __DEFAULT -> + case $wg1 ds of { (# ww [Dmd=SP(U)], ww [Dmd=SP(U)] #) -> + case ww of { GHC.Types.I# x -> + case ww of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + }; + 1# -> lvl; + 2# -> case lvl of { (ds1 [Dmd=A], y [Dmd=SU]) -> y } + } + +-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} +h1 [InlPrag=[2]] :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (w [Occ=Once1!] :: Int) -> + case w of { GHC.Types.I# ww [Occ=Once1, Dmd=MU] -> $wh1 ww }}] +h1 + = \ (w [Dmd=SP(SU)] :: Int) -> + case w of { GHC.Types.I# ww [Dmd=SU] -> $wh1 ww } + + + ===================================== testsuite/tests/stranal/should_compile/T18894b.hs ===================================== @@ -0,0 +1,20 @@ +{-# OPTIONS_GHC -O -fno-call-arity -fforce-recomp #-} + +module T18894 (f) where + +expensive :: Int -> (Int, Int) +expensive n = (n+1, n+2) +{-# NOINLINE expensive #-} + +-- arity 1 by itself, but not exported, thus can be eta-expanded based on usage +eta :: Int -> Int -> Int +eta x = if fst (expensive x) == 13 + then \y -> x + y + else \y -> x * y +{-# NOINLINE eta #-} + +f :: Int -> Int +f 1 = 0 +f m + | odd m = eta m 2 + | otherwise = eta 2 m ===================================== testsuite/tests/stranal/should_compile/T18894b.stderr ===================================== @@ -0,0 +1,187 @@ + +==================== Demand analysis ==================== +Result size of Demand analysis = {terms: 83, types: 40, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 16, types: 7, coercions: 0, joins: 0/0} +expensive [InlPrag=NOINLINE, Dmd=UCU(P(SP(SU),A))] :: Int -> (Int, Int) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [40] 52 10}] +expensive + = \ (n [Dmd=UP(U)] :: Int) -> + (case n of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 1#) }, case n of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 2#) }) + +-- RHS size: {terms: 20, types: 11, coercions: 0, joins: 0/0} +eta [InlPrag=NOINLINE, Dmd=UCU(CS(U))] :: Int -> Int -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [0] 140 120}] +eta + = \ (x [Dmd=UP(U)] :: Int) -> + case expensive x of { (x [Dmd=SP(SU)], ds1 [Dmd=A]) -> + case x of { GHC.Types.I# x [Dmd=SU] -> + case x of { + __DEFAULT -> \ (y [Dmd=SP(U)] :: Int) -> GHC.Num.$fNumInt_$c* x y; + 13# -> \ (y [Dmd=SP(U)] :: Int) -> GHC.Num.$fNumInt_$c+ x y + } + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 21, types: 5, coercions: 0, joins: 0/0} +f :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 111 0}] +f = \ (ds [Dmd=SP(MU)] :: Int) -> + case ds of wild [Dmd=UP(U)] { GHC.Types.I# ds [Dmd=MU] -> + case ds of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> eta wild lvl; + 0# -> eta lvl wild + }; + 1# -> lvl + } + } + + + + +==================== Demand analysis ==================== +Result size of Demand analysis = {terms: 85, types: 47, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 16, types: 9, coercions: 0, joins: 0/0} +$wexpensive [InlPrag=NOINLINE, Dmd=UCU(P(SP(SU),A))] :: Int -> (# Int, Int #) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [40] 42 10}] +$wexpensive + = \ (w [Dmd=UP(U)] :: Int) -> + (# case w of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 1#) }, + case w of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 2#) } #) + +-- RHS size: {terms: 19, types: 12, coercions: 0, joins: 0/0} +eta [InlPrag=NOINLINE, Dmd=UCU(CS(U))] :: Int -> Int -> Int +[LclId, + Arity=2, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [0 0] 120 0}] +eta + = \ (x [Dmd=MP(U)] :: Int) (eta [Dmd=SP(U), OS=OneShot] :: Int) -> + case $wexpensive x of { (# ww [Dmd=SP(SU)], ww [Dmd=A] #) -> + case ww of { GHC.Types.I# x [Dmd=SU] -> + case x of { + __DEFAULT -> GHC.Num.$fNumInt_$c* x eta; + 13# -> GHC.Num.$fNumInt_$c+ x eta + } + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 20, types: 3, coercions: 0, joins: 0/0} +$wf [InlPrag=[2]] :: GHC.Prim.Int# -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 121 0}] +$wf + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> eta (GHC.Types.I# ds) lvl; + 0# -> eta lvl (GHC.Types.I# ds) + }; + 1# -> lvl + } + +-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} +f [InlPrag=[2]] :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (w [Occ=Once1!] :: Int) -> case w of { GHC.Types.I# ww [Occ=Once1, Dmd=MU] -> $wf ww }}] +f = \ (w [Dmd=SP(SU)] :: Int) -> case w of { GHC.Types.I# ww [Dmd=SU] -> $wf ww } + + + ===================================== testsuite/tests/stranal/should_compile/all.T ===================================== @@ -58,3 +58,7 @@ test('T18122', [ grep_errmsg(r'wfoo =') ], compile, ['-ddump-simpl']) # We care about the call demand on $wg test('T18903', [ grep_errmsg(r'Dmd=\S+C\S+') ], compile, ['-ddump-simpl -dsuppress-uniques']) +# We care about the call demand on $wg1 and $wg2 +test('T18894', [ grep_errmsg(r'Dmd=\S+C\S+') ], compile, ['-ddump-stranal -dsuppress-uniques']) +# We care about the Arity 2 on eta, as a result of the annotated Dmd +test('T18894b', [ grep_errmsg(r'Arity=2') ], compile, ['-ddump-stranal -dsuppress-uniques -fno-call-arity -dppr-cols=200']) ===================================== testsuite/tests/stranal/sigs/T5075.stderr ===================================== @@ -1,7 +1,7 @@ ==================== Strictness signatures ==================== T5075.$trModule: -T5075.loop: +T5075.loop: @@ -13,6 +13,6 @@ T5075.loop: ==================== Strictness signatures ==================== T5075.$trModule: -T5075.loop: +T5075.loop: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3aa7927431115f361f4e091dcb59e3f2a31898a6...262324935c4580be01f6d2fe8598447ecc2dc957 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3aa7927431115f361f4e091dcb59e3f2a31898a6...262324935c4580be01f6d2fe8598447ecc2dc957 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 3 15:36:07 2020 From: gitlab at gitlab.haskell.org (Danya Rogozin) Date: Thu, 03 Dec 2020 10:36:07 -0500 Subject: [Git][ghc/ghc][wip/ghc-11342-char-kind] 55 commits: rts: Flush eventlog buffers from flushEventLog Message-ID: <5fc905e7e1a5c_6a094e27a87924f@gitlab.mail> Danya Rogozin pushed to branch wip/ghc-11342-char-kind at Glasgow Haskell Compiler / GHC Commits: f88f4339 by Ben Gamari at 2020-11-24T02:43:20-05:00 rts: Flush eventlog buffers from flushEventLog As noted in #18043, flushTrace failed flush anything beyond the writer. This means that a significant amount of data sitting in capability-local event buffers may never get flushed, despite the users' pleads for us to flush. Fix this by making flushEventLog flush all of the event buffers before flushing the writer. Fixes #18043. - - - - - 7c03cc50 by Ben Gamari at 2020-11-24T02:43:55-05:00 gitlab-ci: Run LLVM job on appropriately-labelled MRs Namely, those marked with the ~"LLVM backend" label - - - - - 9b95d815 by Ben Gamari at 2020-11-24T02:43:55-05:00 gitlab-ci: Run LLVM builds on Debian 10 The current Debian 9 image doesn't provide LLVM 7. - - - - - 2ed3e6c0 by Ben Gamari at 2020-11-24T02:43:55-05:00 CmmToLlvm: Declare signature for memcmp Otherwise `opt` fails with: error: use of undefined value '@memcmp$def' - - - - - be5d74ca by Moritz Angermann at 2020-11-26T16:00:32-05:00 [Sized Cmm] properly retain sizes. This replaces all Word<N> = W<N># Word# and Int<N> = I<N># Int# with Word<N> = W<N># Word<N># and Int<N> = I<N># Int<N>#, thus providing us with properly sized primitives in the codegenerator instead of pretending they are all full machine words. This came up when implementing darwinpcs for arm64. The darwinpcs reqires us to pack function argugments in excess of registers on the stack. While most procedure call standards (pcs) assume arguments are just passed in 8 byte slots; and thus the caller does not know the exact signature to make the call, darwinpcs requires us to adhere to the prototype, and thus have the correct sizes. If we specify CInt in the FFI call, it should correspond to the C int, and not just be Word sized, when it's only half the size. This does change the expected output of T16402 but the new result is no less correct as it eliminates the narrowing (instead of the `and` as was previously done). Bumps the array, bytestring, text, and binary submodules. Co-Authored-By: Ben Gamari <ben at well-typed.com> Metric Increase: T13701 T14697 - - - - - a84e53f9 by Andreas Klebinger at 2020-11-26T16:00:32-05:00 RTS: Fix failed inlining of copy_tag. On windows using gcc-10 gcc failed to inline copy_tag into evacuate. To fix this we now set the always_inline attribute for the various copy* functions in Evac.c. The main motivation here is not the overhead of the function call, but rather that this allows the code to "specialize" for the size of the closure we copy which is often known at compile time. An earlier commit also tried to avoid evacuate_large inlining. But didn't quite succeed. So I also marked evacuate_large as noinline. Fixes #12416 - - - - - cdbd16f5 by Sylvain Henry at 2020-11-26T16:00:33-05:00 Fix toArgRep to support 64-bit reps on all systems [This is @Ericson2314 writing a commit message for @hsyl20's patch.] (Progress towards #11953, #17377, #17375) `Int64Rep` and `Word64Rep` are currently broken on 64-bit systems. This is because they should use "native arg rep" but instead use "large arg rep" as they do on 32-bit systems, which is either a non-concept or a 128-bit rep depending on one's vantage point. Now, these reps currently aren't used during 64-bit compilation, so the brokenness isn't observed, but I don't think that constitutes reasons not to fix it. Firstly, the linked issues there is a clearly expressed desire to use explicit-bitwidth constructs in more places. Secondly, per [1], there are other bugs that *do* manifest from not threading explicit-bitwidth information all the way through the compilation pipeline. One can therefore view this as one piece of the larger effort to do that, improve ergnomics, and squash remaining bugs. Also, this is needed for !3658. I could just merge this as part of that, but I'm keen on merging fixes "as they are ready" so the fixes that aren't ready are isolated and easier to debug. [1]: https://mail.haskell.org/pipermail/ghc-devs/2020-October/019332.html - - - - - a9378e69 by Tim Barnes at 2020-11-26T16:00:34-05:00 Set dynamic users-guide TOC spacing (fixes #18554) - - - - - 86a59d93 by Ben Gamari at 2020-11-26T16:00:34-05:00 rts: Use RTS_LIKELY in CHECK Most compilers probably already infer that `barf` diverges but it nevertheless doesn't hurt to be explicit. - - - - - 5757e82b by Matthew Pickering at 2020-11-26T16:00:35-05:00 Remove special case for GHC.ByteCode.Instr This was added in https://github.com/nomeata/ghc-heap-view/commit/34935206e51b9c86902481d84d2f368a6fd93423 GHC.ByteCode.Instr.BreakInfo no longer exists so the special case is dead code. Any check like this can be easily dealt with in client code. - - - - - d9c8b5b4 by Matthew Pickering at 2020-11-26T16:00:35-05:00 Split Up getClosureDataFromHeapRep Motivation 1. Don't enforce the repeated decoding of an info table, when the client can cache it (ghc-debug) 2. Allow the constructor information decoding to be overridden, this casues segfaults in ghc-debug - - - - - 3e3555cc by Andreas Klebinger at 2020-11-26T16:00:35-05:00 RegAlloc: Add missing raPlatformfield to RegAllocStatsSpill Fixes #18994 Co-Author: Benjamin Maurer <maurer.benjamin at gmail.com> - - - - - a1a75aa9 by Ben Gamari at 2020-11-27T06:20:41-05:00 rts: Allocate MBlocks with MAP_TOP_DOWN on Windows As noted in #18991, we would previously allocate heap in low memory. Due to this the linker, which typically *needs* low memory, would end up competing with the heap. In longer builds we end up running out of low memory entirely, leading to linking failures. - - - - - 75fc1ed5 by Sylvain Henry at 2020-11-28T15:40:23-05:00 Hadrian: fix detection of ghc-pkg for cross-compilers - - - - - 7cb5df96 by Sylvain Henry at 2020-11-28T15:40:23-05:00 hadrian: fix ghc-pkg uses (#17601) Make sure ghc-pkg doesn't read the compiler "settings" file by passing --no-user-package-db. - - - - - e3fd4226 by Ben Gamari at 2020-11-28T15:40:23-05:00 gitlab-ci: Introduce a nightly cross-compilation job This adds a job to test cross-compilation from x86-64 to AArch64 with Hadrian. Fixes #18234 - - - - - 698d3d96 by Ben Gamari at 2020-11-28T15:41:00-05:00 gitlab-ci: Only deploy GitLab Pages in ghc/ghc> The deployments are quite large and yet are currently only served for the ghc/ghc> project. - - - - - 625726f9 by David Eichmann at 2020-11-28T15:41:37-05:00 ghc-heap: partial TSO/STACK decoding Co-authored-by: Sven Tennie <sven.tennie at gmail.com> Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> Co-authored-by: Ben Gamari <bgamari.foss at gmail.com> - - - - - 22ea9c29 by Andreas Klebinger at 2020-11-28T15:42:13-05:00 Small optimization to CmmSink. Inside `regsUsedIn` we can avoid some thunks by specializing the recursion. In particular we avoid the thunk for `(f e z)` in the MachOp/Load branches, where we know this will evaluate to z. Reduces allocations for T3294 by ~1%. - - - - - bba42c62 by John Ericson at 2020-11-28T15:42:49-05:00 Make primop handler indentation more consistent - - - - - c82bc8e9 by John Ericson at 2020-11-28T15:42:49-05:00 Cleanup some primop constructor names Harmonize the internal (big sum type) names of the native vs fixed-sized number primops a bit. (Mainly by renaming the former.) No user-facing names are changed. - - - - - ae14f160 by Ben Gamari at 2020-11-28T15:43:25-05:00 testsuite: Mark T14702 as fragile on Windows Due to #18953. - - - - - 1bc104b0 by Ben Gamari at 2020-11-29T15:33:18-05:00 withTimings: Emit allocations counter This will allow us to back out the allocations per compiler pass from the eventlog. Note that we dump the allocation counter rather than the difference since this will allow us to determine how much work is done *between* `withTiming` blocks. - - - - - e992ea84 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 ThreadPaused: Don't zero slop until free vars are pushed When threadPaused blackholes a thunk it calls `OVERWRITING_CLOSURE` to zero the slop for the benefit of the sanity checker. Previously this was done *before* pushing the thunk's free variables to the update remembered set. Consequently we would pull zero'd pointers to the update remembered set. - - - - - e82cd140 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Fix regression from TSAN work The TSAN rework (specifically aad1f803) introduced a subtle regression in GC.c, swapping `g0` in place of `gen`. Whoops! Fixes #18997. - - - - - 35a5207e by GHC GitLab CI at 2020-11-29T15:33:54-05:00 rts/Messages: Add missing write barrier in THROWTO message update After a THROWTO message has been handle the message closure is overwritten by a NULL message. We must ensure that the original closure's pointers continue to be visible to the nonmoving GC. - - - - - 0120829f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Add missing write barrier in shrinkSmallByteArray - - - - - 8a4d8fb6 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 Updates: Don't zero slop until closure has been pushed Ensure that the the free variables have been pushed to the update remembered set before we zero the slop. - - - - - 2793cfdc by GHC GitLab CI at 2020-11-29T15:33:54-05:00 OSThreads: Fix error code checking pthread_join returns its error code and apparently doesn't set errno. - - - - - e391a16f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Don't join to mark_thread on shutdown The mark thread is not joinable as we detach from it on creation. - - - - - 60d088ab by Ben Gamari at 2020-11-29T15:33:54-05:00 nonmoving: Add reference to Ueno 2016 - - - - - 3aa60362 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Ensure that evacuated large objects are marked See Note [Non-moving GC: Marking evacuated objects]. - - - - - 8d304a99 by Ben Gamari at 2020-11-30T10:15:22-05:00 rts/m32: Refactor handling of allocator seeding Previously, in an attempt to reduce fragmentation, each new allocator would map a region of M32_MAX_PAGES fresh pages to seed itself. However, this ends up being extremely wasteful since it turns out that we often use fewer than this. Consequently, these pages end up getting freed which, ends up fragmenting our address space more than than we would have if we had naively allocated pages on-demand. Here we refactor m32 to avoid this waste while achieving the fragmentation mitigation previously desired. In particular, we move all page allocation into the global m32_alloc_page, which will pull a page from the free page pool. If the free page pool is empty we then refill it by allocating a region of M32_MAP_PAGES and adding them to the pool. Furthermore, we do away with the initial seeding entirely. That is, the allocator starts with no active pages: pages are rather allocated on an as-needed basis. On the whole this ends up being a pleasingly simple change, simultaneously making m32 more efficient, more robust, and simpler. Fixes #18980. - - - - - b6629289 by Ben Gamari at 2020-11-30T10:15:58-05:00 rts: Use CHECK instead of assert Use the GHC wrappers instead of <assert.h>. - - - - - 9f4efa6a by Ben Gamari at 2020-11-30T10:15:58-05:00 rts/linker: Replace some ASSERTs with CHECK In the past some people have confused ASSERT, which is for checking internal invariants, which CHECK, which should be used when checking things that might fail due to bad input (and therefore should be enabled even in the release compiler). Change some of these cases in the linker to use CHECK. - - - - - 0f8a4655 by Ryan Scott at 2020-11-30T10:16:34-05:00 Allow deploy:pages job to fail See #18973. - - - - - 49ebe369 by chessai at 2020-11-30T19:47:40-05:00 Optimisations in Data.Foldable (T17867) This PR concerns the following functions from `Data.Foldable`: * minimum * maximum * sum * product * minimumBy * maximumBy - Default implementations of these functions now use `foldl'` or `foldMap'`. - All have been marked with INLINEABLE to make room for further optimisations. - - - - - 4d79ef65 by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - 6af074ce by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - ab334262 by Viktor Dukhovni at 2020-11-30T19:48:17-05:00 dirty MVAR after mutating TSO queue head While the original head and tail of the TSO queue may be in the same generation as the MVAR, interior elements of the queue could be younger after a GC run and may then be exposed by putMVar operation that updates the queue head. Resolves #18919 - - - - - 5eb163f3 by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Don't allow shared libraries to be loaded multiple times - - - - - 490aa14d by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Initialise CCSs from native shared objects - - - - - 6ac3db5f by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Move shared library loading logic into Elf.c - - - - - b6698d73 by GHC GitLab CI at 2020-11-30T19:48:53-05:00 rts/linker: Don't declare dynamic objects with image_mapped This previously resulted in warnings due to spurious unmap failures. - - - - - b94a65af by jneira at 2020-11-30T19:49:31-05:00 Include tried paths in findToolDir error - - - - - 72a87fbc by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Move core flattening algorithm to Core.Unify This sets the stage for a later change, where this algorithm will be needed from GHC.Core.InstEnv. This commit also splits GHC.Core.Map into GHC.Core.Map.Type and GHC.Core.Map.Expr, in order to avoid module import cycles with GHC.Core. - - - - - 0dd45d0a by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Bump the # of commits searched for perf baseline The previous value of 75 meant that a feature branch with more than 75 commits would get spurious CI passes. This affects #18692, but does not fix that ticket, because if a baseline cannot be found, we should fail, not succeed. - - - - - 8bb52d91 by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Remove flattening variables This patch redesigns the flattener to simplify type family applications directly instead of using flattening meta-variables and skolems. The key new innovation is the CanEqLHS type and the new CEqCan constraint (Ct). A CanEqLHS is either a type variable or exactly-saturated type family application; either can now be rewritten using a CEqCan constraint in the inert set. Because the flattener no longer reduces all type family applications to variables, there was some performance degradation if a lengthy type family application is now flattened over and over (not making progress). To compensate, this patch contains some extra optimizations in the flattener, leading to a number of performance improvements. Close #18875. Close #18910. There are many extra parts of the compiler that had to be affected in writing this patch: * The family-application cache (formerly the flat-cache) sometimes stores coercions built from Given inerts. When these inerts get kicked out, we must kick out from the cache as well. (This was, I believe, true previously, but somehow never caused trouble.) Kicking out from the cache requires adding a filterTM function to TrieMap. * This patch obviates the need to distinguish "blocking" coercion holes from non-blocking ones (which, previously, arose from CFunEqCans). There is thus some simplification around coercion holes. * Extra commentary throughout parts of the code I read through, to preserve the knowledge I gained while working. * A change in the pure unifier around unifying skolems with other types. Unifying a skolem now leads to SurelyApart, not MaybeApart, as documented in Note [Binding when looking up instances] in GHC.Core.InstEnv. * Some more use of MCoercion where appropriate. * Previously, class-instance lookup automatically noticed that e.g. C Int was a "unifier" to a target [W] C (F Bool), because the F Bool was flattened to a variable. Now, a little more care must be taken around checking for unifying instances. * Previously, tcSplitTyConApp_maybe would split (Eq a => a). This is silly, because (=>) is not a tycon in Haskell. Fixed now, but there are some knock-on changes in e.g. TrieMap code and in the canonicaliser. * New function anyFreeVarsOf{Type,Co} to check whether a free variable satisfies a certain predicate. * Type synonyms now remember whether or not they are "forgetful"; a forgetful synonym drops at least one argument. This is useful when flattening; see flattenView. * The pattern-match completeness checker invokes the solver. This invocation might need to look through newtypes when checking representational equality. Thus, the desugarer needs to keep track of the in-scope variables to know what newtype constructors are in scope. I bet this bug was around before but never noticed. * Extra-constraints wildcards are no longer simplified before printing. See Note [Do not simplify ConstraintHoles] in GHC.Tc.Solver. * Whether or not there are Given equalities has become slightly subtler. See the new HasGivenEqs datatype. * Note [Type variable cycles in Givens] in GHC.Tc.Solver.Canonical explains a significant new wrinkle in the new approach. * See Note [What might match later?] in GHC.Tc.Solver.Interact, which explains the fix to #18910. * The inert_count field of InertCans wasn't actually used, so I removed it. Though I (Richard) did the implementation, Simon PJ was very involved in design and review. This updates the Haddock submodule to avoid #18932 by adding a type signature. ------------------------- Metric Decrease: T12227 T5030 T9872a T9872b T9872c Metric Increase: T9872d ------------------------- - - - - - d66660ba by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Rename the flattener to become the rewriter. Now that flattening doesn't produce flattening variables, it's not really flattening anything: it's rewriting. This change also means that the rewriter can no longer be confused the core flattener (in GHC.Core.Unify), which is sometimes used during type-checking. - - - - - add0aeae by Ben Gamari at 2020-12-01T19:58:17-05:00 rts: Introduce mmapAnonForLinker Previously most of the uses of mmapForLinker were mapping anonymous memory, resulting in a great deal of unnecessary repetition. Factor this out into a new helper. Also fixes a few places where error checking was missing or suboptimal. - - - - - 97d71646 by Ben Gamari at 2020-12-01T19:58:17-05:00 rts/linker: Introduce munmapForLinker Consolidates munmap calls to ensure consistent error handling. - - - - - d8872af0 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/Linker: Introduce Windows implementations for mmapForLinker, et al. - - - - - c35d0e03 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/m32: Introduce NEEDS_M32 macro Instead of relying on RTS_LINKER_USE_MMAP - - - - - 41c64eb5 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/linker: Use m32 to allocate symbol extras in PEi386 - - - - - 22aa94f2 by Daniel Rogozin at 2020-12-03T15:59:36+03:00 the char kind: type families, functionality, and submodule updates Co-authored-by: Rinat Stryungis <rinat.stryungis at serokell.io> Metric Decrease: T5205 Metric Increase: Naperian T13035 - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Types/Literals.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/Reg/Graph.hs - compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Axiom.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FamInstEnv.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/Lint.hs - + compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Map.hs → compiler/GHC/Core/Map/Type.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/86bba1e492614d24e0c587fd6392c41de3044180...22aa94f2dae9a5f11b1e3453899f995c7e83f845 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/86bba1e492614d24e0c587fd6392c41de3044180...22aa94f2dae9a5f11b1e3453899f995c7e83f845 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 3 15:42:13 2020 From: gitlab at gitlab.haskell.org (Danya Rogozin) Date: Thu, 03 Dec 2020 10:42:13 -0500 Subject: [Git][ghc/ghc][wip/ghc-11342-char-kind] the char kind: type families, functionality, and submodule updates Message-ID: <5fc90755bb6ae_6a094e23347999b@gitlab.mail> Danya Rogozin pushed to branch wip/ghc-11342-char-kind at Glasgow Haskell Compiler / GHC Commits: 182f6ab1 by Daniel Rogozin at 2020-12-03T18:41:48+03:00 the char kind: type families, functionality, and submodule updates Co-authored-by: Rinat Stryungis <rinat.stryungis at serokell.io> Metric Decrease: T5205 Metric Increase: Naperian T13035 - - - - - 30 changed files: - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Types/Literals.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/Type.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Data/FastString.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Parser.y - compiler/GHC/Rename/HsType.hs - compiler/GHC/StgToCmm/Closure.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Instance/Typeable.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/Binary/Typeable.hs - libraries/base/Data/Typeable/Internal.hs - libraries/base/GHC/TypeLits.hs - libraries/binary - libraries/bytestring The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/182f6ab14ed5f07af7ee3b37da32ee0522250c85 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/182f6ab14ed5f07af7ee3b37da32ee0522250c85 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 3 15:44:53 2020 From: gitlab at gitlab.haskell.org (Danya Rogozin) Date: Thu, 03 Dec 2020 10:44:53 -0500 Subject: [Git][ghc/ghc][wip/ghc-11342-char-kind] the char kind: type families, functionality, and submodule updates Message-ID: <5fc907f5840b0_6a095ff2d0806a8@gitlab.mail> Danya Rogozin pushed to branch wip/ghc-11342-char-kind at Glasgow Haskell Compiler / GHC Commits: 4ed50ac3 by Daniel Rogozin at 2020-12-03T18:44:29+03:00 the char kind: type families, functionality, and submodule updates Co-authored-by: Rinat Stryungis <rinat.stryungis at serokell.io> Metric Decrease: T5205 Metric Increase: Naperian T13035 - - - - - 30 changed files: - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Types/Literals.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/Type.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Data/FastString.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Parser.y - compiler/GHC/Rename/HsType.hs - compiler/GHC/StgToCmm/Closure.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Instance/Typeable.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/Binary/Typeable.hs - libraries/base/Data/Typeable/Internal.hs - libraries/base/GHC/TypeLits.hs - libraries/binary - libraries/ghc-prim/GHC/Types.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4ed50ac334ba8344236565fa988de0d91cf650c2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4ed50ac334ba8344236565fa988de0d91cf650c2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 3 17:20:25 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 03 Dec 2020 12:20:25 -0500 Subject: [Git][ghc/ghc][wip/ci-fixes] gitlab-ci: Run linters through ci.sh Message-ID: <5fc91e59eb81e_6a095fef601053f4@gitlab.mail> Ben Gamari pushed to branch wip/ci-fixes at Glasgow Haskell Compiler / GHC Commits: bf66d123 by Ben Gamari at 2020-12-03T12:20:20-05:00 gitlab-ci: Run linters through ci.sh Ensuring that the right toolchain is used. - - - - - 2 changed files: - .gitlab-ci.yml - .gitlab/ci.sh Changes: ===================================== .gitlab-ci.yml ===================================== @@ -299,12 +299,11 @@ hadrian-ghc-in-ghci: tags: - x86_64-linux script: + - git clean -xdf && git submodule foreach git clean -xdf - .gitlab/ci.sh setup + - .gitlab/ci.sh configure - cabal update - cd hadrian; cabal new-build -j`../mk/detect-cpu-count.sh` --with-compiler=$GHC --project-file=ci.project; cd .. - - git clean -xdf && git submodule foreach git clean -xdf - - ./boot - - ./configure $CONFIGURE_ARGS # Load ghc-in-ghci then immediately exit and check the modules loaded - echo ":q" | hadrian/ghci -j`mk/detect-cpu-count.sh`| tail -n2 | grep "Ok," after_script: @@ -346,8 +345,10 @@ hadrian-ghc-in-ghci: lint-base: extends: .lint-params script: - - hadrian/build -c -j stage1:lib:base - - hadrian/build -j lint:base + - .gitlab/ci.sh setup + - .gitlab/ci.sh configure + - .gitlab/ci.sh run_hadrian stage1:lib:base + - .gitlab/ci.sh run_hadrian lint:base ############################################################ # Validation via Pipelines (make) ===================================== .gitlab/ci.sh ===================================== @@ -575,7 +575,7 @@ case $1 in test_hadrian || res=$? push_perf_notes exit $res ;; - run_hadrian) run_hadrian $@ ;; + run_hadrian) shift; run_hadrian $@ ;; perf_test) run_perf_test ;; clean) clean ;; shell) shell $@ ;; View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bf66d123e7eeb264105fc9483f061c404ab50285 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bf66d123e7eeb264105fc9483f061c404ab50285 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 3 17:23:47 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 03 Dec 2020 12:23:47 -0500 Subject: [Git][ghc/ghc][wip/backports-9.0] testsuite: Add missing #include on Message-ID: <5fc91f23f08f3_6a097620001060fe@gitlab.mail> Ben Gamari pushed to branch wip/backports-9.0 at Glasgow Haskell Compiler / GHC Commits: d4a670bb by Ben Gamari at 2020-12-03T12:23:42-05:00 testsuite: Add missing #include on <stdlib.h> This otherwise fails on newer Clangs, which warn more aggressively on undeclared symbols. (cherry picked from commit 3d7db1488c4bd7764e8b1fe3cfde4c5a548cde16) - - - - - 1 changed file: - testsuite/tests/concurrent/should_run/conc059_c.c Changes: ===================================== testsuite/tests/concurrent/should_run/conc059_c.c ===================================== @@ -1,6 +1,7 @@ #include "HsFFI.h" #include "conc059_stub.h" #include +#include #include #if mingw32_HOST_OS #include View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d4a670bb9f8e2dcfabde4c3b84bcd234b19583c0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d4a670bb9f8e2dcfabde4c3b84bcd234b19583c0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 3 18:01:55 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 03 Dec 2020 13:01:55 -0500 Subject: [Git][ghc/ghc][wip/ci-fixes] 20 commits: Optimisations in Data.Foldable (T17867) Message-ID: <5fc9281333c58_6a0962d1581113dc@gitlab.mail> Ben Gamari pushed to branch wip/ci-fixes at Glasgow Haskell Compiler / GHC Commits: 49ebe369 by chessai at 2020-11-30T19:47:40-05:00 Optimisations in Data.Foldable (T17867) This PR concerns the following functions from `Data.Foldable`: * minimum * maximum * sum * product * minimumBy * maximumBy - Default implementations of these functions now use `foldl'` or `foldMap'`. - All have been marked with INLINEABLE to make room for further optimisations. - - - - - 4d79ef65 by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - 6af074ce by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - ab334262 by Viktor Dukhovni at 2020-11-30T19:48:17-05:00 dirty MVAR after mutating TSO queue head While the original head and tail of the TSO queue may be in the same generation as the MVAR, interior elements of the queue could be younger after a GC run and may then be exposed by putMVar operation that updates the queue head. Resolves #18919 - - - - - 5eb163f3 by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Don't allow shared libraries to be loaded multiple times - - - - - 490aa14d by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Initialise CCSs from native shared objects - - - - - 6ac3db5f by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Move shared library loading logic into Elf.c - - - - - b6698d73 by GHC GitLab CI at 2020-11-30T19:48:53-05:00 rts/linker: Don't declare dynamic objects with image_mapped This previously resulted in warnings due to spurious unmap failures. - - - - - b94a65af by jneira at 2020-11-30T19:49:31-05:00 Include tried paths in findToolDir error - - - - - 72a87fbc by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Move core flattening algorithm to Core.Unify This sets the stage for a later change, where this algorithm will be needed from GHC.Core.InstEnv. This commit also splits GHC.Core.Map into GHC.Core.Map.Type and GHC.Core.Map.Expr, in order to avoid module import cycles with GHC.Core. - - - - - 0dd45d0a by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Bump the # of commits searched for perf baseline The previous value of 75 meant that a feature branch with more than 75 commits would get spurious CI passes. This affects #18692, but does not fix that ticket, because if a baseline cannot be found, we should fail, not succeed. - - - - - 8bb52d91 by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Remove flattening variables This patch redesigns the flattener to simplify type family applications directly instead of using flattening meta-variables and skolems. The key new innovation is the CanEqLHS type and the new CEqCan constraint (Ct). A CanEqLHS is either a type variable or exactly-saturated type family application; either can now be rewritten using a CEqCan constraint in the inert set. Because the flattener no longer reduces all type family applications to variables, there was some performance degradation if a lengthy type family application is now flattened over and over (not making progress). To compensate, this patch contains some extra optimizations in the flattener, leading to a number of performance improvements. Close #18875. Close #18910. There are many extra parts of the compiler that had to be affected in writing this patch: * The family-application cache (formerly the flat-cache) sometimes stores coercions built from Given inerts. When these inerts get kicked out, we must kick out from the cache as well. (This was, I believe, true previously, but somehow never caused trouble.) Kicking out from the cache requires adding a filterTM function to TrieMap. * This patch obviates the need to distinguish "blocking" coercion holes from non-blocking ones (which, previously, arose from CFunEqCans). There is thus some simplification around coercion holes. * Extra commentary throughout parts of the code I read through, to preserve the knowledge I gained while working. * A change in the pure unifier around unifying skolems with other types. Unifying a skolem now leads to SurelyApart, not MaybeApart, as documented in Note [Binding when looking up instances] in GHC.Core.InstEnv. * Some more use of MCoercion where appropriate. * Previously, class-instance lookup automatically noticed that e.g. C Int was a "unifier" to a target [W] C (F Bool), because the F Bool was flattened to a variable. Now, a little more care must be taken around checking for unifying instances. * Previously, tcSplitTyConApp_maybe would split (Eq a => a). This is silly, because (=>) is not a tycon in Haskell. Fixed now, but there are some knock-on changes in e.g. TrieMap code and in the canonicaliser. * New function anyFreeVarsOf{Type,Co} to check whether a free variable satisfies a certain predicate. * Type synonyms now remember whether or not they are "forgetful"; a forgetful synonym drops at least one argument. This is useful when flattening; see flattenView. * The pattern-match completeness checker invokes the solver. This invocation might need to look through newtypes when checking representational equality. Thus, the desugarer needs to keep track of the in-scope variables to know what newtype constructors are in scope. I bet this bug was around before but never noticed. * Extra-constraints wildcards are no longer simplified before printing. See Note [Do not simplify ConstraintHoles] in GHC.Tc.Solver. * Whether or not there are Given equalities has become slightly subtler. See the new HasGivenEqs datatype. * Note [Type variable cycles in Givens] in GHC.Tc.Solver.Canonical explains a significant new wrinkle in the new approach. * See Note [What might match later?] in GHC.Tc.Solver.Interact, which explains the fix to #18910. * The inert_count field of InertCans wasn't actually used, so I removed it. Though I (Richard) did the implementation, Simon PJ was very involved in design and review. This updates the Haddock submodule to avoid #18932 by adding a type signature. ------------------------- Metric Decrease: T12227 T5030 T9872a T9872b T9872c Metric Increase: T9872d ------------------------- - - - - - d66660ba by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Rename the flattener to become the rewriter. Now that flattening doesn't produce flattening variables, it's not really flattening anything: it's rewriting. This change also means that the rewriter can no longer be confused the core flattener (in GHC.Core.Unify), which is sometimes used during type-checking. - - - - - add0aeae by Ben Gamari at 2020-12-01T19:58:17-05:00 rts: Introduce mmapAnonForLinker Previously most of the uses of mmapForLinker were mapping anonymous memory, resulting in a great deal of unnecessary repetition. Factor this out into a new helper. Also fixes a few places where error checking was missing or suboptimal. - - - - - 97d71646 by Ben Gamari at 2020-12-01T19:58:17-05:00 rts/linker: Introduce munmapForLinker Consolidates munmap calls to ensure consistent error handling. - - - - - d8872af0 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/Linker: Introduce Windows implementations for mmapForLinker, et al. - - - - - c35d0e03 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/m32: Introduce NEEDS_M32 macro Instead of relying on RTS_LINKER_USE_MMAP - - - - - 41c64eb5 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/linker: Use m32 to allocate symbol extras in PEi386 - - - - - e0b08c5f by Ben Gamari at 2020-12-03T13:01:47-05:00 gitlab-ci: Fix copy-paste error Also be more consistent in quoting. - - - - - f85141e3 by Ben Gamari at 2020-12-03T13:01:47-05:00 gitlab-ci: Run linters through ci.sh Ensuring that the right toolchain is used. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Axiom.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FamInstEnv.hs - compiler/GHC/Core/InstEnv.hs - + compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Map.hs → compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/Opt/CSE.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/TyCon/Env.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/Maybe.hs - compiler/GHC/Data/TrieMap.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - compiler/GHC/HsToCore/Types.hs - compiler/GHC/Iface/Ext/Utils.hs - compiler/GHC/Stg/CSE.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bf66d123e7eeb264105fc9483f061c404ab50285...f85141e32b34b6e747be17bf0589329b54c6ea96 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bf66d123e7eeb264105fc9483f061c404ab50285...f85141e32b34b6e747be17bf0589329b54c6ea96 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 3 18:05:45 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 03 Dec 2020 13:05:45 -0500 Subject: [Git][ghc/ghc][wip/keepAlive-the-return-of-the-primop] testsuite fixes Message-ID: <5fc928f98f71c_6a0979493811361f@gitlab.mail> Ben Gamari pushed to branch wip/keepAlive-the-return-of-the-primop at Glasgow Haskell Compiler / GHC Commits: 30c65833 by Ben Gamari at 2020-12-03T13:05:39-05:00 testsuite fixes Metric Increase: T10421 T12227 T12234 T12425 T13035 T5536 - - - - - 2 changed files: - testsuite/tests/ghci/should_run/T16012.script - testsuite/tests/ghci/should_run/T16012.stdout Changes: ===================================== testsuite/tests/ghci/should_run/T16012.script ===================================== @@ -3,4 +3,4 @@ -- should always return a reasonably low result. n <- System.Mem.getAllocationCounter -if (n < 0 && n >= -160000) then putStrLn "Alloction counter in expected range" else (putStrLn $ "Unexpected allocation counter result:" ++ show n) +if (n < 0 && n >= -200000) then putStrLn "Allocation counter in expected range" else (putStrLn $ "Unexpected allocation counter result:" ++ show n) ===================================== testsuite/tests/ghci/should_run/T16012.stdout ===================================== @@ -1 +1 @@ -Alloction counter in expected range +Allocation counter in expected range View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/30c6583356d13284f470f9104d6838bb0a7a6f3b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/30c6583356d13284f470f9104d6838bb0a7a6f3b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 3 18:27:06 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 03 Dec 2020 13:27:06 -0500 Subject: [Git][ghc/ghc][wip/andreask/ppr_foreign_labels] 51 commits: [Sized Cmm] properly retain sizes. Message-ID: <5fc92dfa46ae8_6a0976442c1166ad@gitlab.mail> Ben Gamari pushed to branch wip/andreask/ppr_foreign_labels at Glasgow Haskell Compiler / GHC Commits: be5d74ca by Moritz Angermann at 2020-11-26T16:00:32-05:00 [Sized Cmm] properly retain sizes. This replaces all Word<N> = W<N># Word# and Int<N> = I<N># Int# with Word<N> = W<N># Word<N># and Int<N> = I<N># Int<N>#, thus providing us with properly sized primitives in the codegenerator instead of pretending they are all full machine words. This came up when implementing darwinpcs for arm64. The darwinpcs reqires us to pack function argugments in excess of registers on the stack. While most procedure call standards (pcs) assume arguments are just passed in 8 byte slots; and thus the caller does not know the exact signature to make the call, darwinpcs requires us to adhere to the prototype, and thus have the correct sizes. If we specify CInt in the FFI call, it should correspond to the C int, and not just be Word sized, when it's only half the size. This does change the expected output of T16402 but the new result is no less correct as it eliminates the narrowing (instead of the `and` as was previously done). Bumps the array, bytestring, text, and binary submodules. Co-Authored-By: Ben Gamari <ben at well-typed.com> Metric Increase: T13701 T14697 - - - - - a84e53f9 by Andreas Klebinger at 2020-11-26T16:00:32-05:00 RTS: Fix failed inlining of copy_tag. On windows using gcc-10 gcc failed to inline copy_tag into evacuate. To fix this we now set the always_inline attribute for the various copy* functions in Evac.c. The main motivation here is not the overhead of the function call, but rather that this allows the code to "specialize" for the size of the closure we copy which is often known at compile time. An earlier commit also tried to avoid evacuate_large inlining. But didn't quite succeed. So I also marked evacuate_large as noinline. Fixes #12416 - - - - - cdbd16f5 by Sylvain Henry at 2020-11-26T16:00:33-05:00 Fix toArgRep to support 64-bit reps on all systems [This is @Ericson2314 writing a commit message for @hsyl20's patch.] (Progress towards #11953, #17377, #17375) `Int64Rep` and `Word64Rep` are currently broken on 64-bit systems. This is because they should use "native arg rep" but instead use "large arg rep" as they do on 32-bit systems, which is either a non-concept or a 128-bit rep depending on one's vantage point. Now, these reps currently aren't used during 64-bit compilation, so the brokenness isn't observed, but I don't think that constitutes reasons not to fix it. Firstly, the linked issues there is a clearly expressed desire to use explicit-bitwidth constructs in more places. Secondly, per [1], there are other bugs that *do* manifest from not threading explicit-bitwidth information all the way through the compilation pipeline. One can therefore view this as one piece of the larger effort to do that, improve ergnomics, and squash remaining bugs. Also, this is needed for !3658. I could just merge this as part of that, but I'm keen on merging fixes "as they are ready" so the fixes that aren't ready are isolated and easier to debug. [1]: https://mail.haskell.org/pipermail/ghc-devs/2020-October/019332.html - - - - - a9378e69 by Tim Barnes at 2020-11-26T16:00:34-05:00 Set dynamic users-guide TOC spacing (fixes #18554) - - - - - 86a59d93 by Ben Gamari at 2020-11-26T16:00:34-05:00 rts: Use RTS_LIKELY in CHECK Most compilers probably already infer that `barf` diverges but it nevertheless doesn't hurt to be explicit. - - - - - 5757e82b by Matthew Pickering at 2020-11-26T16:00:35-05:00 Remove special case for GHC.ByteCode.Instr This was added in https://github.com/nomeata/ghc-heap-view/commit/34935206e51b9c86902481d84d2f368a6fd93423 GHC.ByteCode.Instr.BreakInfo no longer exists so the special case is dead code. Any check like this can be easily dealt with in client code. - - - - - d9c8b5b4 by Matthew Pickering at 2020-11-26T16:00:35-05:00 Split Up getClosureDataFromHeapRep Motivation 1. Don't enforce the repeated decoding of an info table, when the client can cache it (ghc-debug) 2. Allow the constructor information decoding to be overridden, this casues segfaults in ghc-debug - - - - - 3e3555cc by Andreas Klebinger at 2020-11-26T16:00:35-05:00 RegAlloc: Add missing raPlatformfield to RegAllocStatsSpill Fixes #18994 Co-Author: Benjamin Maurer <maurer.benjamin at gmail.com> - - - - - a1a75aa9 by Ben Gamari at 2020-11-27T06:20:41-05:00 rts: Allocate MBlocks with MAP_TOP_DOWN on Windows As noted in #18991, we would previously allocate heap in low memory. Due to this the linker, which typically *needs* low memory, would end up competing with the heap. In longer builds we end up running out of low memory entirely, leading to linking failures. - - - - - 75fc1ed5 by Sylvain Henry at 2020-11-28T15:40:23-05:00 Hadrian: fix detection of ghc-pkg for cross-compilers - - - - - 7cb5df96 by Sylvain Henry at 2020-11-28T15:40:23-05:00 hadrian: fix ghc-pkg uses (#17601) Make sure ghc-pkg doesn't read the compiler "settings" file by passing --no-user-package-db. - - - - - e3fd4226 by Ben Gamari at 2020-11-28T15:40:23-05:00 gitlab-ci: Introduce a nightly cross-compilation job This adds a job to test cross-compilation from x86-64 to AArch64 with Hadrian. Fixes #18234 - - - - - 698d3d96 by Ben Gamari at 2020-11-28T15:41:00-05:00 gitlab-ci: Only deploy GitLab Pages in ghc/ghc> The deployments are quite large and yet are currently only served for the ghc/ghc> project. - - - - - 625726f9 by David Eichmann at 2020-11-28T15:41:37-05:00 ghc-heap: partial TSO/STACK decoding Co-authored-by: Sven Tennie <sven.tennie at gmail.com> Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> Co-authored-by: Ben Gamari <bgamari.foss at gmail.com> - - - - - 22ea9c29 by Andreas Klebinger at 2020-11-28T15:42:13-05:00 Small optimization to CmmSink. Inside `regsUsedIn` we can avoid some thunks by specializing the recursion. In particular we avoid the thunk for `(f e z)` in the MachOp/Load branches, where we know this will evaluate to z. Reduces allocations for T3294 by ~1%. - - - - - bba42c62 by John Ericson at 2020-11-28T15:42:49-05:00 Make primop handler indentation more consistent - - - - - c82bc8e9 by John Ericson at 2020-11-28T15:42:49-05:00 Cleanup some primop constructor names Harmonize the internal (big sum type) names of the native vs fixed-sized number primops a bit. (Mainly by renaming the former.) No user-facing names are changed. - - - - - ae14f160 by Ben Gamari at 2020-11-28T15:43:25-05:00 testsuite: Mark T14702 as fragile on Windows Due to #18953. - - - - - 1bc104b0 by Ben Gamari at 2020-11-29T15:33:18-05:00 withTimings: Emit allocations counter This will allow us to back out the allocations per compiler pass from the eventlog. Note that we dump the allocation counter rather than the difference since this will allow us to determine how much work is done *between* `withTiming` blocks. - - - - - e992ea84 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 ThreadPaused: Don't zero slop until free vars are pushed When threadPaused blackholes a thunk it calls `OVERWRITING_CLOSURE` to zero the slop for the benefit of the sanity checker. Previously this was done *before* pushing the thunk's free variables to the update remembered set. Consequently we would pull zero'd pointers to the update remembered set. - - - - - e82cd140 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Fix regression from TSAN work The TSAN rework (specifically aad1f803) introduced a subtle regression in GC.c, swapping `g0` in place of `gen`. Whoops! Fixes #18997. - - - - - 35a5207e by GHC GitLab CI at 2020-11-29T15:33:54-05:00 rts/Messages: Add missing write barrier in THROWTO message update After a THROWTO message has been handle the message closure is overwritten by a NULL message. We must ensure that the original closure's pointers continue to be visible to the nonmoving GC. - - - - - 0120829f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Add missing write barrier in shrinkSmallByteArray - - - - - 8a4d8fb6 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 Updates: Don't zero slop until closure has been pushed Ensure that the the free variables have been pushed to the update remembered set before we zero the slop. - - - - - 2793cfdc by GHC GitLab CI at 2020-11-29T15:33:54-05:00 OSThreads: Fix error code checking pthread_join returns its error code and apparently doesn't set errno. - - - - - e391a16f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Don't join to mark_thread on shutdown The mark thread is not joinable as we detach from it on creation. - - - - - 60d088ab by Ben Gamari at 2020-11-29T15:33:54-05:00 nonmoving: Add reference to Ueno 2016 - - - - - 3aa60362 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Ensure that evacuated large objects are marked See Note [Non-moving GC: Marking evacuated objects]. - - - - - 8d304a99 by Ben Gamari at 2020-11-30T10:15:22-05:00 rts/m32: Refactor handling of allocator seeding Previously, in an attempt to reduce fragmentation, each new allocator would map a region of M32_MAX_PAGES fresh pages to seed itself. However, this ends up being extremely wasteful since it turns out that we often use fewer than this. Consequently, these pages end up getting freed which, ends up fragmenting our address space more than than we would have if we had naively allocated pages on-demand. Here we refactor m32 to avoid this waste while achieving the fragmentation mitigation previously desired. In particular, we move all page allocation into the global m32_alloc_page, which will pull a page from the free page pool. If the free page pool is empty we then refill it by allocating a region of M32_MAP_PAGES and adding them to the pool. Furthermore, we do away with the initial seeding entirely. That is, the allocator starts with no active pages: pages are rather allocated on an as-needed basis. On the whole this ends up being a pleasingly simple change, simultaneously making m32 more efficient, more robust, and simpler. Fixes #18980. - - - - - b6629289 by Ben Gamari at 2020-11-30T10:15:58-05:00 rts: Use CHECK instead of assert Use the GHC wrappers instead of <assert.h>. - - - - - 9f4efa6a by Ben Gamari at 2020-11-30T10:15:58-05:00 rts/linker: Replace some ASSERTs with CHECK In the past some people have confused ASSERT, which is for checking internal invariants, which CHECK, which should be used when checking things that might fail due to bad input (and therefore should be enabled even in the release compiler). Change some of these cases in the linker to use CHECK. - - - - - 0f8a4655 by Ryan Scott at 2020-11-30T10:16:34-05:00 Allow deploy:pages job to fail See #18973. - - - - - 49ebe369 by chessai at 2020-11-30T19:47:40-05:00 Optimisations in Data.Foldable (T17867) This PR concerns the following functions from `Data.Foldable`: * minimum * maximum * sum * product * minimumBy * maximumBy - Default implementations of these functions now use `foldl'` or `foldMap'`. - All have been marked with INLINEABLE to make room for further optimisations. - - - - - 4d79ef65 by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - 6af074ce by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - ab334262 by Viktor Dukhovni at 2020-11-30T19:48:17-05:00 dirty MVAR after mutating TSO queue head While the original head and tail of the TSO queue may be in the same generation as the MVAR, interior elements of the queue could be younger after a GC run and may then be exposed by putMVar operation that updates the queue head. Resolves #18919 - - - - - 5eb163f3 by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Don't allow shared libraries to be loaded multiple times - - - - - 490aa14d by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Initialise CCSs from native shared objects - - - - - 6ac3db5f by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Move shared library loading logic into Elf.c - - - - - b6698d73 by GHC GitLab CI at 2020-11-30T19:48:53-05:00 rts/linker: Don't declare dynamic objects with image_mapped This previously resulted in warnings due to spurious unmap failures. - - - - - b94a65af by jneira at 2020-11-30T19:49:31-05:00 Include tried paths in findToolDir error - - - - - 72a87fbc by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Move core flattening algorithm to Core.Unify This sets the stage for a later change, where this algorithm will be needed from GHC.Core.InstEnv. This commit also splits GHC.Core.Map into GHC.Core.Map.Type and GHC.Core.Map.Expr, in order to avoid module import cycles with GHC.Core. - - - - - 0dd45d0a by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Bump the # of commits searched for perf baseline The previous value of 75 meant that a feature branch with more than 75 commits would get spurious CI passes. This affects #18692, but does not fix that ticket, because if a baseline cannot be found, we should fail, not succeed. - - - - - 8bb52d91 by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Remove flattening variables This patch redesigns the flattener to simplify type family applications directly instead of using flattening meta-variables and skolems. The key new innovation is the CanEqLHS type and the new CEqCan constraint (Ct). A CanEqLHS is either a type variable or exactly-saturated type family application; either can now be rewritten using a CEqCan constraint in the inert set. Because the flattener no longer reduces all type family applications to variables, there was some performance degradation if a lengthy type family application is now flattened over and over (not making progress). To compensate, this patch contains some extra optimizations in the flattener, leading to a number of performance improvements. Close #18875. Close #18910. There are many extra parts of the compiler that had to be affected in writing this patch: * The family-application cache (formerly the flat-cache) sometimes stores coercions built from Given inerts. When these inerts get kicked out, we must kick out from the cache as well. (This was, I believe, true previously, but somehow never caused trouble.) Kicking out from the cache requires adding a filterTM function to TrieMap. * This patch obviates the need to distinguish "blocking" coercion holes from non-blocking ones (which, previously, arose from CFunEqCans). There is thus some simplification around coercion holes. * Extra commentary throughout parts of the code I read through, to preserve the knowledge I gained while working. * A change in the pure unifier around unifying skolems with other types. Unifying a skolem now leads to SurelyApart, not MaybeApart, as documented in Note [Binding when looking up instances] in GHC.Core.InstEnv. * Some more use of MCoercion where appropriate. * Previously, class-instance lookup automatically noticed that e.g. C Int was a "unifier" to a target [W] C (F Bool), because the F Bool was flattened to a variable. Now, a little more care must be taken around checking for unifying instances. * Previously, tcSplitTyConApp_maybe would split (Eq a => a). This is silly, because (=>) is not a tycon in Haskell. Fixed now, but there are some knock-on changes in e.g. TrieMap code and in the canonicaliser. * New function anyFreeVarsOf{Type,Co} to check whether a free variable satisfies a certain predicate. * Type synonyms now remember whether or not they are "forgetful"; a forgetful synonym drops at least one argument. This is useful when flattening; see flattenView. * The pattern-match completeness checker invokes the solver. This invocation might need to look through newtypes when checking representational equality. Thus, the desugarer needs to keep track of the in-scope variables to know what newtype constructors are in scope. I bet this bug was around before but never noticed. * Extra-constraints wildcards are no longer simplified before printing. See Note [Do not simplify ConstraintHoles] in GHC.Tc.Solver. * Whether or not there are Given equalities has become slightly subtler. See the new HasGivenEqs datatype. * Note [Type variable cycles in Givens] in GHC.Tc.Solver.Canonical explains a significant new wrinkle in the new approach. * See Note [What might match later?] in GHC.Tc.Solver.Interact, which explains the fix to #18910. * The inert_count field of InertCans wasn't actually used, so I removed it. Though I (Richard) did the implementation, Simon PJ was very involved in design and review. This updates the Haddock submodule to avoid #18932 by adding a type signature. ------------------------- Metric Decrease: T12227 T5030 T9872a T9872b T9872c Metric Increase: T9872d ------------------------- - - - - - d66660ba by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Rename the flattener to become the rewriter. Now that flattening doesn't produce flattening variables, it's not really flattening anything: it's rewriting. This change also means that the rewriter can no longer be confused the core flattener (in GHC.Core.Unify), which is sometimes used during type-checking. - - - - - add0aeae by Ben Gamari at 2020-12-01T19:58:17-05:00 rts: Introduce mmapAnonForLinker Previously most of the uses of mmapForLinker were mapping anonymous memory, resulting in a great deal of unnecessary repetition. Factor this out into a new helper. Also fixes a few places where error checking was missing or suboptimal. - - - - - 97d71646 by Ben Gamari at 2020-12-01T19:58:17-05:00 rts/linker: Introduce munmapForLinker Consolidates munmap calls to ensure consistent error handling. - - - - - d8872af0 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/Linker: Introduce Windows implementations for mmapForLinker, et al. - - - - - c35d0e03 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/m32: Introduce NEEDS_M32 macro Instead of relying on RTS_LINKER_USE_MMAP - - - - - 41c64eb5 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/linker: Use m32 to allocate symbol extras in PEi386 - - - - - d47a75d7 by Andreas Klebinger at 2020-12-03T13:26:47-05:00 Include C label when pretty printing FFI calls. When looking at lets say an STG dump I really do want to know what function is being called. With this patch no longer hides this information. This should fix #19020 - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/Reg/Graph.hs - compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs - compiler/GHC/CmmToC.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Axiom.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FamInstEnv.hs - compiler/GHC/Core/InstEnv.hs - + compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Map.hs → compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/Opt/CSE.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCon.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f90a3e9d1144046a0f6b16fd92838cb7b2bc2251...d47a75d73fdd258679b0d86281408c731849b7d9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f90a3e9d1144046a0f6b16fd92838cb7b2bc2251...d47a75d73fdd258679b0d86281408c731849b7d9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 3 19:18:09 2020 From: gitlab at gitlab.haskell.org (Shayne Fletcher) Date: Thu, 03 Dec 2020 14:18:09 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/fix-import-qualified-span Message-ID: <5fc939f17949e_6a099080f8130246@gitlab.mail> Shayne Fletcher pushed new branch wip/fix-import-qualified-span at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/fix-import-qualified-span You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 3 19:19:23 2020 From: gitlab at gitlab.haskell.org (Shayne Fletcher) Date: Thu, 03 Dec 2020 14:19:23 -0500 Subject: [Git][ghc/ghc][wip/fix-import-qualified-span] 10 commits: Move core flattening algorithm to Core.Unify Message-ID: <5fc93a3b4ac73_6a099080081304fa@gitlab.mail> Shayne Fletcher pushed to branch wip/fix-import-qualified-span at Glasgow Haskell Compiler / GHC Commits: 72a87fbc by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Move core flattening algorithm to Core.Unify This sets the stage for a later change, where this algorithm will be needed from GHC.Core.InstEnv. This commit also splits GHC.Core.Map into GHC.Core.Map.Type and GHC.Core.Map.Expr, in order to avoid module import cycles with GHC.Core. - - - - - 0dd45d0a by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Bump the # of commits searched for perf baseline The previous value of 75 meant that a feature branch with more than 75 commits would get spurious CI passes. This affects #18692, but does not fix that ticket, because if a baseline cannot be found, we should fail, not succeed. - - - - - 8bb52d91 by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Remove flattening variables This patch redesigns the flattener to simplify type family applications directly instead of using flattening meta-variables and skolems. The key new innovation is the CanEqLHS type and the new CEqCan constraint (Ct). A CanEqLHS is either a type variable or exactly-saturated type family application; either can now be rewritten using a CEqCan constraint in the inert set. Because the flattener no longer reduces all type family applications to variables, there was some performance degradation if a lengthy type family application is now flattened over and over (not making progress). To compensate, this patch contains some extra optimizations in the flattener, leading to a number of performance improvements. Close #18875. Close #18910. There are many extra parts of the compiler that had to be affected in writing this patch: * The family-application cache (formerly the flat-cache) sometimes stores coercions built from Given inerts. When these inerts get kicked out, we must kick out from the cache as well. (This was, I believe, true previously, but somehow never caused trouble.) Kicking out from the cache requires adding a filterTM function to TrieMap. * This patch obviates the need to distinguish "blocking" coercion holes from non-blocking ones (which, previously, arose from CFunEqCans). There is thus some simplification around coercion holes. * Extra commentary throughout parts of the code I read through, to preserve the knowledge I gained while working. * A change in the pure unifier around unifying skolems with other types. Unifying a skolem now leads to SurelyApart, not MaybeApart, as documented in Note [Binding when looking up instances] in GHC.Core.InstEnv. * Some more use of MCoercion where appropriate. * Previously, class-instance lookup automatically noticed that e.g. C Int was a "unifier" to a target [W] C (F Bool), because the F Bool was flattened to a variable. Now, a little more care must be taken around checking for unifying instances. * Previously, tcSplitTyConApp_maybe would split (Eq a => a). This is silly, because (=>) is not a tycon in Haskell. Fixed now, but there are some knock-on changes in e.g. TrieMap code and in the canonicaliser. * New function anyFreeVarsOf{Type,Co} to check whether a free variable satisfies a certain predicate. * Type synonyms now remember whether or not they are "forgetful"; a forgetful synonym drops at least one argument. This is useful when flattening; see flattenView. * The pattern-match completeness checker invokes the solver. This invocation might need to look through newtypes when checking representational equality. Thus, the desugarer needs to keep track of the in-scope variables to know what newtype constructors are in scope. I bet this bug was around before but never noticed. * Extra-constraints wildcards are no longer simplified before printing. See Note [Do not simplify ConstraintHoles] in GHC.Tc.Solver. * Whether or not there are Given equalities has become slightly subtler. See the new HasGivenEqs datatype. * Note [Type variable cycles in Givens] in GHC.Tc.Solver.Canonical explains a significant new wrinkle in the new approach. * See Note [What might match later?] in GHC.Tc.Solver.Interact, which explains the fix to #18910. * The inert_count field of InertCans wasn't actually used, so I removed it. Though I (Richard) did the implementation, Simon PJ was very involved in design and review. This updates the Haddock submodule to avoid #18932 by adding a type signature. ------------------------- Metric Decrease: T12227 T5030 T9872a T9872b T9872c Metric Increase: T9872d ------------------------- - - - - - d66660ba by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Rename the flattener to become the rewriter. Now that flattening doesn't produce flattening variables, it's not really flattening anything: it's rewriting. This change also means that the rewriter can no longer be confused the core flattener (in GHC.Core.Unify), which is sometimes used during type-checking. - - - - - add0aeae by Ben Gamari at 2020-12-01T19:58:17-05:00 rts: Introduce mmapAnonForLinker Previously most of the uses of mmapForLinker were mapping anonymous memory, resulting in a great deal of unnecessary repetition. Factor this out into a new helper. Also fixes a few places where error checking was missing or suboptimal. - - - - - 97d71646 by Ben Gamari at 2020-12-01T19:58:17-05:00 rts/linker: Introduce munmapForLinker Consolidates munmap calls to ensure consistent error handling. - - - - - d8872af0 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/Linker: Introduce Windows implementations for mmapForLinker, et al. - - - - - c35d0e03 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/m32: Introduce NEEDS_M32 macro Instead of relying on RTS_LINKER_USE_MMAP - - - - - 41c64eb5 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/linker: Use m32 to allocate symbol extras in PEi386 - - - - - 57f3fdb1 by Shayne Fletcher at 2020-12-03T14:19:14-05:00 Fix bad span calculations of post qualified imports - - - - - 30 changed files: - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Axiom.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FamInstEnv.hs - compiler/GHC/Core/InstEnv.hs - + compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Map.hs → compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/Opt/CSE.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/TyCon/Env.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/Maybe.hs - compiler/GHC/Data/TrieMap.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - compiler/GHC/HsToCore/Types.hs - compiler/GHC/Iface/Ext/Utils.hs - compiler/GHC/Parser.y - compiler/GHC/Stg/CSE.hs - compiler/GHC/Tc/Errors.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/244c56148dc89abe9292fab9ec0a9ac919f116db...57f3fdb1fbeb82b5b19bc5e2970d8857c2514fcc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/244c56148dc89abe9292fab9ec0a9ac919f116db...57f3fdb1fbeb82b5b19bc5e2970d8857c2514fcc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 3 19:20:08 2020 From: gitlab at gitlab.haskell.org (Shayne Fletcher) Date: Thu, 03 Dec 2020 14:20:08 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/wip/19014 Message-ID: <5fc93a6863480_6a098f63581320e5@gitlab.mail> Shayne Fletcher pushed new branch wip/wip/19014 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/wip/19014 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 3 19:20:20 2020 From: gitlab at gitlab.haskell.org (Shayne Fletcher) Date: Thu, 03 Dec 2020 14:20:20 -0500 Subject: [Git][ghc/ghc][wip/19014] 10 commits: Move core flattening algorithm to Core.Unify Message-ID: <5fc93a74f25e5_6a09840b5c13227a@gitlab.mail> Shayne Fletcher pushed to branch wip/19014 at Glasgow Haskell Compiler / GHC Commits: 72a87fbc by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Move core flattening algorithm to Core.Unify This sets the stage for a later change, where this algorithm will be needed from GHC.Core.InstEnv. This commit also splits GHC.Core.Map into GHC.Core.Map.Type and GHC.Core.Map.Expr, in order to avoid module import cycles with GHC.Core. - - - - - 0dd45d0a by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Bump the # of commits searched for perf baseline The previous value of 75 meant that a feature branch with more than 75 commits would get spurious CI passes. This affects #18692, but does not fix that ticket, because if a baseline cannot be found, we should fail, not succeed. - - - - - 8bb52d91 by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Remove flattening variables This patch redesigns the flattener to simplify type family applications directly instead of using flattening meta-variables and skolems. The key new innovation is the CanEqLHS type and the new CEqCan constraint (Ct). A CanEqLHS is either a type variable or exactly-saturated type family application; either can now be rewritten using a CEqCan constraint in the inert set. Because the flattener no longer reduces all type family applications to variables, there was some performance degradation if a lengthy type family application is now flattened over and over (not making progress). To compensate, this patch contains some extra optimizations in the flattener, leading to a number of performance improvements. Close #18875. Close #18910. There are many extra parts of the compiler that had to be affected in writing this patch: * The family-application cache (formerly the flat-cache) sometimes stores coercions built from Given inerts. When these inerts get kicked out, we must kick out from the cache as well. (This was, I believe, true previously, but somehow never caused trouble.) Kicking out from the cache requires adding a filterTM function to TrieMap. * This patch obviates the need to distinguish "blocking" coercion holes from non-blocking ones (which, previously, arose from CFunEqCans). There is thus some simplification around coercion holes. * Extra commentary throughout parts of the code I read through, to preserve the knowledge I gained while working. * A change in the pure unifier around unifying skolems with other types. Unifying a skolem now leads to SurelyApart, not MaybeApart, as documented in Note [Binding when looking up instances] in GHC.Core.InstEnv. * Some more use of MCoercion where appropriate. * Previously, class-instance lookup automatically noticed that e.g. C Int was a "unifier" to a target [W] C (F Bool), because the F Bool was flattened to a variable. Now, a little more care must be taken around checking for unifying instances. * Previously, tcSplitTyConApp_maybe would split (Eq a => a). This is silly, because (=>) is not a tycon in Haskell. Fixed now, but there are some knock-on changes in e.g. TrieMap code and in the canonicaliser. * New function anyFreeVarsOf{Type,Co} to check whether a free variable satisfies a certain predicate. * Type synonyms now remember whether or not they are "forgetful"; a forgetful synonym drops at least one argument. This is useful when flattening; see flattenView. * The pattern-match completeness checker invokes the solver. This invocation might need to look through newtypes when checking representational equality. Thus, the desugarer needs to keep track of the in-scope variables to know what newtype constructors are in scope. I bet this bug was around before but never noticed. * Extra-constraints wildcards are no longer simplified before printing. See Note [Do not simplify ConstraintHoles] in GHC.Tc.Solver. * Whether or not there are Given equalities has become slightly subtler. See the new HasGivenEqs datatype. * Note [Type variable cycles in Givens] in GHC.Tc.Solver.Canonical explains a significant new wrinkle in the new approach. * See Note [What might match later?] in GHC.Tc.Solver.Interact, which explains the fix to #18910. * The inert_count field of InertCans wasn't actually used, so I removed it. Though I (Richard) did the implementation, Simon PJ was very involved in design and review. This updates the Haddock submodule to avoid #18932 by adding a type signature. ------------------------- Metric Decrease: T12227 T5030 T9872a T9872b T9872c Metric Increase: T9872d ------------------------- - - - - - d66660ba by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Rename the flattener to become the rewriter. Now that flattening doesn't produce flattening variables, it's not really flattening anything: it's rewriting. This change also means that the rewriter can no longer be confused the core flattener (in GHC.Core.Unify), which is sometimes used during type-checking. - - - - - add0aeae by Ben Gamari at 2020-12-01T19:58:17-05:00 rts: Introduce mmapAnonForLinker Previously most of the uses of mmapForLinker were mapping anonymous memory, resulting in a great deal of unnecessary repetition. Factor this out into a new helper. Also fixes a few places where error checking was missing or suboptimal. - - - - - 97d71646 by Ben Gamari at 2020-12-01T19:58:17-05:00 rts/linker: Introduce munmapForLinker Consolidates munmap calls to ensure consistent error handling. - - - - - d8872af0 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/Linker: Introduce Windows implementations for mmapForLinker, et al. - - - - - c35d0e03 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/m32: Introduce NEEDS_M32 macro Instead of relying on RTS_LINKER_USE_MMAP - - - - - 41c64eb5 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/linker: Use m32 to allocate symbol extras in PEi386 - - - - - 57f3fdb1 by Shayne Fletcher at 2020-12-03T14:19:14-05:00 Fix bad span calculations of post qualified imports - - - - - 30 changed files: - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Axiom.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FamInstEnv.hs - compiler/GHC/Core/InstEnv.hs - + compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Map.hs → compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/Opt/CSE.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/TyCon/Env.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/Maybe.hs - compiler/GHC/Data/TrieMap.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - compiler/GHC/HsToCore/Types.hs - compiler/GHC/Iface/Ext/Utils.hs - compiler/GHC/Parser.y - compiler/GHC/Stg/CSE.hs - compiler/GHC/Tc/Errors.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d1e974aac557bf71580c10a9fc2460d93393e09d...57f3fdb1fbeb82b5b19bc5e2970d8857c2514fcc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d1e974aac557bf71580c10a9fc2460d93393e09d...57f3fdb1fbeb82b5b19bc5e2970d8857c2514fcc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 3 19:23:55 2020 From: gitlab at gitlab.haskell.org (Shayne Fletcher) Date: Thu, 03 Dec 2020 14:23:55 -0500 Subject: [Git][ghc/ghc] Deleted branch wip/wip/19014 Message-ID: <5fc93b4b3b888_6a09907c481368b1@gitlab.mail> Shayne Fletcher deleted branch wip/wip/19014 at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 3 19:24:18 2020 From: gitlab at gitlab.haskell.org (Shayne Fletcher) Date: Thu, 03 Dec 2020 14:24:18 -0500 Subject: [Git][ghc/ghc] Deleted branch wip/fix-import-qualified-span Message-ID: <5fc93b624b34a_6a099a51281370a8@gitlab.mail> Shayne Fletcher deleted branch wip/fix-import-qualified-span at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 3 20:06:03 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 03 Dec 2020 15:06:03 -0500 Subject: [Git][ghc/ghc][wip/tyconapp-opts] 19 commits: Optimisations in Data.Foldable (T17867) Message-ID: <5fc9452b4d81d_6a098f63581427e0@gitlab.mail> Ben Gamari pushed to branch wip/tyconapp-opts at Glasgow Haskell Compiler / GHC Commits: 49ebe369 by chessai at 2020-11-30T19:47:40-05:00 Optimisations in Data.Foldable (T17867) This PR concerns the following functions from `Data.Foldable`: * minimum * maximum * sum * product * minimumBy * maximumBy - Default implementations of these functions now use `foldl'` or `foldMap'`. - All have been marked with INLINEABLE to make room for further optimisations. - - - - - 4d79ef65 by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - 6af074ce by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - ab334262 by Viktor Dukhovni at 2020-11-30T19:48:17-05:00 dirty MVAR after mutating TSO queue head While the original head and tail of the TSO queue may be in the same generation as the MVAR, interior elements of the queue could be younger after a GC run and may then be exposed by putMVar operation that updates the queue head. Resolves #18919 - - - - - 5eb163f3 by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Don't allow shared libraries to be loaded multiple times - - - - - 490aa14d by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Initialise CCSs from native shared objects - - - - - 6ac3db5f by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Move shared library loading logic into Elf.c - - - - - b6698d73 by GHC GitLab CI at 2020-11-30T19:48:53-05:00 rts/linker: Don't declare dynamic objects with image_mapped This previously resulted in warnings due to spurious unmap failures. - - - - - b94a65af by jneira at 2020-11-30T19:49:31-05:00 Include tried paths in findToolDir error - - - - - 72a87fbc by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Move core flattening algorithm to Core.Unify This sets the stage for a later change, where this algorithm will be needed from GHC.Core.InstEnv. This commit also splits GHC.Core.Map into GHC.Core.Map.Type and GHC.Core.Map.Expr, in order to avoid module import cycles with GHC.Core. - - - - - 0dd45d0a by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Bump the # of commits searched for perf baseline The previous value of 75 meant that a feature branch with more than 75 commits would get spurious CI passes. This affects #18692, but does not fix that ticket, because if a baseline cannot be found, we should fail, not succeed. - - - - - 8bb52d91 by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Remove flattening variables This patch redesigns the flattener to simplify type family applications directly instead of using flattening meta-variables and skolems. The key new innovation is the CanEqLHS type and the new CEqCan constraint (Ct). A CanEqLHS is either a type variable or exactly-saturated type family application; either can now be rewritten using a CEqCan constraint in the inert set. Because the flattener no longer reduces all type family applications to variables, there was some performance degradation if a lengthy type family application is now flattened over and over (not making progress). To compensate, this patch contains some extra optimizations in the flattener, leading to a number of performance improvements. Close #18875. Close #18910. There are many extra parts of the compiler that had to be affected in writing this patch: * The family-application cache (formerly the flat-cache) sometimes stores coercions built from Given inerts. When these inerts get kicked out, we must kick out from the cache as well. (This was, I believe, true previously, but somehow never caused trouble.) Kicking out from the cache requires adding a filterTM function to TrieMap. * This patch obviates the need to distinguish "blocking" coercion holes from non-blocking ones (which, previously, arose from CFunEqCans). There is thus some simplification around coercion holes. * Extra commentary throughout parts of the code I read through, to preserve the knowledge I gained while working. * A change in the pure unifier around unifying skolems with other types. Unifying a skolem now leads to SurelyApart, not MaybeApart, as documented in Note [Binding when looking up instances] in GHC.Core.InstEnv. * Some more use of MCoercion where appropriate. * Previously, class-instance lookup automatically noticed that e.g. C Int was a "unifier" to a target [W] C (F Bool), because the F Bool was flattened to a variable. Now, a little more care must be taken around checking for unifying instances. * Previously, tcSplitTyConApp_maybe would split (Eq a => a). This is silly, because (=>) is not a tycon in Haskell. Fixed now, but there are some knock-on changes in e.g. TrieMap code and in the canonicaliser. * New function anyFreeVarsOf{Type,Co} to check whether a free variable satisfies a certain predicate. * Type synonyms now remember whether or not they are "forgetful"; a forgetful synonym drops at least one argument. This is useful when flattening; see flattenView. * The pattern-match completeness checker invokes the solver. This invocation might need to look through newtypes when checking representational equality. Thus, the desugarer needs to keep track of the in-scope variables to know what newtype constructors are in scope. I bet this bug was around before but never noticed. * Extra-constraints wildcards are no longer simplified before printing. See Note [Do not simplify ConstraintHoles] in GHC.Tc.Solver. * Whether or not there are Given equalities has become slightly subtler. See the new HasGivenEqs datatype. * Note [Type variable cycles in Givens] in GHC.Tc.Solver.Canonical explains a significant new wrinkle in the new approach. * See Note [What might match later?] in GHC.Tc.Solver.Interact, which explains the fix to #18910. * The inert_count field of InertCans wasn't actually used, so I removed it. Though I (Richard) did the implementation, Simon PJ was very involved in design and review. This updates the Haddock submodule to avoid #18932 by adding a type signature. ------------------------- Metric Decrease: T12227 T5030 T9872a T9872b T9872c Metric Increase: T9872d ------------------------- - - - - - d66660ba by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Rename the flattener to become the rewriter. Now that flattening doesn't produce flattening variables, it's not really flattening anything: it's rewriting. This change also means that the rewriter can no longer be confused the core flattener (in GHC.Core.Unify), which is sometimes used during type-checking. - - - - - add0aeae by Ben Gamari at 2020-12-01T19:58:17-05:00 rts: Introduce mmapAnonForLinker Previously most of the uses of mmapForLinker were mapping anonymous memory, resulting in a great deal of unnecessary repetition. Factor this out into a new helper. Also fixes a few places where error checking was missing or suboptimal. - - - - - 97d71646 by Ben Gamari at 2020-12-01T19:58:17-05:00 rts/linker: Introduce munmapForLinker Consolidates munmap calls to ensure consistent error handling. - - - - - d8872af0 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/Linker: Introduce Windows implementations for mmapForLinker, et al. - - - - - c35d0e03 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/m32: Introduce NEEDS_M32 macro Instead of relying on RTS_LINKER_USE_MMAP - - - - - 41c64eb5 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/linker: Use m32 to allocate symbol extras in PEi386 - - - - - e1b35bfa by Ben Gamari at 2020-12-03T14:43:36-05:00 Optimise nullary type constructor usage During the compilation of programs GHC very frequently deals with the `Type` type, which is a synonym of `TYPE 'LiftedRep`. This patch teaches GHC to avoid expanding the `Type` synonym (and other nullary type synonyms) during type comparisons, saving a good amount of work. This optimisation is described in `Note [Comparing nullary type synonyms]`. To maximize the impact of this optimisation, we introduce a few special-cases to reduce `TYPE 'LiftedRep` to `Type`. See `Note [Prefer Type over TYPE 'LiftedPtrRep]`. Closes #17958. Metric Decrease: T18698b T1969 T12227 T12545 T12707 T14683 T3064 T5631 T5642 T9020 T9872a T13035 haddock.Cabal haddock.base - - - - - 23 changed files: - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Types/Prim.hs - + compiler/GHC/Builtin/Types/Prim.hs-boot - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Axiom.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FamInstEnv.hs - compiler/GHC/Core/InstEnv.hs - + compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Map.hs → compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/Opt/CSE.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/TyCon/Env.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c61782a7a1001fba689fb60877ab1b218079b1a7...e1b35bfab8deb6614fa8eb223e4b2c9d23156cc9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c61782a7a1001fba689fb60877ab1b218079b1a7...e1b35bfab8deb6614fa8eb223e4b2c9d23156cc9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 3 21:01:00 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 03 Dec 2020 16:01:00 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/T19027 Message-ID: <5fc9520c297e1_6a099cfa18147619@gitlab.mail> Ben Gamari pushed new branch wip/T19027 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T19027 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 3 21:05:00 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 03 Dec 2020 16:05:00 -0500 Subject: [Git][ghc/ghc][wip/T19027] 732 commits: Fix dead link to haskell prime discussion Message-ID: <5fc952fce6709_6a09a65b58148866@gitlab.mail> Ben Gamari pushed to branch wip/T19027 at Glasgow Haskell Compiler / GHC Commits: 4c719460 by David Binder at 2020-07-22T20:17:35-04:00 Fix dead link to haskell prime discussion - - - - - f2f817e4 by BinderDavid at 2020-07-22T20:17:35-04:00 Replace broken links to old haskell-prime site by working links to gitlab instance. [skip ci] - - - - - 0bf8980e by Daniel Gröber at 2020-07-22T20:18:11-04:00 Remove length field from FastString - - - - - 1010c33b by Daniel Gröber at 2020-07-22T20:18:11-04:00 Use ShortByteString for FastString There are multiple reasons we want this: - Fewer allocations: ByteString has 3 fields, ShortByteString just has one. - ByteString memory is pinned: - This can cause fragmentation issues (see for example #13110) but also - makes using FastStrings in compact regions impossible. Metric Decrease: T5837 T12150 T12234 T12425 - - - - - 8336ba78 by Daniel Gröber at 2020-07-22T20:18:11-04:00 Pass specialised utf8DecodeChar# to utf8DecodeLazy# for performance Currently we're passing a indexWord8OffAddr# type function to utf8DecodeLazy# which then passes it on to utf8DecodeChar#. By passing one of utf8DecodeCharAddr# or utf8DecodeCharByteArray# instead we benefit from the inlining and specialization already done for those. - - - - - 7484a9a4 by Daniel Gröber at 2020-07-22T20:18:11-04:00 Encoding: Add comment about tricky ForeignPtr lifetime - - - - - 5536ed28 by Daniel Gröber at 2020-07-22T20:18:11-04:00 Use IO constructor instead of `stToIO . ST` - - - - - 5b8902e3 by Daniel Gröber at 2020-07-22T20:18:11-04:00 Encoding: Remove redundant use of withForeignPtr - - - - - 5976a161 by Daniel Gröber at 2020-07-22T20:18:11-04:00 Encoding: Reformat utf8EncodeShortByteString to be more consistent - - - - - 9ddf1614 by Daniel Gröber at 2020-07-22T20:18:11-04:00 FastString: Reintroduce character count cache Metric Increase: ManyConstructors Metric Decrease: T4029 - - - - - e9491668 by Ben Gamari at 2020-07-22T20:18:46-04:00 get-win32-tarballs: Fix detection of missing tarballs This fixes the error message given by configure when the user attempts to configure without first download the win32 tarballs. - - - - - 9f3ff8fd by Andreas Klebinger at 2020-07-22T20:19:22-04:00 Enable BangPatterns, ScopedTypeVariables for ghc and hadrian by default. This is only for their respective codebases. - - - - - 0f17b930 by Sylvain Henry at 2020-07-22T20:19:59-04:00 Remove unused "ncg" flag This flag has been removed in 066b369de2c6f7da03c88206288dca29ab061b31 in 2011. - - - - - bab4ec8f by Sylvain Henry at 2020-07-22T20:19:59-04:00 Don't panic if the NCG isn't built (it is always built) - - - - - 8ea33edb by Sylvain Henry at 2020-07-22T20:19:59-04:00 Remove unused sGhcWithNativeCodeGen - - - - - e079bb72 by Sylvain Henry at 2020-07-22T20:19:59-04:00 Correctly test active backend Previously we used a platform settings to detect if the native code generator was used. This was wrong. We need to use the `DynFlags.hscTarget` field instead. - - - - - 735f9d6b by Sylvain Henry at 2020-07-22T20:19:59-04:00 Replace ghcWithNativeCodeGen with a proper Backend datatype * Represent backends with a `Backend` datatype in GHC.Driver.Backend * Don't detect the default backend to use for the target platform at compile time in Hadrian/make but at runtime. It makes "Settings" simpler and it is a step toward making GHC multi-target. * The latter change also fixes hadrian which has not been updated to take into account that the NCG now supports AIX and PPC64 (cf df26b95559fd467abc0a3a4151127c95cb5011b9 and d3c1dda60d0ec07fc7f593bfd83ec9457dfa7984) * Also we don't treat iOS specifically anymore (cf cb4878ffd18a3c70f98bdbb413cd3c4d1f054e1f) - - - - - f7cc4313 by Sylvain Henry at 2020-07-22T20:19:59-04:00 Replace HscTarget with Backend They both have the same role and Backend name is more explicit. Metric Decrease: T3064 Update Haddock submodule - - - - - 15ce1804 by Andreas Klebinger at 2020-07-22T20:20:34-04:00 Deprecate -fdmd-tx-dict-sel. It's behaviour is now unconditionally enabled as it's slightly beneficial. There are almost no benchmarks which benefit from disabling it, so it's not worth the keep this configurable. This fixes #18429. - - - - - ff1b7710 by Sylvain Henry at 2020-07-22T20:21:11-04:00 Add test for #18064 It has been fixed by 0effc57d48ace6b719a9f4cbeac67c95ad55010b - - - - - cfa89149 by Krzysztof Gogolewski at 2020-07-22T20:21:48-04:00 Define type Void# = (# #) (#18441) There's one backwards compatibility issue: GHC.Prim no longer exports Void#, we now manually re-export it from GHC.Exts. - - - - - 02f40b0d by Sebastian Graf at 2020-07-22T20:22:23-04:00 Add regression test for #18478 !3392 backported !2993 to GHC 8.10.2 which most probably is responsible for fixing #18478, which triggered a pattern match checker performance regression in GHC 8.10.1 as first observed in #17977. - - - - - 7f44df1e by Sylvain Henry at 2020-07-22T20:23:00-04:00 Minor refactoring of Unit display * for consistency, try to always use UnitPprInfo to display units to users * remove some uses of `unitPackageIdString` as it doesn't show the component name and it uses String - - - - - dff1cb3d by Moritz Angermann at 2020-07-23T07:55:29-04:00 [linker] Fix out of range relocations. mmap may return address all over the place. mmap_next will ensure we get the next free page after the requested address. This is especially important for linking on aarch64, where the memory model with PIC admits relocations in the +-4GB range, and as such we can't work with arbitrary object locations in memory. Of note: we map the rts into process space, so any mapped objects must not be ouside of the 4GB from the processes address space. - - - - - cdd0ff16 by Tamar Christina at 2020-07-24T18:12:23-04:00 winio: restore console cp on exit - - - - - c1f4f81d by Tamar Christina at 2020-07-24T18:13:00-04:00 winio: change memory allocation strategy and fix double free errors. - - - - - ba205046 by Simon Peyton Jones at 2020-07-24T18:13:35-04:00 Care with occCheckExpand in kind of occurrences Issue #18451 showed that we could get an infinite type, through over-use of occCheckExpand in the kind of an /occurrence/ of a type variable. See Note [Occurrence checking: look inside kinds] in GHC.Core.Type This patch fixes the problem by making occCheckExpand less eager to expand synonyms in kinds. It also improves pretty printing of kinds, by *not* suppressing the kind on a tyvar-binder like (a :: Const Type b) where type Const p q = p. Even though the kind of 'a' is Type, we don't want to suppress the kind ascription. Example: the error message for polykinds/T18451{a,b}. See GHC.Core.TyCo.Ppr Note [Suppressing * kinds]. - - - - - 02133353 by Zubin Duggal at 2020-07-25T00:44:30-04:00 Simplify XRec definition Change `Located X` usage to `XRec pass X` This increases the scope of the LPat experiment to almost all of GHC. Introduce UnXRec and MapXRec classes Fixes #17587 and #18408 Updates haddock submodule Co-authored-by: Philipp Krüger <philipp.krueger1 at gmail.com> - - - - - e443846b by Sylvain Henry at 2020-07-25T00:45:07-04:00 DynFlags: store printer in TraceBinIfaceReading We don't need to pass the whole DynFlags, just pass the logging function, if any. - - - - - 15b2b44f by Sylvain Henry at 2020-07-25T00:45:08-04:00 Rename GHC.Driver.Ways into GHC.Platform.Ways - - - - - 342a01af by Sylvain Henry at 2020-07-25T00:45:08-04:00 Add GHC.Platform.Profile - - - - - 6333d739 by Sylvain Henry at 2020-07-25T00:45:08-04:00 Put PlatformConstants into Platform - - - - - 9dfeca6c by Sylvain Henry at 2020-07-25T00:45:08-04:00 Remove platform constant wrappers Platform constant wrappers took a DynFlags parameter, hence implicitly used the target platform constants. We removed them to allow support for several platforms at once (#14335) and to avoid having to pass the full DynFlags to every function (#17957). Metric Decrease: T4801 - - - - - 73145d57 by Sylvain Henry at 2020-07-25T00:45:08-04:00 Remove dead code in utils/derivConstants - - - - - 7721b923 by Sylvain Henry at 2020-07-25T00:45:08-04:00 Move GHC.Platform into the compiler Previously it was in ghc-boot so that ghc-pkg could use it. However it wasn't necessary because ghc-pkg only uses a subset of it: reading target arch and OS from the settings file. This is now done via GHC.Platform.ArchOS (was called PlatformMini before). - - - - - 459afeb5 by Sylvain Henry at 2020-07-25T00:45:08-04:00 Fix build systems - - - - - 9e2930c3 by Sylvain Henry at 2020-07-25T00:45:08-04:00 Bump CountParserDeps - - - - - 6e2db34b by Sylvain Henry at 2020-07-25T00:45:08-04:00 Add accessors to ArchOS - - - - - fc0f6fbc by Stefan Schulze Frielinghaus at 2020-07-25T00:45:45-04:00 Require SMP support in order to build a threaded stage1 Fixes 18266 - - - - - a7c4439a by Matthias Andreas Benkard at 2020-07-26T13:23:24-04:00 Document loadFramework changes. (#18446) Adds commentary on the rationale for the changes made in merge request !3689. - - - - - da7269a4 by Ben Gamari at 2020-07-26T13:23:59-04:00 rts/win32: Exit with EXIT_HEAPOVERFLOW if memory commit fails Since switching to the two-step allocator, the `outofmem` test fails via `osCommitMemory` failing to commit. However, this was previously exiting with `EXIT_FAILURE`, rather than `EXIT_HEAPOVERFLOW`. I think the latter is a more reasonable exit code for this case and matches the behavior on POSIX platforms. - - - - - f153a1d0 by Ben Gamari at 2020-07-26T13:23:59-04:00 testsuite: Update win32 output for parseTree - - - - - e91672f0 by Ben Gamari at 2020-07-26T13:23:59-04:00 testsuite: Normalise WinIO error message differences Previously the old Windows IO manager threw different errors than WinIO. We now canonicalise these to the WinIO errors. - - - - - 9cbfe086 by Ben Gamari at 2020-07-26T13:23:59-04:00 gitlab-ci: Kill ssh-agent after pushing test metrics Otherwise the Windows builds hang forever waiting for the process to terminate. - - - - - 8236925f by Tamar Christina at 2020-07-26T13:24:35-04:00 winio: remove dead argument to stg_newIOPortzh - - - - - ce0a1d67 by Tamar Christina at 2020-07-26T13:25:11-04:00 winio: fix detection of tty terminals - - - - - 52685cf7 by Tamar Christina at 2020-07-26T13:25:48-04:00 winio: update codeowners - - - - - aee45d9e by Vladislav Zavialov at 2020-07-27T07:06:56-04:00 Improve NegativeLiterals (#18022, GHC Proposal #344) Before this patch, NegativeLiterals used to parse x-1 as x (-1). This may not be what the user expects, and now it is fixed: x-1 is parsed as (-) x 1. We achieve this by the following requirement: * When lexing a negative literal, it must not be preceded by a 'closing token'. This also applies to unboxed literals, e.g. -1#. See GHC Proposal #229 for the definition of a closing token. A nice consequence of this change is that -XNegativeLiterals becomes a subset of -XLexicalNegation. In other words, enabling both of those extensions has the same effect as enabling -XLexicalNegation alone. - - - - - 667ab69e by leiftw at 2020-07-27T07:07:32-04:00 fix typo referring to non-existent `-ohidir` flag, should be `-hidir` I think - - - - - 6ff89c17 by Vladislav Zavialov at 2020-07-27T07:08:07-04:00 Refactor the parser a little * Create a dedicated production for type operators * Create a dedicated type for the UNPACK pragma * Remove an outdated part of Note [Parsing data constructors is hard] - - - - - aa054d32 by Ben Gamari at 2020-07-27T20:09:07-04:00 Drop 32-bit Windows support As noted in #18487, we have reached the end of this road. - - - - - 6da73bbf by Michalis Pardalos at 2020-07-27T20:09:44-04:00 Add minimal test for #12492 - - - - - 47680cb7 by Michalis Pardalos at 2020-07-27T20:09:44-04:00 Use allocate, not ALLOC_PRIM_P for unpackClosure# ALLOC_PRIM_P fails for large closures, by directly using allocate we can handle closures which are larger than the block size. Fixes #12492 - - - - - 3d345c96 by Simon Peyton Jones at 2020-07-27T20:10:19-04:00 Eta-expand the Simplifier monad This patch eta-expands the Simplifier's monad, using the method explained in GHC.Core.Unify Note [The one-shot state monad trick]. It's part of the exta-expansion programme in #18202. It's a tiny patch, but is worth a 1-2% reduction in bytes-allocated by the compiler. Here's the list, based on the compiler-performance tests in perf/compiler: Reduction in bytes allocated T10858(normal) -0.7% T12425(optasm) -1.3% T13056(optasm) -1.8% T14683(normal) -1.1% T15164(normal) -1.3% T15630(normal) -1.4% T17516(normal) -2.3% T18282(normal) -1.6% T18304(normal) -0.8% T1969(normal) -0.6% T4801(normal) -0.8% T5321FD(normal) -0.7% T5321Fun(normal) -0.5% T5642(normal) -0.9% T6048(optasm) -1.1% T9020(optasm) -2.7% T9233(normal) -0.7% T9675(optasm) -0.5% T9961(normal) -2.9% WWRec(normal) -1.2% Metric Decrease: T12425 T9020 T9961 - - - - - 57aca6bb by Ben Gamari at 2020-07-27T20:10:54-04:00 gitlab-ci: Ensure that Hadrian jobs don't download artifacts Previously the Hadrian jobs had the default dependencies, meaning that they would download artifacts from all jobs of earlier stages. This is unneccessary. - - - - - 0a815cea by Ben Gamari at 2020-07-27T20:10:54-04:00 gitlab-ci: Bump bootstrap compiler to 8.8.4 Hopefully this will make the Windows jobs a bit more reliable. - - - - - 0bd60059 by Simon Peyton Jones at 2020-07-28T02:01:49-04:00 This patch addresses the exponential blow-up in the simplifier. Specifically: #13253 exponential inlining #10421 ditto #18140 strict constructors #18282 another nested-function call case This patch makes one really significant changes: change the way that mkDupableCont handles StrictArg. The details are explained in GHC.Core.Opt.Simplify Note [Duplicating StrictArg]. Specific changes * In mkDupableCont, when making auxiliary bindings for the other arguments of a call, add extra plumbing so that we don't forget the demand on them. Otherwise we haev to wait for another round of strictness analysis. But actually all the info is to hand. This change affects: - Make the strictness list in ArgInfo be [Demand] instead of [Bool], and rename it to ai_dmds. - Add as_dmd to ValArg - Simplify.makeTrivial takes a Demand - mkDupableContWithDmds takes a [Demand] There are a number of other small changes 1. For Ids that are used at most once in each branch of a case, make the occurrence analyser record the total number of syntactic occurrences. Previously we recorded just OneBranch or MultipleBranches. I thought this was going to be useful, but I ended up barely using it; see Note [Note [Suppress exponential blowup] in GHC.Core.Opt.Simplify.Utils Actual changes: * See the occ_n_br field of OneOcc. * postInlineUnconditionally 2. I found a small perf buglet in SetLevels; see the new function GHC.Core.Opt.SetLevels.hasFreeJoin 3. Remove the sc_cci field of StrictArg. I found I could get its information from the sc_fun field instead. Less to get wrong! 4. In ArgInfo, arrange that ai_dmds and ai_discs have a simpler invariant: they line up with the value arguments beyond ai_args This allowed a bit of nice refactoring; see isStrictArgInfo, lazyArgcontext, strictArgContext There is virtually no difference in nofib. (The runtime numbers are bogus -- I tried a few manually.) Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- fft +0.0% -2.0% -48.3% -49.4% 0.0% multiplier +0.0% -2.2% -50.3% -50.9% 0.0% -------------------------------------------------------------------------------- Min -0.4% -2.2% -59.2% -60.4% 0.0% Max +0.0% +0.1% +3.3% +4.9% 0.0% Geometric Mean +0.0% -0.0% -33.2% -34.3% -0.0% Test T18282 is an existing example of these deeply-nested strict calls. We get a big decrease in compile time (-85%) because so much less inlining takes place. Metric Decrease: T18282 - - - - - 6ee07b49 by Sylvain Henry at 2020-07-28T02:02:27-04:00 Bignum: add support for negative shifts (fix #18499) shiftR/shiftL support negative arguments despite Haskell 2010 report saying otherwise. We explicitly test for negative values which is bad (it gets in the way of constant folding, etc.). Anyway, for consistency we fix Bits instancesof Integer/Natural. - - - - - f305bbfd by Peter Trommler at 2020-07-28T02:03:02-04:00 config: Fix Haskell platform constructor w/ params Fixes #18505 - - - - - 318bb17c by Oleg Grenrus at 2020-07-28T20:54:13-04:00 Fix typo in haddock Spotted by `vilpan` on `#haskell` - - - - - 39c89862 by Sergei Trofimovich at 2020-07-28T20:54:50-04:00 ghc/mk: don't build gmp packages for BIGNUM_BACKEND=native Before this change make-based `BIGNUM_BACKEND=native` build was failing as: ``` x86_64-pc-linux-gnu-gcc: error: libraries/ghc-bignum/gmp/objs/*.o: No such file or directory ``` This happens because ghc.mk was pulling in gmp-dependent ghc-bignum library unconditionally. The change avoid building ghc-bignum. Bug: https://gitlab.haskell.org/ghc/ghc/-/issues/18437 Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - b9a880fc by Felix Wiemuth at 2020-07-29T15:06:35-04:00 Fix typo - - - - - c59064b0 by Brandon Chinn at 2020-07-29T15:07:11-04:00 Add regression test for #16341 - - - - - a61411ca by Brandon Chinn at 2020-07-29T15:07:11-04:00 Pass dit_rep_tc_args to dsm_stock_gen_fn - - - - - a26498da by Brandon Chinn at 2020-07-29T15:07:11-04:00 Pass tc_args to gen_fn - - - - - 44b11bad by Brandon Chinn at 2020-07-29T15:07:11-04:00 Filter out unreachable constructors when deriving stock instances (#16431) - - - - - bbc51916 by Simon Peyton Jones at 2020-07-29T15:07:47-04:00 Kill off sc_mult and as_mult fields They are readily derivable from other fields, so this is more efficient, and less error prone. Fixes #18494 - - - - - e3db4b4c by Peter Trommler at 2020-07-29T15:08:22-04:00 configure: Fix build system on ARM - - - - - 96c31ea1 by Sylvain Henry at 2020-07-29T15:09:02-04:00 Fix bug in Natural multiplication (fix #18509) A bug was lingering in Natural multiplication (inverting two limbs) despite QuickCheck tests used during the development leading to wrong results (independently of the selected backend). - - - - - e1dc3d7b by Krzysztof Gogolewski at 2020-07-29T15:09:39-04:00 Fix validation errors (#18510) Test T2632 is a stage1 test that failed because of the Q => Quote change. The remaining tests did not use quotation and failed when the path contained a space. - - - - - 6c68a842 by John Ericson at 2020-07-30T07:11:02-04:00 For `-fkeep-going` do not duplicate dependency edge code We now compute the deps for `-fkeep-going` the same way that the original graph calculates them, so the edges are correct. Upsweep really ought to take the graph rather than a topological sort so we are never recalculating anything, but at least things are recaluclated consistently now. - - - - - 502de556 by cgibbard at 2020-07-30T07:11:02-04:00 Add haddock comment for unfilteredEdges and move the note about drop_hs_boot_nodes into it. - - - - - 01c948eb by Ryan Scott at 2020-07-30T07:11:37-04:00 Clean up the inferred type variable restriction This patch primarily: * Documents `checkInferredVars` (previously called `check_inferred_vars`) more carefully. This is the function which throws an error message if a user quantifies an inferred type variable in a place where specificity cannot be observed. See `Note [Unobservably inferred type variables]` in `GHC.Rename.HsType`. Note that I now invoke `checkInferredVars` _alongside_ `rnHsSigType`, `rnHsWcSigType`, etc. rather than doing so _inside_ of these functions. This results in slightly more call sites for `checkInferredVars`, but it makes it much easier to enumerate the spots where the inferred type variable restriction comes into effect. * Removes the inferred type variable restriction for default method type signatures, per the discussion in #18432. As a result, this patch fixes #18432. Along the way, I performed some various cleanup: * I moved `no_nested_foralls_contexts_err` into `GHC.Rename.Utils` (under the new name `noNestedForallsContextsErr`), since it now needs to be invoked from multiple modules. I also added a helper function `addNoNestedForallsContextsErr` that throws the error message after producing it, as this is a common idiom. * In order to ensure that users cannot sneak inferred type variables into `SPECIALISE instance` pragmas by way of nested `forall`s, I now invoke `addNoNestedForallsContextsErr` when renaming `SPECIALISE instance` pragmas, much like when we rename normal instance declarations. (This probably should have originally been done as a part of the fix for #18240, but this task was somehow overlooked.) As a result, this patch fixes #18455 as a side effect. - - - - - d47324ce by Ryan Scott at 2020-07-30T07:12:16-04:00 Don't mark closed type family equations as occurrences Previously, `rnFamInstEqn` would mark the name of the type/data family used in an equation as an occurrence, regardless of what sort of family it is. Most of the time, this is the correct thing to do. The exception is closed type families, whose equations constitute its definition and therefore should not be marked as occurrences. Overzealously counting the equations of a closed type family as occurrences can cause certain warnings to not be emitted, as observed in #18470. See `Note [Type family equations and occurrences]` in `GHC.Rename.Module` for the full story. This fixes #18470 with a little bit of extra-casing in `rnFamInstEqn`. To accomplish this, I added an extra `ClosedTyFamInfo` field to the `NonAssocTyFamEqn` constructor of `AssocTyFamInfo` and refactored the relevant call sites accordingly so that this information is propagated to `rnFamInstEqn`. While I was in town, I moved `wrongTyFamName`, which checks that the name of a closed type family matches the name in an equation for that family, from the renamer to the typechecker to avoid the need for an `ASSERT`. As an added bonus, this lets us simplify the details of `ClosedTyFamInfo` a bit. - - - - - ebe2cf45 by Simon Peyton Jones at 2020-07-30T07:12:52-04:00 Remove an incorrect WARN in extendLocalRdrEnv I noticed this warning going off, and discovered that it's really fine. This small patch removes the warning, and docments what is going on. - - - - - 9f71f697 by Simon Peyton Jones at 2020-07-30T07:13:27-04:00 Add two bangs to improve perf of flattening This tiny patch improves the compile time of flatten-heavy programs by 1-2%, by adding two bangs. Addresses (somewhat) #18502 This reduces allocation by T9872b -1.1% T9872d -3.3% T5321Fun -0.2% T5631 -0.2% T5837 +0.1% T6048 +0.1% Metric Decrease: T9872b T9872d - - - - - 7c274cd5 by Sylvain Henry at 2020-07-30T22:54:48-04:00 Fix minimal imports dump for boot files (fix #18497) - - - - - 175cb5b4 by Sylvain Henry at 2020-07-30T22:55:25-04:00 DynFlags: don't use sdocWithDynFlags in datacon ppr We don't need to use `sdocWithDynFlags` to know whether we should display linear types for datacon types, we already have `sdocLinearTypes` field in `SDocContext`. Moreover we want to remove `sdocWithDynFlags` (#10143, #17957)). - - - - - 380638a3 by Sylvain Henry at 2020-07-30T22:56:03-04:00 Bignum: fix powMod for gmp backend (#18515) Also reenable integerPowMod test which had never been reenabled by mistake. - - - - - 56a7c193 by Sylvain Henry at 2020-07-31T19:32:09+02:00 Refactor CLabel pretty-printing Pretty-printing CLabel relies on sdocWithDynFlags that we want to remove (#10143, #17957). It uses it to query the backend and the platform. This patch exposes Clabel ppr functions specialised for each backend so that backend code can directly use them. - - - - - 3b15dc3c by Sylvain Henry at 2020-07-31T19:32:09+02:00 DynFlags: don't use sdocWithDynFlags in GHC.CmmToAsm.Dwarf.Types - - - - - e30fed6c by Vladislav Zavialov at 2020-08-01T04:23:04-04:00 Test case for #17652 The issue was fixed by 19e80b9af252eee760dc047765a9930ef00067ec - - - - - 22641742 by Ryan Scott at 2020-08-02T16:44:11-04:00 Remove ConDeclGADTPrefixPs This removes the `ConDeclGADTPrefixPs` per the discussion in #18517. Most of this patch simply removes code, although the code in the `rnConDecl` case for `ConDeclGADTPrefixPs` had to be moved around a bit: * The nested `forall`s check now lives in the `rnConDecl` case for `ConDeclGADT`. * The `LinearTypes`-specific code that used to live in the `rnConDecl` case for `ConDeclGADTPrefixPs` now lives in `GHC.Parser.PostProcess.mkGadtDecl`, which is now monadic so that it can check if `-XLinearTypes` is enabled. Fixes #18157. - - - - - f2d1accf by Leon Schoorl at 2020-08-02T16:44:47-04:00 Fix GHC_STAGE definition generated by make Fixes #18070 GHC_STAGE is the stage of the compiler we're building, it should be 1,2(,3?). But make was generating 0 and 1. Hadrian does this correctly using a similar `+ 1`: https://gitlab.haskell.org/ghc/ghc/-/blob/eb8115a8c4cbc842b66798480fefc7ab64d31931/hadrian/src/Rules/Generate.hs#L245 - - - - - 947206f4 by Niklas Hambüchen at 2020-08-03T07:52:33+02:00 hadrian: Fix running stage0/bin/ghc with wrong package DB. Fixes #17468. In the invocation of `cabal configure`, `--ghc-pkg-option=--global-package-db` was already given correctly to tell `stage0/bin/ghc-pkg` that it should use the package DB in `stage1/`. However, `ghc` needs to be given this information as well, not only `ghc-pkg`! Until now that was not the case; the package DB in `stage0` was given to `ghc` instead. This was wrong, because there is no binary compatibility guarantee that says that the `stage0` DB's `package.cache` (which is written by the stage0 == system-provided ghc-pkg) can be deserialised by the `ghc-pkg` from the source code tree. As a result, when trying to add fields to `InstalledPackageInfo` that get serialised into / deserialised from the `package.cache`, errors like _build/stage0/lib/package.conf.d/package.cache: GHC.PackageDb.readPackageDb: inappropriate type (Not a valid Unicode code point!) would appear. This was because the `stage0/bin/ghc would try to deserialise the newly added fields from `_build/stage0/lib/package.conf.d/package.cache`, but they were not in there because the system `ghc-pkg` doesn't know about them and thus didn't write them there. It would try to do that because any GHC by default tries to read the global package db in `../lib/package.conf.d/package.cache`. For `stage0/bin/ghc` that *can never work* as explained above, so we must disable this default via `-no-global-package-db` and give it the correct package DB explicitly. This is the same problem as #16534, and the same fix as in MR !780 (but in another context; that one was for developers trying out the `stage0/bin/ghc` == `_build/ghc-stage1` interactively, while this fix is for a `cabal configure` invocation). I also noticed that the fix for #16534 forgot to pass `-no-global-package-db`, and have fixed that in this commit as well. It only worked until now because nobody tried to add a new ghc-pkg `.conf` field since the introduction of Hadrian. - - - - - ef2ae81a by Alex Biehl at 2020-08-03T07:52:33+02:00 Hardcode RTS includes to cope with unregistered builds - - - - - d613ed76 by Sylvain Henry at 2020-08-05T03:59:27-04:00 Bignum: add backward compat integer-gmp functions Also enhance bigNatCheck# and isValidNatural test - - - - - 3f2f7718 by Sylvain Henry at 2020-08-05T03:59:27-04:00 Bignum: add more BigNat compat functions in integer-gmp - - - - - 5e12cd17 by Krzysztof Gogolewski at 2020-08-05T04:00:04-04:00 Rename Core.Opt.Driver -> Core.Opt.Pipeline Closes #18504. - - - - - 2bff2f87 by Ben Gamari at 2020-08-05T04:00:39-04:00 Revert "iserv: Don't pass --export-dynamic on FreeBSD" This reverts commit 2290eb02cf95e9cfffcb15fc9c593d5ef79c75d9. - - - - - 53ce0db5 by Ben Gamari at 2020-08-05T04:00:39-04:00 Refactor handling of object merging Previously to merge a set of object files we would invoke the linker as usual, adding -r to the command-line. However, this can result in non-sensical command-lines which causes lld to balk (#17962). To avoid this we introduce a new tool setting into GHC, -pgmlm, which is the linker which we use to merge object files. - - - - - eb7013c3 by Hécate at 2020-08-05T04:01:15-04:00 Remove all the unnecessary LANGUAGE pragmas - - - - - fbcb886d by Ryan Scott at 2020-08-05T04:01:51-04:00 Make CodeQ and TExpQ levity polymorphic The patch is quite straightforward. The only tricky part is that `Language.Haskell.TH.Lib.Internal` now must be `Trustworthy` instead of `Safe` due to the `GHC.Exts` import (in order to import `TYPE`). Since `CodeQ` has yet to appear in any released version of `template-haskell`, I didn't bother mentioning the change to `CodeQ` in the `template-haskell` release notes. Fixes #18521. - - - - - 686e06c5 by Vladislav Zavialov at 2020-08-06T13:34:05-04:00 Grammar for types and data/newtype constructors Before this patch, we parsed types into a reversed sequence of operators and operands. For example, (F x y + G a b * X) would be parsed as [X, *, b, a, G, +, y, x, F], using a simple grammar: tyapps : tyapp | tyapps tyapp tyapp : atype | PREFIX_AT atype | tyop | unpackedness Then we used a hand-written state machine to assemble this either into a type, using 'mergeOps', or into a constructor, using 'mergeDataCon'. This is due to a syntactic ambiguity: data T1 a = MkT1 a data T2 a = Ord a => MkT2 a In T1, what follows after the = sign is a data/newtype constructor declaration. However, in T2, what follows is a type (of kind Constraint). We don't know which of the two we are parsing until we encounter =>, and we cannot check for => without unlimited lookahead. This poses a few issues when it comes to e.g. infix operators: data I1 = Int :+ Bool :+ Char -- bad data I2 = Int :+ Bool :+ Char => MkI2 -- fine By this issue alone we are forced into parsing into an intermediate representation and doing a separate validation pass. However, should that intermediate representation be as low-level as a flat sequence of operators and operands? Before GHC Proposal #229, the answer was Yes, due to some particularly nasty corner cases: data T = ! A :+ ! B -- used to be fine, hard to parse data T = ! A :+ ! B => MkT -- bad However, now the answer is No, as this corner case is gone: data T = ! A :+ ! B -- bad data T = ! A :+ ! B => MkT -- bad This means we can write a proper grammar for types, overloading it in the DisambECP style, see Note [Ambiguous syntactic categories]. With this patch, we introduce a new class, DisambTD. Just like DisambECP is used to disambiguate between expressions, commands, and patterns, DisambTD is used to disambiguate between types and data/newtype constructors. This way, we get a proper, declarative grammar for constructors and types: infixtype : ftype | ftype tyop infixtype | unpackedness infixtype ftype : atype | tyop | ftype tyarg | ftype PREFIX_AT tyarg tyarg : atype | unpackedness atype And having a grammar for types means we are a step closer to using a single grammar for types and expressions. - - - - - 6770e199 by Vladislav Zavialov at 2020-08-06T13:34:05-04:00 Clean up the story around runPV/runECP_P/runECP_PV This patch started as a small documentation change, an attempt to make Note [Parser-Validator] and Note [Ambiguous syntactic categories] more clear and up-to-date. But it turned out that runECP_P/runECP_PV are weakly motivated, and it's easier to remove them than to find a good rationale/explanation for their existence. As the result, there's a bit of refactoring in addition to a documentation update. - - - - - 826d07db by Vladislav Zavialov at 2020-08-06T13:34:06-04:00 Fix debug_ppr_ty ForAllTy (#18522) Before this change, GHC would pretty-print forall k. forall a -> () as forall @k a. () which isn't even valid Haskell. - - - - - 0ddb4384 by Vladislav Zavialov at 2020-08-06T13:34:06-04:00 Fix visible forall in ppr_ty (#18522) Before this patch, this type: T :: forall k -> (k ~ k) => forall j -> k -> j -> Type was printed incorrectly as: T :: forall k j -> (k ~ k) => k -> j -> Type - - - - - d2a43225 by Richard Eisenberg at 2020-08-06T13:34:06-04:00 Fail eagerly on a lev-poly datacon arg Close #18534. See commentary in the patch. - - - - - 63348155 by Sylvain Henry at 2020-08-06T13:34:08-04:00 Use a type alias for Ways - - - - - 9570c212 by Takenobu Tani at 2020-08-06T19:46:46-04:00 users-guide: Rename 8.12 to 9.0 GHC 8.12.1 has been renamed to GHC 9.0.1. See also: https://mail.haskell.org/pipermail/ghc-devs/2020-July/019083.html [skip ci] - - - - - 3907ee01 by Cale Gibbard at 2020-08-07T08:34:46-04:00 A fix to an error message in monad comprehensions, and a move of dsHandleMonadicFailure as suggested by comments on !2330. - - - - - fa9bb70a by Cale Gibbard at 2020-08-07T08:34:46-04:00 Add some tests for fail messages in do-expressions and monad-comprehensions. - - - - - 5f036063 by Ben Gamari at 2020-08-07T08:35:21-04:00 cmm: Clean up Notes a bit - - - - - 6402c124 by Ben Gamari at 2020-08-07T08:35:21-04:00 CmmLint: Check foreign call argument register invariant As mentioned in Note [Register parameter passing] the arguments of foreign calls cannot refer to caller-saved registers. - - - - - 15b36de0 by Ben Gamari at 2020-08-07T08:35:21-04:00 nativeGen: One approach to fix #18527 Previously the code generator could produce corrupt C call sequences due to register overlap between MachOp lowerings and the platform's calling convention. We fix this using a hack described in Note [Evaluate C-call arguments before placing in destination registers]. - - - - - 3847ae0c by Ben Gamari at 2020-08-07T08:35:21-04:00 testsuite: Add test for #18527 - - - - - dd51d53b by Ben Gamari at 2020-08-07T08:35:21-04:00 testsuite: Fix prog001 Previously it failed as the `ghc` package was not visible. - - - - - e4f1b73a by Alan Zimmerman at 2020-08-07T23:58:10-04:00 ApiAnnotations; tweaks for ghc-exactprint update Remove unused ApiAnns, add one for linear arrow. Include API Annotations for trailing comma in export list. - - - - - 8a665db6 by Ben Gamari at 2020-08-07T23:58:45-04:00 configure: Fix double-negation in ld merge-objects check We want to only run the check if ld is gold. Fixes the fix to #17962. - - - - - a11c9678 by Adam Sandberg Ericsson at 2020-08-09T11:32:25+02:00 hadrian: depend on boot compiler version #18001 - - - - - c8873b52 by Alan Zimmerman at 2020-08-09T21:17:54-04:00 Api Annotations : Adjust SrcSpans for prefix bang (!). And prefix ~ (cherry picked from commit 8dbee2c578b1f642d45561be3f416119863e01eb) - - - - - 77398b67 by Sylvain Henry at 2020-08-09T21:18:34-04:00 Avoid allocations in `splitAtList` (#18535) As suspected by @simonpj in #18535, avoiding allocations in `GHC.Utils.Misc.splitAtList` when there are no leftover arguments is beneficial for performance: On CI validate-x86_64-linux-deb9-hadrian: T12227 -7% T12545 -12.3% T5030 -10% T9872a -2% T9872b -2.1% T9872c -2.5% Metric Decrease: T12227 T12545 T5030 T9872a T9872b T9872c - - - - - 8ba41a0f by Felix Yan at 2020-08-10T20:23:29-04:00 Correct a typo in ghc.mk - - - - - 1c469264 by Felix Yan at 2020-08-10T20:23:29-04:00 Add a closing parenthesis too - - - - - acf537f9 by Sylvain Henry at 2020-08-10T20:24:09-04:00 Make splitAtList strict in its arguments Also fix its slightly wrong comment Metric Decrease: T5030 T12227 T12545 - - - - - ab4d1589 by Ben Gamari at 2020-08-11T22:18:03-04:00 typecheck: Drop SPECIALISE pragmas when there is no unfolding Previously the desugarer would instead fall over when it realized that there was no unfolding for an imported function with a SPECIALISE pragma. We now rather drop the SPECIALISE pragma and throw a warning. Fixes #18118. - - - - - 0ac8c0a5 by Ben Gamari at 2020-08-11T22:18:03-04:00 testsuite: Add test for #18118 - - - - - c43078d7 by Sven Tennie at 2020-08-11T22:18:38-04:00 Add hie.yaml to ghc-heap This enables IDE support by haskell-language-server for ghc-heap. - - - - - f1088b3f by Ben Gamari at 2020-08-11T22:19:15-04:00 testsuite: Specify metrics collected by T17516 Previously it collected everything, including "max bytes used". This is problematic since the test makes no attempt to control for deviations in GC timing, resulting in high variability. Fix this by only collecting "bytes allocated". - - - - - accbc242 by Sylvain Henry at 2020-08-12T03:50:12-04:00 DynFlags: disentangle Outputable - put panic related functions into GHC.Utils.Panic - put trace related functions using DynFlags in GHC.Driver.Ppr One step closer making Outputable fully independent of DynFlags. Bump haddock submodule - - - - - db6dd810 by Ben Gamari at 2020-08-12T03:50:48-04:00 testsuite: Increase tolerance of T16916 T16916 (testing #16916) has been slightly fragile in CI due to its reliance on CPU times. While it's hard to see how to eliminate the time-dependence entirely, we can nevertheless make it more tolerant. Fixes #16966. - - - - - bee43aca by Sylvain Henry at 2020-08-12T20:52:50-04:00 Rewrite and move the monad-state hack note The note has been rewritten by @simonpj in !3851 [skip ci] - - - - - 25fdf25e by Alan Zimmerman at 2020-08-12T20:53:26-04:00 ApiAnnotations: Fix parser for new GHC 9.0 features - - - - - 7831fe05 by Ben Gamari at 2020-08-13T03:44:17-04:00 parser: Suggest ImportQualifiedPost in prepositive import warning As suggested in #18545. - - - - - 55dec4dc by Sebastian Graf at 2020-08-13T03:44:52-04:00 PmCheck: Better long-distance info for where bindings (#18533) Where bindings can see evidence from the pattern match of the `GRHSs` they belong to, but not from anything in any of the guards (which belong to one of possibly many RHSs). Before this patch, we did *not* consider said evidence, causing #18533, where the lack of considering type information from a case pattern match leads to failure to resolve the vanilla COMPLETE set of a data type. Making available that information required a medium amount of refactoring so that `checkMatches` can return a `[(Deltas, NonEmpty Deltas)]`; one `(Deltas, NonEmpty Deltas)` for each `GRHSs` of the match group. The first component of the pair is the covered set of the pattern, the second component is one covered set per RHS. Fixes #18533. Regression test case: T18533 - - - - - cf97889a by Hécate at 2020-08-13T03:45:29-04:00 Re-add BangPatterns to CodePage.hs - - - - - ffc0d578 by Sylvain Henry at 2020-08-13T09:49:56-04:00 Add HomeUnit type Since Backpack the "home unit" is much more involved than what it was before (just an identifier obtained with `-this-unit-id`). Now it is used in conjunction with `-component-id` and `-instantiated-with` to configure module instantiations and to detect if we are type-checking an indefinite unit or compiling a definite one. This patch introduces a new HomeUnit datatype which is much easier to understand. Moreover to make GHC support several packages in the same instances, we will need to handle several HomeUnits so having a dedicated (documented) type is helpful. Finally in #14335 we will also need to handle the case where we have no HomeUnit at all because we are only loading existing interfaces for plugins which live in a different space compared to units used to produce target code. Several functions will have to be refactored to accept "Maybe HomeUnit" parameters instead of implicitly querying the HomeUnit fields in DynFlags. Having a dedicated type will make this easier. Bump haddock submodule - - - - - 8a51b2ab by Sylvain Henry at 2020-08-13T21:09:15-04:00 Make IOEnv monad one-shot (#18202) On CI (x86_64-linux-deb9-hadrian, compile_time/bytes_allocated): T10421 -1.8% (threshold: +/- 1%) T10421a -1.7% (threshold: +/- 1%) T12150 -4.9% (threshold: +/- 2%) T12227 -1.6 (threshold: +/- 1%) T12425 -1.5% (threshold: +/- 1%) T12545 -3.8% (threshold: +/- 1%) T12707 -3.0% (threshold: +/- 1%) T13035 -3.0% (threshold: +/- 1%) T14683 -10.3% (threshold: +/- 2%) T3064 -6.9% (threshold: +/- 2%) T4801 -4.3% (threshold: +/- 2%) T5030 -2.6% (threshold: +/- 2%) T5321FD -3.6% (threshold: +/- 2%) T5321Fun -4.6% (threshold: +/- 2%) T5631 -19.7% (threshold: +/- 2%) T5642 -13.0% (threshold: +/- 2%) T783 -2.7 (threshold: +/- 2%) T9020 -11.1 (threshold: +/- 2%) T9961 -3.4% (threshold: +/- 2%) T1969 (compile_time/bytes_allocated) -2.2% (threshold: +/-1%) T1969 (compile_time/max_bytes_used) +24.4% (threshold: +/-20%) Additionally on other CIs: haddock.Cabal -10.0% (threshold: +/- 5%) haddock.compiler -9.5% (threshold: +/- 5%) haddock.base (max bytes used) +24.6% (threshold: +/- 15%) T10370 (max bytes used, i386) +18.4% (threshold: +/- 15%) Metric Decrease: T10421 T10421a T12150 T12227 T12425 T12545 T12707 T13035 T14683 T3064 T4801 T5030 T5321FD T5321Fun T5631 T5642 T783 T9020 T9961 haddock.Cabal haddock.compiler Metric Decrease 'compile_time/bytes allocated': T1969 Metric Increase 'compile_time/max_bytes_used': T1969 T10370 haddock.base - - - - - 9f66fdf6 by Ben Gamari at 2020-08-14T15:50:34-04:00 testsuite: Drop --io-manager flag from testsuite configuration This is no longer necessary as there are now dedicated testsuite ways which run tests with WinIO. - - - - - 55fd1dc5 by Ben Gamari at 2020-08-14T15:51:10-04:00 llvm-targets: Add i686 targets Addresses #18422. - - - - - f4cc57fa by Ben Gamari at 2020-08-18T15:38:55-04:00 Allow unsaturated runRW# applications Previously we had a very aggressive Core Lint check which caught unsaturated applications of runRW#. However, there is nothing wrong with such applications and they may naturally arise in desugared Core. For instance, the desugared Core of Data.Primitive.Array.runArray# from the `primitive` package contains: case ($) (runRW# @_ @_) (\s -> ...) of ... In this case it's almost certain that ($) will be inlined, turning the application into a saturated application. However, even if this weren't the case there isn't a problem: CorePrep (after deleting an unnecessary case) can simply generate code in its usual way, resulting in a call to the Haskell definition of runRW#. Fixes #18291. - - - - - 3ac6ae7c by Ben Gamari at 2020-08-18T15:38:55-04:00 testsuite: Add test for #18291 - - - - - a87a0b49 by Eli Schwartz at 2020-08-18T15:39:30-04:00 install: do not install sphinx doctrees These files are 100% not needed at install time, and they contain unreproducible info. See https://reproducible-builds.org/ for why this matters. - - - - - 194b25ee by Ben Gamari at 2020-08-18T15:40:05-04:00 testsuite: Allow baseline commit to be set explicitly - - - - - fdcf7645 by Ben Gamari at 2020-08-18T15:40:05-04:00 gitlab-ci: Use MR base commit as performance baseline - - - - - 9ad5cab3 by Fendor at 2020-08-18T15:40:42-04:00 Expose UnitInfoMap as it is part of the public API - - - - - aa4b744d by Ben Gamari at 2020-08-18T22:11:36-04:00 testsuite: Only run llvm ways if llc is available As noted in #18560, we previously would always run the LLVM ways since `configure` would set `SettingsLlcCommand` to something non-null when it otherwise couldn't find the `llc` executable. Now we rather probe for the existence of the `llc` executable in the testsuite driver. Fixes #18560. - - - - - 0c5ed5c7 by Sylvain Henry at 2020-08-18T22:12:13-04:00 DynFlags: refactor GHC.CmmToAsm (#17957, #10143) This patch removes the use of `sdocWithDynFlags` from GHC.CmmToAsm.*.Ppr To do that I've had to make some refactoring: * X86' and PPC's `Instr` are no longer `Outputable` as they require a `Platform` argument * `Instruction` class now exposes `pprInstr :: Platform -> instr -> SDoc` * as a consequence, I've refactored some modules to avoid .hs-boot files * added (derived) functor instances for some datatypes parametric in the instruction type. It's useful for pretty-printing as we just have to map `pprInstr` before pretty-printing the container datatype. - - - - - 731c8d3b by nineonine at 2020-08-19T18:47:39-04:00 Implement -Wredundant-bang-patterns (#17340) Add new flag '-Wredundant-bang-patterns' that enables checks for "dead" bangs. Dead bangs are the ones that under no circumstances can force a thunk that wasn't already forced. Dead bangs are a form of redundant bangs. The new check is performed in Pattern-Match Coverage Checker along with other checks (namely, redundant and inaccessible RHSs). Given f :: Bool -> Int f True = 1 f !x = 2 we can detect dead bang patterns by checking whether @x ~ ⊥@ is satisfiable where the PmBang appears in 'checkGrdTree'. If not, then clearly the bang is dead. Such a dead bang is then indicated in the annotated pattern-match tree by a 'RedundantSrcBang' wrapping. In 'redundantAndInaccessibles', we collect all dead bangs to warn about. Note that we don't want to warn for a dead bang that appears on a redundant clause. That is because in that case, we recommend to delete the clause wholly, including its leading pattern match. Dead bang patterns are redundant. But there are bang patterns which are redundant that aren't dead, for example f !() = 0 the bang still forces the match variable, before we attempt to match on (). But it is redundant with the forcing done by the () match. We currently don't detect redundant bangs that aren't dead. - - - - - eb9bdaef by Simon Peyton Jones at 2020-08-19T18:48:14-04:00 Add right-to-left rule for pattern bindings Fix #18323 by adding a few lines of code to handle non-recursive pattern bindings. see GHC.Tc.Gen.Bind Note [Special case for non-recursive pattern bindings] Alas, this confused the pattern-match overlap checker; see #18323. Note that this patch only affects pattern bindings like that for (x,y) in this program combine :: (forall a . [a] -> a) -> [forall a. a -> a] -> ((forall a . [a] -> a), [forall a. a -> a]) breaks = let (x,y) = combine head ids in x y True We need ImpredicativeTypes for those [forall a. a->a] types to be valid. And with ImpredicativeTypes the old, unprincipled "allow unification variables to unify with a polytype" story actually works quite well. So this test compiles fine (if delicatedly) with old GHCs; but not with QuickLook unless we add this patch - - - - - 293c7fba by Sylvain Henry at 2020-08-21T09:36:38-04:00 Put CFG weights into their own module (#17957) It avoids having to query DynFlags to get them - - - - - 50eb4460 by Sylvain Henry at 2020-08-21T09:36:38-04:00 Don't use DynFlags in CmmToAsm.BlockLayout (#17957) - - - - - 659eb31b by Sylvain Henry at 2020-08-21T09:36:38-04:00 NCG: Dwarf configuration * remove references to DynFlags in GHC.CmmToAsm.Dwarf * add specific Dwarf options in NCGConfig instead of directly querying the debug level - - - - - 2d8ca917 by Sylvain Henry at 2020-08-21T09:37:15-04:00 Fix -ddump-stg flag -ddump-stg was dumping the initial STG (just after Core-to-STG pass) which was misleading because we want the final STG to know if a function allocates or not. Now we have a new flag -ddump-stg-from-core for this and -ddump-stg is deprecated. - - - - - fddddbf4 by Vladislav Zavialov at 2020-08-21T09:37:49-04:00 Import qualified Prelude in Cmm/Parser.y In preparation for the next version of 'happy', c95920 added a qualified import to GHC/Parser.y but for some reason neglected GHC/Cmm/Parser.y This patch adds the missing qualified import to GHC/Cmm/Parser.y and also adds a clarifying comment to explain why this import is needed. - - - - - 989c1c27 by Ben Gamari at 2020-08-21T11:27:53-04:00 gitlab-ci: Test master branch as well While these builds are strictly speaking redundant (since every commit is tested by @marge-bot before making it into `master`), they are nevertheless useful as they are displayed in the branch's commit list in GitLab's web interface. Fixes #18595. - - - - - e67ae884 by Aditya Gupta at 2020-08-22T03:29:00-04:00 mkUnique refactoring (#18362) Move uniqFromMask from Unique.Supply to Unique. Move the the functions that call mkUnique from Unique to Builtin.Uniques - - - - - 03cfcfd4 by Wander Hillen at 2020-08-22T03:29:36-04:00 Add ubuntu 20.04 jobs for nightly and release - - - - - 3f501545 by Craig Ferguson at 2020-08-22T03:30:13-04:00 Utils: clarify docs slightly The previous comment implies `nTimes n f` is either `f^{n+1}` or `f^{2^n}` (when in fact it's `f^n`). - - - - - 8b865092 by Krzysztof Gogolewski at 2020-08-23T14:12:53+02:00 Do not print synonyms in :i (->), :i Type (#18594) This adds a new printing flag `sdocPrintTypeAbbreviations` that is used specifically to avoid ghci printing 'type (->) = (->)' and 'type Type = Type'. - - - - - d8f61182 by Krzysztof Gogolewski at 2020-08-23T14:12:56+02:00 Move pprTyTcApp' inside pprTyTcApp No semantic change - - - - - 364258e0 by Krzysztof Gogolewski at 2020-08-24T00:32:31-04:00 Fix types in silly shifts (#18589) Patch written by Simon. I have only added a testcase. - - - - - b1eb38a0 by Sylvain Henry at 2020-08-24T00:33:13-04:00 Perf: make SDoc monad one-shot (#18202) With validate-x86_64-linux-deb9-hadrian: T1969 -3.4% (threshold: +/-1%) T3294 -3.3% (threshold: +/-1%) T12707 -1.4% (threshold: +/-1%) Additionally with validate-x86_64-linux-deb9-unreg-hadrian: T4801 -2.4% (threshold: +/-2%) T13035 -1.4% (threshold: +/-1%) T13379 -2.4% (threshold: +/-2%) ManyAlternatives -2.5% (threshold: +/-2%) ManyConstructors -3.0% (threshold: +/-2%) Metric Decrease: T12707 T1969 T3294 ManyAlternatives ManyConstructors T13035 T13379 T4801 - - - - - a77b9ec2 by Krzysztof Gogolewski at 2020-08-24T10:04:20-04:00 Add a test for #18397 The bug was fixed by !3421. - - - - - 05550a5a by Sylvain Henry at 2020-08-24T10:04:59-04:00 Avoid roundtrip through SDoc As found by @monoidal on https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3885#note_295126 - - - - - 0a1ecc5f by Ben Gamari at 2020-08-25T07:37:05-04:00 SysTools.Process: Handle exceptions in readCreateProcessWithExitCode' In #18069 we are observing MVar deadlocks from somewhere in ghc.exe. This use of MVar stood out as being one of the more likely culprits. Here we make sure that it is exception-safe. - - - - - db8793ad by Richard Eisenberg at 2020-08-25T07:37:40-04:00 Use tcView, not coreView, in the pure unifier. Addresses a lingering point within #11715. - - - - - fb77207a by Simon Peyton Jones at 2020-08-25T07:38:16-04:00 Use LIdP rather than (XRec p (IdP p)) This patch mainly just replaces use of XRec p (IdP p) with LIdP p One slightly more significant change is to parameterise HsPatSynDetails over the pass rather than the argument type, so that it's uniform with HsConDeclDetails and HsConPatDetails. I also got rid of the dead code GHC.Hs.type.conDetailsArgs But this is all just minor refactoring. No change in functionality. - - - - - 8426a136 by Krzysztof Gogolewski at 2020-08-25T07:38:54-04:00 Add a test for #18585 - - - - - 2d635a50 by Takenobu Tani at 2020-08-26T04:50:21-04:00 linters: Make CPP linter skip image files This patch adds an exclusion rule for `docs/users_guide/images`, to avoid lint errors of PDF files. - - - - - b7d98cb2 by Takenobu Tani at 2020-08-26T04:50:21-04:00 users-guide: Color the logo on the front page of the PDF This patch updates the logo with a recent color scheme. This affects only the PDF version of the user's guide. See also: * https://mail.haskell.org/pipermail/ghc-devs/2020-August/019139.html * https://gitlab.haskell.org/ghc/ghc/-/wikis/logo - - - - - 0b17fa18 by Sylvain Henry at 2020-08-26T04:50:58-04:00 Refactor UnitId pretty-printing When we pretty-print a UnitId for the user, we try to map it back to its origin package name, version and component to print "package-version:component" instead of some hash. The UnitId type doesn't carry these information, so we have to look into a UnitState to find them. This is why the Outputable instance of UnitId used `sdocWithDynFlags` in order to access the `unitState` field of DynFlags. This is wrong for several reasons: 1. The DynFlags are accessed when the message is printed, not when it is generated. So we could imagine that the unitState may have changed in-between. Especially if we want to allow unit unloading. 2. We want GHC to support several independent sessions at once, hence several UnitState. The current approach supposes there is a unique UnitState as a UnitId doesn't indicate which UnitState to use. See the Note [Pretty-printing UnitId] in GHC.Unit for the new approach implemented by this patch. One step closer to remove `sdocDynFlags` field from `SDocContext` (#10143). Fix #18124. Also fix some Backpack code to use SDoc instead of String. - - - - - dc476a50 by Sylvain Henry at 2020-08-26T04:51:35-04:00 Bignum: fix BigNat subtraction (#18604) There was a confusion between the boolean expected by withNewWordArrayTrimedMaybe and the boolean returned by subtracting functions. - - - - - fcb10b6c by Peter Trommler at 2020-08-26T10:42:30-04:00 PPC and X86: Portable printing of IEEE floats GNU as and the AIX assembler support floating point literals. SPARC seems to have support too but I cannot test on SPARC. Curiously, `doubleToBytes` is also used in the LLVM backend. To avoid endianness issues when cross-compiling float and double literals are printed as C-style floating point values. The assembler then takes care of memory layout and endianness. This was brought up in #18431 by @hsyl20. - - - - - 770100e0 by Krzysztof Gogolewski at 2020-08-26T10:43:13-04:00 primops: Remove Monadic and Dyadic categories There were four categories of primops: Monadic, Dyadic, Compare, GenPrimOp. The compiler does not treat Monadic and Dyadic in any special way, we can just replace them with GenPrimOp. Compare is still used in isComparisonPrimOp. - - - - - 01ff8c89 by Aditya Gupta at 2020-08-27T14:19:26-04:00 Consolidate imports in getMinimalImports (#18264) - - - - - bacccb73 by Ryan Scott at 2020-08-27T14:20:01-04:00 Make {hsExpr,hsType,pat}NeedsParens aware of boxed 1-tuples `hsExprNeedsParens`, `hsTypeNeedsParens`, and `patNeedsParens` previously assumed that all uses of explicit tuples in the source syntax never need to be parenthesized. This is true save for one exception: boxed one-tuples, which use the `Solo` data type from `GHC.Tuple` instead of special tuple syntax. This patch adds the necessary logic to the three `*NeedsParens` functions to handle `Solo` correctly. Fixes #18612. - - - - - c6f50cea by Krzysztof Gogolewski at 2020-08-28T02:22:36-04:00 Add missing primop documentation (#18454) - Add three pseudoops to primops.txt.pp, so that Haddock renders the documentation - Update comments - Remove special case for "->" - it's no longer exported from GHC.Prim - Remove reference to Note [Compiling GHC.Prim] - the ad-hoc fix is no longer there after updates to levity polymorphism. - Document GHC.Prim - Remove the comment that lazy is levity-polymorphic. As far as I can tell, it never was: in 80e399639, only the unfolding was given an open type variable. - Remove haddock hack in GHC.Magic - no longer neccessary after adding realWorld# to primops.txt.pp. - - - - - f065b6b0 by Tamar Christina at 2020-08-28T02:23:13-04:00 Fix use distro toolchian - - - - - 4517a382 by Tamar Christina at 2020-08-28T02:23:13-04:00 document how build system find toolchains on Windows - - - - - 329f7cb9 by Ben Gamari at 2020-08-31T22:59:14-04:00 base: Better error message on invalid getSystemTimerManager call Previously we would produce a rather unhelpful pattern match failure error in the case where the user called `getSystemTimerManager` in a program which isn't built with `-threaded`. This understandably confused the user in #15616. Fixes #15616. - - - - - f6d70a8f by Roland Senn at 2020-08-31T22:59:50-04:00 Add tests for #15617. Avoid a similar regression in the future. - - - - - e5969fd0 by Roland Senn at 2020-08-31T23:00:27-04:00 Add additional tests for #18172 (Followup MR 3543) There was still one active discussion [thread](https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3543#note_284325) when MR !3543 got merged. This MR adds the requested tests exercising the changes in `compiler/GHC/HsToCore/Match/Literal.hs:warnAboutEmptyEnumerations` and its sub-functions. - - - - - fe18b482 by Ben Gamari at 2020-08-31T23:01:02-04:00 Bump Win32 and process submodules - - - - - 2da93308 by Sylvain Henry at 2020-08-31T23:01:39-04:00 Hadrian: fix slow-validate flavour (#18586) - - - - - 85e13008 by Andreas Klebinger at 2020-08-31T23:02:15-04:00 Update dominator code with fixes from the dom-lt package. Two bugs turned out in the package that have been fixed since. This MR includes this fixes in the GHC port of the code. - - - - - dffb38fa by Andreas Klebinger at 2020-08-31T23:02:15-04:00 Dominators.hs: Use unix line endings - - - - - 6189cc04 by Moritz Angermann at 2020-08-31T23:02:50-04:00 [fixup 3433] move debugBelch into IF_DEBUG(linker) The commit in dff1cb3d9c111808fec60190747272b973547c52 incorrectly left the `debugBelch` function without a comment or IF_DEBUG(linker,) decoration. This rectifies it. Needs at least a 8.10 backport, as it was backported in 6471cc6aff80d5deebbdb1bf7b677b31ed2af3d5 - - - - - bcb68a3f by Sylvain Henry at 2020-08-31T23:03:27-04:00 Don't store HomeUnit in UnitConfig Allow the creation of a UnitConfig (hence of a UnitState) without having a HomeUnit. It's required for #14335. - - - - - 0a372387 by Sylvain Henry at 2020-08-31T23:04:04-04:00 Fix documentation and fix "check" bignum backend (#18604) - - - - - eb85f125 by Moritz Angermann at 2020-08-31T23:04:39-04:00 Set the dynamic-system-linker flag to Manual This flag should be user controllable, hence Manual: True. - - - - - 380ef845 by Sven Tennie at 2020-08-31T23:05:14-04:00 Ignore more files Ignore files from "new style" cabal builds (dist-newstyle folders) and from clangd (C language server). - - - - - 74a7fbff by Takenobu Tani at 2020-08-31T23:05:51-04:00 Limit upper version of Happy for ghc-9.0 and earlier (#18620) This patch adds the upper bound of a happy version for ghc-9.0 and earlier. Currently, we can't use happy-1.20.0 for ghc-9.0. See #18620. - - - - - a4473f02 by Takenobu Tani at 2020-08-31T23:05:51-04:00 Limit upper version of Happy for ghc-9.2 (#18620) This patch adds the upper bound of a happy version for ghc-9.2. Currently, We can use happy-1.19 or happy-1.20 for ghc-9.2. See #18620. - - - - - a8a2568b by Sylvain Henry at 2020-08-31T23:06:28-04:00 Bignum: add BigNat compat functions (#18613) - - - - - 884245dd by Sylvain Henry at 2020-09-01T12:39:36-04:00 Fix FastString lexicographic ordering (fix #18562) - - - - - 4b4fbc58 by Sylvain Henry at 2020-09-01T12:39:36-04:00 Remove "Ord FastString" instance FastStrings can be compared in 2 ways: by Unique or lexically. We don't want to bless one particular way with an "Ord" instance because it leads to bugs (#18562) or to suboptimal code (e.g. using lexical comparison while a Unique comparison would suffice). UTF-8 encoding has the advantage that sorting strings by their encoded bytes also sorts them by their Unicode code points, without having to decode the actual code points. BUT GHC uses Modified UTF-8 which diverges from UTF-8 by encoding \0 as 0xC080 instead of 0x00 (to avoid null bytes in the middle of a String so that the string can still be null-terminated). This patch adds a new `utf8CompareShortByteString` function that performs sorting by bytes but that also takes Modified UTF-8 into account. It is much more performant than decoding the strings into [Char] to perform comparisons (which we did in the previous patch). Bump haddock submodule - - - - - b4edcde7 by Ben Gamari at 2020-09-01T14:53:42-04:00 testsuite: Add broken test for #18302 - - - - - bfab2a30 by Sebastian Graf at 2020-09-02T15:54:55-04:00 Turn on -XMonoLocalBinds by default (#18430) And fix the resulting type errors. Co-authored-by: Krzysztof Gogolewski <krz.gogolewski at gmail.com> Metric Decrease: parsing001 - - - - - c30cc0e9 by David Feuer at 2020-09-02T15:55:31-04:00 Remove potential space leak from Data.List.transpose Previously, `transpose` produced a list of heads and a list of tails independently. This meant that a function using only some heads, and only some tails, could potentially leak space. Use `unzip` to work around the problem by producing pairs and selector thunks instead. Time and allocation behavior will be worse, but there should be no more leak potential. - - - - - ffc3da47 by Sylvain Henry at 2020-09-02T15:56:11-04:00 Remove outdated note - - - - - 85e62123 by Sylvain Henry at 2020-09-02T15:56:48-04:00 Bignum: add missing compat import/export functions - - - - - 397c2b03 by Ben Gamari at 2020-09-03T17:31:47-04:00 configure: Work around Raspbian's silly packaging decisions See #17856. - - - - - 4891c18a by Kathryn Spiers at 2020-09-03T17:32:24-04:00 expected-undocumented-flags remove kill flags It looks like the flags were removed in https://gitlab.haskell.org/ghc/ghc/-/commit/3e27205a66b06a4501d87eb31e285eadbc693eb7 and can safely be removed here - - - - - 1d6d6488 by Sylvain Henry at 2020-09-04T16:24:20-04:00 Don't rely on CLabel's Outputable instance in CmmToC This is in preparation of the removal of sdocWithDynFlags (#10143), hence of the refactoring of CLabel's Outputable instance. - - - - - 89ce7cdf by Sylvain Henry at 2020-09-04T16:24:59-04:00 DynFlags: use Platform in foldRegs* - - - - - 220ad8d6 by Sylvain Henry at 2020-09-04T16:24:59-04:00 DynFlags: don't pass DynFlags to cmmImplementSwitchPlans - - - - - c1e54439 by Ryan Scott at 2020-09-04T16:25:35-04:00 Introduce isBoxedTupleDataCon and use it to fix #18644 The code that converts promoted tuple data constructors to `IfaceType`s in `GHC.CoreToIface` was using `isTupleDataCon`, which conflates boxed and unboxed tuple data constructors. To avoid this, this patch introduces `isBoxedTupleDataCon`, which is like `isTupleDataCon` but only works for _boxed_ tuple data constructors. While I was in town, I was horribly confused by the fact that there were separate functions named `isUnboxedTupleCon` and `isUnboxedTupleTyCon` (similarly, `isUnboxedSumCon` and `isUnboxedSumTyCon`). It turns out that the former only works for data constructors, despite its very general name! I opted to rename `isUnboxedTupleCon` to `isUnboxedTupleDataCon` (similarly, I renamed `isUnboxedSumCon` to `isUnboxedSumDataCon`) to avoid this potential confusion, as well as to be more consistent with the naming convention I used for `isBoxedTupleDataCon`. Fixes #18644. - - - - - 07bdcac3 by GHC GitLab CI at 2020-09-04T22:26:25-04:00 configure: Avoid hard-coded ld path on Windows The fix to #17962 ended up regressing on Windows as it failed to replicate the logic responsible for overriding the toolchain paths on Windows. This resulted in a hard-coded path to a directory that likely doesn't exist on the user's system (#18550). - - - - - 0be8e746 by Benjamin Maurer at 2020-09-04T22:27:01-04:00 Documented the as of yet undocumented '--print-*' GHC flags, as well as `-split-objs`, since that is related to `--print-object-splitting-supported`. See #18641 - - - - - 4813486f by Sylvain Henry at 2020-09-04T22:27:44-04:00 Move Hadrian's wiki pages in tree (fix #16165) Only the debugging page contains interesting stuff. Some of this stuff looks old (e.g. recommending "cabal install")... - - - - - 7980ae23 by GHC GitLab CI at 2020-09-05T14:50:52-04:00 rts: Consistently use stgMallocBytes instead of malloc This can help in debugging RTS memory leaks since all allocations go through the same interface. - - - - - 67059893 by Ben Gamari at 2020-09-05T14:51:27-04:00 configure: Fix whitespace - - - - - be2cc0ad by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: More intelligent detection of locale availability Previously ci.sh would unconditionally use C.UTF-8. However, this fails on Centos 7, which appears not to provide this locale. Now we first try C.UTF-8, then try en_US.UTF-8, then fail. Works around #18607. - - - - - 15dca847 by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: Rename RELEASE variable to RELEASE_JOB This interfered with the autoconf variable of the same name, breaking pre-release builds. - - - - - bec0d170 by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: Bump Windows toolchain version This should have been done when we bumped the bootstrap compiler to 8.8.4. - - - - - 9fbaee21 by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: Drop Windows make job These are a significant burden on our CI resources and end up failing quite often due to #18274. Here I drop the make jobs during validaion; it is now run only during the nightly builds. - - - - - 869f6e19 by Ben Gamari at 2020-09-05T14:51:27-04:00 testsuite: Drop Windows-specific output for parseTree The normalise_slashes normaliser should handle this. - - - - - 2c9f743c by Ben Gamari at 2020-09-05T14:51:28-04:00 testsuite: Mark T5975[ab] as broken on Windows Due to #7305. - - - - - 643785e3 by Ben Gamari at 2020-09-05T14:51:28-04:00 gitlab-ci: Fix typo A small typo in a rule regular expression. - - - - - c5413fc6 by Wander Hillen at 2020-09-07T09:33:54-04:00 Add clarification regarding poll/kqueue flags - - - - - 10434d60 by Ben Gamari at 2020-09-07T09:34:32-04:00 gitlab-ci: Configure bignum backend in Hadrian builds - - - - - d4bc9f0d by Ben Gamari at 2020-09-07T09:34:32-04:00 gitlab-ci: Use hadrian builds for Windows release artifacts - - - - - 4ff93292 by Moritz Angermann at 2020-09-07T21:18:39-04:00 [macOS] improved runpath handling In b592bd98ff25730bbe3c13d6f62a427df8c78e28 we started using -dead_strip_dylib on macOS when lining dynamic libraries and binaries. The underlying reason being the Load Command Size Limit in macOS Sierra (10.14) and later. GHC will produce @rpath/libHS... dependency entries together with a corresponding RPATH entry pointing to the location of the libHS... library. Thus for every library we produce two Load Commands. One to specify the dependent library, and one with the path where to find it. This makes relocating libraries and binaries easier, as we just need to update the RPATH entry with the install_name_tool. The dynamic linker will then subsitute each @rpath with the RPATH entries it finds in the libraries load commands or the environement, when looking up @rpath relative libraries. -dead_strip_dylibs intructs the linker to drop unused libraries. This in turn help us reduce the number of referenced libraries, and subsequently the size of the load commands. This however does not remove the RPATH entries. Subsequently we can end up (in extreme cases) with only a single @rpath/libHS... entry, but 100s or more RPATH entries in the Load Commands. This patch rectifies this (slighly unorthodox) by passing *no* -rpath arguments to the linker at link time, but -headerpad 8000. The headerpad argument is in hexadecimal and the maxium 32k of the load command size. This tells the linker to pad the load command section enough for us to inject the RPATHs later. We then proceed to link the library or binary with -dead_strip_dylibs, and *after* the linking inspect the library to find the left over (non-dead-stripped) dependencies (using otool). We find the corresponding RPATHs for each @rpath relative dependency, and inject them into the library or binary using the install_name_tool. Thus achieving a deadstripped dylib (and rpaths) build product. We can not do this in GHC, without starting to reimplement a dynamic linker as we do not know which symbols and subsequently libraries are necessary. Commissioned-by: Mercury Technologies, Inc. (mercury.com) - - - - - df04b81e by Sylvain Henry at 2020-09-07T21:19:20-04:00 Move DynFlags test into updateModDetailsIdInfos's caller (#17957) - - - - - ea1cbb8f by Ben Gamari at 2020-09-08T15:42:02-04:00 rts: Add stg_copyArray_barrier to RtsSymbols list It's incredible that this wasn't noticed until now. - - - - - d7b2f799 by Daishi Nakajima at 2020-09-08T15:42:41-04:00 testsuite: Output performance test results in tabular format this was suggested in #18417. Change the print format of the values. * Shorten commit hash * Reduce precision of the "Value" field * Shorten metrics name * e.g. runtime/bytes allocated -> run/alloc * Shorten "MetricsChange" * e.g. unchanged -> unch, increased -> incr And, print the baseline environment if there are baselines that were measured in a different environment than the current environment. If all "Baseline commit" are the same, print it once. - - - - - 44472daf by Ryan Scott at 2020-09-08T15:43:16-04:00 Make the forall-or-nothing rule only apply to invisible foralls (#18660) This fixes #18660 by changing `isLHsForAllTy` to `isLHsInvisForAllTy`, which is sufficient to make the `forall`-or-nothing rule only apply to invisible `forall`s. I also updated some related documentation and Notes while I was in the neighborhood. - - - - - 0c61cbff by Ben Gamari at 2020-09-08T15:43:54-04:00 gitlab-ci: Handle distributions without locales Previously we would assume that the `locale` utility exists. However, this is not so on Alpine as musl's locale support is essentially non-existent. (cherry picked from commit 17cdb7ac3b557a245fee1686e066f9f770ddc21e) - - - - - d989c842 by Ben Gamari at 2020-09-08T15:43:55-04:00 gitlab-ci: Accept Centos 7 C.utf8 locale Centos apparently has C.utf8 rather than C.UTF-8. (cherry picked from commit d9f85dd25a26a04d3485470afb3395ee2dec6464) - - - - - e5a2899c by John Ericson at 2020-09-09T00:46:05-04:00 Use "to" instead of "2" in internal names of conversion ops Change the constructors for the primop union, and also names of the literal conversion functions. "2" runs into trouble when we need to do conversions from fixed-width types, and end up with thing like "Int642Word". Only the names internal to GHC are changed, as I don't want to worry about breaking changes ATM. - - - - - 822f1057 by Ryan Scott at 2020-09-09T00:46:41-04:00 Postpone associated tyfam default checks until after typechecking Previously, associated type family defaults were validity-checked during typechecking. Unfortunately, the error messages that these checks produce run the risk of printing knot-tied type constructors, which will cause GHC to diverge. In order to preserve the current error message's descriptiveness, this patch postpones these validity checks until after typechecking, which are now located in the new function `GHC.Tc.Validity.checkValidAssocTyFamDeflt`. Fixes #18648. - - - - - 8c892689 by Sylvain Henry at 2020-09-09T11:19:24-04:00 DynFlags: add OptCoercionOpts Use OptCoercionOpts to avoid threading DynFlags all the way down to GHC.Core.Coercion.Opt - - - - - 3f32a9c0 by Sylvain Henry at 2020-09-09T11:19:24-04:00 DynFlags: add UnfoldingOpts and SimpleOpts Milestone: after this patch, we only use 'unsafeGlobalDynFlags' for the state hack and for debug in Outputable. - - - - - b3df72a6 by Sylvain Henry at 2020-09-09T11:19:24-04:00 DynFlags: add sm_pre_inline field into SimplMode (#17957) It avoids passing and querying DynFlags down in the simplifier. - - - - - ffae5792 by Sylvain Henry at 2020-09-09T11:19:24-04:00 Add comments about sm_dflags and simpleOptExpr - - - - - 7911d0d9 by Alan Zimmerman at 2020-09-09T11:20:03-04:00 Remove GENERATED pragma, as it is not being used @alanz pointed out on ghc-devs that the payload of this pragma does not appear to be used anywhere. I (@bgamari) did some digging and traced the pragma's addition back to d386e0d2 (way back in 2006!). It appears that it was intended to be used by code generators for use in informing the code coveraging checker about generated code provenance. When it was added it used the pragma's "payload" fields as source location information to build an "ExternalBox". However, it looks like this was dropped a year later in 55a5d8d9. At this point it seems like the pragma serves no useful purpose. Given that it also is not documented, I think we should remove it. Updates haddock submodule Closes #18639 - - - - - 5aae5b32 by Ben Gamari at 2020-09-09T18:31:40-04:00 gitlab-ci: Bump Docker images We now generate our Docker images via Dhall definitions, as described in ghc/ci-images!52. Additionally, we are far more careful about where tools come from, using the ALEX, HAPPY, HSCOLOR, and GHC environment variables (set in the Dockerfiles) to find bootstrapping tools. - - - - - 4ce9fe88 by Ben Gamari at 2020-09-09T18:31:40-04:00 hadrian: Fix leakage of GHC in PATH into build Previously hadrian would use GHC on PATH when configuring packages (or fail if there is no such GHC). Fix this. Unfortunately this runs into another bug in Cabal which we workaround. - - - - - 291a15dd by Ben Gamari at 2020-09-09T18:31:40-04:00 utils: Bump cabal-version of hp2ps and unlit - - - - - 4798caa0 by David Himmelstrup at 2020-09-09T18:32:16-04:00 rts comment: RTS_TICKY_SYMBOLS moved from rts/Linker.c to rts/RtsSymbols.c - - - - - 67ce72da by Sebastian Graf at 2020-09-10T10:35:33-04:00 Add long-distance info for pattern bindings (#18572) We didn't consider the RHS of a pattern-binding before, which led to surprising warnings listed in #18572. As can be seen from the regression test T18572, we get the expected output now. - - - - - 1207576a by Sebastian Graf at 2020-09-10T10:35:33-04:00 PmCheck: Big refactor using guard tree variants more closely following source syntax (#18565) Previously, we desugared and coverage checked plain guard trees as described in Lower Your Guards. That caused (in !3849) quite a bit of pain when we need to partially recover tree structure of the input syntax to return covered sets for long-distance information, for example. In this refactor, I introduced a guard tree variant for each relevant source syntax component of a pattern-match (mainly match groups, match, GRHS, empty case, pattern binding). I made sure to share as much coverage checking code as possible, so that the syntax-specific checking functions are just wrappers around the more substantial checking functions for the LYG primitives (`checkSequence`, `checkGrds`). The refactoring payed off in clearer code and elimination of all panics related to assumed guard tree structure and thus fixes #18565. I also took the liberty to rename and re-arrange the order of functions and comments in the module, deleted some dead and irrelevant Notes, wrote some new ones and gave an overview module haddock. - - - - - 95455982 by GHC GitLab CI at 2020-09-10T10:36:09-04:00 hadrian: Don't include -fdiagnostics-color in argument hash Otherwise the input hash will vary with whether colors are requested, which changed with `isatty`. Fixes #18672. - - - - - 6abe4a1c by Sebastian Graf at 2020-09-10T17:02:00+02:00 .gitignore *.hiedb files - - - - - 3777be14 by Sebastian Graf at 2020-09-10T17:03:12+02:00 PmCheck: Handle ⊥ and strict fields correctly (#18341) In #18341, we discovered an incorrect digression from Lower Your Guards. This MR changes what's necessary to support properly fixing #18341. In particular, bottomness constraints are now properly tracked in the oracle/inhabitation testing, as an additional field `vi_bot :: Maybe Bool` in `VarInfo`. That in turn allows us to model newtypes as advertised in the Appendix of LYG and fix #17725. Proper handling of ⊥ also fixes #17977 (once again) and fixes #18670. For some reason I couldn't follow, this also fixes #18273. I also added a couple of regression tests that were missing. Most of them were already fixed before. In summary, this patch fixes #18341, #17725, #18273, #17977 and #18670. Metric Decrease: T12227 - - - - - 1bd28931 by David Himmelstrup at 2020-09-11T09:59:43-04:00 Define TICKY_TICKY when compiling cmm RTS files. - - - - - 15e67801 by David Himmelstrup at 2020-09-11T09:59:43-04:00 Fix typos in TICKY_TICKY symbol names. - - - - - 8a5a91cb by David Himmelstrup at 2020-09-11T09:59:43-04:00 Enable TICKY_TICKY for debug builds when building with makefiles. - - - - - fc965c09 by Sandy Maguire at 2020-09-12T00:31:36-04:00 Add clamp function to Data.Ord - - - - - fb6e29e8 by Sandy Maguire at 2020-09-12T00:31:37-04:00 Add tests - - - - - 2a942285 by Sebastian Graf at 2020-09-12T00:32:13-04:00 PmCheck: Disattach COMPLETE pragma lookup from TyCons By not attaching COMPLETE pragmas with a particular TyCon and instead assume that every COMPLETE pragma is applicable everywhere, we can drastically simplify the logic that tries to initialise available COMPLETE sets of a variable during the pattern-match checking process, as well as fixing a few bugs. Of course, we have to make sure not to report any of the ill-typed/unrelated COMPLETE sets, which came up in a few regression tests. In doing so, we fix #17207, #18277 and #14422. There was a metric decrease in #18478 by ~20%. Metric Decrease: T18478 - - - - - 389a6683 by Ben Gamari at 2020-09-12T00:32:49-04:00 hadrian: Pass input file to makeindex Strangely I find that on Alpine (and apparently only on Alpine) the latex makeindex command expects to be given a filename, lest it reads from stdin. - - - - - 853d121a by Ryan Scott at 2020-09-12T00:33:25-04:00 Don't quote argument to Hadrian's test-env flag (#18656) Doing so causes the name of the test environment to gain an extra set of double quotes, which changes the name entirely. Fixes #18656. - - - - - 8440b5fa by Krzysztof Gogolewski at 2020-09-12T00:33:25-04:00 Make sure we can read past perf notes See #18656. - - - - - 2157be52 by theobat at 2020-09-12T21:27:04-04:00 Avoid iterating twice in `zipTyEnv` (#18535) zipToUFM is a new function to replace `listToUFM (zipEqual ks vs)`. An explicit recursion is preferred due to the sensible nature of fusion. T12227 -6.0% T12545 -12.3% T5030 -9.0% T9872a -1.6% T9872b -1.6% T9872c -2.0% ------------------------- Metric Decrease: T12227 T12545 T5030 T9872a T9872b T9872c ------------------------- - - - - - 69ea2fee by Sebastian Graf at 2020-09-12T21:27:40-04:00 Make `tcCheckSatisfiability` incremental (#18645) By taking and returning an `InertSet`. Every new `TcS` session can then pick up where a prior session left with `setTcSInerts`. Since we don't want to unflatten the Givens (and because it leads to infinite loops, see !3971), we introduced a new variant of `runTcS`, `runTcSInerts`, that takes and returns the `InertSet` and makes sure not to unflatten the Givens after running the `TcS` action. Fixes #18645 and #17836. Metric Decrease: T17977 T18478 - - - - - a77e48d2 by Sebastian Graf at 2020-09-12T21:27:40-04:00 Extract definition of DsM into GHC.HsToCore.Types `DsM` was previously defined in `GHC.Tc.Types`, along with `TcM`. But `GHC.Tc.Types` is in the set of transitive dependencies of `GHC.Parser`, a set which we aim to minimise. Test case `CountParserDeps` checks for that. Having `DsM` in that set means the parser also depends on the innards of the pattern-match checker in `GHC.HsToCore.PmCheck.Types`, which is the reason we have that module in the first place. In the previous commit, we represented the `TyState` by an `InertSet`, but that pulls the constraint solver as well as 250 more modules into the set of dependencies, triggering failure of `CountParserDeps`. Clearly, we want to evolve the pattern-match checker (and the desugarer) without being concerned by this test, so this patch includes a small refactor that puts `DsM` into its own module. - - - - - fd5d622a by Sebastian Graf at 2020-09-12T21:27:40-04:00 Hackily decouple the parser from the desugarer In a hopefully temporary hack, I re-used the idea from !1957 of using a nullary type family to break the dependency from GHC.Driver.Hooks on the definition of DsM ("Abstract Data"). This in turn broke the last dependency from the parser to the desugarer. More details in `Note [The Decoupling Abstract Data Hack]`. In the future, we hope to undo this hack again in favour of breaking the dependency from the parser to DynFlags altogether. - - - - - 35a7b7ec by Adam Sandberg Eriksson at 2020-09-14T17:46:16-04:00 docs: -B rts option sounds the bell on every GC (#18351) - - - - - 5ae8212c by Wander Hillen at 2020-09-14T17:46:54-04:00 Populate gitlab cache after building - - - - - a5ffb39a by Wander Hillen at 2020-09-14T17:46:54-04:00 Move ahead cabal cache restoration to before use of cabal - - - - - e8b37c21 by Wander Hillen at 2020-09-14T17:46:54-04:00 Do the hadrian rebuild multicore - - - - - 07762eb5 by Wander Hillen at 2020-09-14T17:46:54-04:00 Also cache other hadrian builds - - - - - 8610bcbe by DenisFrezzato at 2020-09-15T15:19:08-04:00 Fix rtsopts documentation - - - - - c7182a5c by Simon Peyton Jones at 2020-09-15T15:19:44-04:00 Care with implicit-parameter superclasses Two bugs, #18627 and #18649, had the same cause: we were not account for the fact that a constaint tuple might hide an implicit parameter. The solution is not hard: look for implicit parameters in superclasses. See Note [Local implicit parameters] in GHC.Core.Predicate. Then we use this new function in two places * The "short-cut solver" in GHC.Tc.Solver.Interact.shortCutSolver which simply didn't handle implicit parameters properly at all. This fixes #18627 * The specialiser, which should not specialise on implicit parameters This fixes #18649 There are some lingering worries (see Note [Local implicit parameters]) but things are much better. - - - - - 0f3884b0 by Zubin Duggal at 2020-09-15T15:20:23-04:00 Export enrichHie from GHC.Iface.Ext.Ast This is useful for `ghcide` - - - - - b3143f5a by Sylvain Henry at 2020-09-15T15:21:06-04:00 Enhance metrics output - - - - - 4283feaa by Ryan Scott at 2020-09-15T15:21:43-04:00 Introduce and use DerivClauseTys (#18662) This switches `deriv_clause_tys` so that instead of using a list of `LHsSigType`s to represent the types in a `deriving` clause, it now uses a sum type. `DctSingle` represents a `deriving` clause with no enclosing parentheses, while `DctMulti` represents a clause with enclosing parentheses. This makes pretty-printing easier and avoids confusion between `HsParTy` and the enclosing parentheses in `deriving` clauses, which are different semantically. Fixes #18662. - - - - - 90229c4b by Ryan Scott at 2020-09-16T04:53:22-04:00 Include -f{write,validate}-ide-info in the User's Guide flag reference Previously, these were omitted from the flag reference due to a layout oversight in `docs/users_guide/flags.{rst,py}`. Fixes #18426. - - - - - ce42e187 by Ben Gamari at 2020-09-16T04:53:59-04:00 rts: Fix erroneous usage of vsnprintf As pointed out in #18685, this should be snprintf not vsnprintf. This appears to be due to a cut-and-paste error. Fixes #18658. - - - - - b695e7d7 by Sylvain Henry at 2020-09-16T04:54:38-04:00 Rename ghci flag into internal-interpreter "ghci" as a flag name was confusing because it really enables the internal-interpreter. Even the ghci library had a "ghci" flag... - - - - - 8af954d2 by Sylvain Henry at 2020-09-16T04:55:17-04:00 Make ghc-boot reexport modules from ghc-boot-th Packages don't have to import both ghc-boot and ghc-boot-th. It makes the dependency graph easier to understand and to refactor. - - - - - 6baa67f5 by Adam Sandberg Eriksson at 2020-09-16T07:45:47-04:00 docs: correct haddock reference [skip ci] - - - - - 7cf09ab0 by Simon Peyton Jones at 2020-09-17T01:27:25-04:00 Do absence analysis on stable unfoldings Ticket #18638 showed that Very Bad Things happen if we fail to do absence analysis on stable unfoldings. It's all described in Note [Absence analysis for stable unfoldings and RULES]. I'm a bit surprised this hasn't bitten us before. Fortunately the fix is pretty simple. - - - - - 76d3bcbc by Leif Metcalf at 2020-09-17T01:28:01-04:00 Replace deprecated git --recursive The --recursive flag of git-clone has been replaced by the --recurse-submodules flag since git 1.7.4, released in 2011. - - - - - da8f4ddd by Richard Eisenberg at 2020-09-17T01:28:38-04:00 Document IfaceTupleTy - - - - - 3c94c816 by HaskellMouse at 2020-09-17T08:49:51-04:00 Added explicit fixity to (~). Solves #18252 - - - - - b612e396 by Cary Robbins at 2020-09-17T08:50:30-04:00 Make the 'IsString (Const a b)' instance polykinded on 'b' - - - - - 8d0c26c4 by Ben Gamari at 2020-09-17T08:51:08-04:00 rts/win32: Fix missing #include's These slipped through CI. - - - - - 76009ec8 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump Win32 submodule to 2.9.0.0 Also bumps Cabal, directory - - - - - 147bb598 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump version to 9.0 Bumps haskeline and haddock submodules. (cherry picked from commit f218cfc92f7b1a1e01190851972bb9a0e0f3c682) - - - - - 5c7387f6 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Make Z-encoding comment into a note - - - - - c12b3041 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Cosmetic - - - - - 4f461e1a by Vladislav Zavialov at 2020-09-17T08:52:19-04:00 Parser.y: clarify treatment of @{-# UNPACK #-} Before this patch, we had this parser production: ftype : ... | ftype PREFIX_AT tyarg { ... } And 'tyarg' is defined as follows: tyarg : atype { ... } | unpackedness atype { ... } So one might get the (false) impression that that parser production is intended to parse things like: F @{-# UNPACK #-} X However, the lexer wouldn't produce PREFIX_AT followed by 'unpackedness', as the '@' operator followed by '{-' is not considered prefix. Thus there's no point using 'tyarg' after PREFIX_AT, and a simple 'atype' will suffice: ftype : ... | ftype PREFIX_AT atype { ... } This change has no user-facing consequences. It just makes the grammar a bit more clear. - - - - - 9dec8600 by Benjamin Maurer at 2020-09-17T08:52:56-04:00 Documented '-m' flags for machine specific instruction extensions. See #18641 'Documenting the Expected Undocumented Flags' - - - - - ca48076a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Introduce OutputableP Some types need a Platform value to be pretty-printed: CLabel, Cmm types, instructions, etc. Before this patch they had an Outputable instance and the Platform value was obtained via sdocWithDynFlags. It meant that the *renderer* of the SDoc was responsible of passing the appropriate Platform value (e.g. via the DynFlags given to showSDoc). It put the burden of passing the Platform value on the renderer while the generator of the SDoc knows the Platform it is generating the SDoc for and there is no point passing a different Platform at rendering time. With this patch, we introduce a new OutputableP class: class OutputableP a where pdoc :: Platform -> a -> SDoc With this class we still have some polymorphism as we have with `ppr` (i.e. we can use `pdoc` on a variety of types instead of having a dedicated `pprXXX` function for each XXX type). One step closer removing `sdocWithDynFlags` (#10143) and supporting several platforms (#14335). - - - - - e45c8544 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Generalize OutputableP Add a type parameter for the environment required by OutputableP. It avoids tying Platform with OutputableP. - - - - - 37aa224a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Add note about OutputableP - - - - - 7f2785f2 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Remove pprPrec from Outputable (unused) - - - - - b689f3db by Sylvain Henry at 2020-09-17T20:04:46-04:00 Bignum: add clamping naturalToWord (fix #18697) - - - - - 0799b3de by Ben Gamari at 2020-09-18T15:55:50-04:00 rts/nonmoving: Add missing STM write barrier When updating a TRec for a TVar already part of a transaction we previously neglected to add the old value to the update remembered set. I suspect this was the cause of #18587. - - - - - c4921349 by Ben Gamari at 2020-09-18T15:56:25-04:00 rts: Refactor foreign export tracking This avoids calling `libc` in the initializers which are responsible for registering foreign exports. We believe this should avoid the corruption observed in #18548. See Note [Tracking foreign exports] in rts/ForeignExports.c for an overview of the new scheme. - - - - - 40dc9106 by Ben Gamari at 2020-09-18T15:56:25-04:00 rts: Refactor unloading of foreign export StablePtrs Previously we would allocate a linked list cell for each foreign export. Now we can avoid this by taking advantage of the fact that they are already broken into groups. - - - - - 45fa8218 by Simon Jakobi at 2020-09-19T06:57:36-04:00 Deprecate Data.Semigroup.Option Libraries email: https://mail.haskell.org/pipermail/libraries/2018-April/028724.html GHC issue: https://gitlab.haskell.org/ghc/ghc/issues/15028 Corresponding PRs for deepseq: * https://github.com/haskell/deepseq/pull/55 * https://github.com/haskell/deepseq/pull/57 Bumps the deepseq submodule. - - - - - 2229d570 by Vladislav Zavialov at 2020-09-19T15:47:24-04:00 Require happy >=1.20 - - - - - a89c2fba by Ben Gamari at 2020-09-19T15:47:24-04:00 ci.sh: Enforce minimum happy/alex versions Also, always invoke cabal-install to ensure that happy/alex symlinks are up-to-date. - - - - - 2f7ef2fb by Ben Gamari at 2020-09-19T15:47:24-04:00 gitlab-ci: Ensure that cabal-install overwrites existing executables Previously cabal-install wouldn't overwrite toolchain executables if they already existed (as they likely would due to caching). - - - - - ac213d26 by Ryan Scott at 2020-09-19T15:48:01-04:00 Wire in constraint tuples This wires in the definitions of the constraint tuple classes. The key changes are in: * `GHC.Builtin.Types`, where the `mk_ctuple` function is used to define constraint tuple type constructors, data constructors, and superclass selector functions, and * `GHC.Builtin.Uniques`. In addition to wiring in the `Unique`s for constraint tuple type and data constructors, we now must wire in the superclass selector functions. Luckily, this proves to be not that challenging. See the newly added comments. Historical note: constraint tuples used to be wired-in until about five years ago, when commit 130e93aab220bdf14d08028771f83df210da340b turned them into known-key names. This was done as part of a larger refactor to reduce the number of special cases for constraint tuples, but the commit message notes that the main reason that constraint tuples were made known-key (as opposed to boxed/unboxed tuples, which are wired in) is because it was awkward to wire in the superclass selectors. This commit solves the problem of wiring in superclass selectors. Fixes #18635. ------------------------- Metric Decrease: T10421 T12150 T12227 T12234 T12425 T13056 T13253-spj T18282 T18304 T5321FD T5321Fun T5837 T9961 Metric Decrease (test_env='x86_64-linux-deb9-unreg-hadrian'): T12707 Metric Decrease (test_env='x86_64-darwin'): T4029 ------------------------- - - - - - e195dae6 by Wander Hillen at 2020-09-19T15:48:41-04:00 Export singleton function from Data.List Data.OldList exports a monomorphized singleton function but it is not re-exported by Data.List. Adding the export to Data.List causes a conflict with a 14-year old function of the same name and type by SPJ in GHC.Utils.Misc. We can't just remove this function because that leads to a problems when building GHC with a stage0 compiler that does not have singleton in Data.List yet. We also can't hide the function in GHC.Utils.Misc since it is not possible to hide a function from a module if the module does not export the function. To work around this, all places where the Utils.Misc singleton was used now use a qualified version like Utils.singleton and in GHC.Utils.Misc we are very specific about which version we export. - - - - - 9c1b8ad9 by Sylvain Henry at 2020-09-19T15:49:19-04:00 Bump Stack resolver - - - - - d05d13ce by John Ericson at 2020-09-19T15:49:57-04:00 Cinch -fno-warn-name-shadowing down to specific GHCi module - - - - - f1accd00 by Sylvain Henry at 2020-09-19T15:49:57-04:00 Add quick-validate Hadrian flavour (quick + -Werror) - - - - - 8f8d51f1 by Andreas Klebinger at 2020-09-19T15:50:33-04:00 Fix docs who misstated how the RTS treats size suffixes. They are parsed as multiples of 1024. Not 1000. The docs used to imply otherwise. See decodeSize in rts/RtsFlags.c for the logic for this. - - - - - 2ae0edbd by Andreas Klebinger at 2020-09-19T15:50:33-04:00 Fix a codeblock in ghci.rst - - - - - 4df3aa95 by Ben Gamari at 2020-09-19T15:51:07-04:00 users guide: Fix various documentation issues - - - - - 885ecd18 by Ben Gamari at 2020-09-19T15:51:07-04:00 hadrian: Fail on Sphinx syntax errors Specifically the "Inline literal start-string without end-string" warning, which typically means that the user neglected to separate an inline code block from suffix text with a backslash. - - - - - b26cd867 by David Feuer at 2020-09-19T15:51:44-04:00 Unpack the MVar in Compact The `MVar` lock in `Compact` was unnecessarily lazy, creating an extra indirection and wasting two words. Make it strict. - - - - - 760307cf by Artyom Kuznetsov at 2020-09-19T15:52:21-04:00 Remove GADT self-reference check (#11554, #12081, #12174, fixes #15942) Reverts 430f5c84dac1eab550110d543831a70516b5cac8 - - - - - 057db94c by Ben Gamari at 2020-09-19T15:52:56-04:00 rts: Drop field initializer on thread_basic_info_data_t This struct has a number of fields and we only care that the value is initialized with zeros. This eliminates the warnings noted in #17905. - - - - - 87e2e2b1 by Vladislav Zavialov at 2020-09-19T23:55:30+03:00 Resolve shift/reduce conflicts with %shift (#17232) - - - - - 66cba46e by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Unmark T12971 as broken on Windows It's unclear why, but this no longer seems to fail. Closes #17945. - - - - - 816811d4 by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Unmark T5975[ab] as broken on Windows Sadly it's unclear *why* they have suddenly started working. Closes #7305. - - - - - 43a43d39 by Ben Gamari at 2020-09-20T20:30:57-04:00 base/testsuite: Add missing LANGUAGE pragma in ThreadDelay001 Only affected the Windows codepath. - - - - - ced8f113 by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Update expected output for outofmem on Windows The error originates from osCommitMemory rather than getMBlocks. - - - - - ea08aead by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Mark some GHCi/Makefile tests as broken on Windows See #18718. - - - - - caf6a5a3 by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Fix WinIO error message normalization This wasn't being applied to stderr. - - - - - 93ab3e8d by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Mark tempfiles as broken on Win32 without WinIO The old POSIX emulation appears to ignore the user-requested prefix. - - - - - 9df77fed by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Mark TH_spliceE5_prof as broken on Windows Due to #18721. - - - - - 1a0f8243 by Ryan Scott at 2020-09-21T16:45:47-04:00 Remove unused ThBrackCtxt and ResSigCtxt Fixes #18715. - - - - - 2f222b12 by Ryan Scott at 2020-09-21T16:45:47-04:00 Disallow constraints in KindSigCtxt This patch cleans up how `GHC.Tc.Validity` classifies `UserTypeCtxt`s that can only refer to kind-level positions, which is important for rejecting certain classes of programs. In particular, this patch: * Introduces a new `TypeOrKindCtxt` data type and `typeOrKindCtxt :: UserTypeCtxt -> TypeOrKindCtxt` function, which determines whether a `UserTypeCtxt` can refer to type-level contexts, kind-level contexts, or both. * Defines the existing `allConstraintsAllowed` and `vdqAllowed` functions in terms of `typeOrKindCtxt`, which avoids code duplication and ensures that they stay in sync in the future. The net effect of this patch is that it fixes #18714, in which it was discovered that `allConstraintsAllowed` incorrectly returned `True` for `KindSigCtxt`. Because `typeOrKindCtxt` now correctly classifies `KindSigCtxt` as a kind-level context, this bug no longer occurs. - - - - - aaa51dcf by Ben Gamari at 2020-09-21T16:46:22-04:00 hadrian: Add extra-deps: happy-1.20 to stack.yaml GHC now requires happy-1.20, which isn't available in LTS-16.14. Fixes #18726. - - - - - 6de40f83 by Simon Peyton Jones at 2020-09-22T05:37:24-04:00 Better eta-expansion (again) and don't specilise DFuns This patch fixes #18223, which made GHC generate an exponential amount of code. There are three quite separate changes in here 1. Re-engineer eta-expansion (again). The eta-expander was generating lots of intermediate stuff, which could be optimised away, but which choked the simplifier meanwhile. Relatively easy to kill it off at source. See Note [The EtaInfo mechanism] in GHC.Core.Opt.Arity. The main new thing is the use of pushCoArg in getArg_maybe. 2. Stop Specialise specalising DFuns. This is the cause of a huge (and utterly unnecessary) blowup in program size in #18223. See Note [Do not specialise DFuns] in GHC.Core.Opt.Specialise. I also refactored the Specialise monad a bit... it was silly, because it passed on unchanging values as if they were mutable state. 3. Do an extra Simplifer run, after SpecConstra and before late-Specialise. I found (investigating perf/compiler/T16473) that failing to do this was crippling *both* SpecConstr *and* Specialise. See Note [Simplify after SpecConstr] in GHC.Core.Opt.Pipeline. This change does mean an extra run of the Simplifier, but only with -O2, and I think that's acceptable. T16473 allocates *three* times less with this change. (I changed it to check runtime rather than compile time.) Some smaller consequences * I moved pushCoercion, pushCoArg and friends from SimpleOpt to Arity, because it was needed by the new etaInfoApp. And pushCoValArg now returns a MCoercion rather than Coercion for the argument Coercion. * A minor, incidental improvement to Core pretty-printing This does fix #18223, (which was otherwise uncompilable. Hooray. But there is still a big intermediate because there are some very deeply nested types in that program. Modest reductions in compile-time allocation on a couple of benchmarks T12425 -2.0% T13253 -10.3% Metric increase with -O2, due to extra simplifier run T9233 +5.8% T12227 +1.8% T15630 +5.0% There is a spurious apparent increase on heap residency on T9630, on some architectures at least. I tried it with -G1 and the residency is essentially unchanged. Metric Increase T9233 T12227 T9630 Metric Decrease T12425 T13253 - - - - - 416bd50e by Simon Peyton Jones at 2020-09-22T05:37:59-04:00 Fix the occurrence analyser Ticket #18603 demonstrated that the occurrence analyser's handling of local RULES for imported Ids (which I now call IMP-RULES) was inadequate. It led the simplifier into an infnite loop by failing to label a binder as a loop breaker. The main change in this commit is to treat IMP-RULES in a simple and uniform way: as extra rules for the local binder. See Note [IMP-RULES: local rules for imported functions] This led to quite a bit of refactoring. The result is still tricky, but it's much better than before, and better documented I think. Oh, and it fixes the bug. - - - - - 6fe8a0c7 by Sebastian Graf at 2020-09-22T05:38:35-04:00 PmCheck - Comments only: Replace /~ by ≁ - - - - - e9501547 by Sebastian Graf at 2020-09-22T05:38:35-04:00 PmCheck: Rewrite inhabitation test We used to produce inhabitants of a pattern-match refinement type Nabla in the checker in at least two different and mostly redundant ways: 1. There was `provideEvidence` (now called `generateInhabitingPatterns`) which is used by `GHC.HsToCore.PmCheck` to produce non-exhaustive patterns, which produces inhabitants of a Nabla as a sub-refinement type where all match variables are instantiated. 2. There also was `ensure{,All}Inhabited` (now called `inhabitationTest`) which worked slightly different, but was whenever new type constraints or negative term constraints were added. See below why `provideEvidence` and `ensureAllInhabited` can't be the same function, the main reason being performance. 3. And last but not least there was the `nonVoid` test, which tested that a given type was inhabited. We did use this for strict fields and -XEmptyCase in the past. The overlap of (3) with (2) was always a major pet peeve of mine. The latter was quite efficient and proven to work for recursive data types, etc, but could not handle negative constraints well (e.g. we often want to know if a *refined* type is empty, such as `{ x:[a] | x /= [] }`). Lower Your Guards suggested that we could get by with just one, by replacing both functions with `inhabitationTest` in this patch. That was only possible by implementing the structure of φ constraints as in the paper, namely the semantics of φ constructor constraints. This has a number of benefits: a. Proper handling of unlifted types and strict fields, fixing #18249, without any code duplication between `GHC.HsToCore.PmCheck.Oracle.instCon` (was `mkOneConFull`) and `GHC.HsToCore.PmCheck.checkGrd`. b. `instCon` can perform the `nonVoid` test (3) simply by emitting unliftedness constraints for strict fields. c. `nonVoid` (3) is thus simply expressed by a call to `inhabitationTest`. d. Similarly, `ensureAllInhabited` (2), which we called after adding type info, now can similarly be expressed as the fuel-based `inhabitationTest`. See the new `Note [Why inhabitationTest doesn't call generateInhabitingPatterns]` why we still have tests (1) and (2). Fixes #18249 and brings nice metric decreases for `T17836` (-76%) and `T17836b` (-46%), as well as `T18478` (-8%) at the cost of a few very minor regressions (< +2%), potentially due to the fact that `generateInhabitingPatterns` does more work to suggest the minimal COMPLETE set. Metric Decrease: T17836 T17836b - - - - - 086ef018 by Hécate at 2020-09-23T06:52:08-04:00 Remove the list of loaded modules from the ghci prompt - - - - - d7385f70 by Ben Gamari at 2020-09-23T06:52:44-04:00 Bump submodules * Bump bytestring to 0.10.12.0 * Bump Cabal to 3.4.0.0-rc3 * Bump Win32 to 2.10.0.0 - - - - - 667d6355 by Sylvain Henry at 2020-09-23T20:43:48-04:00 Refactor CLabel pretty-printing * Don't depend on the selected backend to know if we print Asm or C labels: we already have PprStyle to determine this. Moreover even when a native backend is used (NCG, LLVM) we may want to C headers containing pretty-printed labels, so it wasn't a good predicate anyway. * Make pretty-printing code clearer and avoid partiality - - - - - a584366b by Sylvain Henry at 2020-09-23T20:43:48-04:00 Remove sdocWithDynFlags (fix #10143) - - - - - a997fa01 by Sylvain Henry at 2020-09-23T20:43:48-04:00 Preliminary work towards removing DynFlags -> Driver.Ppr dependency - - - - - 31fea307 by Hécate at 2020-09-23T20:44:24-04:00 Remove redundant "do", "return" and language extensions from base - - - - - 04d64331 by syd at cs-syd.eu at 2020-09-24T13:15:54-04:00 Update Lock.hs with more documentation to make sure that the Boolean return value is clear. [skip ci] - - - - - 97cff919 by Simon Peyton Jones at 2020-09-24T13:16:32-04:00 Implement Quick Look impredicativity This patch implements Quick Look impredicativity (#18126), sticking very closely to the design in A quick look at impredicativity, Serrano et al, ICFP 2020 The main change is that a big chunk of GHC.Tc.Gen.Expr has been extracted to two new modules GHC.Tc.Gen.App GHC.Tc.Gen.Head which deal with typechecking n-ary applications, and the head of such applications, respectively. Both contain a good deal of documentation. Three other loosely-related changes are in this patch: * I implemented (partly by accident) points (2,3)) of the accepted GHC proposal "Clean up printing of foralls", namely https://github.com/ghc-proposals/ghc-proposals/blob/ master/proposals/0179-printing-foralls.rst (see #16320). In particular, see Note [TcRnExprMode] in GHC.Tc.Module - :type instantiates /inferred/, but not /specified/, quantifiers - :type +d instantiates /all/ quantifiers - :type +v is killed off That completes the implementation of the proposal, since point (1) was done in commit df08468113ab46832b7ac0a7311b608d1b418c4d Author: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> Date: Mon Feb 3 21:17:11 2020 +0100 Always display inferred variables using braces * HsRecFld (which the renamer introduces for record field selectors), is now preserved by the typechecker, rather than being rewritten back to HsVar. This is more uniform, and turned out to be more convenient in the new scheme of things. * The GHCi debugger uses a non-standard unification that allows the unification variables to unify with polytypes. We used to hack this by using ImpredicativeTypes, but that doesn't work anymore so I introduces RuntimeUnkTv. See Note [RuntimeUnkTv] in GHC.Runtime.Heap.Inspect Updates haddock submodule. WARNING: this patch won't validate on its own. It was too hard to fully disentangle it from the following patch, on type errors and kind generalisation. Changes to tests * Fixes #9730 (test added) * Fixes #7026 (test added) * Fixes most of #8808, except function `g2'` which uses a section (which doesn't play with QL yet -- see #18126) Test added * Fixes #1330. NB Church1.hs subsumes Church2.hs, which is now deleted * Fixes #17332 (test added) * Fixes #4295 * This patch makes typecheck/should_run/T7861 fail. But that turns out to be a pre-existing bug: #18467. So I have just made T7861 into expect_broken(18467) - - - - - 9fa26aa1 by Simon Peyton Jones at 2020-09-24T13:16:32-04:00 Improve kind generalisation, error messages This patch does two things: * It refactors GHC.Tc.Errors a bit. In debugging Quick Look I was forced to look in detail at error messages, and ended up doing a bit of refactoring, esp in mkTyVarEqErr'. It's still quite a mess, but a bit better, I think. * It makes a significant improvement to the kind checking of type and class declarations. Specifically, we now ensure that if kind checking fails with an unsolved constraint, all the skolems are in scope. That wasn't the case before, which led to some obscure error messages; and occasional failures with "no skolem info" (eg #16245). Both of these, and the main Quick Look patch itself, affect a /lot/ of error messages, as you can see from the number of files changed. I've checked them all; I think they are as good or better than before. Smaller things * I documented the various instances of VarBndr better. See Note [The VarBndr tyep and its uses] in GHC.Types.Var * Renamed GHC.Tc.Solver.simpl_top to simplifyTopWanteds * A bit of refactoring in bindExplicitTKTele, to avoid the footwork with Either. Simpler now. * Move promoteTyVar from GHC.Tc.Solver to GHC.Tc.Utils.TcMType Fixes #16245 (comment 211369), memorialised as typecheck/polykinds/T16245a Also fixes the three bugs in #18640 - - - - - 6d0ce0eb by Sebastian Graf at 2020-09-24T13:17:07-04:00 PmCheck: Desugar string literal patterns with -XRebindableSyntax correctly (#18708) Fixes #18708. - - - - - 007940d2 by Hécate at 2020-09-24T13:17:44-04:00 Namespace the Hadrian linting rule for base - - - - - 5b727189 by Andreas Klebinger at 2020-09-25T21:10:20-04:00 Make sizeExpr strict in the size threshold to facilitate WW. - - - - - dd664031 by Ben Gamari at 2020-09-25T21:10:56-04:00 ci.sh: Factor out common utilities - - - - - 5b78e865 by Ben Gamari at 2020-09-25T21:10:56-04:00 ci: Add ad-hoc performance testing rule - - - - - 29885f07 by Zubin Duggal at 2020-09-25T21:11:32-04:00 Stop removing definitions of record fields in GHC.Iface.Ext.Ast - - - - - 0d6519d9 by Ben Gamari at 2020-09-25T21:12:08-04:00 gitlab-ci: Drop Darwin cleanup job We now have a proper periodic clean-up script installed on the runners. - - - - - 277d20af by Sebastian Graf at 2020-09-25T21:12:44-04:00 Add regression tests for #18371 They have been fixed by !3959, I believe. Fixes #18371. - - - - - 8edf6056 by Sebastian Graf at 2020-09-25T21:12:44-04:00 Add a regression test for #18609 The egregious performance hits are gone since !4050. So we fix #18609. - - - - - 4a1b89a4 by Sebastian Graf at 2020-09-25T21:12:44-04:00 Accept new test output for #17218 The expected test output was plain wrong. It has been fixed for a long time. Thus we can close #17218. - - - - - 51606236 by Sven Tennie at 2020-09-25T21:13:19-04:00 Print RET_BIG stack closures A RET_BIG closure has a large bitmap that describes it's payload and can be printed with printLargeBitmap(). Additionally, the output for payload closures of small and big bitmaps is changed: printObj() is used to print a bit more information about what's on the stack. - - - - - 2707c4ea by Arnaud Spiwack at 2020-09-25T21:13:58-04:00 Pattern guards BindStmt always use multiplicity Many Fixes #18439 . The rhs of the pattern guard was consumed with multiplicity one, while the pattern assumed it was Many. We use Many everywhere instead. This is behaviour consistent with that of `case` expression. See #18738. - - - - - 92daad24 by Sylvain Henry at 2020-09-25T21:14:36-04:00 Bignum: refactor backend modules * move backends into GHC.Num.Backend.* * split backend selection into GHC.Num.Backend and GHC.Num.Backend.Selected to avoid duplication with the Check backend - - - - - 04bc50b3 by Sylvain Henry at 2020-09-25T21:14:36-04:00 Bignum: implement extended GCD (#18427) - - - - - 6a7dae4b by Krzysztof Gogolewski at 2020-09-25T21:15:14-04:00 Fix typed holes causing linearity errors (#18491) - - - - - 83407ffc by Krzysztof Gogolewski at 2020-09-25T21:15:53-04:00 Various documentation fixes * Remove UnliftedFFITypes from conf. Some time ago, this extension was undocumented and we had to silence a warning. This is no longer needed. * Use r'' in conf.py. This fixes a Sphinx warning: WARNING: Support for evaluating Python 2 syntax is deprecated and will be removed in Sphinx 4.0. Convert docs/users_guide/conf.py to Python 3 syntax. * Mark GHCForeignImportPrim as documented * Fix formatting in template_haskell.rst * Remove 'recursive do' from the list of unsupported items in TH - - - - - af1e84e7 by Sebastian Graf at 2020-09-26T05:36:46-04:00 PmCheck: Big refactor of module structure * Move everything from `GHC.HsToCore.PmCheck.*` to `GHC.HsToCore.Pmc.*` in analogy to `GHC.Tc`, rename exported `covCheck*` functions to `pmc*` * Rename `Pmc.Oracle` to `Pmc.Solver` * Split off the LYG desugaring and checking steps into their own modules (`Pmc.Desugar` and `Pmc.Check` respectively) * Split off a `Pmc.Utils` module with stuff shared by `Pmc.{,Desugar,Check,Solver}` * Move `Pmc.Types` to `Pmc.Solver.Types`, add a new `Pmc.Types` module with all the LYG types, which form the interfaces between `Pmc.{Desugar,Check,Solver,}`. - - - - - f08f98e8 by Sebastian Graf at 2020-09-26T05:36:46-04:00 Extract SharedIdEnv into its own module It's now named `GHC.Types.Unique.SDFM.UniqSDFM`. The implementation is more clear about its stated goals and supported operations. - - - - - 1cde295c by Sylvain Henry at 2020-09-26T05:37:23-04:00 Bignum: add bigNatFromWordArray Reimplementation of integer-gmp's byteArrayToBigNat# - - - - - bda55fa0 by Krzysztof Gogolewski at 2020-09-26T13:18:22-04:00 Make 'undefined x' linear in 'x' (#18731) - - - - - 160fba4a by Krzysztof Gogolewski at 2020-09-26T13:19:00-04:00 Disallow linear types in FFI (#18472) - - - - - e124f2a7 by Krzysztof Gogolewski at 2020-09-26T13:19:36-04:00 Fix handling of function coercions (#18747) This was broken when we added multiplicity to the function type. - - - - - 7ff43382 by Vladislav Zavialov at 2020-09-27T03:01:31+03:00 Comments: change outdated reference to mergeOps As of 686e06c59c3aa6b66895e8a501c7afb019b09e36, GHC.Parser.PostProcess.mergeOps no longer exists. [ci skip] - - - - - 4edf5527 by Vladislav Zavialov at 2020-09-27T10:04:12-04:00 Don't rearrange (->) in the renamer The parser produces an AST where the (->) is already associated correctly: 1. (->) has the least possible precedence 2. (->) is right-associative Thus we don't need to handle it in mkHsOpTyRn. - - - - - a9ce159b by Vladislav Zavialov at 2020-09-27T10:04:12-04:00 Remove outdated comment in rnHsTyKi This comment dates back to 3df40b7b78044206bbcffe3e2c0a57d901baf5e8 and does not seem relevant anymore. - - - - - 583a2070 by Richard Eisenberg at 2020-09-29T00:31:27-04:00 Optimize NthCo (FunCo ...) in coercion opt We were missing this case previously. Close #18528. Metric Decrease: T18223 T5321Fun - - - - - b31a3360 by Krzysztof Gogolewski at 2020-09-29T00:32:05-04:00 Linear types: fix kind inference when checking datacons - - - - - 5830a12c by Vladislav Zavialov at 2020-09-29T00:32:05-04:00 New linear types syntax: a %p -> b (#18459) Implements GHC Proposal #356 Updates the haddock submodule. - - - - - bca4d36d by Vladislav Zavialov at 2020-09-29T00:32:05-04:00 Improve error messages for (a %m) without LinearTypes Detect when the user forgets to enable the LinearTypes extension and produce a better error message. Steals the (a %m) syntax from TypeOperators, the workaround is to write (a % m) instead. - - - - - b9635d0a by Benjamin Maurer at 2020-09-29T00:32:43-04:00 Description of flag `-H` was in 'verbosity options', moved to 'misc'. Fixes #18699 - - - - - 74c797f6 by Benjamin Maurer at 2020-09-29T00:33:20-04:00 Workaround for #18623: GHC crashes bc. under rlimit for vmem it will reserve _all_ of it, leaving nothing for, e.g., thread stacks. Fix will only allocate 2/3rds and check whether remainder is at least large enough for minimum amount of thread stacks. - - - - - 4365d77a by Ryan Scott at 2020-09-29T00:33:57-04:00 Add regression test #18501 ghc/ghc!3220 ended up fixing #18501. This patch adds a regression test for #18501 to ensure that it stays fixed. - - - - - 8e3f00dd by Sylvain Henry at 2020-09-29T17:24:03+02:00 Make the parser module less dependent on DynFlags Bump haddock submodule - - - - - 3ab0d8f7 by Sebastian Graf at 2020-09-30T02:48:27-04:00 PmCheck: Long-distance information for LocalBinds (#18626) Now `desugarLocalBind` (formerly `desugarLet`) reasons about * `FunBind`s that * Have no pattern matches (so which aren't functions) * Have a singleton match group with a single GRHS * (which may have guards) * and looks through trivial post-typechecking `AbsBinds` in doing so to pick up the introduced renamings. And desugars to `PmLet` LYG-style guards. Since GRHSs are no longer denoted simply by `NonEmpty PmGRHS`, but also need to carry a `[PmGrd]` for the `PmLet`s from `LocalBind`s, I added `PmGRHSs` to capture that. Since we call out to the desugarer more often, I found that there were superfluous warnings emitted when desugaring e.g. case expressions. Thus, I made sure that we deactivate any warnings in the LYG desugaring steps by the new wrapper function `noCheckDs`. There's a regression test in `T18626`. Fixes #18626. - - - - - f8f60efc by Ben Gamari at 2020-09-30T02:49:03-04:00 testsuite: Mark T12971 as broken on Windows Due to #17945. - - - - - 6527fc57 by Ben Gamari at 2020-09-30T02:49:03-04:00 Bump Cabal, hsc2hs, directory, process submodules Necessary for recent Win32 bump. - - - - - df3f5880 by Sylvain Henry at 2020-09-30T02:49:41-04:00 Remove unsafeGlobalDynFlags (#17957, #14597) There are still global variables but only 3 booleans instead of a single DynFlags. - - - - - 9befd94d by Sylvain Henry at 2020-09-30T02:49:41-04:00 Remove unused global variables Some removed globals variables were still declared in the RTS. They were removed in the following commits: * 4fc6524a2a4a0003495a96c8b84783286f65c198 * 0dc7985663efa1739aafb480759e2e2e7fca2a36 * bbd3c399939311ec3e308721ab87ca6b9443f358 - - - - - 7c98699f by Richard Eisenberg at 2020-09-30T02:50:17-04:00 Omit redundant kind equality check in solver See updated Note [Use loose types in inert set] in GHC.Tc.Solver.Monad. Close #18753. - - - - - 39549826 by Sebastian Graf at 2020-09-30T02:50:54-04:00 Pmc: Don't call exprType on type arguments (#18767) Fixes #18767. - - - - - 235e410f by Richard Eisenberg at 2020-09-30T02:51:29-04:00 Regression test for #10709. Close #10709 - - - - - 5c32655f by Ben Gamari at 2020-09-30T22:31:55-04:00 hadrian/doc: Clarify documentation of key-value configuration - - - - - 0bb02873 by Sylvain Henry at 2020-10-01T18:34:53-04:00 Add test for T18574 - - - - - e393f213 by Sylvain Henry at 2020-10-01T18:34:53-04:00 Allow fusion with catMaybes (#18574) Metric Decrease: T18574 - - - - - d2cfad96 by Fendor at 2020-10-01T18:35:33-04:00 Add mainModuleNameIs and demote mainModIs Add `mainModuleNameIs` to DynFlags and demote `mainModIs` to function which uses the homeUnit from DynFlags it is created from. - - - - - fc351ab8 by Fendor at 2020-10-01T18:35:33-04:00 Use HomeUnit for main module without module declaration - - - - - dca1cb22 by Fendor at 2020-10-01T18:35:33-04:00 Remove mAIN completely - - - - - a5aaceec by Sylvain Henry at 2020-10-01T18:36:11-04:00 Use ADTs for parser errors/warnings Haskell and Cmm parsers/lexers now report errors and warnings using ADTs defined in GHC.Parser.Errors. They can be printed using functions in GHC.Parser.Errors.Ppr. Some of the errors provide hints with a separate ADT (e.g. to suggest to turn on some extension). For now, however, hints are not consistent across all messages. For example some errors contain the hints in the main message. I didn't want to change any message with this patch. I expect these changes to be discussed and implemented later. Surprisingly, this patch enhances performance. On CI (x86_64/deb9/hadrian, ghc/alloc): parsing001 -11.5% T13719 -2.7% MultiLayerModules -3.5% Naperian -3.1% Bump haddock submodule Metric Decrease: MultiLayerModules Naperian T13719 parsing001 - - - - - a946c7ef by Sylvain Henry at 2020-10-01T18:36:11-04:00 Less DynFlags in Header parsing - - - - - dafe7943 by Sylvain Henry at 2020-10-01T18:36:11-04:00 Parser: remove some unused imports These are not reported by GHC because Happy adds {-# OPTIONS_GHC -w #-} - - - - - 93d5de16 by Sylvain Henry at 2020-10-01T18:36:11-04:00 Don't import GHC.Unit to reduce the number of dependencies - - - - - e3655f81 by Sebastian Graf at 2020-10-01T18:36:47-04:00 Don't attach CPR signatures to NOINLINE data structures (#18154) Because the generated `KindRep`s don't have an unfolding, !3230 did not actually stop to compute, attach and serialise unnecessary CPR signatures for them. As already said in `Note [CPR for data structures]`, that leads to bloated interface files which is ultimately quadratic for Nested CPR. So we don't attach any CPR signature to bindings that * Are not thunks (because thunks are not in WHNF) * Have arity 0 (which means the top-level constructor is not a lambda) If the data structure has an unfolding, we continue to look through it. If not (as is the case for `KindRep`s), we look at the unchanged CPR signature and see `topCprType`, as expected. - - - - - ba5965eb by Richard Eisenberg at 2020-10-01T18:37:23-04:00 Add regression test for #18755. Close #18755 - - - - - a8018c17 by Vladislav Zavialov at 2020-10-01T18:37:58-04:00 Fix pretty-printing of the mult-polymorphic arrow A follow-up to !4020 (5830a12c46e7227c276a8a71213057595ee4fc04) - - - - - e5523324 by Sylvain Henry at 2020-10-01T18:38:35-04:00 Bignum: add integerNegate RULE - - - - - 1edd6d21 by Vladislav Zavialov at 2020-10-01T18:39:10-04:00 Refactor: remove rnHsDoc It did not do any useful work. - - - - - a9ae83af by Krzysztof Gogolewski at 2020-10-02T08:00:25-04:00 Fix typos in comments [skip ci] - - - - - b81350bb by Icelandjack at 2020-10-02T08:01:01-04:00 Replaced MkT1 with T1 in type signatures. - - - - - 3c9beab7 by Vladislav Zavialov at 2020-10-02T13:51:58-04:00 Minor TTG clean-up: comments, unused families, bottom 1. Fix and update section headers in GHC/Hs/Extension.hs 2. Delete the unused 'XCoreAnn' and 'XTickPragma' families 3. Avoid calls to 'panic' in 'pprStmt' - - - - - 12c06927 by Sylvain Henry at 2020-10-02T13:52:38-04:00 Bignum: implement integerRecipMod (#18427) - - - - - 8dd4f405 by Sylvain Henry at 2020-10-02T13:52:38-04:00 Bignum: implement integerPowMod (#18427) Incidentally fix powModInteger which was crashing in integer-gmp for negative exponents when the modular multiplicative inverse for the base didn't exist. Now we compute it explicitly with integerRecipMod so that every backend returns the same result without crashing. - - - - - 1033a720 by Krzysztof Gogolewski at 2020-10-02T13:53:23-04:00 Reject linearity in kinds in checkValidType (#18780) Patch taken from https://gitlab.haskell.org/ghc/ghc/-/issues/18624#note_300673 - - - - - b0ccba66 by Krzysztof Gogolewski at 2020-10-03T19:33:02-04:00 Small documentation fixes - Fix formatting of code blocks and a few sphinx warnings - Move the Void# change to 9.2, it was done right after the branch was cut - Fix typo in linear types documentation - Note that -Wincomplete-uni-patterns affects lazy patterns [skip ci] - - - - - 70dc2f09 by Karel Gardas at 2020-10-03T19:33:06-04:00 fix rts.cabal to use real arch names and not aliasses (fixes #18654) - - - - - bc5de347 by Sebastian Graf at 2020-10-05T13:59:24-04:00 Inline `integerDecodeDouble#` and constant-fold `decodeDouble_Int64#` instead Currently, `integerDecodeDouble#` is known-key so that it can be recognised in constant folding. But that is very brittle and doesn't survive worker/wrapper, which we even do for `NOINLINE` things since #13143. Also it is a trade-off: The implementation of `integerDecodeDouble#` allocates an `Integer` box that never cancels aways if we don't inline it. Hence we recognise the `decodeDouble_Int64#` primop instead in constant folding, so that we can inline `integerDecodeDouble#`. As a result, `integerDecodeDouble#` no longer needs to be known-key. While doing so, I realised that we don't constant-fold `decodeFloat_Int#` either, so I also added a RULE for it. `integerDecodeDouble` is dead, so I deleted it. Part of #18092. This improves the 32-bit `realToFrac`/`toRational`: Metric Decrease: T10359 - - - - - 802b5e6f by Krzysztof Gogolewski at 2020-10-05T13:59:33-04:00 Fix linear types in TH splices (#18465) - - - - - 18a3ddf7 by Ben Gamari at 2020-10-05T13:59:33-04:00 rts: Fix integer width in TICK_BUMP_BY Previously `TICK_BUMP_BY` was defined as ```c #define TICK_BUMP_BY(ctr,n) CLong[ctr] = CLong[ctr] + n ``` Yet the tickers themselves were defined as `StgInt`s. This happened to work out correctly on Linux, where `CLong` is 64-bits. However, it failed on Windows, where `CLong` is 32-bits, resulting in #18782. Fixes #18783. - - - - - 5fc4243b by Rachel at 2020-10-07T14:59:45-04:00 Document profiling flags, warning flags, and no-pie - - - - - b41f7c38 by Andreas Klebinger at 2020-10-07T15:00:20-04:00 WinIO: Small changes related to atomic request swaps. Move the atomix exchange over the Ptr type to an internal module. Fix a bug caused by us passing ptr-to-ptr instead of ptr to atomic exchange. Renamed interlockedExchange to exchangePtr. I've also added an cas primitive. It turned out we don't need it for WinIO but I'm leaving it in as it's useful for other things. - - - - - 948a14e1 by Ben Gamari at 2020-10-07T15:00:55-04:00 gitlab-ci: Fix name of Ubuntu 20.04 image - - - - - 74d4017b by Sylvain Henry at 2020-10-07T15:01:35-04:00 Fix -flink-rts (#18651) Before this patch -flink-rts could link with GHC's rts instead of the selected one. - - - - - 0e8b923d by Sylvain Henry at 2020-10-07T15:01:35-04:00 Apply suggestion to compiler/GHC/SysTools.hs - - - - - d6dff830 by Alan Zimmerman at 2020-10-07T15:02:10-04:00 Preserve as-parsed arrow type for HsUnrestrictedArrow When linear types are disabled, HsUnrestrictedArrow is treated as HslinearArrow. Move this adjustment into the type checking phase, so that the parsed source accurately represents the source as parsed. Closes #18791 - - - - - 030c5ce0 by Karel Gardas at 2020-10-07T15:02:48-04:00 hadrian: use stage0 linker to merge objects when done during the stage0 Fixes #18800. - - - - - a94db588 by Ben Gamari at 2020-10-07T15:03:23-04:00 testsuite: Allow whitespace before "Metric (in|de)crease" Several people have struggled with metric change annotations in their commit messages not being recognized due to the fact that GitLab's job log inserts a space at the beginning of each line. Teach the regular expression to accept this whitespace. - - - - - e91ddddd by Krzysztof Gogolewski at 2020-10-07T15:04:07-04:00 Misc cleanup * Include funTyCon in exposedPrimTyCons. Every single place using exposedPrimTyCons was adding funTyCon manually. * Remove unused synTyConResKind and ieLWrappedName * Add recordSelectorTyCon_maybe * In exprType, panic instead of giving a trace message and dummy output. This prevents #18767 reoccurring. * Fix compilation error in fragile concprog001 test (part of #18732) - - - - - 386c2d7f by Sylvain Henry at 2020-10-09T08:40:33-04:00 Use UnitId in the backend instead of Unit In Cmm we can only have real units identified with an UnitId. Other units (on-the-fly instantiated units and holes) are only used in type-checking backpack sessions that don't produce Cmm. - - - - - a566c83d by Simon Jakobi at 2020-10-09T08:41:09-04:00 Update containers to v0.6.4.1 Updates containers submodule. - - - - - fd984d68 by Tamar Christina at 2020-10-09T08:41:50-04:00 rts: fix race condition in StgCRun On windows the stack has to be allocated 4k at a time, otherwise we get a segfault. This is done by using a helper ___chkstk_ms that is provided by libgcc. The Haskell side already knows how to handle this but we need to do the same from STG. Previously we would drop the stack in StgRun but would only make it valid whenever the scheduler loop ran. This approach was fundamentally broken in that it falls apart when you take a signal from the OS. We see it less often because you initially get allocated a 1MB stack block which you have to blow past first. Concretely this means we must always keep the stack valid. Fixes #18601. - - - - - accdb24a by Sylvain Henry at 2020-10-09T08:42:31-04:00 Expose RTS-only ways (#18651) Some RTS ways are exposed via settings (ghcThreaded, ghcDebugged) but not all. It's simpler if the RTS exposes them all itself. - - - - - d360f343 by MaxGabriel at 2020-10-09T08:43:11-04:00 Document -Wderiving-typeable Tracking: #18641 - - - - - e48cab2a by Krzysztof Gogolewski at 2020-10-09T08:43:49-04:00 Add a flag to indicate that gcc supports -no-pie Fixes #17919. - - - - - f7e2fff9 by Hécate at 2020-10-09T08:44:26-04:00 Add linting of `base` to the CI - - - - - 45a1d493 by Andreas Klebinger at 2020-10-09T08:45:05-04:00 Use proper RTS flags when collecting residency in perf tests. Replace options like collect_stats(['peak_megabytes_allocated'],4) with collect_runtime_residency(4) and so forth. Reason being that the later also supplies some default RTS arguments which make sure residency does not fluctuate too much. The new flags mean we get new (hopefully more accurate) baselines so accept the stat changes. ------------------------- Metric Decrease: T4029 T4334 T7850 Metric Increase: T13218 T7436 ------------------------- - - - - - ef65b154 by Andreas Klebinger at 2020-10-09T08:45:42-04:00 testsuite/timeout: Fix windows specific errors. We now seem to use -Werror there. Which caused some long standing warnings to become errors. I applied changes to remove the warnings allowing the testsuite to run on windows as well. - - - - - e691a5a0 by Sylvain Henry at 2020-10-09T08:46:22-04:00 Hadrian: add quick-debug flavour - - - - - 12191a99 by Sylvain Henry at 2020-10-09T08:47:00-04:00 Bignum: match on small Integer/Natural Previously we only matched on *variables* whose unfoldings were a ConApp of the form `IS lit#` or `NS lit##`. But we forgot to match on the ConApp directly... As a consequence, constant folding only worked after the FloatOut pass which creates bindings for most sub-expressions. With this patch, matching on bignums works even with -O0 (see bignumMatch test). - - - - - 36787bba by Alan Zimmerman at 2020-10-09T08:47:36-04:00 ApiAnnotations : preserve parens in GADTs A cleanup in 7f418acf61e accidentally discarded some parens in ConDeclGADT. Make sure these stay in the AST in a usable format. Also ensure the AnnLolly does not get lost in a GADT. - - - - - 32dc7698 by Krzysztof Gogolewski at 2020-10-09T08:48:15-04:00 Linear types: fix roles in GADTs (#18799) - - - - - 9657f6f3 by Ben Gamari at 2020-10-09T08:48:52-04:00 sdist: Include hadrian sources in source distribution Previously the make build system's source distribution rules neglected to include Hadrian's sources. Fixes #18794. - - - - - c832f7e2 by Tamar Christina at 2020-10-09T08:49:33-04:00 winio: fixed timeouts non-threaded. - - - - - 6f0243ae by Tamar Christina at 2020-10-09T08:50:13-04:00 winio: fix array splat - - - - - 0fd3d360 by Tamar Christina at 2020-10-09T08:50:51-04:00 winio: fixed bytestring reading interface. - - - - - dfaef1ca by Tamar Christina at 2020-10-09T08:51:30-04:00 winio: fixed more data error. - - - - - bfdccac6 by Simon Peyton Jones at 2020-10-09T08:52:07-04:00 Fix desugaring of record updates on data families This fixes a long-standing bug in the desugaring of record updates for data families, when the latter involves a GADT. It's all explained in Note [Update for GADTs] in GHC.HsToCore.Expr. Building the correct cast is surprisingly tricky, as that Note explains. Fixes #18809. The test case (in indexed-types/should_compile/T18809) contains several examples that exercise the dark corners. - - - - - e5c7c9c8 by Ben Gamari at 2020-10-09T08:52:43-04:00 Bump win32-tarballs version to 0.3 This should fix #18774. - - - - - ef950b19 by Andreas Klebinger at 2020-10-09T08:53:21-04:00 Add TyCon Set/Env and use them in a few places. Firstly this improves code clarity. But it also has performance benefits as we no longer go through the name of the TyCon to get at it's unique. In order to make this work the recursion check for TyCon has been moved into it's own module in order to avoid import cycles. - - - - - fd302e93 by Krzysztof Gogolewski at 2020-10-09T08:54:02-04:00 Add -pgmlm and -optlm flags !3798 added documentation and semantics for the flags, but not parsing. - - - - - db236ffc by Sylvain Henry at 2020-10-09T08:54:41-04:00 Testsuite: increase timeout for T18223 (#18795) - - - - - 6a243e9d by Sylvain Henry at 2020-10-09T08:55:21-04:00 Cache HomeUnit in HscEnv (#17957) Instead of recreating the HomeUnit from the DynFlags every time we need it, we store it in the HscEnv. - - - - - 5884fd32 by Fendor at 2020-10-09T19:46:28+02:00 Move File Target parser to library #18596 - - - - - ea59fd4d by Hécate at 2020-10-10T14:49:59-04:00 Lint the compiler for extraneous LANGUAGE pragmas - - - - - 22f218b7 by Krzysztof Gogolewski at 2020-10-10T14:50:42-04:00 Linear types: fix quantification in GADTs (#18790) - - - - - 74ee1237 by Sylvain Henry at 2020-10-10T14:51:20-04:00 Bignum: fix bigNatCompareWord# bug (#18813) - - - - - 274e21f0 by Hécate at 2020-10-11T10:55:56+02:00 Remove the dependency on the ghc-linters stage - - - - - 990ea991 by Daniel Rogozin at 2020-10-11T22:20:04+03:00 Fall back to types when looking up data constructors (#18740) Before this patch, referring to a data constructor in a term-level context led to a scoping error: ghci> id Int <interactive>:1:4: error: Data constructor not in scope: Int After this patch, the renamer falls back to the type namespace and successfully finds the Int. It is then rejected in the type checker with a more useful error message: <interactive>:1:4: error: • Illegal term-level use of the type constructor ‘Int’ imported from ‘Prelude’ (and originally defined in ‘GHC.Types’) • In the first argument of ‘id’, namely ‘Int’ In the expression: id Int We also do this for type variables. - - - - - 9bbc84d2 by Sylvain Henry at 2020-10-12T18:21:51-04:00 DynFlags: refactor DmdAnal Make demand analysis usable without having to provide DynFlags. - - - - - 7fdcce6d by Wander Hillen at 2020-10-13T00:12:47-04:00 Initial ShortText code and conversion of package db code Metric Decrease: Naperian T10421 T10421a T10547 T12150 T12234 T12425 T13035 T18140 T18304 T5837 T6048 T13253-spj T18282 T18223 T3064 T9961 Metric Increase T13701 HFSKJH - - - - - 0a5f2918 by Sylvain Henry at 2020-10-13T00:13:28-04:00 Parser: don't require the HomeUnitId The HomeUnitId is only used by the Cmm parser and this one has access to the DynFlags, so it can grab the UnitId of the HomeUnit from them. Bump haddock submodule - - - - - 8f4f5794 by HaskellMouse at 2020-10-13T13:05:49+03:00 Unification of Nat and Naturals This commit removes the separate kind 'Nat' and enables promotion of type 'Natural' for using as type literal. It partially solves #10776 Now the following code will be successfully typechecked: data C = MkC Natural type CC = MkC 1 Before this change we had to create the separate type for promotion data C = MkC Natural data CP = MkCP Nat type CC = MkCP 1 But CP is uninhabited in terms. For backward compatibility type synonym `Nat` has been made: type Nat = Natural The user's documentation and tests have been updated. The haddock submodule also have been updated. - - - - - 0fc1cb54 by Ben Gamari at 2020-10-14T03:42:50-04:00 gitlab-ci: Verify that Hadrian builds with Stack As noted in #18726, this regularly breaks. Let's test it. Note that we don't actually perform a build of GHC itself; we merely test that the Hadrian executable builds and works (by invoking `hadrian --version`). - - - - - 89f4d8e9 by Ben Gamari at 2020-10-14T12:03:57-04:00 Bump LLVM version to 10.0 Fixes #18267. - - - - - 716385c9 by Ryan Scott at 2020-10-14T12:04:34-04:00 Make DataKinds the sole arbiter of kind-level literals (and friends) Previously, the use of kind-level literals, promoted tuples, and promoted lists required enabling both `DataKinds` and `PolyKinds`. This made sense back in a `TypeInType` world, but not so much now that `TypeInType`'s role has been superseded. Nowadays, `PolyKinds` only controls kind polymorphism, so let's make `DataKinds` the thing that controls the other aspects of `TypeInType`, which include literals, promoted tuples and promoted lists. There are some other things that overzealously required `PolyKinds`, which this patch fixes as well: * Previously, using constraints in kinds (e.g., `data T :: () -> Type`) required `PolyKinds`, despite the fact that this is orthogonal to kind polymorphism. This now requires `DataKinds` instead. * Previously, using kind annotations in kinds (e.g., `data T :: (Type :: Type) -> Type`) required both `KindSignatures` and `PolyKinds`. This doesn't make much sense, so it only requires `KindSignatures` now. Fixes #18831. - - - - - ac300a0d by Vladislav Zavialov at 2020-10-14T12:05:11-04:00 Remove "Operator sections" from docs/users_guide/bugs.rst The issue described in that section was fixed by 2b89ca5b850b4097447cc4908cbb0631011ce979 - - - - - bf2411a3 by Vladislav Zavialov at 2020-10-14T12:05:11-04:00 Fix PostfixOperators (#18151) This fixes a regression introduced in 2b89ca5b850b4097447cc4908cbb0631011ce979 See the new T18151x test case. - - - - - e60ae8a3 by Fumiaki Kinoshita at 2020-10-14T18:06:12-04:00 Add -Wnoncanonical-{monad,monoid}-instances to standardWarnings ------------------------- Metric Decrease: T12425 Metric Increase: T17516 ------------------------- - - - - - 15d2340c by Simon Peyton Jones at 2020-10-14T18:06:48-04:00 Fix some missed opportunities for preInlineUnconditionally There are two signficant changes here: * Ticket #18815 showed that we were missing some opportunities for preInlineUnconditionally. The one-line fix is in the code for GHC.Core.Opt.Simplify.Utils.preInlineUnconditionally, which now switches off only for INLINE pragmas. I expanded Note [Stable unfoldings and preInlineUnconditionally] to explain. * When doing this I discovered a way in which preInlineUnconditionally was occasionally /too/ eager. It's all explained in Note [Occurrences in stable unfoldings] in GHC.Core.Opt.OccurAnal, and the one-line change adding markAllMany to occAnalUnfolding. I also got confused about what NoUserInline meant, so I've renamed it to NoUserInlinePrag, and changed its pretty-printing slightly. That led to soem error messate wibbling, and touches quite a few files, but there is no change in functionality. I did a nofib run. As expected, no significant changes. Program Size Allocs ---------------------------------------- sphere -0.0% -0.4% ---------------------------------------- Min -0.0% -0.4% Max -0.0% +0.0% Geometric Mean -0.0% -0.0% I'm allowing a max-residency increase for T10370, which seems very irreproducible. (See comments on !4241.) There is always sampling error for max-residency measurements; and in any case the change shows up on some platforms but not others. Metric Increase: T10370 - - - - - 0c4bfed8 by Ben Gamari at 2020-10-14T18:07:25-04:00 users-guide: Add missing :ghc-flag: directive - - - - - 51c4b851 by Krzysztof Gogolewski at 2020-10-15T04:30:27-04:00 Remove Proxy# argument in Data.Typeable.Internal No longer neccessary - TypeRep is now indexed, there is no ambiguity. Also fix a comment in Evidence.hs, IsLabel no longer takes a Proxy#. - - - - - 809f09e8 by Sylvain Henry at 2020-10-15T04:31:07-04:00 Fix parsing of PIE flags -fPIE and -fno-PIE flags were (un)setting Opt_PIC instead of Opt_PIE. Original commit: 3625728a0e3a9b56c2b85ae7ea8bcabdd83ece6a - - - - - 3d7db148 by Ben Gamari at 2020-10-15T04:31:42-04:00 testsuite: Add missing #include on <stdlib.h> This otherwise fails on newer Clangs, which warn more aggressively on undeclared symbols. - - - - - 998803dc by Andrzej Rybczak at 2020-10-15T11:40:32+02:00 Add flags for annotating Generic{,1} methods INLINE[1] (#11068) Makes it possible for GHC to optimize away intermediate Generic representation for more types. Metric Increase: T12227 - - - - - 6b14c418 by GHC GitLab CI at 2020-10-15T21:57:50-04:00 Extend mAX_TUPLE_SIZE to 64 As well a ctuples and sums. - - - - - d495f36a by Ben Gamari at 2020-10-15T21:58:27-04:00 rts: Clean-up whitespace in Interpreter - - - - - cf10becd by Ben Gamari at 2020-10-15T21:58:27-04:00 compiler/ByteCode: Use strict Maps in bytecode assembler - - - - - ae146b53 by Ben Gamari at 2020-10-15T21:58:27-04:00 compiler/ByteCode: Make LocalLabel a newtype - - - - - cc536288 by Ben Gamari at 2020-10-15T21:58:27-04:00 compiler/ByteCode: Allow 2^32 local labels This widens LocalLabel to 2^16, avoiding the crash observed in #14334. Closes #14334. - - - - - 1bb0512f by Ben Gamari at 2020-10-16T00:15:31-04:00 mingw: Extract zst toolchain archives This should have been done when the toolchain was bumped. - - - - - bf7c5b6d by Ben Gamari at 2020-10-16T00:15:31-04:00 base: Reintroduce necessary LANGUAGE pragmas These were incorrectly removed in a recent cleanup commit. - - - - - c6b4be4b by Ben Gamari at 2020-10-16T00:15:31-04:00 testsuite: Sort metrics by metric type Closes #18838. - - - - - c7989c93 by Ben Gamari at 2020-10-16T00:15:31-04:00 testsuite: Account for -Wnoncanonical-monoid-instances changes on Windows - - - - - 330a5433 by Ben Gamari at 2020-10-16T00:15:31-04:00 rts: Add __mingw_vfprintf to RtsSymbols.c Following the model of the other printf symbols. See Note [Symbols for MinGW's printf]. - - - - - c4a69f37 by Ben Gamari at 2020-10-16T00:15:31-04:00 gitlab-ci: Remove allow_failure from Windows jobs - - - - - 9a9679db by Ben Gamari at 2020-10-16T00:15:31-04:00 gitlab-ci: Fix Hadrian bindist names - - - - - 07b0db86 by f-a at 2020-10-16T10:14:39-04:00 Clarify Eq documentation #18713 - - - - - aca0e63b by Ben Gamari at 2020-10-17T10:20:31-04:00 gitlab-ci: Allow doc-tarball job to fail Currently the Hadrian build appears not to package documentation correctly, causing doc-tarball to fail due to the Windows build. - - - - - b02a9ea7 by Ben Gamari at 2020-10-17T13:26:24-04:00 gitlab-ci: s/allow_newer/allow_failure Silly mistake on my part. - - - - - 59d7c9f4 by John Ericson at 2020-10-17T22:01:38-04:00 Skip type family defaults with hs-boot and hsig files Works around #17190, possible resolution for #17224. New design is is according to accepted [GHC Propoal 320]. Instances in signatures currently unconditionally opt into associated family defaults if no explicit instance is given. This is bad for two reasons: 1. It constrains possible instantiations to use the default, rather than possibly define the associated family differently. 2. It breaks compilation as type families are unsupported in signatures. This PR simply turns off the filling in of defaults in those cases. Additionally, it squelches a missing definition warning for hs-boot too that was only squelched for hsig before. The downsides are: 1. There is no way to opt into the default, other than copying its definition. 2. If we fixed type classes in signatures, and wanted instances to have to explicitly *out of* rather than into the default, that would now be a breaking change. The change that is most unambiguously goood is harmonizing the warning squelching between hs-boot or hsig. Maybe they should have the warning (opt out of default) maybe they shouldn't (opt in to default), but surely it should be the same for both. Add hs-boot version of a backpack test regarding class-specified defaults in instances that appear in an hs-boot file. The metrics increase is very slight and makes no sense --- at least no one has figured anything out after this languishing for a while, so I'm just going to accept it. Metric Increase: T10421a [GHC proposal 320]: https://github.com/ghc-proposals/ghc-proposals/pull/320 - - - - - 7eb46a09 by Sebastian Graf at 2020-10-17T22:02:13-04:00 Arity: Refactor fixed-point iteration in GHC.Core.Opt.Arity Arity analysis used to propagate optimistic arity types during fixed-point interation through the `ArityEnv`'s `ae_cheap_fun` field, which is like `GHC.Core.Utils.exprIsCheap`, but also considers the current iteration's optimistic arity, for the binder in question only. In #18793, we have seen that this is a problematic design, because it doesn't allow us to look through PAP bindings of that binder. Hence this patch refactors to a more traditional form with an explicit signature environment, in which we record the optimistic `ArityType` of the binder in question (and at the moment is the *only* binder that is recorded in the arity environment). - - - - - 6b3eb06a by Sebastian Graf at 2020-10-17T22:02:13-04:00 Arity: Record arity types for non-recursive lets In #18793, we saw a compelling example which requires us to look at non-recursive let-bindings during arity analysis and unleash their arity types at use sites. After the refactoring in the previous patch, the needed change is quite simple and very local to `arityType`'s defn for non-recurisve `Let`. Apart from that, we had to get rid of the second item of `Note [Dealing with bottoms]`, which was entirely a safety measure and hindered optimistic fixed-point iteration. Fixes #18793. The following metric increases are all caused by this commit and a result of the fact that we just do more work now: Metric Increase: T3294 T12545 T12707 - - - - - 451455fd by Sebastian Graf at 2020-10-17T22:02:13-04:00 Testsuite: Add dead arity analysis tests We didn't seem to test these old tests at all, judging from their expected output. - - - - - 50e9df49 by Dylan Yudaken at 2020-10-17T22:02:50-04:00 When using rts_setInCallCapability, lock incall threads This diff makes sure that incall threads, when using `rts_setInCallCapability`, will be created as locked. If the thread is not locked, the thread might end up being scheduled to a different capability. While this is mentioned in the docs for `rts_setInCallCapability,`, it makes the method significantly less useful as there is no guarantees on the capability being used. This commit also adds a test to make sure things stay on the correct capability. - - - - - 0b995759 by DylanZA at 2020-10-17T22:02:50-04:00 Apply suggestion to testsuite/tests/ffi/should_run/all.T - - - - - a91dcb66 by Sylvain Henry at 2020-10-17T22:04:02-04:00 Don't get host RTS ways via settings (#18651) To correctly perform a linking hack for Windows we need to link with the RTS GHC is currently using. We used to query the RTS ways via the "settings" file but it is fragile (#18651). The hack hasn't been fixed to take into account all the ways (Tracing) and it makes linking of GHC with another RTS more difficult (we need to link with another RTS and to regenerate the settings file). So this patch uses the ways reported by the RTS itself (GHC.Platform.Ways.hostWays) instead of the "settings" file. - - - - - d858a3ae by Hécate at 2020-10-17T22:04:38-04:00 Linting corrections * Bring back LANGUAGE pragmas in GHC.IO.Handle.Lock.Windows * Exclude some modules that are wrongfully reported - - - - - b5b3e34e by Vladislav Zavialov at 2020-10-19T18:16:20-04:00 Implement -Woperator-whitespace (#18834) This patch implements two related warnings: -Woperator-whitespace-ext-conflict warns on uses of infix operators that would be parsed differently were a particular GHC extension enabled -Woperator-whitespace warns on prefix, suffix, and tight infix uses of infix operators Updates submodules: haddock, containers. - - - - - 9648d680 by Sylvain Henry at 2020-10-19T18:16:58-04:00 Remove pdocPrec pdocPrec was only used in GHC.Cmm.DebugBlock.pprUnwindExpr, so remove it. OutputableP becomes a one-function class which might be better for performance. - - - - - ee5dcdf9 by Ben Gamari at 2020-10-20T00:47:54-04:00 testsuite: Add test for #18346 This was fixed by 4291bddaea3148908c55f235ee8978e1d9aa6f20. - - - - - 6c7a5c0c by Krzysztof Gogolewski at 2020-10-20T00:48:29-04:00 Minor comments, update linear types docs - Update comments: placeHolderTypeTc no longer exists "another level check problem" was a temporary comment from linear types - Use Mult type synonym (reported in #18676) - Mention multiplicity-polymorphic fields in linear types docs - - - - - 58a1ca38 by nineonine at 2020-10-20T00:49:07-04:00 Compile modules with `-fobject-code` enabled to byte-code when loaded with `*` prefix in ghci (#8042) The documentation states that when using :add and :load, the `*` prefix forces a module to be loaded as byte-code. However, this seems to be ignored when -fobject-code has been enabled. In that case, the compiled code is always used, regardless of whether the *-form is used. The idea is to consult the Targets in HscEnv and check the 'targetAllowObjCode' flag. If the flag for given module is set, then patch up DynFlags and select compilation backend accordingly. This would require a linear scan of course, but that shouldn't be too costly. - - - - - 59b08a5d by Ben Gamari at 2020-10-20T00:49:41-04:00 gitlab-ci: Rename FLAVOUR -> BUILD_FLAVOUR Previously the Hadrian jobs used the `FLAVOUR` environment variable to communicate which flavour `ci.sh` should build whereas `make` used `BUILD_FLAVOUR`. This caused unnecessary confusion. Consolidate these two. - - - - - ea736839 by Alan Zimmerman at 2020-10-20T08:35:34+01:00 API Annotations: Keep track of unicode for linear arrow notation The linear arrow can be parsed as `%1 ->` or a direct single token unicode equivalent. Make sure that this distinction is captured in the parsed AST by using IsUnicodeSyntax where it appears, and introduce a new API Annotation, AnnMult to represent its location when unicode is not used. Updated haddock submodule - - - - - cf3c3bcd by Ben Gamari at 2020-10-20T22:56:31-04:00 testsuite: Mark T12971 as fragile on Windows Due to #17945. - - - - - e2c4a947 by Vladislav Zavialov at 2020-10-21T16:00:30+03:00 Parser regression tests, close #12862 #12446 These issues were fixed by earlier parser changes, most likely related to whitespace-sensitive parsing. - - - - - 711929e6 by Simon Peyton Jones at 2020-10-23T02:42:59-04:00 Fix error message location in tcCheckPatSynDecl Ticket #18856 showed that we were failing to set the right location for an error message. Easy to fix, happily. Turns out that this also improves the error location in test T11010, which was bogus before but we had never noticed. - - - - - 730bb590 by Ben Gamari at 2020-10-23T02:43:33-04:00 cmm: Add Note reference to ForeignHint - - - - - b9d4dd9c by Ben Gamari at 2020-10-24T20:44:17-04:00 SMP.h: Add C11-style atomic operations - - - - - ccf2d4b0 by Ben Gamari at 2020-10-24T20:59:39-04:00 rts: Infrastructure for testing with ThreadSanitizer - - - - - a61f66d6 by Ben Gamari at 2020-10-24T20:59:39-04:00 rts/CNF: Initialize all bdescrs in group It seems wise and cheap to ensure that the whole bdescr of all blocks of a compact group is valid, even if most cases only look at the flags field. - - - - - 65136c13 by Ben Gamari at 2020-10-24T20:59:39-04:00 rts/Capability: Intialize interrupt field Previously this was left uninitialized. Also clarify some comments. - - - - - b3ce6aca by Ben Gamari at 2020-10-24T20:59:39-04:00 rts/Task: Make comments proper Notes - - - - - d3890ac7 by Ben Gamari at 2020-10-24T20:59:39-04:00 rts/SpinLock: Move to proper atomics This is fairly straightforward; we just needed to use relaxed operations for the PROF_SPIN counters and a release store instead of a write barrier. - - - - - ef88712f by Ben Gamari at 2020-10-24T20:59:39-04:00 rts/OSThreads: Fix data race Previously we would race on the cached processor count. Avoiding this is straightforward; just use relaxed operations. - - - - - 33a719c3 by Ben Gamari at 2020-10-24T20:59:39-04:00 rts/ClosureMaros: Use relaxed atomics - - - - - f08951fd by Ben Gamari at 2020-10-24T20:59:39-04:00 configure: Bump minimum-supported gcc version to 4.7 Since the __atomic_* builtins are not supported until gcc 4.7. Given that this version was released in 2012 I think this is acceptable. - - - - - d584923a by Ben Gamari at 2020-10-24T20:59:39-04:00 testsuite: Fix thread leak in hs_try_putmvar00[13] - - - - - bf1b0bc7 by Ben Gamari at 2020-10-24T20:59:39-04:00 rts: Introduce SET_HDR_RELEASE Also ensure that we also store the info table pointer last to ensure that the synchronization covers all stores. - - - - - 1a2e9f5e by Ben Gamari at 2020-10-24T21:00:19-04:00 gitlab-ci: Add nightly-x86_64-linux-deb9-tsan job - - - - - 58a5b0e5 by GHC GitLab CI at 2020-10-24T21:00:19-04:00 testsuite: Mark setnumcapabilities001 as broken with TSAN Due to #18808. - - - - - d9bc7dea by GHC GitLab CI at 2020-10-24T21:00:19-04:00 testsuite: Skip divbyzero and derefnull under TSAN ThreadSanitizer changes the output of these tests. - - - - - fcc42a10 by Ben Gamari at 2020-10-24T21:00:19-04:00 testsuite: Skip high memory usage tests with TSAN ThreadSanitizer significantly increases the memory footprint of tests, so much so that it can send machines into OOM. - - - - - cae4bb3e by Ben Gamari at 2020-10-24T21:00:19-04:00 testsuite: Mark hie002 as high_memory_usage This test has a peak residency of 1GByte; this is large enough to classify as "high" in my book. - - - - - dae1b86a by Ben Gamari at 2020-10-24T21:00:19-04:00 testsuite: Mark T9872[abc] as high_memory_usage These all have a maximum residency of over 2 GB. - - - - - c5a0bb22 by Ben Gamari at 2020-10-24T21:00:19-04:00 gitlab-ci: Disable documentation in TSAN build Haddock chews through enough memory to cause the CI builders to OOM and there's frankly no reason to build documentation in this job anyways. - - - - - 4cb1232e by Ben Gamari at 2020-10-24T21:00:19-04:00 TSANUtils: Ensure that C11 atomics are supported - - - - - 7ed15f7f by Ben Gamari at 2020-10-24T21:00:19-04:00 testsuite: Mark T3807 as broken with TSAN Due to #18883. - - - - - f7e6f012 by Ben Gamari at 2020-10-24T21:00:19-04:00 testsuite: Mark T13702 as broken with TSAN due to #18884 - - - - - 16b136b0 by Ben Gamari at 2020-10-24T21:00:36-04:00 rts: Factor out logic to identify a good capability for running a task Not only does this make the control flow a bit clearer but it also allows us to add a TSAN suppression on this logic, which requires (harmless) data races. - - - - - 2781d68c by Ben Gamari at 2020-10-24T21:00:36-04:00 rts: Annotate benign race in waitForCapability - - - - - f6b4b492 by Ben Gamari at 2020-10-24T21:00:36-04:00 rts: Clarify locking behavior of releaseCapability_ - - - - - 65219810 by Ben Gamari at 2020-10-24T21:00:36-04:00 rts: Add assertions for task ownership of capabilities - - - - - 31fa87ec by Ben Gamari at 2020-10-24T21:00:36-04:00 rts: Use relaxed atomics on n_returning_tasks This mitigates the warning of a benign race on n_returning_tasks in shouldYieldCapability. See #17261. - - - - - 6517a2ea by Ben Gamari at 2020-10-24T21:00:36-04:00 rts: Mitigate races in capability interruption logic - - - - - 2e9ba3f2 by Ben Gamari at 2020-10-24T21:00:36-04:00 rts/Capability: Use relaxed operations for last_free_capability - - - - - e10dde37 by Ben Gamari at 2020-10-24T21:00:37-04:00 rts: Use relaxed operations for cap->running_task (TODO) This shouldn't be necessary since only the owning thread of the capability should be touching this. - - - - - 855325cd by Ben Gamari at 2020-10-24T21:00:37-04:00 rts/Schedule: Use relaxed operations for sched_state - - - - - 811f915d by Ben Gamari at 2020-10-24T21:00:37-04:00 rts: Accept data race in work-stealing implementation This race is okay since the task is owned by the capability pushing it. By Note [Ownership of Task] this means that the capability is free to write to `task->cap` without taking `task->lock`. Fixes #17276. - - - - - 8d2b3c3d by Ben Gamari at 2020-10-24T21:00:37-04:00 rts: Eliminate data races on pending_sync - - - - - f8871018 by Ben Gamari at 2020-10-24T21:00:37-04:00 rts/Schedule: Eliminate data races on recent_activity We cannot safely use relaxed atomics here. - - - - - d079b943 by Ben Gamari at 2020-10-24T21:00:37-04:00 rts: Avoid data races in message handling - - - - - 06f80497 by Ben Gamari at 2020-10-24T21:00:37-04:00 rts/Messages: Drop incredibly fishy write barrier executeMessage previously had a write barrier at the beginning of its loop apparently in an attempt to synchronize with another thread's writes to the Message. I would guess that the author had intended to use a load barrier here given that there are no globally-visible writes done in executeMessage. I've removed the redundant barrier since the necessary load barrier is now provided by the ACQUIRE_LOAD. - - - - - d4a87779 by Ben Gamari at 2020-10-24T21:00:38-04:00 rts/ThreadPaused: Avoid data races - - - - - 56778ab3 by Ben Gamari at 2020-10-24T21:00:38-04:00 rts/Schedule: Eliminate data races in run queue management - - - - - 086521f7 by Ben Gamari at 2020-10-24T21:00:38-04:00 rts: Eliminate shutdown data race on task counters - - - - - abad9778 by Ben Gamari at 2020-10-24T21:00:38-04:00 rts/Threads: Avoid data races (TODO) Replace barriers with appropriate ordering. Drop redundant barrier in tryWakeupThread (the RELEASE barrier will be provided by sendMessage's mutex release). We use relaxed operations on why_blocked and the stack although it's not clear to me why this is necessary. - - - - - 2f56be8a by Ben Gamari at 2020-10-24T21:00:39-04:00 rts/Messages: Annotate benign race - - - - - 7c0cdab1 by Ben Gamari at 2020-10-24T21:00:39-04:00 rts/RaiseAsync: Synchronize what_next read - - - - - 6cc2a8a5 by Ben Gamari at 2020-10-24T21:00:39-04:00 rts/Task: Move debugTrace to avoid data race Specifically, we need to hold all_tasks_mutex to read taskCount. - - - - - bbaec97d by Ben Gamari at 2020-10-24T21:00:39-04:00 Disable flawed assertion - - - - - dd175a92 by Ben Gamari at 2020-10-24T21:00:39-04:00 Document schedulePushWork race - - - - - 3416244b by Ben Gamari at 2020-10-24T21:00:40-04:00 Capabiliity: Properly fix data race on n_returning_tasks There is a real data race but can be made safe by using proper atomic (but relaxed) accesses. - - - - - dffd9432 by Ben Gamari at 2020-10-24T21:00:40-04:00 rts: Make write of to_cap->inbox atomic This is necessary since emptyInbox may read from to_cap->inbox without taking cap->lock. - - - - - 1f4cbc29 by Ben Gamari at 2020-10-24T21:00:57-04:00 rts/BlockAlloc: Use relaxed operations - - - - - d0d07cff by Ben Gamari at 2020-10-24T21:00:57-04:00 rts: Rework handling of mutlist scavenging statistics - - - - - 9e5c7f6d by Ben Gamari at 2020-10-24T21:00:57-04:00 rts: Avoid data races in StablePtr implementation This fixes two potentially problematic data races in the StablePtr implementation: * We would fail to RELEASE the stable pointer table when enlarging it, causing other cores to potentially see uninitialized memory. * We would fail to ACQUIRE when dereferencing a stable pointer. - - - - - 316add67 by Ben Gamari at 2020-10-24T21:00:57-04:00 rts/Storage: Use atomics - - - - - 5c23bc4c by Ben Gamari at 2020-10-24T21:00:58-04:00 rts/Updates: Use proper atomic operations - - - - - 3d0f033c by Ben Gamari at 2020-10-24T21:00:58-04:00 rts/Weak: Eliminate data races By taking all_tasks_mutex in stat_exit. Also better-document the fact that the task statistics are protected by all_tasks_mutex. - - - - - edb4b92b by Ben Gamari at 2020-10-24T21:01:18-04:00 rts/WSDeque: Rewrite with proper atomics After a few attempts at shoring up the previous implementation, I ended up turning to the literature and now use the proven implementation, > N.M. Lê, A. Pop, A.Cohen, and F.Z. Nardelli. "Correct and Efficient > Work-Stealing for Weak Memory Models". PPoPP'13, February 2013, > ACM 978-1-4503-1922/13/02. Note only is this approach formally proven correct under C11 semantics but it is also proved to be a bit faster in practice. - - - - - d39bbd3d by Ben Gamari at 2020-10-24T21:01:33-04:00 rts: Use relaxed atomics for whitehole spin stats - - - - - 8f802f38 by Ben Gamari at 2020-10-24T21:01:33-04:00 rts: Avoid lock order inversion during fork Fixes #17275. - - - - - cef667b0 by GHC GitLab CI at 2020-10-24T21:01:34-04:00 rts: Use proper relaxe operations in getCurrentThreadCPUTime Here we are doing lazy initialization; it's okay if we do the check more than once, hence relaxed operation is fine. - - - - - 8cf50eb1 by Ben Gamari at 2020-10-24T21:01:54-04:00 rts/STM: Use atomics This fixes a potentially harmful race where we failed to synchronize before looking at a TVar's current_value. Also did a bit of refactoring to avoid abstract over management of max_commits. - - - - - 88a7ce38 by Ben Gamari at 2020-10-24T21:01:54-04:00 rts/stm: Strengthen orderings to SEQ_CST instead of volatile Previously the `current_value`, `first_watch_queue_entry`, and `num_updates` fields of `StgTVar` were marked as `volatile` in an attempt to provide strong ordering. Of course, this isn't sufficient. We now use proper atomic operations. In most of these cases I strengthen the ordering all the way to SEQ_CST although it's possible that some could be weakened with some thought. - - - - - f97c59ce by Ben Gamari at 2020-10-24T21:02:11-04:00 Mitigate data races in event manager startup/shutdown - - - - - c7c3f8aa by Ben Gamari at 2020-10-24T21:02:22-04:00 rts: Accept benign races in Proftimer - - - - - 5a98dfca by Ben Gamari at 2020-10-24T21:02:22-04:00 rts: Pause timer while changing capability count This avoids #17289. - - - - - 01d95525 by Ben Gamari at 2020-10-24T21:02:22-04:00 Fix #17289 - - - - - 9a528985 by Ben Gamari at 2020-10-24T21:02:23-04:00 suppress #17289 (ticker) race - - - - - 1726ec41 by Ben Gamari at 2020-10-24T21:02:23-04:00 rts: Fix timer initialization Previously `initScheduler` would attempt to pause the ticker and in so doing acquire the ticker mutex. However, initTicker, which is responsible for initializing said mutex, hadn't been called yet. - - - - - bfbe4366 by Ben Gamari at 2020-10-24T21:02:23-04:00 rts: Fix races in Pthread timer backend shudown We can generally be pretty relaxed in the barriers here since the timer thread is a loop. - - - - - 297acc71 by Ben Gamari at 2020-10-24T21:02:44-04:00 rts/Stats: Hide a few unused unnecessarily global functions - - - - - 9ad51bc9 by David Beacham at 2020-10-27T13:59:35-04:00 Fix `instance Bounded a => Bounded (Down a)` (#18716) * Flip `minBound` and `maxBound` to respect the change in ordering * Remove awkward `Enum` (and hence `Integral`) instances for `Data.Ord.Down` * Update changelog - - - - - eedec53d by Vladislav Zavialov at 2020-10-27T14:00:11-04:00 Version bump: base-4.16 (#18712) Also bumps upper bounds on base in boot libraries (incl. submodules). - - - - - 412018c1 by Tamar Christina at 2020-10-27T14:00:49-04:00 winio: simplify logic remove optimization step. - - - - - 4950dd07 by Ben Gamari at 2020-10-27T14:01:24-04:00 hadrian: Suppress xelatex output unless it fails As noted in #18835, xelatex produces an absurd amount of output, nearly all of which is meaningless. Silence this. Fixes #18835. - - - - - f3d8ab2e by Ben Gamari at 2020-10-27T14:02:00-04:00 build system: Clean mingw tarballs Tamar noticed in !4293 that the build systems fail to clean up the mingw tarballs directory (`ghc-tarballs`). Fix this in both the make build system and Hadrian. - - - - - 0b3d23af by Simon Peyton Jones at 2020-10-27T14:02:34-04:00 Fix two constraint solving problems This patch fixes two problems in the constraint solver. * An actual bug #18555: we were floating out a constraint to eagerly, and that was ultimately fatal. It's explained in Note [Do not float blocked constraints] in GHC.Core.Constraint. This is all very delicate, but it's all going to become irrelevant when we stop floating constraints (#17656). * A major performance infelicity in the flattener. When flattening (ty |> co) we *never* generated Refl, even when there was nothing at all to do. Result: we would gratuitously rewrite the constraint to exactly the same thing, wasting work. Described in #18413, and came up again in #18855. Solution: exploit the special case by calling the new function castCoercionKind1. See Note [castCoercionKind1] in GHC.Core.Coercion - - - - - f76c5a08 by Sergei Trofimovich at 2020-10-27T14:03:14-04:00 ghc.mk: amend 'make sdist' Noticed 'make sdist' failure seen as: ``` "rm" -rf sdistprep/ghc/ghc-9.1.0.20201020/hadrian/_build/ (SRC_DIST_GHC_DIR)/hadrian/dist-newstyle/ /bin/sh: -c: line 0: syntax error near unexpected token `(' ``` commit 9657f6f34 ("sdist: Include hadrian sources in source distribution") added a new cleanup path without a variable expantion. The change adds variable reference. While at it move directory cleanup to a separate statement. Amends #18794 Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - 78b52c88 by David Eichmann at 2020-10-27T14:03:51-04:00 Use config.run_ways for multi_compile_and_run tests - - - - - e3fdd419 by Alan Zimmerman at 2020-10-27T14:04:26-04:00 Api Annotations: Introduce AnnPercent for HsExplicitMult For the case foo :: a %p -> b The location of the '%' is captured, separate from the 'p' - - - - - d2a25f42 by Ben Gamari at 2020-10-27T14:05:02-04:00 gitlab-ci: Bump ci-images Bumps bootstrap compiler to 8.10.1. - - - - - 28f98b01 by Sebastian Graf at 2020-10-27T14:05:37-04:00 DmdAnal: Kill `is_thunk` case in `splitFV` The `splitFV` function implements the highly dubious hack described in `Note [Lazy und unleashable free variables]` in GHC.Core.Opt.DmdAnal. It arranges it so that demand signatures only carry strictness info on free variables. Usage info is released through other means, see the Note. It's purely for analysis performance reasons. It turns out that `splitFV` has a quite involved case for thunks that produces slightly different usage signatures and it's not clear why we need it: `splitFV` is only relevant in the LetDown case and the only time we call it on thunks is for top-level or local recursive thunks. Since usage signatures of top-level thunks can only reference other top-level bindings and we completely discard demand info we have on top-level things (see the lack of `setIdDemandInfo` in `dmdAnalTopBind`), the `is_thunk` case is completely irrelevant here. For local, recursive thunks, the added benefit of the `is_thunk` test is marginal: We get used-multiple-times in some cases where previously we had used-once if a recursive thunk has multiple call sites. It's very unlikely and not a case to optimise for. So we kill the `is_thunk` case and inline `splitFV` at its call site, exposing `isWeakDmd` from `GHC.Types.Demand` instead. The NoFib summary supports this decision: ``` Min 0.0% -0.0% Max 0.0% +0.0% Geometric Mean -0.0% -0.0% ``` - - - - - 60322f93 by Ben Gamari at 2020-10-28T21:11:39-04:00 hadrian: Don't quote metric baseline argument Previously this was quoted inappropriately. - - - - - c85eb372 by Alan Zimmerman at 2020-10-28T21:12:15-04:00 API Annotations: put constructors in alphabetical order - - - - - 795908dc by John Ericson at 2020-10-29T03:53:14-04:00 Widen acceptance threshold for T10421a Progress towards #18842. As @sgraf812 points out, widening the window is dangerous until the exponential described in #17658 is fixed. But this test has caused enough misery and is low stakes enough that we and @bgamari think it's worth it in this one case for the time being. - - - - - 0e9f6def by Sylvain Henry at 2020-10-29T03:53:52-04:00 Split GHC.Driver.Types I was working on making DynFlags stateless (#17957), especially by storing loaded plugins into HscEnv instead of DynFlags. It turned out to be complicated because HscEnv is in GHC.Driver.Types but LoadedPlugin isn't: it is in GHC.Driver.Plugins which depends on GHC.Driver.Types. I didn't feel like introducing yet another hs-boot file to break the loop. Additionally I remember that while we introduced the module hierarchy (#13009) we talked about splitting GHC.Driver.Types because it contained various unrelated types and functions, but we never executed. I didn't feel like making GHC.Driver.Types bigger with more unrelated Plugins related types, so finally I bit the bullet and split GHC.Driver.Types. As a consequence this patch moves a lot of things. I've tried to put them into appropriate modules but nothing is set in stone. Several other things moved to avoid loops. * Removed Binary instances from GHC.Utils.Binary for random compiler things * Moved Typeable Binary instances into GHC.Utils.Binary.Typeable: they import a lot of things that users of GHC.Utils.Binary don't want to depend on. * put everything related to Units/Modules under GHC.Unit: GHC.Unit.Finder, GHC.Unit.Module.{ModGuts,ModIface,Deps,etc.} * Created several modules under GHC.Types: GHC.Types.Fixity, SourceText, etc. * Split GHC.Utils.Error (into GHC.Types.Error) * Finally removed GHC.Driver.Types Note that this patch doesn't put loaded plugins into HscEnv. It's left for another patch. Bump haddock submodule - - - - - 22f5d9a9 by Sylvain Henry at 2020-10-29T03:53:52-04:00 GC: Avoid data race (#18717, #17964) - - - - - 2ef2fac4 by Ryan Scott at 2020-10-29T04:18:52-04:00 Check for large tuples more thoroughly This fixes #18723 by: * Moving the existing `GHC.Tc.Gen.HsType.bigConstraintTuple` validity check to `GHC.Rename.Utils.checkCTupSize` for consistency with `GHC.Rename.Utils.checkTupSize`, and * Using `check(C)TupSize` when checking tuple _types_, in addition to checking names, expressions, and patterns. Note that I put as many of these checks as possible in the typechecker so that GHC can properly distinguish between boxed and constraint tuples. The exception to this rule is checking names, which I perform in the renamer (in `GHC.Rename.Env`) so that we can rule out `(,, ... ,,)` and `''(,, ... ,,)` alike in one fell swoop. While I was in town, I also removed the `HsConstraintTuple` and `HsBoxedTuple` constructors of `HsTupleSort`, which are functionally unused. This requires a `haddock` submodule bump. - - - - - 7f8be3eb by Richard Eisenberg at 2020-10-29T22:08:13-04:00 Remove unnecessary gender from comments/docs While, say, alternating "he" and "she" in sequential writing may be nicer than always using "they", reading code/documentation is almost never sequential. If this small change makes individuals feel more welcome in GHC's codebase, that's a good thing. - - - - - aad1f803 by Ben Gamari at 2020-10-30T00:41:14-04:00 rts/GC: Use atomics - - - - - d0bc0517 by Ben Gamari at 2020-10-30T00:41:14-04:00 rts: Use RELEASE ordering in unlockClosure - - - - - d44f5232 by Ben Gamari at 2020-10-30T00:41:14-04:00 rts/Storage: Accept races on heap size counters - - - - - 4e4a7386 by Ben Gamari at 2020-10-30T00:41:14-04:00 rts: Join to concurrent mark thread during shutdown Previously we would take all capabilities but fail to join on the thread itself, potentially resulting in a leaked thread. - - - - - a80cc857 by GHC GitLab CI at 2020-10-30T00:41:14-04:00 rts: Fix race in GC CPU time accounting Ensure that the GC leader synchronizes with workers before calling stat_endGC. - - - - - 9902d9ec by Viktor Dukhovni at 2020-10-30T05:28:30-04:00 [skip ci] Fix typo in `callocBytes` haddock. - - - - - 105d43db by Ben Gamari at 2020-10-30T14:02:19-04:00 rts/SpinLock: Separate out slow path Not only is this in general a good idea, but it turns out that GCC unrolls the retry loop, resulting is massive code bloat in critical parts of the RTS (e.g. `evacuate`). - - - - - f7b45cde by Ben Gamari at 2020-10-30T14:02:19-04:00 rts: Use relaxed ordering on spinlock counters - - - - - 31fcb55f by Ryan Scott at 2020-10-30T18:52:50-04:00 Split HsConDecl{H98,GADT}Details Haskell98 and GADT constructors both use `HsConDeclDetails`, which includes `InfixCon`. But `InfixCon` is never used for GADT constructors, which results in an awkward unrepresentable state. This removes the unrepresentable state by: * Renaming the existing `HsConDeclDetails` synonym to `HsConDeclH98Details`, which emphasizes the fact that it is now only used for Haskell98-style data constructors, and * Creating a new `HsConDeclGADTDetails` data type with `PrefixConGADT` and `RecConGADT` constructors that closely resemble `PrefixCon` and `InfixCon` in `HsConDeclH98Details`. The key difference is that `HsConDeclGADTDetails` lacks any way to represent infix constructors. The rest of the patch is refactoring to accommodate the new structure of `HsConDecl{H98,GADT}Details`. Some highlights: * The `getConArgs` and `hsConDeclArgTys` functions have been removed, as there is no way to implement these functions uniformly for all `ConDecl`s. For the most part, their previous call sites now pattern match on the `ConDecl`s directly and do different things for `ConDeclH98`s and `ConDeclGADT`s. I did introduce one new function to make the transition easier: `getRecConArgs_maybe`, which extracts the arguments from a `RecCon(GADT)`. This is still possible since `RecCon(GADT)`s still use the same representation in both `HsConDeclH98Details` and `HsConDeclGADTDetails`, and since the pattern that `getRecConArgs_maybe` implements is used in several places, I thought it worthwhile to factor it out into its own function. * Previously, the `con_args` fields in `ConDeclH98` and `ConDeclGADT` were both of type `HsConDeclDetails`. Now, the former is of type `HsConDeclH98Details`, and the latter is of type `HsConDeclGADTDetails`, which are distinct types. As a result, I had to rename the `con_args` field in `ConDeclGADT` to `con_g_args` to make it typecheck. A consequence of all this is that the `con_args` field is now partial, so using `con_args` as a top-level field selector is dangerous. (Indeed, Haddock was using `con_args` at the top-level, which caused it to crash at runtime before I noticed what was wrong!) I decided to add a disclaimer in the 9.2.1 release notes to advertise this pitfall. Fixes #18844. Bumps the `haddock` submodule. - - - - - 57c3db96 by Ryan Scott at 2020-10-31T02:53:55-04:00 Make typechecker equality consider visibility in ForAllTys Previously, `can_eq_nc'` would equate `ForAllTy`s regardless of their `ArgFlag`, including `forall i -> i -> Type` and `forall i. i -> Type`! To fix this, `can_eq_nc'` now uses the `sameVis` function to first check if the `ArgFlag`s are equal modulo specificity. I have also updated `tcEqType`'s implementation to match this behavior. For more explanation on the "modulo specificity" part, see the new `Note [ForAllTy and typechecker equality]` in `GHC.Tc.Solver.Canonical`. While I was in town, I fixed some related documentation issues: * I added `Note [Typechecker equality]` to `GHC.Tc.Utils.TcType` to describe what exactly distinguishes `can_eq_nc'` and `tcEqType` (which implement typechecker equality) from `eqType` (which implements definitional equality, which does not care about the `ArgFlags` of `ForAllTy`s at all). * The User's Guide had some outdated prose on the specified/inferred distinction being different for types and kinds, a holdover from #15079. This is no longer the case on today's GHC, so I removed this prose, added some new prose to take its place, and added a regression test for the programs in #15079. * The User's Guide had some _more_ outdated prose on inferred type variables not being allowed in `default` type signatures for class methods, which is no longer true as of the resolution of #18432. * The related `Note [Deferred Unification]` was being referenced as `Note [Deferred unification]` elsewhere, which made it harder to `grep` for. I decided to change the name of the Note to `Deferred unification` for consistency with the capitalization style used for most other Notes. Fixes #18863. - - - - - a98593f0 by Sylvain Henry at 2020-10-31T02:54:34-04:00 Refactor numeric constant folding rules Avoid the use of global pattern synonyms. 1) I think it's going to be helpful to implement constant folding for other numeric types, especially Natural which doesn't have a wrapping behavior. We'll have to refactor these rules even more so we'd better make them less cryptic. 2) It should also be slightly faster because global pattern synonyms matched operations for every numeric types instead of the current one: e.g., ":**:" pattern was matching multiplication for both Int# and Word# types. As we will probably want to implement constant folding for other numeric types (Int8#, Int16#, etc.), it is more efficient to only match primops for a given type as we do now. - - - - - 730ef38f by Sylvain Henry at 2020-10-31T02:54:34-04:00 Simplify constant-folding (#18032) See #18032 for the details. * Use `Lit (LitNumber _ i)` instead of `isLitValue_maybe` which does more work but that is not needed for constant-folding * Don't export `GHC.Types.Literal.isLitValue_maybe` * Kill `GHC.Types.Literal.isLitValue` which isn't used - - - - - d5a53c1a by Ben Gamari at 2020-10-31T02:55:10-04:00 primops.txt.pp: Move ByteArray# primops to separate file This file will be generated. - - - - - b4278a41 by Ben Gamari at 2020-10-31T02:55:10-04:00 primops: Generate ByteArray# index/read/write primops Previously these were mostly undocumented and was ripe for potential inconsistencies. - - - - - 08e6993a by Sylvain Henry at 2020-10-31T02:55:50-04:00 Move loadDecl into IfaceToCore - - - - - cb1f755c by Tamar Christina at 2020-10-31T09:26:56-04:00 winio: Fix unused variables warnings - - - - - eb368078 by Andrzej Rybczak at 2020-10-31T09:27:34-04:00 Add testcase for #816 - - - - - bd4abdc9 by Ben Gamari at 2020-11-01T01:10:31-04:00 testsuite: Add performance test for #18698 - - - - - dfd27445 by Hécate at 2020-11-01T01:11:09-04:00 Add the proper HLint rules and remove redundant keywords from compiler - - - - - ce1bb995 by Hécate at 2020-11-01T08:52:08-05:00 Fix a leak in `transpose` This patch was authored by David Feuer <david.feuer at gmail.com> - - - - - e63db32c by Ben Gamari at 2020-11-01T08:52:44-05:00 Scav: Use bd->gen_no instead of bd->gen->no This potentially saves a cache miss per scavenge. - - - - - b1dda153 by Ben Gamari at 2020-11-01T12:58:36-05:00 rts/Stats: Protect with mutex While on face value this seems a bit heavy, I think it's far better than enforcing ordering on every access. - - - - - 5c2e6bce by Ben Gamari at 2020-11-01T12:58:36-05:00 rts: Tear down stats_mutex after exitHeapProfiling Since the latter wants to call getRTSStats. - - - - - ef25aaa1 by Ben Gamari at 2020-11-01T13:02:11-05:00 rts: Annotate hopefully "benign" races in freeGroup - - - - - 3a181553 by Ben Gamari at 2020-11-01T13:02:18-05:00 Strengthen ordering in releaseGCThreads - - - - - af474f62 by Ben Gamari at 2020-11-01T13:05:38-05:00 Suppress data race due to close This suppresses the other side of a race during shutdown. - - - - - b4686bff by Ben Gamari at 2020-11-01T13:09:59-05:00 Merge branch 'wip/tsan/ci' into wip/tsan/all - - - - - b8e66e0e by Ben Gamari at 2020-11-01T13:10:01-05:00 Merge branch 'wip/tsan/storage' into wip/tsan/all - - - - - 375512cf by Ben Gamari at 2020-11-01T13:10:02-05:00 Merge branch 'wip/tsan/wsdeque' into wip/tsan/all - - - - - 65ebf07e by Ben Gamari at 2020-11-01T13:10:03-05:00 Merge branch 'wip/tsan/misc' into wip/tsan/all - - - - - 55c375d0 by Ben Gamari at 2020-11-01T13:10:04-05:00 Merge branch 'wip/tsan/stm' into wip/tsan/all - - - - - a9f75fe2 by Ben Gamari at 2020-11-01T13:10:06-05:00 Merge branch 'wip/tsan/event-mgr' into wip/tsan/all - - - - - 8325d658 by Ben Gamari at 2020-11-01T13:10:24-05:00 Merge branch 'wip/tsan/timer' into wip/tsan/all - - - - - 07e82ba5 by Ben Gamari at 2020-11-01T13:10:35-05:00 Merge branch 'wip/tsan/stats' into wip/tsan/all - - - - - 4ce2f7d6 by GHC GitLab CI at 2020-11-02T23:45:06-05:00 testsuite: Add --top flag to driver This allows us to make `config.top` a proper Path. Previously it was a str, which caused the Ghostscript detection logic to break. - - - - - 0b772221 by Ben Gamari at 2020-11-02T23:45:42-05:00 Document that ccall convention doesn't support varargs We do not support foreign "C" imports of varargs functions. While this works on amd64, in general the platform's calling convention may need more type information that our Cmm representation can currently provide. For instance, this is the case with Darwin's AArch64 calling convention. Document this fact in the users guide and fix T5423 which makes use of a disallowed foreign import. Closes #18854. - - - - - 81006a06 by David Eichmann at 2020-11-02T23:46:19-05:00 RtsAPI: pause and resume the RTS The `rts_pause` and `rts_resume` functions have been added to `RtsAPI.h` and allow an external process to completely pause and resume the RTS. Co-authored-by: Sven Tennie <sven.tennie at gmail.com> Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> Co-authored-by: Ben Gamari <bgamari.foss at gmail.com> - - - - - bfb1e272 by Ryan Scott at 2020-11-02T23:46:55-05:00 Display results of GHC.Core.Lint.lint* functions consistently Previously, the functions in `GHC.Core.Lint` used a patchwork of different ways to display Core Lint errors: * `lintPassResult` (which is the source of most Core Lint errors) renders Core Lint errors with a distinctive banner (e.g., `*** Core Lint errors : in result of ... ***`) that sets them apart from ordinary GHC error messages. * `lintAxioms`, in contrast, uses a completely different code path that displays Core Lint errors in a rather confusing manner. For example, the program in #18770 would give these results: ``` Bug.hs:1:1: error: Bug.hs:12:1: warning: Non-*-like kind when *-like expected: RuntimeRep when checking the body of forall: 'TupleRep '[r] In the coercion axiom Bug.N:T :: []. Bug.T ~_R Any Substitution: [TCvSubst In scope: InScope {r} Type env: [axl :-> r] Co env: []] | 1 | {-# LANGUAGE DataKinds #-} | ^ ``` * Further digging reveals that `GHC.IfaceToCore` displays Core Lint errors for iface unfoldings as though they were a GHC panic. See, for example, this excerpt from #17723: ``` ghc: panic! (the 'impossible' happened) (GHC version 8.8.2 for x86_64-unknown-linux): Iface Lint failure In interface for Lib ... ``` This patch makes all of these code paths display Core Lint errors and warnings consistently. I decided to adopt the conventions that `lintPassResult` currently uses, as they appear to have been around the longest (and look the best, in my subjective opinion). We now use the `displayLintResult` function for all three scenarios mentioned above. For example, here is what the Core Lint error for the program in #18770 looks like after this patch: ``` [1 of 1] Compiling Bug ( Bug.hs, Bug.o ) *** Core Lint errors : in result of TcGblEnv axioms *** Bug.hs:12:1: warning: Non-*-like kind when *-like expected: RuntimeRep when checking the body of forall: 'TupleRep '[r_axn] In the coercion axiom N:T :: []. T ~_R Any Substitution: [TCvSubst In scope: InScope {r_axn} Type env: [axn :-> r_axn] Co env: []] *** Offending Program *** axiom N:T :: T = Any -- Defined at Bug.hs:12:1 *** End of Offense *** <no location info>: error: Compilation had errors ``` Fixes #18770. - - - - - a9e5f52c by Simon Peyton Jones at 2020-11-02T23:47:31-05:00 Expand type synonyms with :kind! The User's Guide claims that `:kind!` should expand type synonyms, but GHCi wasn't doing this in practice. Let's just update the implementation to match the specification in the User's Guide. Fixes #13795. Fixes #18828. Co-authored-by: Ryan Scott <ryan.gl.scott at gmail.com> - - - - - 1370eda7 by Ben Gamari at 2020-11-02T23:48:06-05:00 hadrian: Don't capture RunTest output There are a few reasons why capturing the output of the RunTest builder is undesirable: * there is a large amount of output which then gets unnecessarily duplicated by Hadrian if the builder fails * the output may contain codepoints which are unrepresentable in the current codepage on Windows, causing Hadrian to crash * capturing the output causes the testsuite driver to disable its colorisation logic, making the output less legible. - - - - - 78f2767d by Matthew Pickering at 2020-11-03T17:39:53-05:00 Update inlining flags documentation - - - - - 14ce454f by Sylvain Henry at 2020-11-03T17:40:34-05:00 Linker: reorganize linker related code Move linker related code into GHC.Linker. Previously it was scattered into GHC.Unit.State, GHC.Driver.Pipeline, GHC.Runtime.Linker, etc. Add documentation in GHC.Linker - - - - - 616bec0d by Alan Zimmerman at 2020-11-03T17:41:10-05:00 Restrict Linear arrow %1 to exactly literal 1 only This disallows `a %001 -> b`, and makes sure the type literal is printed from its SourceText so it is clear why. Closes #18888 - - - - - 3486ebe6 by Sylvain Henry at 2020-11-03T17:41:48-05:00 Hadrian: don't fail if ghc-tarballs dir doesn't exist - - - - - 37f0434d by Sylvain Henry at 2020-11-03T17:42:26-05:00 Constant-folding: don't pass through GHC's Int/Word (fix #11704) Constant-folding rules for integerToWord/integerToInt were performing the following coercions at compilation time: integerToWord: target's Integer -> ghc's Word -> target's Word integerToInt : target's Integer -> ghc's Int -> target's Int 1) It was wrong for cross-compilers when GHC's word size is smaller than the target one. This patch avoids passing through GHC's word-sized types: integerToWord: target's Integer -> ghc's Integer -> target's Word integerToInt : target's Integer -> ghc's Integer -> target's Int 2) Additionally we didn't wrap the target word/int literal to make it fit into the target's range! This broke the invariant of literals only containing values in range. The existing code is wrong only with a 64-bit cross-compiling GHC, targeting a 32-bit platform, and performing constant folding on a literal that doesn't fit in a 32-bit word. If GHC was built with DEBUG, the assertion in GHC.Types.Literal.mkLitWord would fail. Otherwise the bad transformation would go unnoticed. - - - - - bff74de7 by Sylvain Henry at 2020-11-03T17:43:03-05:00 Bignum: make GMP's bignat_add not recursive bignat_add was a loopbreaker with an INLINE pragma (spotted by @mpickering). This patch makes it non recursive to avoid the issue. - - - - - bb100805 by Andreas Klebinger at 2020-11-04T16:47:24-05:00 NCG: Fix 64bit int comparisons on 32bit x86 We no compare these by doing 64bit subtraction and checking the resulting flags. We used to do this differently but the old approach was broken when the high bits compared equal and the comparison was one of >= or <=. The new approach should be both correct and faster. - - - - - b790b7f9 by Andreas Klebinger at 2020-11-04T16:47:59-05:00 Testsuite: Support for user supplied package dbs We can now supply additional package dbs to the testsuite. For make the package db can be supplied by passing PACKAGE_DB=/path/to/db. In the testsuite driver it's passed via the --test-package-db argument. - - - - - 81560981 by Sylvain Henry at 2020-11-04T16:48:42-05:00 Don't use LEA with 8-bit registers (#18614) - - - - - 17d5c518 by Viktor Dukhovni at 2020-11-05T00:50:23-05:00 Naming, value types and tests for Addr# atomics The atomic Exchange and CAS operations on integral types are updated to take and return more natural `Word#` rather than `Int#` values. These are bit-block not arithmetic operations, and the sign bit plays no special role. Standardises the names to `atomic<OpType><ValType>Addr#`, where `OpType` is one of `Cas` or `Exchange` and `ValType` is presently either `Word` or `Addr`. Eventually, variants for `Word32` and `Word64` can and should be added, once #11953 and related issues (e.g. #13825) are resolved. Adds tests for `Addr#` CAS that mirror existing tests for `MutableByteArray#`. - - - - - 2125b1d6 by Ryan Scott at 2020-11-05T00:51:01-05:00 Add a regression test for #18920 Commit f594a68a5500696d94ae36425bbf4d4073aca3b2 (`Use level numbers for generalisation`) ended up fixing #18920. Let's add a regression test to ensure that it stays fixed. Fixes #18920. - - - - - e07e383a by Ryan Scott at 2020-11-06T03:45:28-05:00 Replace HsImplicitBndrs with HsOuterTyVarBndrs This refactors the GHC AST to remove `HsImplicitBndrs` and replace it with `HsOuterTyVarBndrs`, a type which records whether the outermost quantification in a type is explicit (i.e., with an outermost, invisible `forall`) or implicit. As a result of this refactoring, it is now evident in the AST where the `forall`-or-nothing rule applies: it's all the places that use `HsOuterTyVarBndrs`. See the revamped `Note [forall-or-nothing rule]` in `GHC.Hs.Type` (previously in `GHC.Rename.HsType`). Moreover, the places where `ScopedTypeVariables` brings lexically scoped type variables into scope are a subset of the places that adhere to the `forall`-or-nothing rule, so this also makes places that interact with `ScopedTypeVariables` easier to find. See the revamped `Note [Lexically scoped type variables]` in `GHC.Hs.Type` (previously in `GHC.Tc.Gen.Sig`). `HsOuterTyVarBndrs` are used in type signatures (see `HsOuterSigTyVarBndrs`) and type family equations (see `HsOuterFamEqnTyVarBndrs`). The main difference between the former and the latter is that the former cares about specificity but the latter does not. There are a number of knock-on consequences: * There is now a dedicated `HsSigType` type, which is the combination of `HsOuterSigTyVarBndrs` and `HsType`. `LHsSigType` is now an alias for an `XRec` of `HsSigType`. * Working out the details led us to a substantial refactoring of the handling of explicit (user-written) and implicit type-variable bindings in `GHC.Tc.Gen.HsType`. Instead of a confusing family of higher order functions, we now have a local data type, `SkolemInfo`, that controls how these binders are kind-checked. It remains very fiddly, not fully satisfying. But it's better than it was. Fixes #16762. Bumps the Haddock submodule. Co-authored-by: Simon Peyton Jones <simonpj at microsoft.com> Co-authored-by: Richard Eisenberg <rae at richarde.dev> Co-authored-by: Zubin Duggal <zubin at cmi.ac.in> - - - - - c85f4928 by Sylvain Henry at 2020-11-06T03:46:08-05:00 Refactor -dynamic-too handling 1) Don't modify DynFlags (too much) for -dynamic-too: now when we generate dynamic outputs for "-dynamic-too", we only set "dynamicNow" boolean field in DynFlags instead of modifying several other fields. These fields now have accessors that take dynamicNow into account. 2) Use DynamicTooState ADT to represent -dynamic-too state. It's much clearer than the undocumented "DynamicTooConditional" that was used before. As a result, we can finally remove the hscs_iface_dflags field in HscRecomp. There was a comment on this field saying: "FIXME (osa): I don't understand why this is necessary, but I spent almost two days trying to figure this out and I couldn't .. perhaps someone who understands this code better will remove this later." I don't fully understand the details, but it was needed because of the changes made to the DynFlags for -dynamic-too. There is still something very dubious in GHC.Iface.Recomp: we have to disable the "dynamicNow" flag at some point for some Backpack's "heinous hack" to continue to work. It may be because interfaces for indefinite units are always non-dynamic, or because we mix and match dynamic and non-dynamic interfaces (#9176), or something else, who knows? - - - - - 2cb87909 by Moritz Angermann at 2020-11-06T03:46:44-05:00 [AArch64] Aarch64 Always PIC - - - - - b1d2c1f3 by Ben Gamari at 2020-11-06T03:47:19-05:00 rts/Sanity: Avoid nasty race in weak pointer sanity-checking See Note [Racing weak pointer evacuation] for all of the gory details. - - - - - 638f38c5 by Ben Gamari at 2020-11-08T09:29:16-05:00 Merge remote-tracking branch 'origin/wip/tsan/all' - - - - - 22888798 by Ben Gamari at 2020-11-08T12:08:40-05:00 Fix haddock submodule The previous merge mistakenly reverted it. - - - - - d445cf05 by Ben Gamari at 2020-11-10T10:26:20-05:00 rts/linker: Fix relocation overflow in PE linker Previously the overflow check for the IMAGE_REL_AMD64_ADDR32NB relocation failed to account for the signed nature of the value. Specifically, the overflow check was: uint64_t v; v = S + A; if (v >> 32) { ... } However, `v` ultimately needs to fit into 32-bits as a signed value. Consequently, values `v > 2^31` in fact overflow yet this is not caught by the existing overflow check. Here we rewrite the overflow check to rather ensure that `INT32_MIN <= v <= INT32_MAX`. There is now quite a bit of repetition between the `IMAGE_REL_AMD64_REL32` and `IMAGE_REL_AMD64_ADDR32` cases but I am leaving fixing this for future work. This bug was first noticed by @awson. Fixes #15808. - - - - - 4c407f6e by Sylvain Henry at 2020-11-10T10:27:00-05:00 Export SPEC from GHC.Exts (#13681) - - - - - 7814cd5b by David Eichmann at 2020-11-10T10:27:35-05:00 ghc-heap: expose decoding from heap representation Co-authored-by: Sven Tennie <sven.tennie at gmail.com> Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> Co-authored-by: Ben Gamari <bgamari.foss at gmail.com> - - - - - fa344d33 by Richard Eisenberg at 2020-11-10T10:28:10-05:00 Add test case for #17186. This got fixed sometime recently; not worth it trying to figure out which commit. - - - - - 2e63a0fb by David Eichmann at 2020-11-10T10:28:46-05:00 Add code comments for StgInfoTable and StgStack structs - - - - - fcfda909 by Ben Gamari at 2020-11-11T03:19:59-05:00 nativeGen: Make makeImportsDoc take an NCGConfig rather than DynFlags It appears this was an oversight as there is no reason the full DynFlags is necessary. - - - - - 6e23695e by Ben Gamari at 2020-11-11T03:19:59-05:00 Move this_module into NCGConfig In various places in the NCG we need the Module currently being compiled. Let's move this into the environment instead of chewing threw another register. - - - - - c6264a2d by Ben Gamari at 2020-11-11T03:20:00-05:00 codeGen: Produce local symbols for module-internal functions It turns out that some important native debugging/profiling tools (e.g. perf) rely only on symbol tables for function name resolution (as opposed to using DWARF DIEs). However, previously GHC would emit temporary symbols (e.g. `.La42b`) to identify module-internal entities. Such symbols are dropped during linking and therefore not visible to runtime tools (in addition to having rather un-helpful unique names). For instance, `perf report` would often end up attributing all cost to the libc `frame_dummy` symbol since Haskell code was no covered by any proper symbol (see #17605). We now rather follow the model of C compilers and emit descriptively-named local symbols for module internal things. Since this will increase object file size this behavior can be disabled with the `-fno-expose-internal-symbols` flag. With this `perf record` can finally be used against Haskell executables. Even more, with `-g3` `perf annotate` provides inline source code. - - - - - 584058dd by Ben Gamari at 2020-11-11T03:20:00-05:00 Enable -fexpose-internal-symbols when debug level >=2 This seems like a reasonable default as the object file size increases by around 5%. - - - - - c34a4b98 by Ömer Sinan Ağacan at 2020-11-11T03:20:35-05:00 Fix and enable object unloading in GHCi Fixes #16525 by tracking dependencies between object file symbols and marking symbol liveness during garbage collection See Note [Object unloading] in CheckUnload.c for details. - - - - - 2782487f by Ray Shih at 2020-11-11T03:20:35-05:00 Add loadNativeObj and unloadNativeObj (This change is originally written by niteria) This adds two functions: * `loadNativeObj` * `unloadNativeObj` and implements them for Linux. They are useful if you want to load a shared object with Haskell code using the system linker and have GHC call dlclose() after the code is no longer referenced from the heap. Using the system linker allows you to load the shared object above outside the low-mem region. It also loads the DWARF sections in a way that `perf` understands. `dl_iterate_phdr` is what makes this implementation Linux specific. - - - - - 7a65f9e1 by GHC GitLab CI at 2020-11-11T03:20:35-05:00 rts: Introduce highMemDynamic - - - - - e9e1b2e7 by GHC GitLab CI at 2020-11-11T03:20:35-05:00 Introduce test for dynamic library unloading This uses the highMemDynamic flag introduced earlier to verify that dynamic objects are properly unloaded. - - - - - 5506f134 by Krzysztof Gogolewski at 2020-11-11T03:21:14-05:00 Force argument in setIdMult (#18925) - - - - - 787e93ae by Ben Gamari at 2020-11-11T23:14:11-05:00 testsuite: Add testcase for #18733 - - - - - 5353fd50 by Ben Gamari at 2020-11-12T10:05:30-05:00 compiler: Fix recompilation checking In ticket #18733 we noticed a rather serious deficiency in the current fingerprinting logic for recursive groups. I have described the old fingerprinting story and its problems in Note [Fingerprinting recursive groups] and have reworked the story accordingly to avoid these issues. Fixes #18733. - - - - - 63fa3997 by Sebastian Graf at 2020-11-13T14:29:39-05:00 Arity: Rework `ArityType` to fix monotonicity (#18870) As we found out in #18870, `andArityType` is not monotone, with potentially severe consequences for termination of fixed-point iteration. That showed in an abundance of "Exciting arity" DEBUG messages that are emitted whenever we do more than one step in fixed-point iteration. The solution necessitates also recording `OneShotInfo` info for `ABot` arity type. Thus we get the following definition for `ArityType`: ``` data ArityType = AT [OneShotInfo] Divergence ``` The majority of changes in this patch are the result of refactoring use sites of `ArityType` to match the new definition. The regression test `T18870` asserts that we indeed don't emit any DEBUG output anymore for a function where we previously would have. Similarly, there's a regression test `T18937` for #18937, which we expect to be broken for now. Fixes #18870. - - - - - 197d59fa by Sebastian Graf at 2020-11-13T14:29:39-05:00 Arity: Emit "Exciting arity" warning only after second iteration (#18937) See Note [Exciting arity] why we emit the warning at all and why we only do after the second iteration now. Fixes #18937. - - - - - de7ec9dd by David Eichmann at 2020-11-13T14:30:16-05:00 Add rts_listThreads and rts_listMiscRoots to RtsAPI.h These are used to find the current roots of the garbage collector. Co-authored-by: Sven Tennie's avatarSven Tennie <sven.tennie at gmail.com> Co-authored-by: Matthew Pickering's avatarMatthew Pickering <matthewtpickering at gmail.com> Co-authored-by: default avatarBen Gamari <bgamari.foss at gmail.com> - - - - - 24a86f09 by Ben Gamari at 2020-11-13T14:30:51-05:00 gitlab-ci: Cache cabal store in linting job - - - - - 0a7e592c by Ben Gamari at 2020-11-15T03:35:45-05:00 nativeGen/dwarf: Fix procedure end addresses Previously the `.debug_aranges` and `.debug_info` (DIE) DWARF information would claim that procedures (represented with a `DW_TAG_subprogram` DIE) would only span the range covered by their entry block. This omitted all of the continuation blocks (represented by `DW_TAG_lexical_block` DIEs), confusing `perf`. Fix this by introducing a end-of-procedure label and using this as the `DW_AT_high_pc` of procedure `DW_TAG_subprogram` DIEs Fixes #17605. - - - - - 1e19183d by Ben Gamari at 2020-11-15T03:35:45-05:00 nativeGen/dwarf: Only produce DW_AT_source_note DIEs in -g3 Standard debugging tools don't know how to understand these so let's not produce them unless asked. - - - - - ad73370f by Ben Gamari at 2020-11-15T03:35:45-05:00 nativeGen/dwarf: Use DW_AT_linkage instead of DW_AT_MIPS_linkage - - - - - a2539650 by Ben Gamari at 2020-11-15T03:35:45-05:00 gitlab-ci: Add DWARF release jobs for Debian 10, Fedora27 - - - - - d61adb3d by Ryan Scott at 2020-11-15T03:36:21-05:00 Name (tc)SplitForAll- functions more consistently There is a zoo of `splitForAll-` functions in `GHC.Core.Type` (as well as `tcSplitForAll-` functions in `GHC.Tc.Utils.TcType`) that all do very similar things, but vary in the particular form of type variable that they return. To make things worse, the names of these functions are often quite misleading. Some particularly egregious examples: * `splitForAllTys` returns `TyCoVar`s, but `splitSomeForAllTys` returns `VarBndr`s. * `splitSomeForAllTys` returns `VarBndr`s, but `tcSplitSomeForAllTys` returns `TyVar`s. * `splitForAllTys` returns `TyCoVar`s, but `splitForAllTysInvis` returns `InvisTVBinder`s. (This in particular arose in the context of #18939, and this finally motivated me to bite the bullet and improve the status quo vis-à-vis how we name these functions.) In an attempt to bring some sanity to how these functions are named, I have opted to rename most of these functions en masse to use consistent suffixes that describe the particular form of type variable that each function returns. In concrete terms, this amounts to: * Functions that return a `TyVar` now use the suffix `-TyVar`. This caused the following functions to be renamed: * `splitTyVarForAllTys` -> `splitForAllTyVars` * `splitForAllTy_ty_maybe` -> `splitForAllTyVar_maybe` * `tcSplitForAllTys` -> `tcSplitForAllTyVars` * `tcSplitSomeForAllTys` -> `tcSplitSomeForAllTyVars` * Functions that return a `CoVar` now use the suffix `-CoVar`. This caused the following functions to be renamed: * `splitForAllTy_co_maybe` -> `splitForAllCoVar_maybe` * Functions that return a `TyCoVar` now use the suffix `-TyCoVar`. This caused the following functions to be renamed: * `splitForAllTy` -> `splitForAllTyCoVar` * `splitForAllTys` -> `splitForAllTyCoVars` * `splitForAllTys'` -> `splitForAllTyCoVars'` * `splitForAllTy_maybe` -> `splitForAllTyCoVar_maybe` * Functions that return a `VarBndr` now use the suffix corresponding to the most relevant type synonym. This caused the following functions to be renamed: * `splitForAllVarBndrs` -> `splitForAllTyCoVarBinders` * `splitForAllTysInvis` -> `splitForAllInvisTVBinders` * `splitForAllTysReq` -> `splitForAllReqTVBinders` * `splitSomeForAllTys` -> `splitSomeForAllTyCoVarBndrs` * `tcSplitForAllVarBndrs` -> `tcSplitForAllTyVarBinders` * `tcSplitForAllTysInvis` -> `tcSplitForAllInvisTVBinders` * `tcSplitForAllTysReq` -> `tcSplitForAllReqTVBinders` * `tcSplitForAllTy_maybe` -> `tcSplitForAllTyVarBinder_maybe` Note that I left the following functions alone: * Functions that split apart things besides `ForAllTy`s, such as `splitFunTys` or `splitPiTys`. Thankfully, there are far fewer of these functions than there are functions that split apart `ForAllTy`s, so there isn't much of a pressing need to apply the new naming convention elsewhere. * Functions that split apart `ForAllCo`s in `Coercion`s, such as `GHC.Core.Coercion.splitForAllCo_maybe`. We could theoretically apply the new naming convention here, but then we'd have to figure out how to disambiguate `Type`-splitting functions from `Coercion`-splitting functions. Ultimately, the `Coercion`-splitting functions aren't used nearly as much as the `Type`-splitting functions, so I decided to leave the former alone. This is purely refactoring and should cause no change in behavior. - - - - - 645444af by Ryan Scott at 2020-11-15T03:36:21-05:00 Use tcSplitForAllInvisTyVars (not tcSplitForAllTyVars) in more places The use of `tcSplitForAllTyVars` in `tcDataFamInstHeader` was the immediate cause of #18939, and replacing it with a new `tcSplitForAllInvisTyVars` function (which behaves like `tcSplitForAllTyVars` but only splits invisible type variables) fixes the issue. However, this led me to realize that _most_ uses of `tcSplitForAllTyVars` in GHC really ought to be `tcSplitForAllInvisTyVars` instead. While I was in town, I opted to replace most uses of `tcSplitForAllTys` with `tcSplitForAllTysInvis` to reduce the likelihood of such bugs in the future. I say "most uses" above since there is one notable place where we _do_ want to use `tcSplitForAllTyVars`: in `GHC.Tc.Validity.forAllTyErr`, which produces the "`Illegal polymorphic type`" error message if you try to use a higher-rank `forall` without having `RankNTypes` enabled. Here, we really do want to split all `forall`s, not just invisible ones, or we run the risk of giving an inaccurate error message in the newly added `T18939_Fail` test case. I debated at some length whether I wanted to name the new function `tcSplitForAllInvisTyVars` or `tcSplitForAllTyVarsInvisible`, but in the end, I decided that I liked the former better. For consistency's sake, I opted to rename the existing `splitPiTysInvisible` and `splitPiTysInvisibleN` functions to `splitInvisPiTys` and `splitPiTysInvisN`, respectively, so that they use the same naming convention. As a consequence, this ended up requiring a `haddock` submodule bump. Fixes #18939. - - - - - 8887102f by Moritz Angermann at 2020-11-15T03:36:56-05:00 AArch64/arm64 adjustments This addes the necessary logic to support aarch64 on elf, as well as aarch64 on mach-o, which Apple calls arm64. We change architecture name to AArch64, which is the official arm naming scheme. - - - - - fc644b1a by Ben Gamari at 2020-11-15T03:37:31-05:00 ghc-bin: Build with eventlogging by default We now have all sorts of great facilities using the eventlog which were previously unavailable without building a custom GHC. Fix this by linking with `-eventlog` by default. - - - - - 52114fa0 by Sylvain Henry at 2020-11-16T11:48:47+01:00 Add Addr# atomic primops (#17751) This reuses the codegen used for ByteArray#'s atomic primops. - - - - - 8150f654 by Sebastian Graf at 2020-11-18T23:38:40-05:00 PmCheck: Print types of uncovered patterns (#18932) In order to avoid confusion as in #18932, we display the type of the match variables in the non-exhaustiveness warning, e.g. ``` T18932.hs:14:1: warning: [-Wincomplete-patterns] Pattern match(es) are non-exhaustive In an equation for ‘g’: Patterns of type ‘T a’, ‘T a’, ‘T a’ not matched: (MkT2 _) (MkT1 _) (MkT1 _) (MkT2 _) (MkT1 _) (MkT2 _) (MkT2 _) (MkT2 _) (MkT1 _) (MkT2 _) (MkT2 _) (MkT2 _) ... | 14 | g (MkT1 x) (MkT1 _) (MkT1 _) = x | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ``` It also allows us to omit the type signature on wildcard matches which we previously showed in only some situations, particularly `-XEmptyCase`. Fixes #18932. - - - - - 165352a2 by Krzysztof Gogolewski at 2020-11-20T02:08:36-05:00 Export indexError from GHC.Ix (#18579) - - - - - b57845c3 by Kamil Dworakowski at 2020-11-20T02:09:16-05:00 Clarify interruptible FFI wrt masking state - - - - - 321d1bd8 by Sebastian Graf at 2020-11-20T02:09:51-05:00 Fix strictness signatures of `prefetchValue*#` primops Their strictness signatures said the primops are strict in their first argument, which is wrong: Handing it a thunk will prefetch the pointer to the thunk, but not evaluate it. Hence not strict. The regression test `T8256` actually tests for laziness in the first argument, so GHC apparently never exploited the strictness signature. See also https://gitlab.haskell.org/ghc/ghc/-/issues/8256#note_310867, where this came up. - - - - - 0aec78b6 by Sebastian Graf at 2020-11-20T02:09:51-05:00 Demand: Interleave usage and strictness demands (#18903) As outlined in #18903, interleaving usage and strictness demands not only means a more compact demand representation, but also allows us to express demands that we weren't easily able to express before. Call demands are *relative* in the sense that a call demand `Cn(cd)` on `g` says "`g` is called `n` times. *Whenever `g` is called*, the result is used according to `cd`". Example from #18903: ```hs h :: Int -> Int h m = let g :: Int -> (Int,Int) g 1 = (m, 0) g n = (2 * n, 2 `div` n) {-# NOINLINE g #-} in case m of 1 -> 0 2 -> snd (g m) _ -> uncurry (+) (g m) ``` Without the interleaved representation, we would just get `L` for the strictness demand on `g`. Now we are able to express that whenever `g` is called, its second component is used strictly in denoting `g` by `1C1(P(1P(U),SP(U)))`. This would allow Nested CPR to unbox the division, for example. Fixes #18903. While fixing regressions, I also discovered and fixed #18957. Metric Decrease: T13253-spj - - - - - 3a55b3a2 by Sebastian Graf at 2020-11-20T02:09:51-05:00 Update user's guide entry on demand analysis and worker/wrapper The demand signature notation has been undocumented for a long time. The only source to understand it, apart from reading the `Outputable` instance, has been an outdated wiki page. Since the previous commits have reworked the demand lattice, I took it as an opportunity to also write some documentation about notation. - - - - - fc963932 by Greg Steuck at 2020-11-20T02:10:31-05:00 Find hadrian location more reliably in cabal-install output Fix #18944 - - - - - 9f40cf6c by Ben Gamari at 2020-11-20T02:11:07-05:00 rts/linker: Align bssSize to page size when mapping symbol extras We place symbol_extras right after bss. We also need to ensure that symbol_extras can be mprotect'd independently from the rest of the image. To ensure this we round up the size of bss to a page boundary, thus ensuring that symbol_extras is also page-aligned. - - - - - b739c319 by Ben Gamari at 2020-11-20T02:11:43-05:00 gitlab-ci: Add usage message to ci.sh - - - - - 802e9180 by Ben Gamari at 2020-11-20T02:11:43-05:00 gitlab-ci: Add VERBOSE environment variable And change the make build system's default behavior to V=0, greatly reducing build log sizes. - - - - - 2a8a979c by Ben Gamari at 2020-11-21T01:13:26-05:00 users-guide: A bit of clean-up in profiling flag documentation - - - - - 56804e33 by Ben Gamari at 2020-11-21T01:13:26-05:00 testsuite: Refactor CountParserDeps - - - - - 53ad67ea by Ben Gamari at 2020-11-21T01:13:26-05:00 Introduce -fprof-callers flag This introducing a new compiler flag to provide a convenient way to introduce profiler cost-centers on all occurrences of the named identifier. Closes #18566. - - - - - ecfd0278 by Sylvain Henry at 2020-11-21T01:14:09-05:00 Move Plugins into HscEnv (#17957) Loaded plugins have nothing to do in DynFlags so this patch moves them into HscEnv (session state). "DynFlags plugins" become "Driver plugins" to still be able to register static plugins. Bump haddock submodule - - - - - 72f2257c by Sylvain Henry at 2020-11-21T01:14:09-05:00 Don't initialize plugins in the Core2Core pipeline Some plugins can be added via TH (cf addCorePlugin). Initialize them in the driver instead of in the Core2Core pipeline. - - - - - ddbeeb3c by Ryan Scott at 2020-11-21T01:14:44-05:00 Add regression test for #10504 This issue was fixed at some point between GHC 8.0 and 8.2. Let's add a regression test to ensure that it stays fixed. Fixes #10504. - - - - - a4a6dc2a by Ben Gamari at 2020-11-21T01:15:21-05:00 dwarf: Apply info table offset consistently Previously we failed to apply the info table offset to the aranges and DIEs, meaning that we often failed to unwind in gdb. For some reason this only seemed to manifest in the RTS's Cmm closures. Nevertheless, now we can unwind completely up to `main` - - - - - 69bfbc21 by Ben Gamari at 2020-11-21T01:15:56-05:00 hadrian: Disable stripping when debug information is enabled - - - - - 7e93ae8b by Ben Gamari at 2020-11-21T13:13:29-05:00 rts: Post ticky entry counts to the eventlog We currently only post the entry counters, not the other global counters as in my experience the former are more useful. We use the heap profiler's census period to decide when to dump. Also spruces up the documentation surrounding ticky-ticky a bit. - - - - - bc9c3916 by Ben Gamari at 2020-11-22T06:28:10-05:00 Implement -ddump-c-backend argument To dump output of the C backend. - - - - - 901bc220 by Ben Gamari at 2020-11-22T12:39:02-05:00 Bump time submodule to 1.11.1 Also bumps directory, Cabal, hpc, time, and unix submodules. Closes #18847. - - - - - 92c0afbf by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Dump STG when ticky is enabled This changes the "ticky" modifier to enable dumping of final STG as this is generally needed to make sense of the ticky profiles. - - - - - d23fef68 by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Introduce notion of flavour transformers This extends Hadrian's notion of "flavour", as described in #18942. - - - - - 179d0bec by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Add a viaLlvmBackend modifier Note that this also slightly changes the semantics of these flavours as we only use LLVM for >= stage1 builds. - - - - - d4d95e51 by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Add profiled_ghc and no_dynamic_ghc modifiers - - - - - 6815603f by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Drop redundant flavour definitions Drop the profiled, LLVM, and ThreadSanitizer flavour definitions as these can now be realized with flavour transformers. - - - - - f88f4339 by Ben Gamari at 2020-11-24T02:43:20-05:00 rts: Flush eventlog buffers from flushEventLog As noted in #18043, flushTrace failed flush anything beyond the writer. This means that a significant amount of data sitting in capability-local event buffers may never get flushed, despite the users' pleads for us to flush. Fix this by making flushEventLog flush all of the event buffers before flushing the writer. Fixes #18043. - - - - - 7c03cc50 by Ben Gamari at 2020-11-24T02:43:55-05:00 gitlab-ci: Run LLVM job on appropriately-labelled MRs Namely, those marked with the ~"LLVM backend" label - - - - - 9b95d815 by Ben Gamari at 2020-11-24T02:43:55-05:00 gitlab-ci: Run LLVM builds on Debian 10 The current Debian 9 image doesn't provide LLVM 7. - - - - - 2ed3e6c0 by Ben Gamari at 2020-11-24T02:43:55-05:00 CmmToLlvm: Declare signature for memcmp Otherwise `opt` fails with: error: use of undefined value '@memcmp$def' - - - - - be5d74ca by Moritz Angermann at 2020-11-26T16:00:32-05:00 [Sized Cmm] properly retain sizes. This replaces all Word<N> = W<N># Word# and Int<N> = I<N># Int# with Word<N> = W<N># Word<N># and Int<N> = I<N># Int<N>#, thus providing us with properly sized primitives in the codegenerator instead of pretending they are all full machine words. This came up when implementing darwinpcs for arm64. The darwinpcs reqires us to pack function argugments in excess of registers on the stack. While most procedure call standards (pcs) assume arguments are just passed in 8 byte slots; and thus the caller does not know the exact signature to make the call, darwinpcs requires us to adhere to the prototype, and thus have the correct sizes. If we specify CInt in the FFI call, it should correspond to the C int, and not just be Word sized, when it's only half the size. This does change the expected output of T16402 but the new result is no less correct as it eliminates the narrowing (instead of the `and` as was previously done). Bumps the array, bytestring, text, and binary submodules. Co-Authored-By: Ben Gamari <ben at well-typed.com> Metric Increase: T13701 T14697 - - - - - a84e53f9 by Andreas Klebinger at 2020-11-26T16:00:32-05:00 RTS: Fix failed inlining of copy_tag. On windows using gcc-10 gcc failed to inline copy_tag into evacuate. To fix this we now set the always_inline attribute for the various copy* functions in Evac.c. The main motivation here is not the overhead of the function call, but rather that this allows the code to "specialize" for the size of the closure we copy which is often known at compile time. An earlier commit also tried to avoid evacuate_large inlining. But didn't quite succeed. So I also marked evacuate_large as noinline. Fixes #12416 - - - - - cdbd16f5 by Sylvain Henry at 2020-11-26T16:00:33-05:00 Fix toArgRep to support 64-bit reps on all systems [This is @Ericson2314 writing a commit message for @hsyl20's patch.] (Progress towards #11953, #17377, #17375) `Int64Rep` and `Word64Rep` are currently broken on 64-bit systems. This is because they should use "native arg rep" but instead use "large arg rep" as they do on 32-bit systems, which is either a non-concept or a 128-bit rep depending on one's vantage point. Now, these reps currently aren't used during 64-bit compilation, so the brokenness isn't observed, but I don't think that constitutes reasons not to fix it. Firstly, the linked issues there is a clearly expressed desire to use explicit-bitwidth constructs in more places. Secondly, per [1], there are other bugs that *do* manifest from not threading explicit-bitwidth information all the way through the compilation pipeline. One can therefore view this as one piece of the larger effort to do that, improve ergnomics, and squash remaining bugs. Also, this is needed for !3658. I could just merge this as part of that, but I'm keen on merging fixes "as they are ready" so the fixes that aren't ready are isolated and easier to debug. [1]: https://mail.haskell.org/pipermail/ghc-devs/2020-October/019332.html - - - - - a9378e69 by Tim Barnes at 2020-11-26T16:00:34-05:00 Set dynamic users-guide TOC spacing (fixes #18554) - - - - - 86a59d93 by Ben Gamari at 2020-11-26T16:00:34-05:00 rts: Use RTS_LIKELY in CHECK Most compilers probably already infer that `barf` diverges but it nevertheless doesn't hurt to be explicit. - - - - - 5757e82b by Matthew Pickering at 2020-11-26T16:00:35-05:00 Remove special case for GHC.ByteCode.Instr This was added in https://github.com/nomeata/ghc-heap-view/commit/34935206e51b9c86902481d84d2f368a6fd93423 GHC.ByteCode.Instr.BreakInfo no longer exists so the special case is dead code. Any check like this can be easily dealt with in client code. - - - - - d9c8b5b4 by Matthew Pickering at 2020-11-26T16:00:35-05:00 Split Up getClosureDataFromHeapRep Motivation 1. Don't enforce the repeated decoding of an info table, when the client can cache it (ghc-debug) 2. Allow the constructor information decoding to be overridden, this casues segfaults in ghc-debug - - - - - 3e3555cc by Andreas Klebinger at 2020-11-26T16:00:35-05:00 RegAlloc: Add missing raPlatformfield to RegAllocStatsSpill Fixes #18994 Co-Author: Benjamin Maurer <maurer.benjamin at gmail.com> - - - - - a1a75aa9 by Ben Gamari at 2020-11-27T06:20:41-05:00 rts: Allocate MBlocks with MAP_TOP_DOWN on Windows As noted in #18991, we would previously allocate heap in low memory. Due to this the linker, which typically *needs* low memory, would end up competing with the heap. In longer builds we end up running out of low memory entirely, leading to linking failures. - - - - - 75fc1ed5 by Sylvain Henry at 2020-11-28T15:40:23-05:00 Hadrian: fix detection of ghc-pkg for cross-compilers - - - - - 7cb5df96 by Sylvain Henry at 2020-11-28T15:40:23-05:00 hadrian: fix ghc-pkg uses (#17601) Make sure ghc-pkg doesn't read the compiler "settings" file by passing --no-user-package-db. - - - - - e3fd4226 by Ben Gamari at 2020-11-28T15:40:23-05:00 gitlab-ci: Introduce a nightly cross-compilation job This adds a job to test cross-compilation from x86-64 to AArch64 with Hadrian. Fixes #18234 - - - - - 698d3d96 by Ben Gamari at 2020-11-28T15:41:00-05:00 gitlab-ci: Only deploy GitLab Pages in ghc/ghc> The deployments are quite large and yet are currently only served for the ghc/ghc> project. - - - - - 625726f9 by David Eichmann at 2020-11-28T15:41:37-05:00 ghc-heap: partial TSO/STACK decoding Co-authored-by: Sven Tennie <sven.tennie at gmail.com> Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> Co-authored-by: Ben Gamari <bgamari.foss at gmail.com> - - - - - 22ea9c29 by Andreas Klebinger at 2020-11-28T15:42:13-05:00 Small optimization to CmmSink. Inside `regsUsedIn` we can avoid some thunks by specializing the recursion. In particular we avoid the thunk for `(f e z)` in the MachOp/Load branches, where we know this will evaluate to z. Reduces allocations for T3294 by ~1%. - - - - - bba42c62 by John Ericson at 2020-11-28T15:42:49-05:00 Make primop handler indentation more consistent - - - - - c82bc8e9 by John Ericson at 2020-11-28T15:42:49-05:00 Cleanup some primop constructor names Harmonize the internal (big sum type) names of the native vs fixed-sized number primops a bit. (Mainly by renaming the former.) No user-facing names are changed. - - - - - ae14f160 by Ben Gamari at 2020-11-28T15:43:25-05:00 testsuite: Mark T14702 as fragile on Windows Due to #18953. - - - - - 1bc104b0 by Ben Gamari at 2020-11-29T15:33:18-05:00 withTimings: Emit allocations counter This will allow us to back out the allocations per compiler pass from the eventlog. Note that we dump the allocation counter rather than the difference since this will allow us to determine how much work is done *between* `withTiming` blocks. - - - - - e992ea84 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 ThreadPaused: Don't zero slop until free vars are pushed When threadPaused blackholes a thunk it calls `OVERWRITING_CLOSURE` to zero the slop for the benefit of the sanity checker. Previously this was done *before* pushing the thunk's free variables to the update remembered set. Consequently we would pull zero'd pointers to the update remembered set. - - - - - e82cd140 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Fix regression from TSAN work The TSAN rework (specifically aad1f803) introduced a subtle regression in GC.c, swapping `g0` in place of `gen`. Whoops! Fixes #18997. - - - - - 35a5207e by GHC GitLab CI at 2020-11-29T15:33:54-05:00 rts/Messages: Add missing write barrier in THROWTO message update After a THROWTO message has been handle the message closure is overwritten by a NULL message. We must ensure that the original closure's pointers continue to be visible to the nonmoving GC. - - - - - 0120829f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Add missing write barrier in shrinkSmallByteArray - - - - - 8a4d8fb6 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 Updates: Don't zero slop until closure has been pushed Ensure that the the free variables have been pushed to the update remembered set before we zero the slop. - - - - - 2793cfdc by GHC GitLab CI at 2020-11-29T15:33:54-05:00 OSThreads: Fix error code checking pthread_join returns its error code and apparently doesn't set errno. - - - - - e391a16f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Don't join to mark_thread on shutdown The mark thread is not joinable as we detach from it on creation. - - - - - 60d088ab by Ben Gamari at 2020-11-29T15:33:54-05:00 nonmoving: Add reference to Ueno 2016 - - - - - 3aa60362 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Ensure that evacuated large objects are marked See Note [Non-moving GC: Marking evacuated objects]. - - - - - 8d304a99 by Ben Gamari at 2020-11-30T10:15:22-05:00 rts/m32: Refactor handling of allocator seeding Previously, in an attempt to reduce fragmentation, each new allocator would map a region of M32_MAX_PAGES fresh pages to seed itself. However, this ends up being extremely wasteful since it turns out that we often use fewer than this. Consequently, these pages end up getting freed which, ends up fragmenting our address space more than than we would have if we had naively allocated pages on-demand. Here we refactor m32 to avoid this waste while achieving the fragmentation mitigation previously desired. In particular, we move all page allocation into the global m32_alloc_page, which will pull a page from the free page pool. If the free page pool is empty we then refill it by allocating a region of M32_MAP_PAGES and adding them to the pool. Furthermore, we do away with the initial seeding entirely. That is, the allocator starts with no active pages: pages are rather allocated on an as-needed basis. On the whole this ends up being a pleasingly simple change, simultaneously making m32 more efficient, more robust, and simpler. Fixes #18980. - - - - - b6629289 by Ben Gamari at 2020-11-30T10:15:58-05:00 rts: Use CHECK instead of assert Use the GHC wrappers instead of <assert.h>. - - - - - 9f4efa6a by Ben Gamari at 2020-11-30T10:15:58-05:00 rts/linker: Replace some ASSERTs with CHECK In the past some people have confused ASSERT, which is for checking internal invariants, which CHECK, which should be used when checking things that might fail due to bad input (and therefore should be enabled even in the release compiler). Change some of these cases in the linker to use CHECK. - - - - - 0f8a4655 by Ryan Scott at 2020-11-30T10:16:34-05:00 Allow deploy:pages job to fail See #18973. - - - - - 49ebe369 by chessai at 2020-11-30T19:47:40-05:00 Optimisations in Data.Foldable (T17867) This PR concerns the following functions from `Data.Foldable`: * minimum * maximum * sum * product * minimumBy * maximumBy - Default implementations of these functions now use `foldl'` or `foldMap'`. - All have been marked with INLINEABLE to make room for further optimisations. - - - - - 4d79ef65 by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - 6af074ce by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - ab334262 by Viktor Dukhovni at 2020-11-30T19:48:17-05:00 dirty MVAR after mutating TSO queue head While the original head and tail of the TSO queue may be in the same generation as the MVAR, interior elements of the queue could be younger after a GC run and may then be exposed by putMVar operation that updates the queue head. Resolves #18919 - - - - - 5eb163f3 by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Don't allow shared libraries to be loaded multiple times - - - - - 490aa14d by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Initialise CCSs from native shared objects - - - - - 6ac3db5f by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Move shared library loading logic into Elf.c - - - - - b6698d73 by GHC GitLab CI at 2020-11-30T19:48:53-05:00 rts/linker: Don't declare dynamic objects with image_mapped This previously resulted in warnings due to spurious unmap failures. - - - - - b94a65af by jneira at 2020-11-30T19:49:31-05:00 Include tried paths in findToolDir error - - - - - 72a87fbc by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Move core flattening algorithm to Core.Unify This sets the stage for a later change, where this algorithm will be needed from GHC.Core.InstEnv. This commit also splits GHC.Core.Map into GHC.Core.Map.Type and GHC.Core.Map.Expr, in order to avoid module import cycles with GHC.Core. - - - - - 0dd45d0a by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Bump the # of commits searched for perf baseline The previous value of 75 meant that a feature branch with more than 75 commits would get spurious CI passes. This affects #18692, but does not fix that ticket, because if a baseline cannot be found, we should fail, not succeed. - - - - - 8bb52d91 by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Remove flattening variables This patch redesigns the flattener to simplify type family applications directly instead of using flattening meta-variables and skolems. The key new innovation is the CanEqLHS type and the new CEqCan constraint (Ct). A CanEqLHS is either a type variable or exactly-saturated type family application; either can now be rewritten using a CEqCan constraint in the inert set. Because the flattener no longer reduces all type family applications to variables, there was some performance degradation if a lengthy type family application is now flattened over and over (not making progress). To compensate, this patch contains some extra optimizations in the flattener, leading to a number of performance improvements. Close #18875. Close #18910. There are many extra parts of the compiler that had to be affected in writing this patch: * The family-application cache (formerly the flat-cache) sometimes stores coercions built from Given inerts. When these inerts get kicked out, we must kick out from the cache as well. (This was, I believe, true previously, but somehow never caused trouble.) Kicking out from the cache requires adding a filterTM function to TrieMap. * This patch obviates the need to distinguish "blocking" coercion holes from non-blocking ones (which, previously, arose from CFunEqCans). There is thus some simplification around coercion holes. * Extra commentary throughout parts of the code I read through, to preserve the knowledge I gained while working. * A change in the pure unifier around unifying skolems with other types. Unifying a skolem now leads to SurelyApart, not MaybeApart, as documented in Note [Binding when looking up instances] in GHC.Core.InstEnv. * Some more use of MCoercion where appropriate. * Previously, class-instance lookup automatically noticed that e.g. C Int was a "unifier" to a target [W] C (F Bool), because the F Bool was flattened to a variable. Now, a little more care must be taken around checking for unifying instances. * Previously, tcSplitTyConApp_maybe would split (Eq a => a). This is silly, because (=>) is not a tycon in Haskell. Fixed now, but there are some knock-on changes in e.g. TrieMap code and in the canonicaliser. * New function anyFreeVarsOf{Type,Co} to check whether a free variable satisfies a certain predicate. * Type synonyms now remember whether or not they are "forgetful"; a forgetful synonym drops at least one argument. This is useful when flattening; see flattenView. * The pattern-match completeness checker invokes the solver. This invocation might need to look through newtypes when checking representational equality. Thus, the desugarer needs to keep track of the in-scope variables to know what newtype constructors are in scope. I bet this bug was around before but never noticed. * Extra-constraints wildcards are no longer simplified before printing. See Note [Do not simplify ConstraintHoles] in GHC.Tc.Solver. * Whether or not there are Given equalities has become slightly subtler. See the new HasGivenEqs datatype. * Note [Type variable cycles in Givens] in GHC.Tc.Solver.Canonical explains a significant new wrinkle in the new approach. * See Note [What might match later?] in GHC.Tc.Solver.Interact, which explains the fix to #18910. * The inert_count field of InertCans wasn't actually used, so I removed it. Though I (Richard) did the implementation, Simon PJ was very involved in design and review. This updates the Haddock submodule to avoid #18932 by adding a type signature. ------------------------- Metric Decrease: T12227 T5030 T9872a T9872b T9872c Metric Increase: T9872d ------------------------- - - - - - d66660ba by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Rename the flattener to become the rewriter. Now that flattening doesn't produce flattening variables, it's not really flattening anything: it's rewriting. This change also means that the rewriter can no longer be confused the core flattener (in GHC.Core.Unify), which is sometimes used during type-checking. - - - - - add0aeae by Ben Gamari at 2020-12-01T19:58:17-05:00 rts: Introduce mmapAnonForLinker Previously most of the uses of mmapForLinker were mapping anonymous memory, resulting in a great deal of unnecessary repetition. Factor this out into a new helper. Also fixes a few places where error checking was missing or suboptimal. - - - - - 97d71646 by Ben Gamari at 2020-12-01T19:58:17-05:00 rts/linker: Introduce munmapForLinker Consolidates munmap calls to ensure consistent error handling. - - - - - d8872af0 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/Linker: Introduce Windows implementations for mmapForLinker, et al. - - - - - c35d0e03 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/m32: Introduce NEEDS_M32 macro Instead of relying on RTS_LINKER_USE_MMAP - - - - - 41c64eb5 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/linker: Use m32 to allocate symbol extras in PEi386 - - - - - 95b346f1 by Ben Gamari at 2020-12-03T16:04:50-05:00 typecheck: Account for -XStrict in irrefutability check When -XStrict is enabled the rules for irrefutability are slightly modified. Specifically, the pattern in a program like do ~(Just hi) <- expr cannot be considered irrefutable. The ~ here merely disables the bang that -XStrict would usually apply, rendering the program equivalent to the following without -XStrict do Just hi <- expr To achieve make this pattern irrefutable with -XStrict the user would rather need to write do ~(~(Just hi)) <- expr Failing to account for this resulted in #19027. To fix this isIrrefutableHsPat takes care to check for two the irrefutability of the inner pattern when it encounters a LazyPat and -XStrict is enabled. - - - - - 21 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - + .gitlab/common.sh - .gitlab/linters/check-cpp.py - .gitlab/test-metrics.sh - CODEOWNERS - README.md - aclocal.m4 - + compiler/.hlint.yaml - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Types/Literals.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/Uniques.hs-boot - compiler/GHC/Builtin/Utils.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7713f45070c48b6ca58998e2e79db76772cf041c...95b346f1f152362f26036cbe8752a501e3dd1e5b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7713f45070c48b6ca58998e2e79db76772cf041c...95b346f1f152362f26036cbe8752a501e3dd1e5b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 3 21:10:15 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Thu, 03 Dec 2020 16:10:15 -0500 Subject: [Git][ghc/ghc][wip/T18894] 2 commits: DmdAnal: Annotate top-level function bindings with demands (#18894) Message-ID: <5fc954375100e_6a09a65b58151381@gitlab.mail> Sebastian Graf pushed to branch wip/T18894 at Glasgow Haskell Compiler / GHC Commits: 4c9e4ee0 by Sebastian Graf at 2020-12-03T22:10:05+01:00 DmdAnal: Annotate top-level function bindings with demands (#18894) It's useful to annotate a non-exported top-level function like `g` in ```hs module Lib (h) where g :: Int -> Int -> (Int,Int) g m 1 = (m, 0) g m n = (2 * m, 2 `div` n) {-# NOINLINE g #-} h :: Int -> Int h 1 = 0 h m | odd m = snd (g m 2) | otherwise = uncurry (+) (g 2 m) ``` with its demand `UCU(CS(P(1P(U),SP(U))`, which tells us that whenever `g` was called, the second component of the returned pair was evaluated strictly. Since #18903 we do so for local functions, where we can see all calls. For top-level functions, we can assume that all *exported* functions are demanded according to `topDmd` and thus get sound demands for non-exported top-level functions. The demand on `g` is crucial information for Nested CPR, which may the go on and unbox `g` for the second pair component. That is true even if that pair component may diverge, as is the case for the call site `g 13 0`, which throws a div-by-zero exception. In `T18894b`, you can even see the new demand annotation enabling us to eta-expand a function that we wouldn't be able to eta-expand without Call Arity. We only track bindings of function type in order not to risk huge compile-time regressions, see `isInterestingTopLevelFn`. There was a CoreLint check that rejected strict demand annotations on recursive or top-level bindings, which seems completely unjustified. All the cases I investigated were fine, so I removed it. Fixes #18894. - - - - - 09383c87 by Sebastian Graf at 2020-12-03T22:10:05+01:00 Demand: Simplify `CU(U)` to `U` (#19005) Both sub-demands encode the same information. This is a trivial change and already affects a few regression tests (e.g. `T5075`), so no separate regression test is necessary. - - - - - 17 changed files: - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Types/Demand.hs - compiler/GHC/Types/Id/Info.hs - testsuite/tests/arityanal/should_compile/Arity11.stderr - testsuite/tests/arityanal/should_compile/Arity16.stderr - + testsuite/tests/stranal/should_compile/T18894.hs - + testsuite/tests/stranal/should_compile/T18894.stderr - + testsuite/tests/stranal/should_compile/T18894b.hs - + testsuite/tests/stranal/should_compile/T18894b.stderr - testsuite/tests/stranal/should_compile/all.T - testsuite/tests/stranal/sigs/T5075.stderr Changes: ===================================== compiler/GHC/Core/FVs.hs ===================================== @@ -525,12 +525,11 @@ ruleLhsFVIds (Rule { ru_bndrs = bndrs, ru_args = args }) = filterFV isLocalId $ addBndrs bndrs (exprs_fvs args) ruleRhsFreeIds :: CoreRule -> VarSet --- ^ This finds all locally-defined free Ids on the left hand side of a rule +-- ^ This finds all locally-defined free Ids on the right hand side of a rule -- and returns them as a non-deterministic set ruleRhsFreeIds (BuiltinRule {}) = emptyVarSet -ruleRhsFreeIds (Rule { ru_bndrs = bndrs, ru_args = args }) - = fvVarSet $ filterFV isLocalId $ - addBndrs bndrs $ exprs_fvs args +ruleRhsFreeIds (Rule { ru_bndrs = bndrs, ru_rhs = rhs }) + = fvVarSet $ filterFV isLocalId $ addBndrs bndrs $ expr_fvs rhs {- Note [Rule free var hack] (Not a hack any more) ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -623,14 +623,6 @@ lintLetBind top_lvl rec_flag binder rhs rhs_ty || exprIsTickedString rhs) (badBndrTyMsg binder (text "unlifted")) - -- Check that if the binder is top-level or recursive, it's not - -- demanded. Primitive string literals are exempt as there is no - -- computation to perform, see Note [Core top-level string literals]. - ; checkL (not (isStrictId binder) - || (isNonRec rec_flag && not (isTopLevel top_lvl)) - || exprIsTickedString rhs) - (mkStrictMsg binder) - -- Check that if the binder is at the top level and has type Addr#, -- that it is a string literal, see -- Note [Core top-level string literals]. @@ -3119,13 +3111,6 @@ badBndrTyMsg binder what = vcat [ text "The type of this binder is" <+> what <> colon <+> ppr binder , text "Binder's type:" <+> ppr (idType binder) ] -mkStrictMsg :: Id -> MsgDoc -mkStrictMsg binder - = vcat [hsep [text "Recursive or top-level binder has strict demand info:", - ppr binder], - hsep [text "Binder's demand info:", ppr (idDemandInfo binder)] - ] - mkNonTopExportedMsg :: Id -> MsgDoc mkNonTopExportedMsg binder = hsep [text "Non-top-level binder is marked as exported:", ppr binder] ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -37,6 +37,7 @@ import GHC.Core.Type import GHC.Core.FVs ( exprFreeIds, ruleRhsFreeIds ) import GHC.Core.Coercion ( Coercion, coVarsOfCo ) import GHC.Core.FamInstEnv +import GHC.Core.Opt.Arity ( typeArity ) import GHC.Utils.Misc import GHC.Utils.Panic import GHC.Data.Maybe ( isJust ) @@ -64,28 +65,54 @@ data DmdAnalOpts = DmdAnalOpts -- -- Note: use `seqBinds` on the result to avoid leaks due to lazyness (cf Note -- [Stamp out space leaks in demand analysis]) -dmdAnalProgram :: DmdAnalOpts -> FamInstEnvs -> CoreProgram -> CoreProgram -dmdAnalProgram opts fam_envs binds = binds_plus_dmds - where - env = emptyAnalEnv opts fam_envs - binds_plus_dmds = snd $ mapAccumL dmdAnalTopBind env binds - --- Analyse a (group of) top-level binding(s) -dmdAnalTopBind :: AnalEnv - -> CoreBind - -> (AnalEnv, CoreBind) -dmdAnalTopBind env (NonRec id rhs) - = ( extendAnalEnv TopLevel env id sig - , NonRec (setIdStrictness id sig) rhs') +dmdAnalProgram :: DmdAnalOpts -> FamInstEnvs -> [CoreRule] -> CoreProgram -> CoreProgram +dmdAnalProgram opts fam_envs rules binds + = snd $ go (emptyAnalEnv opts fam_envs) binds where - ( _, sig, rhs') = dmdAnalRhsLetDown Nothing env topSubDmd id rhs - -dmdAnalTopBind env (Rec pairs) - = (env', Rec pairs') - where - (env', _, pairs') = dmdFix TopLevel env topSubDmd pairs - -- We get two iterations automatically - -- c.f. the NonRec case above + -- See Note [Analysing top-level bindings] + -- TLDR; We analyse them like + -- let ex1 = ... in (ex1, let nex1 = ... in let ex2 = ... in (ex2, ...))) + -- where ex* are exported (or RULE mentions) and nex* are not. + go _ [] = (nopDmdType, []) + go env (b:bs) = cons_up $ dmdAnalBind TopLevel env topSubDmd b anal_body + where + anal_body env' + | (body_ty, bs') <- go env' bs + = (add_exported_uses env' body_ty (bindersOf b), bs') + + cons_up :: (a, b, [b]) -> (a, [b]) + cons_up (dmd_ty, b', bs') = (dmd_ty, b':bs') + + add_exported_uses :: AnalEnv -> DmdType -> [Id] -> DmdType + add_exported_uses env = foldl' (add_exported_use env) + + -- | If @e@ is denoted by @dmd_ty@, then @add_exported_use _ dmd_ty id@ + -- corresponds to the demand type of @(id, e)@, but is a lot more direct. + -- See Note [Analysing top-level bindings]. + add_exported_use :: AnalEnv -> DmdType -> Id -> DmdType + add_exported_use env dmd_ty id + | isExportedId id || elemVarSet id rule_fvs + -- See Note [Absence analysis for stable unfoldings and RULES] + = dmd_ty `plusDmdType` fst (dmdAnalStar env topDmd (Var id)) + | otherwise = dmd_ty + + rule_fvs :: IdSet + rule_fvs = foldr (unionVarSet . ruleRhsFreeIds) emptyVarSet rules + +-- | Whether we want to store demands on a top-level Id or just default +-- to 'topDmd'. +-- +-- Basically, we want to now how top-level *functions* are *used* +-- (e.g. called), but aren't interested in whether they were called strictly +-- or not. Other top-level bindings are boring. +isInterestingTopLevelFn :: Id -> Bool +-- SG tried to set this to True and got a +2% ghc/alloc regression in T5642 +-- (which is dominated by the Simplifier) at no gain in analysis precision. +-- If there was a gain, that regression might be acceptable. +-- Plus, we could use LetUp for thunks and share some code with local let +-- bindings. +isInterestingTopLevelFn id = + typeArity (idType id) `lengthExceeds` 0 {- Note [Stamp out space leaks in demand analysis] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -105,8 +132,56 @@ generation would hold on to an extra copy of the Core program, via unforced thunks in demand or strictness information; and it is the most memory-intensive part of the compilation process, so this added seqBinds makes a big difference in peak memory usage. --} +Note [Analysing top-level bindings] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider a CoreProgram like + e1 = ... + n1 = ... + e2 = \a b -> ... fst (n1 a b) ... + n2 = \c d -> ... snd (e2 c d) ... + ... +where e* are exported, but n* are not. +Intuitively, we can see that @n1@ is only ever called with two arguments +and in every call site, the first component of the result of the call +is evaluated. Thus, we'd like it to have idDemandInfo @UCU(C1(P(SU,A))@. + +(This can be exploited by a Nested CPR pass which may then unbox the +first component of the pair returned from @n1 at . Or if @n1@ had arity +1 before, we may now eta-expand to arity 2.) + +NB: We may *not* give e2 a similar annotation, because it is exported and +external callers might use it in arbitrary ways, expressed by 'topDmd'. + +How do we get this result? Answer: By analysing the program as if it was a let +expression of this form: + let e1 = ... in + (e1, let n1 = ... in + ( let e2 = ... in + (e2, let n2 = ... in + ( ...)))) +E.g. putting all bindings in nested lets, where whenever it binds an exported +binding, the body is a *pair* of an occurrence of the exported binder and +the other nested lets. Of course, we will not actually build that CoreExpr! +Instead we faithfully simulate analysis of said expression by adding the +free variable 'DmdEnv' of @e*@'s strictness signatures to the 'DmdType' we +get from analysing the nested bindings. + +You might also wonder why we didn't analyse in terms of the simpler + let e1 = ... in + let n1 = ... in + let e2 = ... in + let n2 = ... in + (e1,e2, ...) +The reason is analysis performance: If @e1@ uses many free variables, we'll +unnecessarily carry their demands around with us from the moment we analyse +the pair to the moment we bubble back up to the binding for @e1 at . +This blows up e.g. @T10370 at . + +A final note about variables occuring free in RULE RHSs: They are to be handled +pretty much like exported Ids. +See also Note [Absence analysis for stable unfoldings and RULES] +-} {- ************************************************************************ @@ -114,7 +189,103 @@ seqBinds makes a big difference in peak memory usage. \subsection{The analyser itself} * * ************************************************************************ +-} + +-- | Analyse a binding group and its \"body\", e.g. where it is in scope. +-- +-- It calls a function that knows how to analyse this \"body\" given +-- an 'AnalEnv' with updated demand signatures for the binding group +-- (reflecting their 'idStrictnessInfo') and expects to receive a +-- 'DmdType' in return, which it uses to annotate the binding group with their +-- 'idDemandInfo'. +dmdAnalBind + :: TopLevelFlag + -> AnalEnv + -> SubDemand -- ^ Demand put on the "body" + -- (important for join points) + -> CoreBind + -> (AnalEnv -> (DmdType, a)) -- ^ How to analyse the "body", e.g. + -- where the binding is in scope + -> (DmdType, CoreBind, a) +dmdAnalBind top_lvl env dmd bind anal_body = case bind of + NonRec id rhs + | useLetUp top_lvl id + -> dmdAnalBindLetUp top_lvl env id rhs anal_body + _ -> dmdAnalBindLetDown top_lvl env dmd bind anal_body + +-- | Annotates uninteresting top level functions ('isInterestingTopLevelFn') +-- with 'topDmd', the rest with the given demand. +setBindIdDemandInfo :: TopLevelFlag -> Id -> Demand -> Id +setBindIdDemandInfo top_lvl id dmd = setIdDemandInfo id $ case top_lvl of + TopLevel | not (isInterestingTopLevelFn id) -> topDmd + _ -> dmd + +-- | Let bindings can be processed in two ways: +-- Down (RHS before body) or Up (body before RHS). +-- This function handles the up variant. +-- +-- It is very simple. For let x = rhs in body +-- * Demand-analyse 'body' in the current environment +-- * Find the demand, 'rhs_dmd' placed on 'x' by 'body' +-- * Demand-analyse 'rhs' in 'rhs_dmd' +-- +-- This is used for a non-recursive local let without manifest lambdas (see +-- 'useLetUp'). +-- +-- This is the LetUp rule in the paper “Higher-Order Cardinality Analysis”. +dmdAnalBindLetUp :: TopLevelFlag -> AnalEnv -> Id -> CoreExpr -> (AnalEnv -> (DmdType, a)) -> (DmdType, CoreBind, a) +dmdAnalBindLetUp top_lvl env id rhs anal_body = (final_ty, NonRec id' rhs', body') + where + (body_ty, body') = anal_body env + (body_ty', id_dmd) = findBndrDmd env notArgOfDfun body_ty id + id' = setBindIdDemandInfo top_lvl id id_dmd + (rhs_ty, rhs') = dmdAnalStar env (dmdTransformThunkDmd rhs id_dmd) rhs + final_ty = body_ty' `plusDmdType` rhs_ty + +-- | Let bindings can be processed in two ways: +-- Down (RHS before body) or Up (body before RHS). +-- This function handles the down variant. +-- +-- It computes a demand signature (by means of 'dmdAnalRhsSig') and uses +-- that at call sites in the body. +-- +-- It is used for toplevel definitions, recursive definitions and local +-- non-recursive definitions that have manifest lambdas (cf. 'useLetUp'). +-- Local non-recursive definitions without a lambda are handled with LetUp. +-- +-- This is the LetDown rule in the paper “Higher-Order Cardinality Analysis”. +dmdAnalBindLetDown :: TopLevelFlag -> AnalEnv -> SubDemand -> CoreBind -> (AnalEnv -> (DmdType, a)) -> (DmdType, CoreBind, a) +dmdAnalBindLetDown top_lvl env dmd bind anal_body = case bind of + NonRec id rhs + | (env', lazy_fv, id1, rhs1) <- + dmdAnalRhsSig top_lvl NonRecursive env dmd id rhs + -> do_rest env' lazy_fv [(id1, rhs1)] (\[(id2, rhs2)] -> NonRec id2 rhs2) + Rec pairs + | (env', lazy_fv, pairs') <- dmdFix top_lvl env dmd pairs + -> do_rest env' lazy_fv pairs' Rec + where + do_rest env' lazy_fv pairs1 build_bind = (final_ty, build_bind pairs2, body') + where + (body_ty, body') = anal_body env' + -- see Note [Lazy and unleashable free variables] + dmd_ty = addLazyFVs body_ty lazy_fv + (!final_ty, id_dmds) = findBndrsDmds env' dmd_ty (map fst pairs1) + pairs2 = zipWith do_one pairs1 id_dmds + do_one (id', rhs') dmd = (setBindIdDemandInfo top_lvl id' dmd, rhs') + -- If the actual demand is better than the vanilla call + -- demand, you might think that we might do better to re-analyse + -- the RHS with the stronger demand. + -- But (a) That seldom happens, because it means that *every* path in + -- the body of the let has to use that stronger demand + -- (b) It often happens temporarily in when fixpointing, because + -- the recursive function at first seems to place a massive demand. + -- But we don't want to go to extra work when the function will + -- probably iterate to something less demanding. + -- In practice, all the times the actual demand on id2 is more than + -- the vanilla call demand seem to be due to (b). So we don't + -- bother to re-analyse the RHS. +{- Note [Ensure demand is strict] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ It's important not to analyse e with a lazy demand because @@ -194,7 +365,7 @@ dmdAnal' env dmd (App fun arg) -- Crucially, coercions /are/ handled here, because they are -- value arguments (#10288) let - call_dmd = mkCallDmd dmd + call_dmd = mkCalledOnceDmd dmd (fun_ty, fun') = dmdAnal env call_dmd fun (arg_dmd, res_ty) = splitDmdTy fun_ty (arg_ty, arg') = dmdAnalStar env (dmdTransformThunkDmd arg arg_dmd) arg @@ -295,60 +466,11 @@ dmdAnal' env dmd (Case scrut case_bndr ty alts) -- , text "res_ty" <+> ppr res_ty ]) $ (res_ty, Case scrut' case_bndr' ty alts') --- Let bindings can be processed in two ways: --- Down (RHS before body) or Up (body before RHS). --- The following case handle the up variant. --- --- It is very simple. For let x = rhs in body --- * Demand-analyse 'body' in the current environment --- * Find the demand, 'rhs_dmd' placed on 'x' by 'body' --- * Demand-analyse 'rhs' in 'rhs_dmd' --- --- This is used for a non-recursive local let without manifest lambdas. --- This is the LetUp rule in the paper “Higher-Order Cardinality Analysis”. -dmdAnal' env dmd (Let (NonRec id rhs) body) - | useLetUp id - = (final_ty, Let (NonRec id' rhs') body') +dmdAnal' env dmd (Let bind body) + = (final_ty, Let bind' body') where - (body_ty, body') = dmdAnal env dmd body - (body_ty', id_dmd) = findBndrDmd env notArgOfDfun body_ty id - id' = setIdDemandInfo id id_dmd - - (rhs_ty, rhs') = dmdAnalStar env (dmdTransformThunkDmd rhs id_dmd) rhs - final_ty = body_ty' `plusDmdType` rhs_ty - -dmdAnal' env dmd (Let (NonRec id rhs) body) - = (body_ty2, Let (NonRec id2 rhs') body') - where - (lazy_fv, sig, rhs') = dmdAnalRhsLetDown Nothing env dmd id rhs - id1 = setIdStrictness id sig - env1 = extendAnalEnv NotTopLevel env id sig - (body_ty, body') = dmdAnal env1 dmd body - (body_ty1, id2) = annotateBndr env body_ty id1 - body_ty2 = addLazyFVs body_ty1 lazy_fv -- see Note [Lazy and unleashable free variables] - - -- If the actual demand is better than the vanilla call - -- demand, you might think that we might do better to re-analyse - -- the RHS with the stronger demand. - -- But (a) That seldom happens, because it means that *every* path in - -- the body of the let has to use that stronger demand - -- (b) It often happens temporarily in when fixpointing, because - -- the recursive function at first seems to place a massive demand. - -- But we don't want to go to extra work when the function will - -- probably iterate to something less demanding. - -- In practice, all the times the actual demand on id2 is more than - -- the vanilla call demand seem to be due to (b). So we don't - -- bother to re-analyse the RHS. - -dmdAnal' env dmd (Let (Rec pairs) body) - = let - (env', lazy_fv, pairs') = dmdFix NotTopLevel env dmd pairs - (body_ty, body') = dmdAnal env' dmd body - body_ty1 = deleteFVs body_ty (map fst pairs) - body_ty2 = addLazyFVs body_ty1 lazy_fv -- see Note [Lazy and unleashable free variables] - in - body_ty2 `seq` - (body_ty2, Let (Rec pairs') body') + (final_ty, bind', body') = dmdAnalBind NotTopLevel env dmd bind go' + go' env' = dmdAnal env' dmd body -- | A simple, syntactic analysis of whether an expression MAY throw a precise -- exception when evaluated. It's always sound to return 'True'. @@ -582,9 +704,13 @@ dmdTransform env var dmd | Just (sig, top_lvl) <- lookupSigEnv env var , let fn_ty = dmdTransformSig sig dmd = -- pprTrace "dmdTransform:LetDown" (vcat [ppr var, ppr sig, ppr dmd, ppr fn_ty]) $ - if isTopLevel top_lvl - then fn_ty -- Don't record demand on top-level things - else addVarDmd fn_ty var (C_11 :* dmd) + case top_lvl of + NotTopLevel -> addVarDmd fn_ty var (C_11 :* dmd) + TopLevel + | isInterestingTopLevelFn var + -> addVarDmd fn_ty var (C_0N `multDmd` (C_11 :* dmd)) -- discard strictness + | otherwise + -> fn_ty -- don't bother tracking; just annotate with 'topDmd' later -- Everything else: -- * Local let binders for which we use LetUp (cf. 'useLetUp') -- * Lambda binders @@ -599,46 +725,46 @@ dmdTransform env var dmd * * ********************************************************************* -} --- Let bindings can be processed in two ways: --- Down (RHS before body) or Up (body before RHS). --- dmdAnalRhsLetDown implements the Down variant: --- * assuming a demand of +-- | @dmdAnalRhsSig@ analyses the given RHS to compute a demand signature +-- for the LetDown rule. It works as follows: +-- +-- * assuming a demand of -- * looking at the definition -- * determining a strictness signature -- --- It is used for toplevel definition, recursive definitions and local --- non-recursive definitions that have manifest lambdas. --- Local non-recursive definitions without a lambda are handled with LetUp. --- --- This is the LetDown rule in the paper “Higher-Order Cardinality Analysis”. -dmdAnalRhsLetDown - :: Maybe [Id] -- Just bs <=> recursive, Nothing <=> non-recursive +-- Since it assumed a demand of , the resulting signature is applicable at +-- any call site. +dmdAnalRhsSig + :: TopLevelFlag + -> RecFlag -> AnalEnv -> SubDemand -> Id -> CoreExpr - -> (DmdEnv, StrictSig, CoreExpr) + -> (AnalEnv, DmdEnv, Id, CoreExpr) -- Process the RHS of the binding, add the strictness signature -- to the Id, and augment the environment with the signature as well. -- See Note [NOINLINE and strictness] -dmdAnalRhsLetDown rec_flag env let_dmd id rhs - = -- pprTrace "dmdAnalRhsLetDown" (ppr id $$ ppr let_dmd $$ ppr sig $$ ppr lazy_fv) $ - (lazy_fv, sig, rhs') +dmdAnalRhsSig top_lvl rec_flag env let_dmd id rhs + = -- pprTrace "dmdAnalRhsSig" (ppr id $$ ppr let_dmd $$ ppr sig $$ ppr lazy_fv) $ + (env', lazy_fv, id', rhs') where rhs_arity = idArity id + -- See Note [Demand signatures are computed for a threshold demand based on idArity] rhs_dmd -- See Note [Demand analysis for join points] -- See Note [Invariants on join points] invariant 2b, in GHC.Core -- rhs_arity matches the join arity of the join point | isJoinId id - = mkCallDmds rhs_arity let_dmd + = mkCalledOnceDmds rhs_arity let_dmd | otherwise - -- NB: rhs_arity - -- See Note [Demand signatures are computed for a threshold demand based on idArity] - = mkRhsDmd env rhs_arity rhs + = mkCalledOnceDmds rhs_arity topSubDmd (rhs_dmd_ty, rhs') = dmdAnal env rhs_dmd rhs DmdType rhs_fv rhs_dmds rhs_div = rhs_dmd_ty sig = mkStrictSigForArity rhs_arity (DmdType sig_fv rhs_dmds rhs_div) + id' = id `setIdStrictness` sig + env' = extendAnalEnv top_lvl env id' sig + -- See Note [Aggregated demand for cardinality] -- FIXME: That Note doesn't explain the following lines at all. The reason -- is really much different: When we have a recursive function, we'd @@ -651,8 +777,8 @@ dmdAnalRhsLetDown rec_flag env let_dmd id rhs -- we'd have to do an additional iteration. reuseEnv makes sure that -- we never get used-once info for FVs of recursive functions. rhs_fv1 = case rec_flag of - Just bs -> reuseEnv (delVarEnvList rhs_fv bs) - Nothing -> rhs_fv + Recursive -> reuseEnv rhs_fv + NonRecursive -> rhs_fv rhs_fv2 = rhs_fv1 `keepAliveDmdEnv` extra_fvs -- Find the RHS free vars of the unfoldings and RULES @@ -669,13 +795,6 @@ dmdAnalRhsLetDown rec_flag env let_dmd id rhs = exprFreeIds unf_body | otherwise = emptyVarSet --- | @mkRhsDmd env rhs_arity rhs@ creates a 'SubDemand' for --- unleashing on the given function's @rhs@, by creating --- a call demand of @rhs_arity@ --- See Historical Note [Product demands for function body] -mkRhsDmd :: AnalEnv -> Arity -> CoreExpr -> SubDemand -mkRhsDmd _env rhs_arity _rhs = mkCallDmds rhs_arity topSubDmd - -- | If given the (local, non-recursive) let-bound 'Id', 'useLetUp' determines -- whether we should process the binding up (body before rhs) or down (rhs -- before body). @@ -720,8 +839,8 @@ mkRhsDmd _env rhs_arity _rhs = mkCallDmds rhs_arity topSubDmd -- * For a more convincing example with join points, see Note [Demand analysis -- for join points]. -- -useLetUp :: Var -> Bool -useLetUp f = idArity f == 0 && not (isJoinId f) +useLetUp :: TopLevelFlag -> Var -> Bool +useLetUp top_lvl f = isNotTopLevel top_lvl && idArity f == 0 && not (isJoinId f) {- Note [Demand analysis for join points] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -939,8 +1058,6 @@ dmdFix :: TopLevelFlag dmdFix top_lvl env let_dmd orig_pairs = loop 1 initial_pairs where - bndrs = map fst orig_pairs - -- See Note [Initialising strictness] initial_pairs | ae_virgin env = [(setIdStrictness id botSig, rhs) | (id, rhs) <- orig_pairs ] | otherwise = orig_pairs @@ -990,10 +1107,8 @@ dmdFix top_lvl env let_dmd orig_pairs = -- pprTrace "my_downRhs" (ppr id $$ ppr (idStrictness id) $$ ppr sig) $ ((env', lazy_fv'), (id', rhs')) where - (lazy_fv1, sig, rhs') = dmdAnalRhsLetDown (Just bndrs) env let_dmd id rhs - lazy_fv' = plusVarEnv_C plusDmd lazy_fv lazy_fv1 - env' = extendAnalEnv top_lvl env id sig - id' = setIdStrictness id sig + (env', lazy_fv1, id', rhs') = dmdAnalRhsSig top_lvl Recursive env let_dmd id rhs + lazy_fv' = plusVarEnv_C plusDmd lazy_fv lazy_fv1 zapIdStrictness :: [(Id, CoreExpr)] -> [(Id, CoreExpr)] zapIdStrictness pairs = [(setIdStrictness id nopSig, rhs) | (id, rhs) <- pairs ] @@ -1090,7 +1205,7 @@ addLazyFVs dmd_ty lazy_fvs -- demand with the bottom coming up from 'error' -- -- I got a loop in the fixpointer without this, due to an interaction - -- with the lazy_fv filtering in dmdAnalRhsLetDown. Roughly, it was + -- with the lazy_fv filtering in dmdAnalRhsSig. Roughly, it was -- letrec f n x -- = letrec g y = x `fatbar` -- letrec h z = z + ...g... @@ -1156,10 +1271,6 @@ annotateLamIdBndr env arg_of_dfun dmd_ty id main_ty = addDemand dmd dmd_ty' (dmd_ty', dmd) = findBndrDmd env arg_of_dfun dmd_ty id -deleteFVs :: DmdType -> [Var] -> DmdType -deleteFVs (DmdType fvs dmds res) bndrs - = DmdType (delVarEnvList fvs bndrs) dmds res - {- Note [NOINLINE and strictness] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Core/Opt/Pipeline.hs ===================================== @@ -65,6 +65,7 @@ import GHC.Types.SrcLoc import GHC.Types.Id import GHC.Types.Id.Info import GHC.Types.Basic +import GHC.Types.Demand ( zapDmdEnvSig ) import GHC.Types.Var.Set import GHC.Types.Var.Env import GHC.Types.Unique.Supply ( UniqSupply, mkSplitUniqSupply, splitUniqSupply ) @@ -495,7 +496,7 @@ doCorePass CoreDoExitify = {-# SCC "Exitify" #-} doPass exitifyProgram doCorePass CoreDoDemand = {-# SCC "DmdAnal" #-} - doPassDFM dmdAnal + doPassDFRM dmdAnal doCorePass CoreDoCpr = {-# SCC "CprAnal" #-} doPassDFM cprAnalProgram @@ -575,6 +576,13 @@ doPassDFM do_pass guts = do let fam_envs = (p_fam_env, mg_fam_inst_env guts) doPassM (liftIO . do_pass dflags fam_envs) guts +doPassDFRM :: (DynFlags -> FamInstEnvs -> [CoreRule] -> CoreProgram -> IO CoreProgram) -> ModGuts -> CoreM ModGuts +doPassDFRM do_pass guts = do + dflags <- getDynFlags + p_fam_env <- getPackageFamInstEnv + let fam_envs = (p_fam_env, mg_fam_inst_env guts) + doPassM (liftIO . do_pass dflags fam_envs (mg_rules guts)) guts + doPassDFU :: (DynFlags -> FamInstEnvs -> UniqSupply -> CoreProgram -> CoreProgram) -> ModGuts -> CoreM ModGuts doPassDFU do_pass guts = do dflags <- getDynFlags @@ -1088,13 +1096,13 @@ transferIdInfo exported_id local_id -dmdAnal :: DynFlags -> FamInstEnvs -> CoreProgram -> IO CoreProgram -dmdAnal dflags fam_envs binds = do +dmdAnal :: DynFlags -> FamInstEnvs -> [CoreRule] -> CoreProgram -> IO CoreProgram +dmdAnal dflags fam_envs rules binds = do let opts = DmdAnalOpts { dmd_strict_dicts = gopt Opt_DictsStrict dflags } - binds_plus_dmds = dmdAnalProgram opts fam_envs binds + binds_plus_dmds = dmdAnalProgram opts fam_envs rules binds Err.dumpIfSet_dyn dflags Opt_D_dump_str_signatures "Strictness signatures" FormatText $ - dumpIdInfoOfProgram (ppr . strictnessInfo) binds_plus_dmds + dumpIdInfoOfProgram (ppr . zapDmdEnvSig . strictnessInfo) binds_plus_dmds -- See Note [Stamp out space leaks in demand analysis] in GHC.Core.Opt.DmdAnal seqBinds binds_plus_dmds `seq` return binds_plus_dmds ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -598,11 +598,10 @@ addJoinFlts = appOL mkRecFloats :: SimplFloats -> SimplFloats -- Flattens the floats into a single Rec group, -- They must either all be lifted LetFloats or all JoinFloats -mkRecFloats floats@(SimplFloats { sfLetFloats = LetFloats bs ff +mkRecFloats floats@(SimplFloats { sfLetFloats = LetFloats bs _ff , sfJoinFloats = jbs , sfInScope = in_scope }) - = ASSERT2( case ff of { FltLifted -> True; _ -> False }, ppr (fromOL bs) ) - ASSERT2( isNilOL bs || isNilOL jbs, ppr floats ) + = ASSERT2( isNilOL bs || isNilOL jbs, ppr floats ) SimplFloats { sfLetFloats = floats' , sfJoinFloats = jfloats' , sfInScope = in_scope } ===================================== compiler/GHC/Core/Opt/WorkWrap/Utils.hs ===================================== @@ -1275,10 +1275,14 @@ mk_absent_let dflags fam_envs arg abs_rhs = mkAbsentErrorApp arg_ty msg msg = showSDoc (gopt_set dflags Opt_SuppressUniques) - (ppr arg <+> ppr (idType arg) <+> file_msg) + (vcat + [ text "Arg:" <+> ppr arg + , text "Type:" <+> ppr arg_ty + , file_msg + ]) file_msg = case outputFile dflags of Nothing -> empty - Just f -> text "in output file " <+> quotes (text f) + Just f -> text "In output file " <+> quotes (text f) -- We need to suppress uniques here because otherwise they'd -- end up in the generated code as strings. This is bad for -- determinism, because with different uniques the strings ===================================== compiler/GHC/Core/Tidy.hs ===================================== @@ -21,7 +21,7 @@ import GHC.Core import GHC.Core.Seq ( seqUnfolding ) import GHC.Types.Id import GHC.Types.Id.Info -import GHC.Types.Demand ( zapUsageEnvSig ) +import GHC.Types.Demand ( zapDmdEnvSig ) import GHC.Core.Type ( tidyType, tidyVarBndr ) import GHC.Core.Coercion ( tidyCo ) import GHC.Types.Var @@ -206,7 +206,7 @@ tidyLetBndr rec_tidy_env env@(tidy_env, var_env) id new_info = vanillaIdInfo `setOccInfo` occInfo old_info `setArityInfo` arityInfo old_info - `setStrictnessInfo` zapUsageEnvSig (strictnessInfo old_info) + `setStrictnessInfo` zapDmdEnvSig (strictnessInfo old_info) `setDemandInfo` demandInfo old_info `setInlinePragInfo` inlinePragInfo old_info `setUnfoldingInfo` new_unf ===================================== compiler/GHC/Types/Demand.hs ===================================== @@ -34,7 +34,7 @@ module GHC.Types.Demand ( lazyApply1Dmd, lazyApply2Dmd, strictOnceApply1Dmd, strictManyApply1Dmd, -- ** Other @Demand@ operations oneifyCard, oneifyDmd, strictifyDmd, strictifyDictDmd, mkWorkerDemand, - peelCallDmd, peelManyCalls, mkCallDmd, mkCallDmds, + peelCallDmd, peelManyCalls, mkCalledOnceDmd, mkCalledOnceDmds, addCaseBndrDmd, -- ** Extracting one-shot information argOneShots, argsOneShots, saturatedByOneShots, @@ -73,7 +73,7 @@ module GHC.Types.Demand ( seqDemand, seqDemandList, seqDmdType, seqStrictSig, -- * Zapping usage information - zapUsageDemand, zapUsageEnvSig, zapUsedOnceDemand, zapUsedOnceSig + zapUsageDemand, zapDmdEnvSig, zapUsedOnceDemand, zapUsedOnceSig ) where #include "HsVersions.h" @@ -278,7 +278,8 @@ data SubDemand -- ^ @Call n sd@ describes the evaluation context of @n@ function -- applications, where every individual result is evaluated according to @sd at . -- @sd@ is /relative/ to a single call, cf. Note [Call demands are relative]. - -- Used only for values of function type. + -- Used only for values of function type. Use the smart constructor 'mkCall' + -- whenever possible! | Prod ![Demand] -- ^ @Prod ds@ describes the evaluation context of a case scrutinisation -- on an expression of product type, where the product components are @@ -306,7 +307,7 @@ polyDmd C_1N = C_1N :* poly1N polyDmd C_10 = C_10 :* poly10 -- | A smart constructor for 'Prod', applying rewrite rules along the semantic --- equalities @Prod [polyDmd n, ...] === polyDmd n@, simplifying to 'Poly' +-- equality @Prod [polyDmd n, ...] === polyDmd n@, simplifying to 'Poly' -- 'SubDemand's when possible. Note that this degrades boxity information! E.g. a -- polymorphic demand will never unbox. mkProd :: [Demand] -> SubDemand @@ -335,6 +336,13 @@ viewProd _ _ = Nothing {-# INLINE viewProd #-} -- we want to fuse away the replicate and the allocation -- for Arity. Otherwise, #18304 bites us. +-- | A smart constructor for 'Call', applying rewrite rules along the semantic +-- equality @Call n (Poly n) === Poly n@, simplifying to 'Poly' 'SubDemand's +-- when possible. +mkCall :: Card -> SubDemand -> SubDemand +mkCall n cd@(Poly m) | n == m = cd +mkCall n cd = Call n cd + -- | @viewCall sd@ interprets @sd@ as a 'Call', expanding 'Poly' demands as -- necessary. viewCall :: SubDemand -> Maybe (Card, SubDemand) @@ -356,8 +364,8 @@ lubSubDmd (Prod ds1) (viewProd (length ds1) -> Just ds2) = -- Handle Call lubSubDmd (Call n1 d1) (viewCall -> Just (n2, d2)) -- See Note [Call demands are relative] - | isAbs n2 = Call (lubCard n1 n2) (lubSubDmd d1 botSubDmd) - | otherwise = Call (lubCard n1 n2) (lubSubDmd d1 d2) + | isAbs n2 = mkCall (lubCard n1 n2) (lubSubDmd d1 botSubDmd) + | otherwise = mkCall (lubCard n1 n2) (lubSubDmd d1 d2) -- Handle Poly lubSubDmd (Poly n1) (Poly n2) = Poly (lubCard n1 n2) -- Make use of reflexivity (so we'll match the Prod or Call cases again). @@ -377,8 +385,8 @@ plusSubDmd (Prod ds1) (viewProd (length ds1) -> Just ds2) = -- Handle Call plusSubDmd (Call n1 d1) (viewCall -> Just (n2, d2)) -- See Note [Call demands are relative] - | isAbs n2 = Call (plusCard n1 n2) (lubSubDmd d1 botSubDmd) - | otherwise = Call (plusCard n1 n2) (lubSubDmd d1 d2) + | isAbs n2 = mkCall (plusCard n1 n2) (lubSubDmd d1 botSubDmd) + | otherwise = mkCall (plusCard n1 n2) (lubSubDmd d1 d2) -- Handle Poly plusSubDmd (Poly n1) (Poly n2) = Poly (plusCard n1 n2) -- Make use of reflexivity (so we'll match the Prod or Call cases again). @@ -407,7 +415,7 @@ multSubDmd :: Card -> SubDemand -> SubDemand multSubDmd n sd | Just sd' <- multTrivial n seqSubDmd sd = sd' multSubDmd n (Poly n') = Poly (multCard n n') -multSubDmd n (Call n' sd) = Call (multCard n n') sd -- See Note [Call demands are relative] +multSubDmd n (Call n' sd) = mkCall (multCard n n') sd -- See Note [Call demands are relative] multSubDmd n (Prod ds) = Prod (map (multDmd n) ds) multDmd :: Card -> Demand -> Demand @@ -457,22 +465,22 @@ evalDmd = C_1N :* topSubDmd -- | First argument of 'GHC.Exts.maskAsyncExceptions#': @SCS(U)@. -- Called exactly once. strictOnceApply1Dmd :: Demand -strictOnceApply1Dmd = C_11 :* Call C_11 topSubDmd +strictOnceApply1Dmd = C_11 :* mkCall C_11 topSubDmd -- | First argument of 'GHC.Exts.atomically#': @MCM(U)@. -- Called at least once, possibly many times. strictManyApply1Dmd :: Demand -strictManyApply1Dmd = C_1N :* Call C_1N topSubDmd +strictManyApply1Dmd = C_1N :* mkCall C_1N topSubDmd -- | First argument of catch#: @1C1(U)@. -- Evaluates its arg lazily, but then applies it exactly once to one argument. lazyApply1Dmd :: Demand -lazyApply1Dmd = C_01 :* Call C_01 topSubDmd +lazyApply1Dmd = C_01 :* mkCall C_01 topSubDmd -- | Second argument of catch#: @1C1(CS(U))@. -- Calls its arg lazily, but then applies it exactly once to an additional argument. lazyApply2Dmd :: Demand -lazyApply2Dmd = C_01 :* Call C_01 (Call C_11 topSubDmd) +lazyApply2Dmd = C_01 :* mkCall C_01 (mkCall C_11 topSubDmd) -- | Make a 'Demand' evaluated at-most-once. oneifyDmd :: Demand -> Demand @@ -512,12 +520,12 @@ strictifyDictDmd ty (n :* Prod ds) strictifyDictDmd _ dmd = dmd -- | Wraps the 'SubDemand' with a one-shot call demand: @d@ -> @CS(d)@. -mkCallDmd :: SubDemand -> SubDemand -mkCallDmd sd = Call C_11 sd +mkCalledOnceDmd :: SubDemand -> SubDemand +mkCalledOnceDmd sd = mkCall C_11 sd --- | @mkCallDmds n d@ returns @CS(CS...(CS d))@ where there are @n@ @CS@'s. -mkCallDmds :: Arity -> SubDemand -> SubDemand -mkCallDmds arity sd = iterate mkCallDmd sd !! arity +-- | @mkCalledOnceDmds n d@ returns @CS(CS...(CS d))@ where there are @n@ @CS@'s. +mkCalledOnceDmds :: Arity -> SubDemand -> SubDemand +mkCalledOnceDmds arity sd = iterate mkCalledOnceDmd sd !! arity -- | Peels one call level from the sub-demand, and also returns how many -- times we entered the lambda body. @@ -669,7 +677,7 @@ This is needed even for non-product types, in case the case-binder is used but the components of the case alternative are not. Note [Don't optimise UP(U,U,...) to U] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ These two SubDemands: UP(U,U) (@Prod [topDmd, topDmd]@) and U (@topSubDmd@) are semantically equivalent, but we do not turn the former into @@ -1571,9 +1579,9 @@ This is weird, so I'm not worried about whether this optimises brilliantly; but it should not fall over. -} -zapUsageEnvSig :: StrictSig -> StrictSig --- Remove the usage environment from the demand -zapUsageEnvSig (StrictSig (DmdType _ ds r)) = mkClosedStrictSig ds r +-- | Remove the demand environment from the signature. +zapDmdEnvSig :: StrictSig -> StrictSig +zapDmdEnvSig (StrictSig (DmdType _ ds r)) = mkClosedStrictSig ds r zapUsageDemand :: Demand -> Demand -- Remove the usage info, but not the strictness info, from the demand @@ -1615,8 +1623,8 @@ kill_usage kfs (n :* sd) = kill_usage_card kfs n :* kill_usage_sd kfs sd kill_usage_sd :: KillFlags -> SubDemand -> SubDemand kill_usage_sd kfs (Call n sd) - | kf_called_once kfs = Call (lubCard C_1N n) (kill_usage_sd kfs sd) - | otherwise = Call n (kill_usage_sd kfs sd) + | kf_called_once kfs = mkCall (lubCard C_1N n) (kill_usage_sd kfs sd) + | otherwise = mkCall n (kill_usage_sd kfs sd) kill_usage_sd kfs (Prod ds) = Prod (map (kill_usage kfs) ds) kill_usage_sd _ sd = sd @@ -1640,7 +1648,7 @@ trimToType (n :* sd) ts where go (Prod ds) (TsProd tss) | equalLength ds tss = Prod (zipWith trimToType ds tss) - go (Call n sd) (TsFun ts) = Call n (go sd ts) + go (Call n sd) (TsFun ts) = mkCall n (go sd ts) go sd at Poly{} _ = sd go _ _ = topSubDmd @@ -1804,7 +1812,7 @@ instance Binary SubDemand where h <- getByte bh case h of 0 -> Poly <$> get bh - 1 -> Call <$> get bh <*> get bh + 1 -> mkCall <$> get bh <*> get bh 2 -> Prod <$> get bh _ -> pprPanic "Binary:SubDemand" (ppr (fromIntegral h :: Int)) ===================================== compiler/GHC/Types/Id/Info.hs ===================================== @@ -650,7 +650,7 @@ zapUsageInfo info = Just (info {demandInfo = zapUsageDemand (demandInfo info)}) zapUsageEnvInfo :: IdInfo -> Maybe IdInfo zapUsageEnvInfo info | hasDemandEnvSig (strictnessInfo info) - = Just (info {strictnessInfo = zapUsageEnvSig (strictnessInfo info)}) + = Just (info {strictnessInfo = zapDmdEnvSig (strictnessInfo info)}) | otherwise = Nothing ===================================== testsuite/tests/arityanal/should_compile/Arity11.stderr ===================================== @@ -35,7 +35,7 @@ end Rec } -- RHS size: {terms: 52, types: 28, coercions: 0, joins: 0/5} F11.$wfib [InlPrag=[2]] :: forall {a} {p}. (a -> a -> Bool) -> (Num a, Num p) => a -> p -[GblId, Arity=4, Str=, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 150 60 0] 460 0}] +[GblId, Arity=4, Str=, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 150 60 0] 460 0}] F11.$wfib = \ (@a) (@p) (ww :: a -> a -> Bool) (w :: Num a) (w1 :: Num p) (w2 :: a) -> let { @@ -73,7 +73,7 @@ F11.$wfib fib [InlPrag=[2]] :: forall {a} {p}. (Eq a, Num a, Num p) => a -> p [GblId, Arity=4, - Str=, + Str=, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=4,unsat_ok=True,boring_ok=False) Tmpl= \ (@a) (@p) (w [Occ=Once1!] :: Eq a) (w1 [Occ=Once1] :: Num a) (w2 [Occ=Once1] :: Num p) (w3 [Occ=Once1] :: a) -> case w of { GHC.Classes.C:Eq ww1 [Occ=Once1] _ [Occ=Dead] -> F11.$wfib @a @p ww1 w1 w2 w3 }}] fib = \ (@a) (@p) (w :: Eq a) (w1 :: Num a) (w2 :: Num p) (w3 :: a) -> case w of { GHC.Classes.C:Eq ww1 ww2 -> F11.$wfib @a @p ww1 w1 w2 w3 } ===================================== testsuite/tests/arityanal/should_compile/Arity16.stderr ===================================== @@ -5,7 +5,7 @@ Result size of Tidy Core = {terms: 52, types: 87, coercions: 0, joins: 0/0} Rec { -- RHS size: {terms: 15, types: 17, coercions: 0, joins: 0/0} map2 [Occ=LoopBreaker] :: forall {t} {a}. (t -> a) -> [t] -> [a] -[GblId, Arity=2, Str=, Unf=OtherCon []] +[GblId, Arity=2, Str=, Unf=OtherCon []] map2 = \ (@t) (@a) (f :: t -> a) (ds :: [t]) -> case ds of { ===================================== testsuite/tests/stranal/should_compile/T18894.hs ===================================== @@ -0,0 +1,28 @@ +{-# OPTIONS_GHC -O2 -fforce-recomp #-} + +-- | The point of this test is that @g*@ get's a demand that says +-- "whenever @g*@ is called, the second component of the pair is evaluated strictly". +module T18894 (h1, h2) where + +g1 :: Int -> (Int,Int) +g1 1 = (15, 0) +g1 n = (2 * n, 2 `div` n) +{-# NOINLINE g1 #-} + +h1 :: Int -> Int +h1 1 = 0 +-- Sadly, the @g1 2@ subexpression will be floated to top-level, where we +-- don't see the specific demand placed on it by @snd at . Tracked in #19001. +h1 2 = snd (g1 2) +h1 m = uncurry (+) (g1 m) + +g2 :: Int -> Int -> (Int,Int) +g2 m 1 = (m, 0) +g2 m n = (2 * m, 2 `div` n) +{-# NOINLINE g2 #-} + +h2 :: Int -> Int +h2 1 = 0 +h2 m + | odd m = snd (g2 m 2) + | otherwise = uncurry (+) (g2 2 m) ===================================== testsuite/tests/stranal/should_compile/T18894.stderr ===================================== @@ -0,0 +1,404 @@ + +==================== Demand analysis ==================== +Result size of Demand analysis + = {terms: 177, types: 97, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 36, types: 16, coercions: 0, joins: 0/0} +g2 [InlPrag=NOINLINE, Dmd=UCU(CS(P(1P(U),SP(U))))] + :: Int -> Int -> (Int, Int) +[LclId, + Arity=2, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20 20] 161 20}] +g2 + = \ (m [Dmd=UP(U)] :: Int) (ds [Dmd=SP(SU)] :: Int) -> + case ds of { GHC.Types.I# ds [Dmd=SU] -> + case ds of ds [Dmd=1U] { + __DEFAULT -> + (case m of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.*# 2# y) }, + case ds of wild { + __DEFAULT -> + case GHC.Classes.divInt# 2# wild of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> GHC.Types.I# -2#; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + }); + 1# -> (m, lvl) + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 36, types: 19, coercions: 0, joins: 0/0} +h2 :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 162 10}] +h2 + = \ (ds [Dmd=SP(MU)] :: Int) -> + case ds of wild [Dmd=UP(U)] { GHC.Types.I# ds [Dmd=MU] -> + case ds of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> + case g2 wild lvl of { (ds1 [Dmd=A], y [Dmd=SU]) -> y }; + 0# -> + case g2 lvl wild of { (x [Dmd=SP(U)], ds [Dmd=SP(U)]) -> + case x of { GHC.Types.I# x -> + case ds of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + } + }; + 1# -> lvl + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 15# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +lvl :: (Int, Int) +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = (lvl, lvl) + +-- RHS size: {terms: 30, types: 11, coercions: 0, joins: 0/0} +g1 [InlPrag=NOINLINE, Dmd=UCU(P(UP(U),UP(U)))] :: Int -> (Int, Int) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 141 10}] +g1 + = \ (ds [Dmd=SP(SU)] :: Int) -> + case ds of { GHC.Types.I# ds [Dmd=SU] -> + case ds of ds { + __DEFAULT -> + (GHC.Types.I# (GHC.Prim.*# 2# ds), + case ds of wild { + __DEFAULT -> + case GHC.Classes.divInt# 2# wild of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> GHC.Types.I# -2#; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + }); + 1# -> lvl + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +lvl :: (Int, Int) +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=False, ConLike=False, + WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 30 0}] +lvl = g1 (GHC.Types.I# 2#) + +-- RHS size: {terms: 28, types: 18, coercions: 0, joins: 0/0} +h1 :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 111 10}] +h1 + = \ (ds [Dmd=SP(MU)] :: Int) -> + case ds of wild [Dmd=1P(1U)] { GHC.Types.I# ds [Dmd=MU] -> + case ds of { + __DEFAULT -> + case g1 wild of { (x [Dmd=SP(U)], ds [Dmd=SP(U)]) -> + case x of { GHC.Types.I# x -> + case ds of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + }; + 1# -> lvl; + 2# -> case lvl of { (ds1 [Dmd=A], y [Dmd=SU]) -> y } + } + } + + + + +==================== Demand analysis ==================== +Result size of Demand analysis + = {terms: 171, types: 120, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# -2# + +-- RHS size: {terms: 32, types: 18, coercions: 0, joins: 0/0} +$wg2 [InlPrag=NOINLINE, Dmd=UCU(CS(P(1P(U),SP(U))))] + :: Int -> GHC.Prim.Int# -> (# Int, Int #) +[LclId, + Arity=2, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20 30] 121 20}] +$wg2 + = \ (w [Dmd=UP(U)] :: Int) (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + (# case w of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.*# 2# y) }, + case ds of { + __DEFAULT -> + case GHC.Classes.divInt# 2# ds of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> lvl; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + } #); + 1# -> (# w, lvl #) + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 34, types: 21, coercions: 0, joins: 0/0} +$wh2 [InlPrag=[2]] :: GHC.Prim.Int# -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 162 10}] +$wh2 + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> + case $wg2 (GHC.Types.I# ds) 2# of + { (# ww [Dmd=A], ww [Dmd=SU] #) -> + ww + }; + 0# -> + case $wg2 lvl ds of { (# ww [Dmd=SP(U)], ww [Dmd=SP(U)] #) -> + case ww of { GHC.Types.I# x -> + case ww of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + } + }; + 1# -> lvl + } + +-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} +h2 [InlPrag=[2]] :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (w [Occ=Once1!] :: Int) -> + case w of { GHC.Types.I# ww [Occ=Once1, Dmd=MU] -> $wh2 ww }}] +h2 + = \ (w [Dmd=SP(SU)] :: Int) -> + case w of { GHC.Types.I# ww [Dmd=SU] -> $wh2 ww } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 15# + +-- RHS size: {terms: 28, types: 15, coercions: 0, joins: 0/0} +$wg1 [InlPrag=NOINLINE, Dmd=UCU(P(UP(U),UP(U)))] + :: GHC.Prim.Int# -> (# Int, Int #) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 111 20}] +$wg1 + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + (# GHC.Types.I# (GHC.Prim.*# 2# ds), + case ds of { + __DEFAULT -> + case GHC.Classes.divInt# 2# ds of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> lvl; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + } #); + 1# -> (# lvl, lvl #) + } + +-- RHS size: {terms: 7, types: 9, coercions: 0, joins: 0/0} +lvl :: (Int, Int) +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=False, ConLike=False, + WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 40 10}] +lvl = case $wg1 2# of { (# ww, ww #) -> (ww, ww) } + +-- RHS size: {terms: 25, types: 18, coercions: 0, joins: 0/0} +$wh1 [InlPrag=[2]] :: GHC.Prim.Int# -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [50] 101 10}] +$wh1 + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds [Dmd=1U] { + __DEFAULT -> + case $wg1 ds of { (# ww [Dmd=SP(U)], ww [Dmd=SP(U)] #) -> + case ww of { GHC.Types.I# x -> + case ww of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + }; + 1# -> lvl; + 2# -> case lvl of { (ds1 [Dmd=A], y [Dmd=SU]) -> y } + } + +-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} +h1 [InlPrag=[2]] :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (w [Occ=Once1!] :: Int) -> + case w of { GHC.Types.I# ww [Occ=Once1, Dmd=MU] -> $wh1 ww }}] +h1 + = \ (w [Dmd=SP(SU)] :: Int) -> + case w of { GHC.Types.I# ww [Dmd=SU] -> $wh1 ww } + + + ===================================== testsuite/tests/stranal/should_compile/T18894b.hs ===================================== @@ -0,0 +1,20 @@ +{-# OPTIONS_GHC -O -fno-call-arity -fforce-recomp #-} + +module T18894 (f) where + +expensive :: Int -> (Int, Int) +expensive n = (n+1, n+2) +{-# NOINLINE expensive #-} + +-- arity 1 by itself, but not exported, thus can be eta-expanded based on usage +eta :: Int -> Int -> Int +eta x = if fst (expensive x) == 13 + then \y -> x + y + else \y -> x * y +{-# NOINLINE eta #-} + +f :: Int -> Int +f 1 = 0 +f m + | odd m = eta m 2 + | otherwise = eta 2 m ===================================== testsuite/tests/stranal/should_compile/T18894b.stderr ===================================== @@ -0,0 +1,187 @@ + +==================== Demand analysis ==================== +Result size of Demand analysis = {terms: 83, types: 40, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 16, types: 7, coercions: 0, joins: 0/0} +expensive [InlPrag=NOINLINE, Dmd=UCU(P(SP(SU),A))] :: Int -> (Int, Int) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [40] 52 10}] +expensive + = \ (n [Dmd=UP(U)] :: Int) -> + (case n of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 1#) }, case n of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 2#) }) + +-- RHS size: {terms: 20, types: 11, coercions: 0, joins: 0/0} +eta [InlPrag=NOINLINE, Dmd=UCU(CS(U))] :: Int -> Int -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [0] 140 120}] +eta + = \ (x [Dmd=UP(U)] :: Int) -> + case expensive x of { (x [Dmd=SP(SU)], ds1 [Dmd=A]) -> + case x of { GHC.Types.I# x [Dmd=SU] -> + case x of { + __DEFAULT -> \ (y [Dmd=SP(U)] :: Int) -> GHC.Num.$fNumInt_$c* x y; + 13# -> \ (y [Dmd=SP(U)] :: Int) -> GHC.Num.$fNumInt_$c+ x y + } + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 21, types: 5, coercions: 0, joins: 0/0} +f :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 111 0}] +f = \ (ds [Dmd=SP(MU)] :: Int) -> + case ds of wild [Dmd=UP(U)] { GHC.Types.I# ds [Dmd=MU] -> + case ds of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> eta wild lvl; + 0# -> eta lvl wild + }; + 1# -> lvl + } + } + + + + +==================== Demand analysis ==================== +Result size of Demand analysis = {terms: 85, types: 47, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 16, types: 9, coercions: 0, joins: 0/0} +$wexpensive [InlPrag=NOINLINE, Dmd=UCU(P(SP(SU),A))] :: Int -> (# Int, Int #) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [40] 42 10}] +$wexpensive + = \ (w [Dmd=UP(U)] :: Int) -> + (# case w of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 1#) }, + case w of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 2#) } #) + +-- RHS size: {terms: 19, types: 12, coercions: 0, joins: 0/0} +eta [InlPrag=NOINLINE, Dmd=UCU(CS(U))] :: Int -> Int -> Int +[LclId, + Arity=2, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [0 0] 120 0}] +eta + = \ (x [Dmd=MP(U)] :: Int) (eta [Dmd=SP(U), OS=OneShot] :: Int) -> + case $wexpensive x of { (# ww [Dmd=SP(SU)], ww [Dmd=A] #) -> + case ww of { GHC.Types.I# x [Dmd=SU] -> + case x of { + __DEFAULT -> GHC.Num.$fNumInt_$c* x eta; + 13# -> GHC.Num.$fNumInt_$c+ x eta + } + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 20, types: 3, coercions: 0, joins: 0/0} +$wf [InlPrag=[2]] :: GHC.Prim.Int# -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 121 0}] +$wf + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> eta (GHC.Types.I# ds) lvl; + 0# -> eta lvl (GHC.Types.I# ds) + }; + 1# -> lvl + } + +-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} +f [InlPrag=[2]] :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (w [Occ=Once1!] :: Int) -> case w of { GHC.Types.I# ww [Occ=Once1, Dmd=MU] -> $wf ww }}] +f = \ (w [Dmd=SP(SU)] :: Int) -> case w of { GHC.Types.I# ww [Dmd=SU] -> $wf ww } + + + ===================================== testsuite/tests/stranal/should_compile/all.T ===================================== @@ -58,3 +58,7 @@ test('T18122', [ grep_errmsg(r'wfoo =') ], compile, ['-ddump-simpl']) # We care about the call demand on $wg test('T18903', [ grep_errmsg(r'Dmd=\S+C\S+') ], compile, ['-ddump-simpl -dsuppress-uniques']) +# We care about the call demand on $wg1 and $wg2 +test('T18894', [ grep_errmsg(r'Dmd=\S+C\S+') ], compile, ['-ddump-stranal -dsuppress-uniques']) +# We care about the Arity 2 on eta, as a result of the annotated Dmd +test('T18894b', [ grep_errmsg(r'Arity=2') ], compile, ['-ddump-stranal -dsuppress-uniques -fno-call-arity -dppr-cols=200']) ===================================== testsuite/tests/stranal/sigs/T5075.stderr ===================================== @@ -1,7 +1,7 @@ ==================== Strictness signatures ==================== T5075.$trModule: -T5075.loop: +T5075.loop: @@ -13,6 +13,6 @@ T5075.loop: ==================== Strictness signatures ==================== T5075.$trModule: -T5075.loop: +T5075.loop: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/262324935c4580be01f6d2fe8598447ecc2dc957...09383c87247c471342938b0a119d547e6ea00871 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/262324935c4580be01f6d2fe8598447ecc2dc957...09383c87247c471342938b0a119d547e6ea00871 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 3 22:19:16 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Thu, 03 Dec 2020 17:19:16 -0500 Subject: [Git][ghc/ghc][wip/T18894] 2 commits: DmdAnal: Annotate top-level function bindings with demands (#18894) Message-ID: <5fc964643417e_6a09b047f8155252@gitlab.mail> Sebastian Graf pushed to branch wip/T18894 at Glasgow Haskell Compiler / GHC Commits: e664d78f by Sebastian Graf at 2020-12-03T23:19:05+01:00 DmdAnal: Annotate top-level function bindings with demands (#18894) It's useful to annotate a non-exported top-level function like `g` in ```hs module Lib (h) where g :: Int -> Int -> (Int,Int) g m 1 = (m, 0) g m n = (2 * m, 2 `div` n) {-# NOINLINE g #-} h :: Int -> Int h 1 = 0 h m | odd m = snd (g m 2) | otherwise = uncurry (+) (g 2 m) ``` with its demand `UCU(CS(P(1P(U),SP(U))`, which tells us that whenever `g` was called, the second component of the returned pair was evaluated strictly. Since #18903 we do so for local functions, where we can see all calls. For top-level functions, we can assume that all *exported* functions are demanded according to `topDmd` and thus get sound demands for non-exported top-level functions. The demand on `g` is crucial information for Nested CPR, which may the go on and unbox `g` for the second pair component. That is true even if that pair component may diverge, as is the case for the call site `g 13 0`, which throws a div-by-zero exception. In `T18894b`, you can even see the new demand annotation enabling us to eta-expand a function that we wouldn't be able to eta-expand without Call Arity. We only track bindings of function type in order not to risk huge compile-time regressions, see `isInterestingTopLevelFn`. There was a CoreLint check that rejected strict demand annotations on recursive or top-level bindings, which seems completely unjustified. All the cases I investigated were fine, so I removed it. Fixes #18894. - - - - - 314cbee3 by Sebastian Graf at 2020-12-03T23:19:05+01:00 Demand: Simplify `CU(U)` to `U` (#19005) Both sub-demands encode the same information. This is a trivial change and already affects a few regression tests (e.g. `T5075`), so no separate regression test is necessary. - - - - - 18 changed files: - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Types/Demand.hs - compiler/GHC/Types/Id/Info.hs - testsuite/tests/arityanal/should_compile/Arity11.stderr - testsuite/tests/arityanal/should_compile/Arity16.stderr - + testsuite/tests/stranal/should_compile/T18894.hs - + testsuite/tests/stranal/should_compile/T18894.stderr - + testsuite/tests/stranal/should_compile/T18894b.hs - + testsuite/tests/stranal/should_compile/T18894b.stderr - testsuite/tests/stranal/should_compile/all.T - testsuite/tests/stranal/sigs/T5075.stderr Changes: ===================================== compiler/GHC/Core/FVs.hs ===================================== @@ -525,12 +525,11 @@ ruleLhsFVIds (Rule { ru_bndrs = bndrs, ru_args = args }) = filterFV isLocalId $ addBndrs bndrs (exprs_fvs args) ruleRhsFreeIds :: CoreRule -> VarSet --- ^ This finds all locally-defined free Ids on the left hand side of a rule +-- ^ This finds all locally-defined free Ids on the right hand side of a rule -- and returns them as a non-deterministic set ruleRhsFreeIds (BuiltinRule {}) = emptyVarSet -ruleRhsFreeIds (Rule { ru_bndrs = bndrs, ru_args = args }) - = fvVarSet $ filterFV isLocalId $ - addBndrs bndrs $ exprs_fvs args +ruleRhsFreeIds (Rule { ru_bndrs = bndrs, ru_rhs = rhs }) + = fvVarSet $ filterFV isLocalId $ addBndrs bndrs $ expr_fvs rhs {- Note [Rule free var hack] (Not a hack any more) ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -623,14 +623,6 @@ lintLetBind top_lvl rec_flag binder rhs rhs_ty || exprIsTickedString rhs) (badBndrTyMsg binder (text "unlifted")) - -- Check that if the binder is top-level or recursive, it's not - -- demanded. Primitive string literals are exempt as there is no - -- computation to perform, see Note [Core top-level string literals]. - ; checkL (not (isStrictId binder) - || (isNonRec rec_flag && not (isTopLevel top_lvl)) - || exprIsTickedString rhs) - (mkStrictMsg binder) - -- Check that if the binder is at the top level and has type Addr#, -- that it is a string literal, see -- Note [Core top-level string literals]. @@ -3119,13 +3111,6 @@ badBndrTyMsg binder what = vcat [ text "The type of this binder is" <+> what <> colon <+> ppr binder , text "Binder's type:" <+> ppr (idType binder) ] -mkStrictMsg :: Id -> MsgDoc -mkStrictMsg binder - = vcat [hsep [text "Recursive or top-level binder has strict demand info:", - ppr binder], - hsep [text "Binder's demand info:", ppr (idDemandInfo binder)] - ] - mkNonTopExportedMsg :: Id -> MsgDoc mkNonTopExportedMsg binder = hsep [text "Non-top-level binder is marked as exported:", ppr binder] ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -37,6 +37,7 @@ import GHC.Core.Type import GHC.Core.FVs ( exprFreeIds, ruleRhsFreeIds ) import GHC.Core.Coercion ( Coercion, coVarsOfCo ) import GHC.Core.FamInstEnv +import GHC.Core.Opt.Arity ( typeArity ) import GHC.Utils.Misc import GHC.Utils.Panic import GHC.Data.Maybe ( isJust ) @@ -64,28 +65,54 @@ data DmdAnalOpts = DmdAnalOpts -- -- Note: use `seqBinds` on the result to avoid leaks due to lazyness (cf Note -- [Stamp out space leaks in demand analysis]) -dmdAnalProgram :: DmdAnalOpts -> FamInstEnvs -> CoreProgram -> CoreProgram -dmdAnalProgram opts fam_envs binds = binds_plus_dmds - where - env = emptyAnalEnv opts fam_envs - binds_plus_dmds = snd $ mapAccumL dmdAnalTopBind env binds - --- Analyse a (group of) top-level binding(s) -dmdAnalTopBind :: AnalEnv - -> CoreBind - -> (AnalEnv, CoreBind) -dmdAnalTopBind env (NonRec id rhs) - = ( extendAnalEnv TopLevel env id sig - , NonRec (setIdStrictness id sig) rhs') +dmdAnalProgram :: DmdAnalOpts -> FamInstEnvs -> [CoreRule] -> CoreProgram -> CoreProgram +dmdAnalProgram opts fam_envs rules binds + = snd $ go (emptyAnalEnv opts fam_envs) binds where - ( _, sig, rhs') = dmdAnalRhsLetDown Nothing env topSubDmd id rhs - -dmdAnalTopBind env (Rec pairs) - = (env', Rec pairs') - where - (env', _, pairs') = dmdFix TopLevel env topSubDmd pairs - -- We get two iterations automatically - -- c.f. the NonRec case above + -- See Note [Analysing top-level bindings] + -- TLDR; We analyse them like + -- let ex1 = ... in (ex1, let nex1 = ... in let ex2 = ... in (ex2, ...))) + -- where ex* are exported (or RULE mentions) and nex* are not. + go _ [] = (nopDmdType, []) + go env (b:bs) = cons_up $ dmdAnalBind TopLevel env topSubDmd b anal_body + where + anal_body env' + | (body_ty, bs') <- go env' bs + = (add_exported_uses env' body_ty (bindersOf b), bs') + + cons_up :: (a, b, [b]) -> (a, [b]) + cons_up (dmd_ty, b', bs') = (dmd_ty, b':bs') + + add_exported_uses :: AnalEnv -> DmdType -> [Id] -> DmdType + add_exported_uses env = foldl' (add_exported_use env) + + -- | If @e@ is denoted by @dmd_ty@, then @add_exported_use _ dmd_ty id@ + -- corresponds to the demand type of @(id, e)@, but is a lot more direct. + -- See Note [Analysing top-level bindings]. + add_exported_use :: AnalEnv -> DmdType -> Id -> DmdType + add_exported_use env dmd_ty id + | isExportedId id || elemVarSet id rule_fvs + -- See Note [Absence analysis for stable unfoldings and RULES] + = dmd_ty `plusDmdType` fst (dmdAnalStar env topDmd (Var id)) + | otherwise = dmd_ty + + rule_fvs :: IdSet + rule_fvs = foldr (unionVarSet . ruleRhsFreeIds) emptyVarSet rules + +-- | Whether we want to store demands on a top-level Id or just default +-- to 'topDmd'. +-- +-- Basically, we want to now how top-level *functions* are *used* +-- (e.g. called), but aren't interested in whether they were called strictly +-- or not. Other top-level bindings are boring. +isInterestingTopLevelFn :: Id -> Bool +-- SG tried to set this to True and got a +2% ghc/alloc regression in T5642 +-- (which is dominated by the Simplifier) at no gain in analysis precision. +-- If there was a gain, that regression might be acceptable. +-- Plus, we could use LetUp for thunks and share some code with local let +-- bindings. +isInterestingTopLevelFn id = + typeArity (idType id) `lengthExceeds` 0 {- Note [Stamp out space leaks in demand analysis] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -105,8 +132,56 @@ generation would hold on to an extra copy of the Core program, via unforced thunks in demand or strictness information; and it is the most memory-intensive part of the compilation process, so this added seqBinds makes a big difference in peak memory usage. --} +Note [Analysing top-level bindings] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider a CoreProgram like + e1 = ... + n1 = ... + e2 = \a b -> ... fst (n1 a b) ... + n2 = \c d -> ... snd (e2 c d) ... + ... +where e* are exported, but n* are not. +Intuitively, we can see that @n1@ is only ever called with two arguments +and in every call site, the first component of the result of the call +is evaluated. Thus, we'd like it to have idDemandInfo @UCU(C1(P(SU,A))@. + +(This can be exploited by a Nested CPR pass which may then unbox the +first component of the pair returned from @n1 at . Or if @n1@ had arity +1 before, we may now eta-expand to arity 2.) + +NB: We may *not* give e2 a similar annotation, because it is exported and +external callers might use it in arbitrary ways, expressed by 'topDmd'. + +How do we get this result? Answer: By analysing the program as if it was a let +expression of this form: + let e1 = ... in + (e1, let n1 = ... in + ( let e2 = ... in + (e2, let n2 = ... in + ( ...)))) +E.g. putting all bindings in nested lets, where whenever it binds an exported +binding, the body is a *pair* of an occurrence of the exported binder and +the other nested lets. Of course, we will not actually build that CoreExpr! +Instead we faithfully simulate analysis of said expression by adding the +free variable 'DmdEnv' of @e*@'s strictness signatures to the 'DmdType' we +get from analysing the nested bindings. + +You might also wonder why we didn't analyse in terms of the simpler + let e1 = ... in + let n1 = ... in + let e2 = ... in + let n2 = ... in + (e1,e2, ...) +The reason is analysis performance: If @e1@ uses many free variables, we'll +unnecessarily carry their demands around with us from the moment we analyse +the pair to the moment we bubble back up to the binding for @e1 at . +This blows up e.g. @T10370 at . + +A final note about variables occuring free in RULE RHSs: They are to be handled +pretty much like exported Ids. +See also Note [Absence analysis for stable unfoldings and RULES] +-} {- ************************************************************************ @@ -114,7 +189,103 @@ seqBinds makes a big difference in peak memory usage. \subsection{The analyser itself} * * ************************************************************************ +-} + +-- | Analyse a binding group and its \"body\", e.g. where it is in scope. +-- +-- It calls a function that knows how to analyse this \"body\" given +-- an 'AnalEnv' with updated demand signatures for the binding group +-- (reflecting their 'idStrictnessInfo') and expects to receive a +-- 'DmdType' in return, which it uses to annotate the binding group with their +-- 'idDemandInfo'. +dmdAnalBind + :: TopLevelFlag + -> AnalEnv + -> SubDemand -- ^ Demand put on the "body" + -- (important for join points) + -> CoreBind + -> (AnalEnv -> (DmdType, a)) -- ^ How to analyse the "body", e.g. + -- where the binding is in scope + -> (DmdType, CoreBind, a) +dmdAnalBind top_lvl env dmd bind anal_body = case bind of + NonRec id rhs + | useLetUp top_lvl id + -> dmdAnalBindLetUp top_lvl env id rhs anal_body + _ -> dmdAnalBindLetDown top_lvl env dmd bind anal_body + +-- | Annotates uninteresting top level functions ('isInterestingTopLevelFn') +-- with 'topDmd', the rest with the given demand. +setBindIdDemandInfo :: TopLevelFlag -> Id -> Demand -> Id +setBindIdDemandInfo top_lvl id dmd = setIdDemandInfo id $ case top_lvl of + TopLevel | not (isInterestingTopLevelFn id) -> topDmd + _ -> dmd + +-- | Let bindings can be processed in two ways: +-- Down (RHS before body) or Up (body before RHS). +-- This function handles the up variant. +-- +-- It is very simple. For let x = rhs in body +-- * Demand-analyse 'body' in the current environment +-- * Find the demand, 'rhs_dmd' placed on 'x' by 'body' +-- * Demand-analyse 'rhs' in 'rhs_dmd' +-- +-- This is used for a non-recursive local let without manifest lambdas (see +-- 'useLetUp'). +-- +-- This is the LetUp rule in the paper “Higher-Order Cardinality Analysis”. +dmdAnalBindLetUp :: TopLevelFlag -> AnalEnv -> Id -> CoreExpr -> (AnalEnv -> (DmdType, a)) -> (DmdType, CoreBind, a) +dmdAnalBindLetUp top_lvl env id rhs anal_body = (final_ty, NonRec id' rhs', body') + where + (body_ty, body') = anal_body env + (body_ty', id_dmd) = findBndrDmd env notArgOfDfun body_ty id + id' = setBindIdDemandInfo top_lvl id id_dmd + (rhs_ty, rhs') = dmdAnalStar env (dmdTransformThunkDmd rhs id_dmd) rhs + final_ty = body_ty' `plusDmdType` rhs_ty + +-- | Let bindings can be processed in two ways: +-- Down (RHS before body) or Up (body before RHS). +-- This function handles the down variant. +-- +-- It computes a demand signature (by means of 'dmdAnalRhsSig') and uses +-- that at call sites in the body. +-- +-- It is used for toplevel definitions, recursive definitions and local +-- non-recursive definitions that have manifest lambdas (cf. 'useLetUp'). +-- Local non-recursive definitions without a lambda are handled with LetUp. +-- +-- This is the LetDown rule in the paper “Higher-Order Cardinality Analysis”. +dmdAnalBindLetDown :: TopLevelFlag -> AnalEnv -> SubDemand -> CoreBind -> (AnalEnv -> (DmdType, a)) -> (DmdType, CoreBind, a) +dmdAnalBindLetDown top_lvl env dmd bind anal_body = case bind of + NonRec id rhs + | (env', lazy_fv, id1, rhs1) <- + dmdAnalRhsSig top_lvl NonRecursive env dmd id rhs + -> do_rest env' lazy_fv [(id1, rhs1)] (\[(id2, rhs2)] -> NonRec id2 rhs2) + Rec pairs + | (env', lazy_fv, pairs') <- dmdFix top_lvl env dmd pairs + -> do_rest env' lazy_fv pairs' Rec + where + do_rest env' lazy_fv pairs1 build_bind = (final_ty, build_bind pairs2, body') + where + (body_ty, body') = anal_body env' + -- see Note [Lazy and unleashable free variables] + dmd_ty = addLazyFVs body_ty lazy_fv + (!final_ty, id_dmds) = findBndrsDmds env' dmd_ty (map fst pairs1) + pairs2 = zipWith do_one pairs1 id_dmds + do_one (id', rhs') dmd = (setBindIdDemandInfo top_lvl id' dmd, rhs') + -- If the actual demand is better than the vanilla call + -- demand, you might think that we might do better to re-analyse + -- the RHS with the stronger demand. + -- But (a) That seldom happens, because it means that *every* path in + -- the body of the let has to use that stronger demand + -- (b) It often happens temporarily in when fixpointing, because + -- the recursive function at first seems to place a massive demand. + -- But we don't want to go to extra work when the function will + -- probably iterate to something less demanding. + -- In practice, all the times the actual demand on id2 is more than + -- the vanilla call demand seem to be due to (b). So we don't + -- bother to re-analyse the RHS. +{- Note [Ensure demand is strict] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ It's important not to analyse e with a lazy demand because @@ -194,7 +365,7 @@ dmdAnal' env dmd (App fun arg) -- Crucially, coercions /are/ handled here, because they are -- value arguments (#10288) let - call_dmd = mkCallDmd dmd + call_dmd = mkCalledOnceDmd dmd (fun_ty, fun') = dmdAnal env call_dmd fun (arg_dmd, res_ty) = splitDmdTy fun_ty (arg_ty, arg') = dmdAnalStar env (dmdTransformThunkDmd arg arg_dmd) arg @@ -295,60 +466,11 @@ dmdAnal' env dmd (Case scrut case_bndr ty alts) -- , text "res_ty" <+> ppr res_ty ]) $ (res_ty, Case scrut' case_bndr' ty alts') --- Let bindings can be processed in two ways: --- Down (RHS before body) or Up (body before RHS). --- The following case handle the up variant. --- --- It is very simple. For let x = rhs in body --- * Demand-analyse 'body' in the current environment --- * Find the demand, 'rhs_dmd' placed on 'x' by 'body' --- * Demand-analyse 'rhs' in 'rhs_dmd' --- --- This is used for a non-recursive local let without manifest lambdas. --- This is the LetUp rule in the paper “Higher-Order Cardinality Analysis”. -dmdAnal' env dmd (Let (NonRec id rhs) body) - | useLetUp id - = (final_ty, Let (NonRec id' rhs') body') +dmdAnal' env dmd (Let bind body) + = (final_ty, Let bind' body') where - (body_ty, body') = dmdAnal env dmd body - (body_ty', id_dmd) = findBndrDmd env notArgOfDfun body_ty id - id' = setIdDemandInfo id id_dmd - - (rhs_ty, rhs') = dmdAnalStar env (dmdTransformThunkDmd rhs id_dmd) rhs - final_ty = body_ty' `plusDmdType` rhs_ty - -dmdAnal' env dmd (Let (NonRec id rhs) body) - = (body_ty2, Let (NonRec id2 rhs') body') - where - (lazy_fv, sig, rhs') = dmdAnalRhsLetDown Nothing env dmd id rhs - id1 = setIdStrictness id sig - env1 = extendAnalEnv NotTopLevel env id sig - (body_ty, body') = dmdAnal env1 dmd body - (body_ty1, id2) = annotateBndr env body_ty id1 - body_ty2 = addLazyFVs body_ty1 lazy_fv -- see Note [Lazy and unleashable free variables] - - -- If the actual demand is better than the vanilla call - -- demand, you might think that we might do better to re-analyse - -- the RHS with the stronger demand. - -- But (a) That seldom happens, because it means that *every* path in - -- the body of the let has to use that stronger demand - -- (b) It often happens temporarily in when fixpointing, because - -- the recursive function at first seems to place a massive demand. - -- But we don't want to go to extra work when the function will - -- probably iterate to something less demanding. - -- In practice, all the times the actual demand on id2 is more than - -- the vanilla call demand seem to be due to (b). So we don't - -- bother to re-analyse the RHS. - -dmdAnal' env dmd (Let (Rec pairs) body) - = let - (env', lazy_fv, pairs') = dmdFix NotTopLevel env dmd pairs - (body_ty, body') = dmdAnal env' dmd body - body_ty1 = deleteFVs body_ty (map fst pairs) - body_ty2 = addLazyFVs body_ty1 lazy_fv -- see Note [Lazy and unleashable free variables] - in - body_ty2 `seq` - (body_ty2, Let (Rec pairs') body') + (final_ty, bind', body') = dmdAnalBind NotTopLevel env dmd bind go' + go' env' = dmdAnal env' dmd body -- | A simple, syntactic analysis of whether an expression MAY throw a precise -- exception when evaluated. It's always sound to return 'True'. @@ -582,9 +704,13 @@ dmdTransform env var dmd | Just (sig, top_lvl) <- lookupSigEnv env var , let fn_ty = dmdTransformSig sig dmd = -- pprTrace "dmdTransform:LetDown" (vcat [ppr var, ppr sig, ppr dmd, ppr fn_ty]) $ - if isTopLevel top_lvl - then fn_ty -- Don't record demand on top-level things - else addVarDmd fn_ty var (C_11 :* dmd) + case top_lvl of + NotTopLevel -> addVarDmd fn_ty var (C_11 :* dmd) + TopLevel + | isInterestingTopLevelFn var + -> addVarDmd fn_ty var (C_0N `multDmd` (C_11 :* dmd)) -- discard strictness + | otherwise + -> fn_ty -- don't bother tracking; just annotate with 'topDmd' later -- Everything else: -- * Local let binders for which we use LetUp (cf. 'useLetUp') -- * Lambda binders @@ -599,46 +725,46 @@ dmdTransform env var dmd * * ********************************************************************* -} --- Let bindings can be processed in two ways: --- Down (RHS before body) or Up (body before RHS). --- dmdAnalRhsLetDown implements the Down variant: --- * assuming a demand of +-- | @dmdAnalRhsSig@ analyses the given RHS to compute a demand signature +-- for the LetDown rule. It works as follows: +-- +-- * assuming a demand of -- * looking at the definition -- * determining a strictness signature -- --- It is used for toplevel definition, recursive definitions and local --- non-recursive definitions that have manifest lambdas. --- Local non-recursive definitions without a lambda are handled with LetUp. --- --- This is the LetDown rule in the paper “Higher-Order Cardinality Analysis”. -dmdAnalRhsLetDown - :: Maybe [Id] -- Just bs <=> recursive, Nothing <=> non-recursive +-- Since it assumed a demand of , the resulting signature is applicable at +-- any call site. +dmdAnalRhsSig + :: TopLevelFlag + -> RecFlag -> AnalEnv -> SubDemand -> Id -> CoreExpr - -> (DmdEnv, StrictSig, CoreExpr) + -> (AnalEnv, DmdEnv, Id, CoreExpr) -- Process the RHS of the binding, add the strictness signature -- to the Id, and augment the environment with the signature as well. -- See Note [NOINLINE and strictness] -dmdAnalRhsLetDown rec_flag env let_dmd id rhs - = -- pprTrace "dmdAnalRhsLetDown" (ppr id $$ ppr let_dmd $$ ppr sig $$ ppr lazy_fv) $ - (lazy_fv, sig, rhs') +dmdAnalRhsSig top_lvl rec_flag env let_dmd id rhs + = -- pprTrace "dmdAnalRhsSig" (ppr id $$ ppr let_dmd $$ ppr sig $$ ppr lazy_fv) $ + (env', lazy_fv, id', rhs') where rhs_arity = idArity id + -- See Note [Demand signatures are computed for a threshold demand based on idArity] rhs_dmd -- See Note [Demand analysis for join points] -- See Note [Invariants on join points] invariant 2b, in GHC.Core -- rhs_arity matches the join arity of the join point | isJoinId id - = mkCallDmds rhs_arity let_dmd + = mkCalledOnceDmds rhs_arity let_dmd | otherwise - -- NB: rhs_arity - -- See Note [Demand signatures are computed for a threshold demand based on idArity] - = mkRhsDmd env rhs_arity rhs + = mkCalledOnceDmds rhs_arity topSubDmd (rhs_dmd_ty, rhs') = dmdAnal env rhs_dmd rhs DmdType rhs_fv rhs_dmds rhs_div = rhs_dmd_ty sig = mkStrictSigForArity rhs_arity (DmdType sig_fv rhs_dmds rhs_div) + id' = id `setIdStrictness` sig + env' = extendAnalEnv top_lvl env id' sig + -- See Note [Aggregated demand for cardinality] -- FIXME: That Note doesn't explain the following lines at all. The reason -- is really much different: When we have a recursive function, we'd @@ -651,8 +777,8 @@ dmdAnalRhsLetDown rec_flag env let_dmd id rhs -- we'd have to do an additional iteration. reuseEnv makes sure that -- we never get used-once info for FVs of recursive functions. rhs_fv1 = case rec_flag of - Just bs -> reuseEnv (delVarEnvList rhs_fv bs) - Nothing -> rhs_fv + Recursive -> reuseEnv rhs_fv + NonRecursive -> rhs_fv rhs_fv2 = rhs_fv1 `keepAliveDmdEnv` extra_fvs -- Find the RHS free vars of the unfoldings and RULES @@ -669,13 +795,6 @@ dmdAnalRhsLetDown rec_flag env let_dmd id rhs = exprFreeIds unf_body | otherwise = emptyVarSet --- | @mkRhsDmd env rhs_arity rhs@ creates a 'SubDemand' for --- unleashing on the given function's @rhs@, by creating --- a call demand of @rhs_arity@ --- See Historical Note [Product demands for function body] -mkRhsDmd :: AnalEnv -> Arity -> CoreExpr -> SubDemand -mkRhsDmd _env rhs_arity _rhs = mkCallDmds rhs_arity topSubDmd - -- | If given the (local, non-recursive) let-bound 'Id', 'useLetUp' determines -- whether we should process the binding up (body before rhs) or down (rhs -- before body). @@ -720,8 +839,8 @@ mkRhsDmd _env rhs_arity _rhs = mkCallDmds rhs_arity topSubDmd -- * For a more convincing example with join points, see Note [Demand analysis -- for join points]. -- -useLetUp :: Var -> Bool -useLetUp f = idArity f == 0 && not (isJoinId f) +useLetUp :: TopLevelFlag -> Var -> Bool +useLetUp top_lvl f = isNotTopLevel top_lvl && idArity f == 0 && not (isJoinId f) {- Note [Demand analysis for join points] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -939,8 +1058,6 @@ dmdFix :: TopLevelFlag dmdFix top_lvl env let_dmd orig_pairs = loop 1 initial_pairs where - bndrs = map fst orig_pairs - -- See Note [Initialising strictness] initial_pairs | ae_virgin env = [(setIdStrictness id botSig, rhs) | (id, rhs) <- orig_pairs ] | otherwise = orig_pairs @@ -990,10 +1107,8 @@ dmdFix top_lvl env let_dmd orig_pairs = -- pprTrace "my_downRhs" (ppr id $$ ppr (idStrictness id) $$ ppr sig) $ ((env', lazy_fv'), (id', rhs')) where - (lazy_fv1, sig, rhs') = dmdAnalRhsLetDown (Just bndrs) env let_dmd id rhs - lazy_fv' = plusVarEnv_C plusDmd lazy_fv lazy_fv1 - env' = extendAnalEnv top_lvl env id sig - id' = setIdStrictness id sig + (env', lazy_fv1, id', rhs') = dmdAnalRhsSig top_lvl Recursive env let_dmd id rhs + lazy_fv' = plusVarEnv_C plusDmd lazy_fv lazy_fv1 zapIdStrictness :: [(Id, CoreExpr)] -> [(Id, CoreExpr)] zapIdStrictness pairs = [(setIdStrictness id nopSig, rhs) | (id, rhs) <- pairs ] @@ -1090,7 +1205,7 @@ addLazyFVs dmd_ty lazy_fvs -- demand with the bottom coming up from 'error' -- -- I got a loop in the fixpointer without this, due to an interaction - -- with the lazy_fv filtering in dmdAnalRhsLetDown. Roughly, it was + -- with the lazy_fv filtering in dmdAnalRhsSig. Roughly, it was -- letrec f n x -- = letrec g y = x `fatbar` -- letrec h z = z + ...g... @@ -1156,10 +1271,6 @@ annotateLamIdBndr env arg_of_dfun dmd_ty id main_ty = addDemand dmd dmd_ty' (dmd_ty', dmd) = findBndrDmd env arg_of_dfun dmd_ty id -deleteFVs :: DmdType -> [Var] -> DmdType -deleteFVs (DmdType fvs dmds res) bndrs - = DmdType (delVarEnvList fvs bndrs) dmds res - {- Note [NOINLINE and strictness] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Core/Opt/Pipeline.hs ===================================== @@ -65,6 +65,7 @@ import GHC.Types.SrcLoc import GHC.Types.Id import GHC.Types.Id.Info import GHC.Types.Basic +import GHC.Types.Demand ( zapDmdEnvSig ) import GHC.Types.Var.Set import GHC.Types.Var.Env import GHC.Types.Unique.Supply ( UniqSupply, mkSplitUniqSupply, splitUniqSupply ) @@ -495,7 +496,7 @@ doCorePass CoreDoExitify = {-# SCC "Exitify" #-} doPass exitifyProgram doCorePass CoreDoDemand = {-# SCC "DmdAnal" #-} - doPassDFM dmdAnal + doPassDFRM dmdAnal doCorePass CoreDoCpr = {-# SCC "CprAnal" #-} doPassDFM cprAnalProgram @@ -575,6 +576,13 @@ doPassDFM do_pass guts = do let fam_envs = (p_fam_env, mg_fam_inst_env guts) doPassM (liftIO . do_pass dflags fam_envs) guts +doPassDFRM :: (DynFlags -> FamInstEnvs -> [CoreRule] -> CoreProgram -> IO CoreProgram) -> ModGuts -> CoreM ModGuts +doPassDFRM do_pass guts = do + dflags <- getDynFlags + p_fam_env <- getPackageFamInstEnv + let fam_envs = (p_fam_env, mg_fam_inst_env guts) + doPassM (liftIO . do_pass dflags fam_envs (mg_rules guts)) guts + doPassDFU :: (DynFlags -> FamInstEnvs -> UniqSupply -> CoreProgram -> CoreProgram) -> ModGuts -> CoreM ModGuts doPassDFU do_pass guts = do dflags <- getDynFlags @@ -1088,13 +1096,13 @@ transferIdInfo exported_id local_id -dmdAnal :: DynFlags -> FamInstEnvs -> CoreProgram -> IO CoreProgram -dmdAnal dflags fam_envs binds = do +dmdAnal :: DynFlags -> FamInstEnvs -> [CoreRule] -> CoreProgram -> IO CoreProgram +dmdAnal dflags fam_envs rules binds = do let opts = DmdAnalOpts { dmd_strict_dicts = gopt Opt_DictsStrict dflags } - binds_plus_dmds = dmdAnalProgram opts fam_envs binds + binds_plus_dmds = dmdAnalProgram opts fam_envs rules binds Err.dumpIfSet_dyn dflags Opt_D_dump_str_signatures "Strictness signatures" FormatText $ - dumpIdInfoOfProgram (ppr . strictnessInfo) binds_plus_dmds + dumpIdInfoOfProgram (ppr . zapDmdEnvSig . strictnessInfo) binds_plus_dmds -- See Note [Stamp out space leaks in demand analysis] in GHC.Core.Opt.DmdAnal seqBinds binds_plus_dmds `seq` return binds_plus_dmds ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -598,11 +598,10 @@ addJoinFlts = appOL mkRecFloats :: SimplFloats -> SimplFloats -- Flattens the floats into a single Rec group, -- They must either all be lifted LetFloats or all JoinFloats -mkRecFloats floats@(SimplFloats { sfLetFloats = LetFloats bs ff +mkRecFloats floats@(SimplFloats { sfLetFloats = LetFloats bs _ff , sfJoinFloats = jbs , sfInScope = in_scope }) - = ASSERT2( case ff of { FltLifted -> True; _ -> False }, ppr (fromOL bs) ) - ASSERT2( isNilOL bs || isNilOL jbs, ppr floats ) + = ASSERT2( isNilOL bs || isNilOL jbs, ppr floats ) SimplFloats { sfLetFloats = floats' , sfJoinFloats = jfloats' , sfInScope = in_scope } ===================================== compiler/GHC/Core/Opt/WorkWrap.hs ===================================== @@ -484,7 +484,7 @@ tryWW dflags fam_envs is_rec fn_id rhs | is_fun && is_eta_exp = splitFun dflags fam_envs new_fn_id fn_info wrap_dmds div cpr rhs - | is_thunk -- See Note [Thunk splitting] + | isNonRec is_rec, is_thunk -- See Note [Thunk splitting] = splitThunk dflags fam_envs is_rec new_fn_id rhs | otherwise ===================================== compiler/GHC/Core/Opt/WorkWrap/Utils.hs ===================================== @@ -1275,10 +1275,14 @@ mk_absent_let dflags fam_envs arg abs_rhs = mkAbsentErrorApp arg_ty msg msg = showSDoc (gopt_set dflags Opt_SuppressUniques) - (ppr arg <+> ppr (idType arg) <+> file_msg) + (vcat + [ text "Arg:" <+> ppr arg + , text "Type:" <+> ppr arg_ty + , file_msg + ]) file_msg = case outputFile dflags of Nothing -> empty - Just f -> text "in output file " <+> quotes (text f) + Just f -> text "In output file " <+> quotes (text f) -- We need to suppress uniques here because otherwise they'd -- end up in the generated code as strings. This is bad for -- determinism, because with different uniques the strings ===================================== compiler/GHC/Core/Tidy.hs ===================================== @@ -21,7 +21,7 @@ import GHC.Core import GHC.Core.Seq ( seqUnfolding ) import GHC.Types.Id import GHC.Types.Id.Info -import GHC.Types.Demand ( zapUsageEnvSig ) +import GHC.Types.Demand ( zapDmdEnvSig ) import GHC.Core.Type ( tidyType, tidyVarBndr ) import GHC.Core.Coercion ( tidyCo ) import GHC.Types.Var @@ -206,7 +206,7 @@ tidyLetBndr rec_tidy_env env@(tidy_env, var_env) id new_info = vanillaIdInfo `setOccInfo` occInfo old_info `setArityInfo` arityInfo old_info - `setStrictnessInfo` zapUsageEnvSig (strictnessInfo old_info) + `setStrictnessInfo` zapDmdEnvSig (strictnessInfo old_info) `setDemandInfo` demandInfo old_info `setInlinePragInfo` inlinePragInfo old_info `setUnfoldingInfo` new_unf ===================================== compiler/GHC/Types/Demand.hs ===================================== @@ -34,7 +34,7 @@ module GHC.Types.Demand ( lazyApply1Dmd, lazyApply2Dmd, strictOnceApply1Dmd, strictManyApply1Dmd, -- ** Other @Demand@ operations oneifyCard, oneifyDmd, strictifyDmd, strictifyDictDmd, mkWorkerDemand, - peelCallDmd, peelManyCalls, mkCallDmd, mkCallDmds, + peelCallDmd, peelManyCalls, mkCalledOnceDmd, mkCalledOnceDmds, addCaseBndrDmd, -- ** Extracting one-shot information argOneShots, argsOneShots, saturatedByOneShots, @@ -73,7 +73,7 @@ module GHC.Types.Demand ( seqDemand, seqDemandList, seqDmdType, seqStrictSig, -- * Zapping usage information - zapUsageDemand, zapUsageEnvSig, zapUsedOnceDemand, zapUsedOnceSig + zapUsageDemand, zapDmdEnvSig, zapUsedOnceDemand, zapUsedOnceSig ) where #include "HsVersions.h" @@ -278,7 +278,8 @@ data SubDemand -- ^ @Call n sd@ describes the evaluation context of @n@ function -- applications, where every individual result is evaluated according to @sd at . -- @sd@ is /relative/ to a single call, cf. Note [Call demands are relative]. - -- Used only for values of function type. + -- Used only for values of function type. Use the smart constructor 'mkCall' + -- whenever possible! | Prod ![Demand] -- ^ @Prod ds@ describes the evaluation context of a case scrutinisation -- on an expression of product type, where the product components are @@ -306,7 +307,7 @@ polyDmd C_1N = C_1N :* poly1N polyDmd C_10 = C_10 :* poly10 -- | A smart constructor for 'Prod', applying rewrite rules along the semantic --- equalities @Prod [polyDmd n, ...] === polyDmd n@, simplifying to 'Poly' +-- equality @Prod [polyDmd n, ...] === polyDmd n@, simplifying to 'Poly' -- 'SubDemand's when possible. Note that this degrades boxity information! E.g. a -- polymorphic demand will never unbox. mkProd :: [Demand] -> SubDemand @@ -335,6 +336,13 @@ viewProd _ _ = Nothing {-# INLINE viewProd #-} -- we want to fuse away the replicate and the allocation -- for Arity. Otherwise, #18304 bites us. +-- | A smart constructor for 'Call', applying rewrite rules along the semantic +-- equality @Call n (Poly n) === Poly n@, simplifying to 'Poly' 'SubDemand's +-- when possible. +mkCall :: Card -> SubDemand -> SubDemand +mkCall n cd@(Poly m) | n == m = cd +mkCall n cd = Call n cd + -- | @viewCall sd@ interprets @sd@ as a 'Call', expanding 'Poly' demands as -- necessary. viewCall :: SubDemand -> Maybe (Card, SubDemand) @@ -356,8 +364,8 @@ lubSubDmd (Prod ds1) (viewProd (length ds1) -> Just ds2) = -- Handle Call lubSubDmd (Call n1 d1) (viewCall -> Just (n2, d2)) -- See Note [Call demands are relative] - | isAbs n2 = Call (lubCard n1 n2) (lubSubDmd d1 botSubDmd) - | otherwise = Call (lubCard n1 n2) (lubSubDmd d1 d2) + | isAbs n2 = mkCall (lubCard n1 n2) (lubSubDmd d1 botSubDmd) + | otherwise = mkCall (lubCard n1 n2) (lubSubDmd d1 d2) -- Handle Poly lubSubDmd (Poly n1) (Poly n2) = Poly (lubCard n1 n2) -- Make use of reflexivity (so we'll match the Prod or Call cases again). @@ -377,8 +385,8 @@ plusSubDmd (Prod ds1) (viewProd (length ds1) -> Just ds2) = -- Handle Call plusSubDmd (Call n1 d1) (viewCall -> Just (n2, d2)) -- See Note [Call demands are relative] - | isAbs n2 = Call (plusCard n1 n2) (lubSubDmd d1 botSubDmd) - | otherwise = Call (plusCard n1 n2) (lubSubDmd d1 d2) + | isAbs n2 = mkCall (plusCard n1 n2) (lubSubDmd d1 botSubDmd) + | otherwise = mkCall (plusCard n1 n2) (lubSubDmd d1 d2) -- Handle Poly plusSubDmd (Poly n1) (Poly n2) = Poly (plusCard n1 n2) -- Make use of reflexivity (so we'll match the Prod or Call cases again). @@ -407,7 +415,7 @@ multSubDmd :: Card -> SubDemand -> SubDemand multSubDmd n sd | Just sd' <- multTrivial n seqSubDmd sd = sd' multSubDmd n (Poly n') = Poly (multCard n n') -multSubDmd n (Call n' sd) = Call (multCard n n') sd -- See Note [Call demands are relative] +multSubDmd n (Call n' sd) = mkCall (multCard n n') sd -- See Note [Call demands are relative] multSubDmd n (Prod ds) = Prod (map (multDmd n) ds) multDmd :: Card -> Demand -> Demand @@ -457,22 +465,22 @@ evalDmd = C_1N :* topSubDmd -- | First argument of 'GHC.Exts.maskAsyncExceptions#': @SCS(U)@. -- Called exactly once. strictOnceApply1Dmd :: Demand -strictOnceApply1Dmd = C_11 :* Call C_11 topSubDmd +strictOnceApply1Dmd = C_11 :* mkCall C_11 topSubDmd -- | First argument of 'GHC.Exts.atomically#': @MCM(U)@. -- Called at least once, possibly many times. strictManyApply1Dmd :: Demand -strictManyApply1Dmd = C_1N :* Call C_1N topSubDmd +strictManyApply1Dmd = C_1N :* mkCall C_1N topSubDmd -- | First argument of catch#: @1C1(U)@. -- Evaluates its arg lazily, but then applies it exactly once to one argument. lazyApply1Dmd :: Demand -lazyApply1Dmd = C_01 :* Call C_01 topSubDmd +lazyApply1Dmd = C_01 :* mkCall C_01 topSubDmd -- | Second argument of catch#: @1C1(CS(U))@. -- Calls its arg lazily, but then applies it exactly once to an additional argument. lazyApply2Dmd :: Demand -lazyApply2Dmd = C_01 :* Call C_01 (Call C_11 topSubDmd) +lazyApply2Dmd = C_01 :* mkCall C_01 (mkCall C_11 topSubDmd) -- | Make a 'Demand' evaluated at-most-once. oneifyDmd :: Demand -> Demand @@ -512,12 +520,12 @@ strictifyDictDmd ty (n :* Prod ds) strictifyDictDmd _ dmd = dmd -- | Wraps the 'SubDemand' with a one-shot call demand: @d@ -> @CS(d)@. -mkCallDmd :: SubDemand -> SubDemand -mkCallDmd sd = Call C_11 sd +mkCalledOnceDmd :: SubDemand -> SubDemand +mkCalledOnceDmd sd = mkCall C_11 sd --- | @mkCallDmds n d@ returns @CS(CS...(CS d))@ where there are @n@ @CS@'s. -mkCallDmds :: Arity -> SubDemand -> SubDemand -mkCallDmds arity sd = iterate mkCallDmd sd !! arity +-- | @mkCalledOnceDmds n d@ returns @CS(CS...(CS d))@ where there are @n@ @CS@'s. +mkCalledOnceDmds :: Arity -> SubDemand -> SubDemand +mkCalledOnceDmds arity sd = iterate mkCalledOnceDmd sd !! arity -- | Peels one call level from the sub-demand, and also returns how many -- times we entered the lambda body. @@ -669,7 +677,7 @@ This is needed even for non-product types, in case the case-binder is used but the components of the case alternative are not. Note [Don't optimise UP(U,U,...) to U] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ These two SubDemands: UP(U,U) (@Prod [topDmd, topDmd]@) and U (@topSubDmd@) are semantically equivalent, but we do not turn the former into @@ -1571,9 +1579,9 @@ This is weird, so I'm not worried about whether this optimises brilliantly; but it should not fall over. -} -zapUsageEnvSig :: StrictSig -> StrictSig --- Remove the usage environment from the demand -zapUsageEnvSig (StrictSig (DmdType _ ds r)) = mkClosedStrictSig ds r +-- | Remove the demand environment from the signature. +zapDmdEnvSig :: StrictSig -> StrictSig +zapDmdEnvSig (StrictSig (DmdType _ ds r)) = mkClosedStrictSig ds r zapUsageDemand :: Demand -> Demand -- Remove the usage info, but not the strictness info, from the demand @@ -1615,8 +1623,8 @@ kill_usage kfs (n :* sd) = kill_usage_card kfs n :* kill_usage_sd kfs sd kill_usage_sd :: KillFlags -> SubDemand -> SubDemand kill_usage_sd kfs (Call n sd) - | kf_called_once kfs = Call (lubCard C_1N n) (kill_usage_sd kfs sd) - | otherwise = Call n (kill_usage_sd kfs sd) + | kf_called_once kfs = mkCall (lubCard C_1N n) (kill_usage_sd kfs sd) + | otherwise = mkCall n (kill_usage_sd kfs sd) kill_usage_sd kfs (Prod ds) = Prod (map (kill_usage kfs) ds) kill_usage_sd _ sd = sd @@ -1640,7 +1648,7 @@ trimToType (n :* sd) ts where go (Prod ds) (TsProd tss) | equalLength ds tss = Prod (zipWith trimToType ds tss) - go (Call n sd) (TsFun ts) = Call n (go sd ts) + go (Call n sd) (TsFun ts) = mkCall n (go sd ts) go sd at Poly{} _ = sd go _ _ = topSubDmd @@ -1804,7 +1812,7 @@ instance Binary SubDemand where h <- getByte bh case h of 0 -> Poly <$> get bh - 1 -> Call <$> get bh <*> get bh + 1 -> mkCall <$> get bh <*> get bh 2 -> Prod <$> get bh _ -> pprPanic "Binary:SubDemand" (ppr (fromIntegral h :: Int)) ===================================== compiler/GHC/Types/Id/Info.hs ===================================== @@ -650,7 +650,7 @@ zapUsageInfo info = Just (info {demandInfo = zapUsageDemand (demandInfo info)}) zapUsageEnvInfo :: IdInfo -> Maybe IdInfo zapUsageEnvInfo info | hasDemandEnvSig (strictnessInfo info) - = Just (info {strictnessInfo = zapUsageEnvSig (strictnessInfo info)}) + = Just (info {strictnessInfo = zapDmdEnvSig (strictnessInfo info)}) | otherwise = Nothing ===================================== testsuite/tests/arityanal/should_compile/Arity11.stderr ===================================== @@ -35,7 +35,7 @@ end Rec } -- RHS size: {terms: 52, types: 28, coercions: 0, joins: 0/5} F11.$wfib [InlPrag=[2]] :: forall {a} {p}. (a -> a -> Bool) -> (Num a, Num p) => a -> p -[GblId, Arity=4, Str=, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 150 60 0] 460 0}] +[GblId, Arity=4, Str=, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 150 60 0] 460 0}] F11.$wfib = \ (@a) (@p) (ww :: a -> a -> Bool) (w :: Num a) (w1 :: Num p) (w2 :: a) -> let { @@ -73,7 +73,7 @@ F11.$wfib fib [InlPrag=[2]] :: forall {a} {p}. (Eq a, Num a, Num p) => a -> p [GblId, Arity=4, - Str=, + Str=, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=4,unsat_ok=True,boring_ok=False) Tmpl= \ (@a) (@p) (w [Occ=Once1!] :: Eq a) (w1 [Occ=Once1] :: Num a) (w2 [Occ=Once1] :: Num p) (w3 [Occ=Once1] :: a) -> case w of { GHC.Classes.C:Eq ww1 [Occ=Once1] _ [Occ=Dead] -> F11.$wfib @a @p ww1 w1 w2 w3 }}] fib = \ (@a) (@p) (w :: Eq a) (w1 :: Num a) (w2 :: Num p) (w3 :: a) -> case w of { GHC.Classes.C:Eq ww1 ww2 -> F11.$wfib @a @p ww1 w1 w2 w3 } ===================================== testsuite/tests/arityanal/should_compile/Arity16.stderr ===================================== @@ -5,7 +5,7 @@ Result size of Tidy Core = {terms: 52, types: 87, coercions: 0, joins: 0/0} Rec { -- RHS size: {terms: 15, types: 17, coercions: 0, joins: 0/0} map2 [Occ=LoopBreaker] :: forall {t} {a}. (t -> a) -> [t] -> [a] -[GblId, Arity=2, Str=, Unf=OtherCon []] +[GblId, Arity=2, Str=, Unf=OtherCon []] map2 = \ (@t) (@a) (f :: t -> a) (ds :: [t]) -> case ds of { ===================================== testsuite/tests/stranal/should_compile/T18894.hs ===================================== @@ -0,0 +1,28 @@ +{-# OPTIONS_GHC -O2 -fforce-recomp #-} + +-- | The point of this test is that @g*@ get's a demand that says +-- "whenever @g*@ is called, the second component of the pair is evaluated strictly". +module T18894 (h1, h2) where + +g1 :: Int -> (Int,Int) +g1 1 = (15, 0) +g1 n = (2 * n, 2 `div` n) +{-# NOINLINE g1 #-} + +h1 :: Int -> Int +h1 1 = 0 +-- Sadly, the @g1 2@ subexpression will be floated to top-level, where we +-- don't see the specific demand placed on it by @snd at . Tracked in #19001. +h1 2 = snd (g1 2) +h1 m = uncurry (+) (g1 m) + +g2 :: Int -> Int -> (Int,Int) +g2 m 1 = (m, 0) +g2 m n = (2 * m, 2 `div` n) +{-# NOINLINE g2 #-} + +h2 :: Int -> Int +h2 1 = 0 +h2 m + | odd m = snd (g2 m 2) + | otherwise = uncurry (+) (g2 2 m) ===================================== testsuite/tests/stranal/should_compile/T18894.stderr ===================================== @@ -0,0 +1,404 @@ + +==================== Demand analysis ==================== +Result size of Demand analysis + = {terms: 177, types: 97, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 36, types: 16, coercions: 0, joins: 0/0} +g2 [InlPrag=NOINLINE, Dmd=UCU(CS(P(1P(U),SP(U))))] + :: Int -> Int -> (Int, Int) +[LclId, + Arity=2, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20 20] 161 20}] +g2 + = \ (m [Dmd=UP(U)] :: Int) (ds [Dmd=SP(SU)] :: Int) -> + case ds of { GHC.Types.I# ds [Dmd=SU] -> + case ds of ds [Dmd=1U] { + __DEFAULT -> + (case m of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.*# 2# y) }, + case ds of wild { + __DEFAULT -> + case GHC.Classes.divInt# 2# wild of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> GHC.Types.I# -2#; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + }); + 1# -> (m, lvl) + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 36, types: 19, coercions: 0, joins: 0/0} +h2 :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 162 10}] +h2 + = \ (ds [Dmd=SP(MU)] :: Int) -> + case ds of wild [Dmd=UP(U)] { GHC.Types.I# ds [Dmd=MU] -> + case ds of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> + case g2 wild lvl of { (ds1 [Dmd=A], y [Dmd=SU]) -> y }; + 0# -> + case g2 lvl wild of { (x [Dmd=SP(U)], ds [Dmd=SP(U)]) -> + case x of { GHC.Types.I# x -> + case ds of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + } + }; + 1# -> lvl + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 15# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +lvl :: (Int, Int) +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = (lvl, lvl) + +-- RHS size: {terms: 30, types: 11, coercions: 0, joins: 0/0} +g1 [InlPrag=NOINLINE, Dmd=UCU(P(UP(U),UP(U)))] :: Int -> (Int, Int) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 141 10}] +g1 + = \ (ds [Dmd=SP(SU)] :: Int) -> + case ds of { GHC.Types.I# ds [Dmd=SU] -> + case ds of ds { + __DEFAULT -> + (GHC.Types.I# (GHC.Prim.*# 2# ds), + case ds of wild { + __DEFAULT -> + case GHC.Classes.divInt# 2# wild of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> GHC.Types.I# -2#; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + }); + 1# -> lvl + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +lvl :: (Int, Int) +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=False, ConLike=False, + WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 30 0}] +lvl = g1 (GHC.Types.I# 2#) + +-- RHS size: {terms: 28, types: 18, coercions: 0, joins: 0/0} +h1 :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 111 10}] +h1 + = \ (ds [Dmd=SP(MU)] :: Int) -> + case ds of wild [Dmd=1P(1U)] { GHC.Types.I# ds [Dmd=MU] -> + case ds of { + __DEFAULT -> + case g1 wild of { (x [Dmd=SP(U)], ds [Dmd=SP(U)]) -> + case x of { GHC.Types.I# x -> + case ds of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + }; + 1# -> lvl; + 2# -> case lvl of { (ds1 [Dmd=A], y [Dmd=SU]) -> y } + } + } + + + + +==================== Demand analysis ==================== +Result size of Demand analysis + = {terms: 171, types: 120, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# -2# + +-- RHS size: {terms: 32, types: 18, coercions: 0, joins: 0/0} +$wg2 [InlPrag=NOINLINE, Dmd=UCU(CS(P(1P(U),SP(U))))] + :: Int -> GHC.Prim.Int# -> (# Int, Int #) +[LclId, + Arity=2, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20 30] 121 20}] +$wg2 + = \ (w [Dmd=UP(U)] :: Int) (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + (# case w of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.*# 2# y) }, + case ds of { + __DEFAULT -> + case GHC.Classes.divInt# 2# ds of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> lvl; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + } #); + 1# -> (# w, lvl #) + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 34, types: 21, coercions: 0, joins: 0/0} +$wh2 [InlPrag=[2]] :: GHC.Prim.Int# -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 162 10}] +$wh2 + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> + case $wg2 (GHC.Types.I# ds) 2# of + { (# ww [Dmd=A], ww [Dmd=SU] #) -> + ww + }; + 0# -> + case $wg2 lvl ds of { (# ww [Dmd=SP(U)], ww [Dmd=SP(U)] #) -> + case ww of { GHC.Types.I# x -> + case ww of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + } + }; + 1# -> lvl + } + +-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} +h2 [InlPrag=[2]] :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (w [Occ=Once1!] :: Int) -> + case w of { GHC.Types.I# ww [Occ=Once1, Dmd=MU] -> $wh2 ww }}] +h2 + = \ (w [Dmd=SP(SU)] :: Int) -> + case w of { GHC.Types.I# ww [Dmd=SU] -> $wh2 ww } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 15# + +-- RHS size: {terms: 28, types: 15, coercions: 0, joins: 0/0} +$wg1 [InlPrag=NOINLINE, Dmd=UCU(P(UP(U),UP(U)))] + :: GHC.Prim.Int# -> (# Int, Int #) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 111 20}] +$wg1 + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + (# GHC.Types.I# (GHC.Prim.*# 2# ds), + case ds of { + __DEFAULT -> + case GHC.Classes.divInt# 2# ds of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> lvl; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + } #); + 1# -> (# lvl, lvl #) + } + +-- RHS size: {terms: 7, types: 9, coercions: 0, joins: 0/0} +lvl :: (Int, Int) +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=False, ConLike=False, + WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 40 10}] +lvl = case $wg1 2# of { (# ww, ww #) -> (ww, ww) } + +-- RHS size: {terms: 25, types: 18, coercions: 0, joins: 0/0} +$wh1 [InlPrag=[2]] :: GHC.Prim.Int# -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [50] 101 10}] +$wh1 + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds [Dmd=1U] { + __DEFAULT -> + case $wg1 ds of { (# ww [Dmd=SP(U)], ww [Dmd=SP(U)] #) -> + case ww of { GHC.Types.I# x -> + case ww of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + }; + 1# -> lvl; + 2# -> case lvl of { (ds1 [Dmd=A], y [Dmd=SU]) -> y } + } + +-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} +h1 [InlPrag=[2]] :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (w [Occ=Once1!] :: Int) -> + case w of { GHC.Types.I# ww [Occ=Once1, Dmd=MU] -> $wh1 ww }}] +h1 + = \ (w [Dmd=SP(SU)] :: Int) -> + case w of { GHC.Types.I# ww [Dmd=SU] -> $wh1 ww } + + + ===================================== testsuite/tests/stranal/should_compile/T18894b.hs ===================================== @@ -0,0 +1,20 @@ +{-# OPTIONS_GHC -O -fno-call-arity -fforce-recomp #-} + +module T18894 (f) where + +expensive :: Int -> (Int, Int) +expensive n = (n+1, n+2) +{-# NOINLINE expensive #-} + +-- arity 1 by itself, but not exported, thus can be eta-expanded based on usage +eta :: Int -> Int -> Int +eta x = if fst (expensive x) == 13 + then \y -> x + y + else \y -> x * y +{-# NOINLINE eta #-} + +f :: Int -> Int +f 1 = 0 +f m + | odd m = eta m 2 + | otherwise = eta 2 m ===================================== testsuite/tests/stranal/should_compile/T18894b.stderr ===================================== @@ -0,0 +1,187 @@ + +==================== Demand analysis ==================== +Result size of Demand analysis = {terms: 83, types: 40, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 16, types: 7, coercions: 0, joins: 0/0} +expensive [InlPrag=NOINLINE, Dmd=UCU(P(SP(SU),A))] :: Int -> (Int, Int) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [40] 52 10}] +expensive + = \ (n [Dmd=UP(U)] :: Int) -> + (case n of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 1#) }, case n of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 2#) }) + +-- RHS size: {terms: 20, types: 11, coercions: 0, joins: 0/0} +eta [InlPrag=NOINLINE, Dmd=UCU(CS(U))] :: Int -> Int -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [0] 140 120}] +eta + = \ (x [Dmd=UP(U)] :: Int) -> + case expensive x of { (x [Dmd=SP(SU)], ds1 [Dmd=A]) -> + case x of { GHC.Types.I# x [Dmd=SU] -> + case x of { + __DEFAULT -> \ (y [Dmd=SP(U)] :: Int) -> GHC.Num.$fNumInt_$c* x y; + 13# -> \ (y [Dmd=SP(U)] :: Int) -> GHC.Num.$fNumInt_$c+ x y + } + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 21, types: 5, coercions: 0, joins: 0/0} +f :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 111 0}] +f = \ (ds [Dmd=SP(MU)] :: Int) -> + case ds of wild [Dmd=UP(U)] { GHC.Types.I# ds [Dmd=MU] -> + case ds of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> eta wild lvl; + 0# -> eta lvl wild + }; + 1# -> lvl + } + } + + + + +==================== Demand analysis ==================== +Result size of Demand analysis = {terms: 85, types: 47, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 16, types: 9, coercions: 0, joins: 0/0} +$wexpensive [InlPrag=NOINLINE, Dmd=UCU(P(SP(SU),A))] :: Int -> (# Int, Int #) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [40] 42 10}] +$wexpensive + = \ (w [Dmd=UP(U)] :: Int) -> + (# case w of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 1#) }, + case w of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 2#) } #) + +-- RHS size: {terms: 19, types: 12, coercions: 0, joins: 0/0} +eta [InlPrag=NOINLINE, Dmd=UCU(CS(U))] :: Int -> Int -> Int +[LclId, + Arity=2, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [0 0] 120 0}] +eta + = \ (x [Dmd=MP(U)] :: Int) (eta [Dmd=SP(U), OS=OneShot] :: Int) -> + case $wexpensive x of { (# ww [Dmd=SP(SU)], ww [Dmd=A] #) -> + case ww of { GHC.Types.I# x [Dmd=SU] -> + case x of { + __DEFAULT -> GHC.Num.$fNumInt_$c* x eta; + 13# -> GHC.Num.$fNumInt_$c+ x eta + } + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 20, types: 3, coercions: 0, joins: 0/0} +$wf [InlPrag=[2]] :: GHC.Prim.Int# -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 121 0}] +$wf + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> eta (GHC.Types.I# ds) lvl; + 0# -> eta lvl (GHC.Types.I# ds) + }; + 1# -> lvl + } + +-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} +f [InlPrag=[2]] :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (w [Occ=Once1!] :: Int) -> case w of { GHC.Types.I# ww [Occ=Once1, Dmd=MU] -> $wf ww }}] +f = \ (w [Dmd=SP(SU)] :: Int) -> case w of { GHC.Types.I# ww [Dmd=SU] -> $wf ww } + + + ===================================== testsuite/tests/stranal/should_compile/all.T ===================================== @@ -58,3 +58,7 @@ test('T18122', [ grep_errmsg(r'wfoo =') ], compile, ['-ddump-simpl']) # We care about the call demand on $wg test('T18903', [ grep_errmsg(r'Dmd=\S+C\S+') ], compile, ['-ddump-simpl -dsuppress-uniques']) +# We care about the call demand on $wg1 and $wg2 +test('T18894', [ grep_errmsg(r'Dmd=\S+C\S+') ], compile, ['-ddump-stranal -dsuppress-uniques']) +# We care about the Arity 2 on eta, as a result of the annotated Dmd +test('T18894b', [ grep_errmsg(r'Arity=2') ], compile, ['-ddump-stranal -dsuppress-uniques -fno-call-arity -dppr-cols=200']) ===================================== testsuite/tests/stranal/sigs/T5075.stderr ===================================== @@ -1,7 +1,7 @@ ==================== Strictness signatures ==================== T5075.$trModule: -T5075.loop: +T5075.loop: @@ -13,6 +13,6 @@ T5075.loop: ==================== Strictness signatures ==================== T5075.$trModule: -T5075.loop: +T5075.loop: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/09383c87247c471342938b0a119d547e6ea00871...314cbee31b1ec9a167228fba236cc125f7f9cc68 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/09383c87247c471342938b0a119d547e6ea00871...314cbee31b1ec9a167228fba236cc125f7f9cc68 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 3 23:25:09 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Thu, 03 Dec 2020 18:25:09 -0500 Subject: [Git][ghc/ghc][wip/T18891] Fix kind inference for data types. Again. Message-ID: <5fc973d5efa04_6a09b91108161748@gitlab.mail> Simon Peyton Jones pushed to branch wip/T18891 at Glasgow Haskell Compiler / GHC Commits: 558cabbc by Simon Peyton Jones at 2020-12-03T23:22:20+00:00 Fix kind inference for data types. Again. This patch fixes several aspects of kind inference for data type declarations, especially data /instance/ declarations Specifically 1. In kcConDecls/kcConDecl make it clear that the tc_res_kind argument is only used in the H98 case; and in that case there is no result kind signature; and hence no need for the disgusting splitPiTys in kcConDecls (now thankfully gone). The GADT case is a bit different to before, and much nicer. This is what fixes #18891. See Note [kcConDecls: kind-checking data type decls] 2. Do not look at the constructor decls of a data/newtype instance in tcDataFamInstanceHeader. See GHC.Tc.TyCl.Instance Note [Kind inference for data family instances]. This was a new realisation that arose when doing (1) This causes a few knock-on effects in the tests suite, because we require more information than before in the instance /header/. New user-manual material about this in "Kind inference in data type declarations" and "Kind inference for data/newtype instance declarations". 3. Minor improvement in kcTyClDecl, combining GADT and H98 cases 4. Fix #14111 and #8707 by allowing the header of a data instance to affect kind inferece for the the data constructor signatures; as described at length in Note [GADT return types] in GHC.Tc.TyCl This led to a modest refactoring of the arguments (and argument order) of tcConDecl/tcConDecls. 5. Fix #19000 by inverting the sense of the test in new_locs in GHC.Tc.Solver.Canonical.canDecomposableTyConAppOK. Rather to my surprise, CI tells us that we get quite a few compile time perf improvements in compiler bytes-allocated. Here are the ones that reduced more than 1%. Good news! I have no idea why. Test Metric value New value Change --------------------------------------------------------------------------- ManyAlternatives(normal) ghc/alloc 803792416.0 800063504.0 -0.5% Naperian(optasm) ghc/alloc 54311984.0 52874144.0 -2.6% GOOD PmSeriesG(normal) ghc/alloc 57119912.0 53369856.0 -6.6% PmSeriesS(normal) ghc/alloc 71507464.0 67756248.0 -5.2% PmSeriesT(normal) ghc/alloc 104597416.0 100846208.0 -3.6% PmSeriesV(normal) ghc/alloc 70326360.0 66576336.0 -5.3% T10421(normal) ghc/alloc 132567776.0 128845672.0 -2.8% GOOD T10421a(normal) ghc/alloc 94605104.0 90858592.0 -4.0% T10547(normal) ghc/alloc 34996968.0 33557256.0 -4.1% GOOD T10858(normal) ghc/alloc 212086488.0 208375832.0 -1.7% T11195(normal) ghc/alloc 310033360.0 306391248.0 -1.2% T11276(normal) ghc/alloc 145378016.0 141657896.0 -2.6% T11303b(normal) ghc/alloc 55148504.0 51404904.0 -6.8% T11374(normal) ghc/alloc 243783840.0 240133008.0 -1.5% T11822(normal) ghc/alloc 154231136.0 150490720.0 -2.4% T12150(optasm) ghc/alloc 94489040.0 90752656.0 -4.0% GOOD T12234(optasm) ghc/alloc 69407208.0 65659624.0 -5.4% GOOD T12425(optasm) ghc/alloc 115122960.0 111397664.0 -3.2% GOOD T13035(normal) ghc/alloc 118754176.0 114795136.0 -3.3% GOOD T13253-spj(normal) ghc/alloc 168969768.0 165225400.0 -2.2% GOOD T15630(normal) ghc/alloc 201226672.0 197491904.0 -1.9% T16190(normal) ghc/alloc 289119984.0 285560848.0 -1.2% T17096(normal) ghc/alloc 326080472.0 322369512.0 -1.1% T17836b(normal) ghc/alloc 69578304.0 65830328.0 -5.4% T17977(normal) ghc/alloc 55833520.0 52094448.0 -6.7% T17977b(normal) ghc/alloc 50731152.0 46983088.0 -7.4% T18140(normal) ghc/alloc 120628376.0 116879552.0 -3.1% GOOD T18282(normal) ghc/alloc 170207168.0 166491784.0 -2.2% GOOD T18304(normal) ghc/alloc 107596576.0 103853360.0 -3.5% GOOD T3064(normal) ghc/alloc 209696560.0 205954384.0 -1.8% T4801(normal) ghc/alloc 376239392.0 372505256.0 -1.0% T5030(normal) ghc/alloc 388667176.0 384947480.0 -1.0% T5321FD(normal) ghc/alloc 332509600.0 328779208.0 -1.1% T5321Fun(normal) ghc/alloc 379067288.0 375338056.0 -1.0% T5837(normal) ghc/alloc 46272360.0 42540544.0 -8.1% GOOD T6048(optasm) ghc/alloc 99200336.0 95462744.0 -3.8% GOOD T9020(optasm) ghc/alloc 282057000.0 278339944.0 -1.3% T9233(normal) ghc/alloc 967401992.0 963669872.0 -0.4% - - - - - 30 changed files: - compiler/GHC/Hs/Extension.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Instance.hs - docs/users_guide/9.2.1-notes.rst - docs/users_guide/exts/poly_kinds.rst - testsuite/tests/dependent/should_fail/T13780a.stderr - testsuite/tests/deriving/should_compile/T11416.hs - testsuite/tests/deriving/should_compile/T9359.hs - + testsuite/tests/indexed-types/should_compile/T14111.hs - + testsuite/tests/indexed-types/should_compile/T8707.hs - testsuite/tests/indexed-types/should_compile/all.T - testsuite/tests/indexed-types/should_fail/T8368.stderr - testsuite/tests/indexed-types/should_fail/T8368a.stderr - testsuite/tests/patsyn/should_fail/T15685.stderr - testsuite/tests/polykinds/T13659.stderr - testsuite/tests/polykinds/T16221a.stderr - testsuite/tests/th/T11145.stderr - testsuite/tests/th/T9692.hs - + testsuite/tests/typecheck/should_compile/T18891.hs - testsuite/tests/typecheck/should_compile/UnliftedNewtypesUnassociatedFamily.hs - testsuite/tests/typecheck/should_compile/UnliftedNewtypesUnifySig.hs - testsuite/tests/typecheck/should_compile/all.T - + testsuite/tests/typecheck/should_fail/T18891a.hs - + testsuite/tests/typecheck/should_fail/T18891a.stderr - testsuite/tests/typecheck/should_fail/UnliftedNewtypesFamilyKindFail2.stderr - + testsuite/tests/typecheck/should_fail/UnliftedNewtypesUnassociatedFamilyFail.hs - + testsuite/tests/typecheck/should_fail/UnliftedNewtypesUnassociatedFamilyFail.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/Hs/Extension.hs ===================================== @@ -253,9 +253,9 @@ sure that any uses of it as a field are strict. -- | Used as a data type index for the hsSyn AST; also serves -- as a singleton type for Pass data GhcPass (c :: Pass) where - GhcPs :: GhcPs - GhcRn :: GhcRn - GhcTc :: GhcTc + GhcPs :: GhcPass 'Parsed + GhcRn :: GhcPass 'Renamed + GhcTc :: GhcPass 'Typechecked -- This really should never be entered, but the data-deriving machinery -- needs the instance to exist. ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -2986,7 +2986,7 @@ bindOuterSigTKBndrs_Tv_M :: TcTyMode -> TcM a -> TcM (HsOuterSigTyVarBndrs GhcTc, a) -- Do not push level; do not make implication constraint; use Tvs -- Two major clients of this "bind-only" path are: --- Note [Kind-checking for GADTs] in TyCl +-- Note [Using TyVarTvs for kind-checking GADTs] in GHC.Tc.TyCl -- Note [Checking partial type signatures] bindOuterSigTKBndrs_Tv_M mode = bindOuterTKBndrsX (smVanilla { sm_clone = True, sm_tvtv = True @@ -3299,8 +3299,8 @@ When we /must/ clone. When kind-checking T, we give (a :: kappa1). Then: - In kcConDecl we make a TyVarTv unification variable kappa2 for k2 - (as described in Note [Kind-checking for GADTs], even though this - example is an existential) + (as described in Note [Using TyVarTvs for kind-checking GADTs], + even though this example is an existential) - So we get (b :: kappa2) via bindExplicitTKBndrs_Tv - We end up unifying kappa1 := kappa2, because of the (SameKind a b) ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -1885,7 +1885,7 @@ canDecomposableTyConAppOK ev eq_rel tc tys1 tys2 | bndr <- tyConBinders tc , let new_loc0 | isNamedTyConBinder bndr = toKindLoc loc | otherwise = loc - new_loc | isVisibleTyConBinder bndr + new_loc | isInvisibleTyConBinder bndr = updateCtLocOrigin new_loc0 toInvisibleOrigin | otherwise = new_loc0 ] ===================================== compiler/GHC/Tc/TyCl.hs ===================================== @@ -17,7 +17,8 @@ module GHC.Tc.TyCl ( -- Functions used by GHC.Tc.TyCl.Instance to check -- data/type family instance declarations - kcConDecls, tcConDecls, dataDeclChecks, checkValidTyCon, + kcConDecls, tcConDecls, DataDeclInfo(..), + dataDeclChecks, checkValidTyCon, tcFamTyPats, tcTyFamInstEqn, tcAddTyFamInstCtxt, tcMkDataFamInstCtxt, tcAddDataFamInstCtxt, unravelFamInstPats, addConsistencyConstraints, @@ -38,7 +39,7 @@ import GHC.Tc.Solver( pushLevelAndSolveEqualities, pushLevelAndSolveEqualitiesX , reportUnsolvedEqualities ) import GHC.Tc.Utils.Monad import GHC.Tc.Utils.Env -import GHC.Tc.Utils.Unify( emitResidualTvConstraint ) +import GHC.Tc.Utils.Unify( unifyType, emitResidualTvConstraint ) import GHC.Tc.Types.Constraint( emptyWC ) import GHC.Tc.Validity import GHC.Tc.Utils.Zonk @@ -130,7 +131,7 @@ Note [Check role annotations in a second pass] Role inference potentially depends on the types of all of the datacons declared in a mutually recursive group. The validity of a role annotation, in turn, depends on the result of role inference. Because the types of datacons might -be ill-formed (see #7175 and Note [Checking GADT return types]) we must check +be ill-formed (see #7175 and Note [rejigConRes]) we must check *all* the tycons in a group for validity before checking *any* of the roles. Thus, we take two passes over the resulting tycons, first checking for general validity and then checking for valid role annotations. @@ -1529,27 +1530,16 @@ kcTyClDecl :: TyClDecl GhcRn -> TcTyCon -> TcM () -- result kind signature have already been dealt with -- by inferInitialKind, so we can ignore them here. -kcTyClDecl (DataDecl { tcdLName = (L _ name) - , tcdDataDefn = defn }) tyCon - | HsDataDefn { dd_cons = cons@((L _ (ConDeclGADT {})) : _) - , dd_ctxt = (L _ []) - , dd_ND = new_or_data } <- defn - = -- See Note [Implementation of UnliftedNewtypes] STEP 2 - kcConDecls new_or_data (tyConResKind tyCon) cons - - -- hs_tvs and dd_kindSig already dealt with in inferInitialKind - -- This must be a GADT-style decl, - -- (see invariants of DataDefn declaration) - -- so (a) we don't need to bring the hs_tvs into scope, because the - -- ConDecls bind all their own variables - -- (b) dd_ctxt is not allowed for GADT-style decls, so we can ignore it - - | HsDataDefn { dd_ctxt = ctxt - , dd_cons = cons - , dd_ND = new_or_data } <- defn +kcTyClDecl (DataDecl { tcdLName = (L _ name), tcdDataDefn = defn }) tycon + | HsDataDefn { dd_ctxt = ctxt, dd_cons = cons, dd_ND = new_or_data } <- defn = bindTyClTyVars name $ \ _ _ _ -> - do { _ <- tcHsContext ctxt - ; kcConDecls new_or_data (tyConResKind tyCon) cons + -- NB: binding these tyvars isn't necessary for GADTs, but it does no + -- harm. For GADTs, each data con brings its own tyvars into scope, + -- and the ones from this bindTyClTyVars are either not mentioned or + -- (conceivably) shadowed. + do { traceTc "kcTyClDecl" (ppr tycon $$ ppr (tyConTyVars tycon) $$ ppr (tyConResKind tycon)) + ; _ <- tcHsContext ctxt + ; kcConDecls new_or_data (tyConResKind tycon) cons } kcTyClDecl (SynDecl { tcdLName = L _ name, tcdRhs = rhs }) _tycon @@ -1606,13 +1596,12 @@ kcConGADTArgs new_or_data res_kind con_args = case con_args of kcConDecls :: NewOrData -> Kind -- The result kind signature + -- Used only in H98 case -> [LConDecl GhcRn] -- The data constructors -> TcM () -kcConDecls new_or_data res_kind cons - = mapM_ (wrapLocM_ (kcConDecl new_or_data final_res_kind)) cons - where - (_, final_res_kind) = splitPiTys res_kind - -- See Note [kcConDecls result kind] +-- See Note [kcConDecls: kind-checking data type decls] +kcConDecls new_or_data tc_res_kind cons + = mapM_ (wrapLocM_ (kcConDecl new_or_data tc_res_kind)) cons -- Kind check a data constructor. In additional to the data constructor, -- we also need to know about whether or not its corresponding type was @@ -1623,82 +1612,69 @@ kcConDecl :: NewOrData -> Kind -- Result kind of the type constructor -- Usually Type but can be TYPE UnliftedRep -- or even TYPE r, in the case of unlifted newtype + -- Used only in H98 case -> ConDecl GhcRn -> TcM () -kcConDecl new_or_data res_kind (ConDeclH98 +kcConDecl new_or_data tc_res_kind (ConDeclH98 { con_name = name, con_ex_tvs = ex_tvs , con_mb_cxt = ex_ctxt, con_args = args }) - = addErrCtxt (dataConCtxtName [name]) $ + = addErrCtxt (dataConCtxt [name]) $ discardResult $ bindExplicitTKBndrs_Tv ex_tvs $ do { _ <- tcHsMbContext ex_ctxt - ; kcConH98Args new_or_data res_kind args + ; kcConH98Args new_or_data tc_res_kind args -- We don't need to check the telescope here, -- because that's done in tcConDecl } -kcConDecl new_or_data res_kind (ConDeclGADT +kcConDecl new_or_data + _tc_res_kind -- Not used in GADT case (and doesn't make sense) + (ConDeclGADT { con_names = names, con_bndrs = L _ outer_bndrs, con_mb_cxt = cxt , con_g_args = args, con_res_ty = res_ty }) - = -- Even though the GADT-style data constructor's type is closed, - -- we must still kind-check the type, because that may influence - -- the inferred kind of the /type/ constructor. Example: - -- data T f a where - -- MkT :: f a -> T f a - -- If we don't look at MkT we won't get the correct kind - -- for the type constructor T - addErrCtxt (dataConCtxtName names) $ + = -- See Note [kcConDecls: kind-checking data type decls] + addErrCtxt (dataConCtxt names) $ discardResult $ bindOuterSigTKBndrs_Tv outer_bndrs $ - -- Why "_Tv"? See Note [Kind-checking for GADTs] + -- Why "_Tv"? See Note [Using TyVarTvs for kind-checking GADTs] do { _ <- tcHsMbContext cxt - ; kcConGADTArgs new_or_data res_kind args - ; _ <- tcHsOpenType res_ty + ; traceTc "kcConDecl:GADT {" (ppr names $$ ppr res_ty) + ; con_res_kind <- newOpenTypeKind + ; _ <- tcCheckLHsType res_ty (TheKind con_res_kind) + ; kcConGADTArgs new_or_data con_res_kind args + ; traceTc "kcConDecl:GADT }" (ppr names $$ ppr con_res_kind) ; return () } -{- Note [kcConDecls result kind] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We might have e.g. - data T a :: Type -> Type where ... -or - newtype instance N a :: Type -> Type where .. -in which case, the 'res_kind' passed to kcConDecls will be - Type->Type - -We must look past those arrows, or even foralls, to the Type in the -corner, to pass to kcConDecl c.f. #16828. Hence the splitPiTys here. - -I am a bit concerned about tycons with a declaration like - data T a :: Type -> forall k. k -> Type where ... - -It does not have a CUSK, so kcInferDeclHeader will make a TcTyCon -with tyConResKind of Type -> forall k. k -> Type. Even that is fine: -the splitPiTys will look past the forall. But I'm bothered about -what if the type "in the corner" mentions k? This is incredibly -obscure but something like this could be bad: - data T a :: Type -> foral k. k -> TYPE (F k) where ... - -I bet we are not quite right here, but my brain suffered a buffer -overflow and I thought it best to nail the common cases right now. - -Note [Recursion and promoting data constructors] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We don't want to allow promotion in a strongly connected component -when kind checking. - -Consider: - data T f = K (f (K Any)) - -When kind checking the `data T' declaration the local env contains the -mappings: - T -> ATcTyCon - K -> APromotionErr - -APromotionErr is only used for DataCons, and only used during type checking -in tcTyClGroup. - -Note [Kind-checking for GADTs] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [kcConDecls: kind-checking data type decls] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +kcConDecls is used when we are inferring the kind of the type +constructor in a data type declaration. E.g. + data T f a = MkT (f a) +we want to infer the kind of 'f' and 'a'. The basic plan is described +in Note [Inferring kinds for type declarations]; here are doing Step 2. + +In the H98 case, for unlifted newtypes only, we need the result kind of +the TyCon, to unify with the argument kind. The tycon's result kind +is not used at all in the GADT case. + +In the GADT case we may have this: + data T f a where + MkT :: forall g b. g b -> T g b +Notice that the variables f,a, and g,b are quite distinct. +Nevertheless, this decl must still influence the kind T (which is, +remember Step 1, something like T :: kappa1 -> kappa2 -> Type), otherwise +we'd infer the bogus kind T :: forall k1 k2. k1 -> k2 -> Type. + +The data constructor type influences the kind of T simply by +kind-checking the result type (T g b), which will force 'f' and 'g' to +have the same kinds. This is the call to + tcCheckLHsType res_ty (TheKind con_res_kind) +Because this is the result type of an arrow, we know the kind must be +of form (TYPE rr), and we get better error messages if we enforce that +here (e.g. test gadt10). + +Note [Using TyVarTvs for kind-checking GADTs] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider data Proxy a where @@ -1708,26 +1684,27 @@ Consider It seems reasonable that this should be accepted. But something very strange is going on here: when we're kind-checking this declaration, we need to unify the kind of `a` with k and j -- even though k and j's scopes are local to the type of -MkProxy{1,2}. The best approach we've come up with is to use TyVarTvs during -the kind-checking pass. First off, note that it's OK if the kind-checking pass -is too permissive: we'll snag the problems in the type-checking pass later. -(This extra permissiveness might happen with something like +MkProxy{1,2}. + +In effect, we are simply gathering constraints on the shape of Proxy's +kind, with no skolemisation or implication constraints involved at all. + +The best approach we've come up with is to use TyVarTvs during the +kind-checking pass, rather than ordinary skolems. This is why we use +the "_Tv" variant, bindOuterSigTKBndrs_Tv. + +Our only goal is to gather constraints on the kind of the type constructor; +we do not certify that the data declaration is well-kinded. For example: data SameKind :: k -> k -> Type data Bad a where MkBad :: forall k1 k2 (a :: k1) (b :: k2). Bad (SameKind a b) -which would be accepted if k1 and k2 were TyVarTvs. This is correctly rejected -in the second pass, though. Test case: polykinds/TyVarTvKinds3) -Recall that the kind-checking pass exists solely to collect constraints -on the kinds and to power unification. +which would be accepted by kcConDecl because k1 and k2 are +TyVarTvs. It is correctly rejected in the second pass, tcConDecl. +(Test case: polykinds/TyVarTvKinds3) -To achieve the use of TyVarTvs, we must be careful to use specialized functions -that produce TyVarTvs, not ordinary skolems. This is why we need -kcExplicitTKBndrs and kcImplicitTKBndrs in GHC.Tc.Gen.HsType, separate from their -tc... variants. - -The drawback of this approach is sometimes it will accept a definition that +One drawback of this approach is sometimes it will accept a definition that a (hypothetical) declarative specification would likely reject. As a general rule, we don't want to allow polymorphic recursion without a CUSK. Indeed, the whole point of CUSKs is to allow polymorphic recursion. Yet, the TyVarTvs @@ -1746,6 +1723,23 @@ be rejected (without a CUSK). However, the accepted definitions are indeed well-kinded and any rejected definitions would be accepted with a CUSK, and so this wrinkle need not cause anyone to lose sleep. +Note [Recursion and promoting data constructors] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We don't want to allow promotion in a strongly connected component +when kind checking. + +Consider: + data T f = K (f (K Any)) + +When kind checking the `data T' declaration the local env contains the +mappings: + T -> ATcTyCon + K -> APromotionErr + +APromotionErr is only used for DataCons, and only used during type checking +in tcTyClGroup. + + ************************************************************************ * * \subsection{Type checking} @@ -2782,18 +2776,14 @@ tcDataDefn err_ctxt roles_info tc_name ; when (isJust mb_ksig) $ checkTc (kind_signatures) (badSigTyDecl tc_name) - ; tycon <- fixM $ \ tycon -> do + ; tycon <- fixM $ \ rec_tycon -> do { let final_bndrs = tycon_binders `chkAppend` extra_bndrs - res_ty = mkTyConApp tycon (mkTyVarTys (binderVars final_bndrs)) roles = roles_info tc_name ; data_cons <- tcConDecls - tycon - new_or_data - final_bndrs - final_res_kind - res_ty + new_or_data DDVanilla + rec_tycon final_bndrs final_res_kind cons - ; tc_rhs <- mk_tc_rhs hsc_src tycon data_cons + ; tc_rhs <- mk_tc_rhs hsc_src rec_tycon data_cons ; tc_rep_nm <- newTyConRepName tc_name ; return (mkAlgTyCon tc_name final_bndrs @@ -3195,36 +3185,51 @@ consUseGadtSyntax _ = False -- All constructors have same shape ----------------------------------- -tcConDecls :: KnotTied TyCon -> NewOrData - -> [TyConBinder] -> TcKind -- binders and result kind of tycon - -> KnotTied Type -> [LConDecl GhcRn] -> TcM [DataCon] -tcConDecls rep_tycon new_or_data tmpl_bndrs res_kind res_tmpl +data DataDeclInfo + = DDVanilla -- data T a b = T1 a | T2 b + | DDInstance -- data instance D [a] = D1 a | D2 + Type -- The header D [a] + +mkDDHeaderTy :: DataDeclInfo -> TyCon -> [TyConBinder] -> Type +mkDDHeaderTy dd_info rep_tycon tc_bndrs + = case dd_info of + DDVanilla -> mkTyConApp rep_tycon $ + mkTyVarTys (binderVars tc_bndrs) + DDInstance header_ty -> header_ty + +tcConDecls :: NewOrData + -> DataDeclInfo + -> KnotTied TyCon -- Representation TyCon + -> [TyConBinder] -- Binders of representation TyCon + -> TcKind -- Result kind + -> [LConDecl GhcRn] -> TcM [DataCon] +tcConDecls new_or_data dd_info rep_tycon tmpl_bndrs res_kind = concatMapM $ addLocM $ - tcConDecl rep_tycon (mkTyConTagMap rep_tycon) - tmpl_bndrs res_kind res_tmpl new_or_data - -- It's important that we pay for tag allocation here, once per TyCon, - -- See Note [Constructor tag allocation], fixes #14657 - -tcConDecl :: KnotTied TyCon -- Representation tycon. Knot-tied! + tcConDecl new_or_data dd_info rep_tycon tmpl_bndrs res_kind + (mkTyConTagMap rep_tycon) + -- mkTyConTagMap: it's important that we pay for tag allocation here, + -- once per TyCon. See Note [Constructor tag allocation], fixes #14657 + +tcConDecl :: NewOrData + -> DataDeclInfo + -> KnotTied TyCon -- Representation tycon. Knot-tied! + -> [TyConBinder] -- Binders of representation TyCon + -> TcKind -- Result kind -> NameEnv ConTag - -> [TyConBinder] -> TcKind -- tycon binders and result kind - -> KnotTied Type - -- Return type template (T tys), where T is the family TyCon - -> NewOrData -> ConDecl GhcRn -> TcM [DataCon] -tcConDecl rep_tycon tag_map tmpl_bndrs res_kind res_tmpl new_or_data +tcConDecl new_or_data dd_info rep_tycon tc_bndrs res_kind tag_map (ConDeclH98 { con_name = lname@(L _ name) , con_ex_tvs = explicit_tkv_nms , con_mb_cxt = hs_ctxt , con_args = hs_args }) - = addErrCtxt (dataConCtxtName [lname]) $ + = addErrCtxt (dataConCtxt [lname]) $ do { -- NB: the tyvars from the declaration header are in scope -- Get hold of the existential type variables -- e.g. data T a = forall k (b::k) f. MkT a (f b) - -- Here tmpl_bndrs = {a} + -- Here tc_bndrs = {a} -- hs_qvars = HsQTvs { hsq_implicit = {k} -- , hsq_explicit = {f,b} } @@ -3242,29 +3247,35 @@ tcConDecl rep_tycon tag_map tmpl_bndrs res_kind res_tmpl new_or_data } - ; let tmpl_tvs = binderVars tmpl_bndrs - ; let fake_ty = mkSpecForAllTys tmpl_tvs $ + ; let tc_tvs = binderVars tc_bndrs + fake_ty = mkSpecForAllTys tc_tvs $ mkInvisForAllTys exp_tvbndrs $ mkPhiTy ctxt $ mkVisFunTys arg_tys $ unitTy -- That type is a lie, of course. (It shouldn't end in ()!) -- And we could construct a proper result type from the info - -- at hand. But the result would mention only the tmpl_tvs, + -- at hand. But the result would mention only the univ_tvs, -- and so it just creates more work to do it right. Really, -- we're only doing this to find the right kind variables to -- quantify over, and this type is fine for that purpose. - -- exp_tvs have explicit, user-written binding sites + -- exp_tvbndrs have explicit, user-written binding sites -- the kvs below are those kind variables entirely unmentioned by the user -- and discovered only by generalization ; kvs <- kindGeneralizeAll fake_ty - ; let skol_tvs = kvs ++ tmpl_tvs + ; let skol_tvs = tc_tvs ++ kvs ++ binderVars exp_tvbndrs ; reportUnsolvedEqualities skol_info skol_tvs tclvl wanted - - -- Zonk to Types + -- The skol_info claims that all the variables are bound + -- by the data constructor decl, whereas actually the + -- univ_tvs are bound by the data type decl itself. It + -- would be better to have a doubly-nested implication. + -- But that just doesn't seem worth it. + -- See test dependent/should_fail/T13780a + + -- Zonk to Types ; (ze, qkvs) <- zonkTyBndrs kvs ; (ze, user_qtvbndrs) <- zonkTyVarBindersX ze exp_tvbndrs ; arg_tys <- zonkScaledTcTypesToTypesX ze arg_tys @@ -3272,15 +3283,14 @@ tcConDecl rep_tycon tag_map tmpl_bndrs res_kind res_tmpl new_or_data -- Can't print univ_tvs, arg_tys etc, because we are inside the knot here ; traceTc "tcConDecl 2" (ppr name $$ ppr field_lbls) - ; let - univ_tvbs = tyConInvisTVBinders tmpl_bndrs - univ_tvs = binderVars univ_tvbs - ex_tvbs = mkTyVarBinders InferredSpec qkvs ++ user_qtvbndrs - ex_tvs = binderVars ex_tvbs - -- For H98 datatypes, the user-written tyvar binders are precisely - -- the universals followed by the existentials. - -- See Note [DataCon user type variable binders] in GHC.Core.DataCon. - user_tvbs = univ_tvbs ++ ex_tvbs + ; let univ_tvbs = tyConInvisTVBinders tc_bndrs + ex_tvbs = mkTyVarBinders InferredSpec qkvs ++ user_qtvbndrs + ex_tvs = binderVars ex_tvbs + -- For H98 datatypes, the user-written tyvar binders are precisely + -- the universals followed by the existentials. + -- See Note [DataCon user type variable binders] in GHC.Core.DataCon. + user_tvbs = univ_tvbs ++ ex_tvbs + user_res_ty = mkDDHeaderTy dd_info rep_tycon tc_bndrs ; traceTc "tcConDecl 2" (ppr name) ; is_infix <- tcConIsInfixH98 name hs_args @@ -3288,9 +3298,9 @@ tcConDecl rep_tycon tag_map tmpl_bndrs res_kind res_tmpl new_or_data ; fam_envs <- tcGetFamInstEnvs ; dc <- buildDataCon fam_envs name is_infix rep_nm stricts Nothing field_lbls - univ_tvs ex_tvs user_tvbs + tc_tvs ex_tvs user_tvbs [{- no eq_preds -}] ctxt arg_tys - res_tmpl rep_tycon tag_map + user_res_ty rep_tycon tag_map -- NB: we put data_tc, the type constructor gotten from the -- constructor type signature into the data constructor; -- that way checkValidDataCon can complain if it's wrong. @@ -3299,14 +3309,14 @@ tcConDecl rep_tycon tag_map tmpl_bndrs res_kind res_tmpl new_or_data where skol_info = DataConSkol name -tcConDecl rep_tycon tag_map tmpl_bndrs _res_kind res_tmpl new_or_data +tcConDecl new_or_data dd_info rep_tycon tc_bndrs _res_kind tag_map -- NB: don't use res_kind here, as it's ill-scoped. Instead, -- we get the res_kind by typechecking the result type. (ConDeclGADT { con_names = names , con_bndrs = L _ outer_hs_bndrs , con_mb_cxt = cxt, con_g_args = hs_args , con_res_ty = hs_res_ty }) - = addErrCtxt (dataConCtxtName names) $ + = addErrCtxt (dataConCtxt names) $ do { traceTc "tcConDecl 1 gadt" (ppr names) ; let (L _ name : _) = names @@ -3317,10 +3327,23 @@ tcConDecl rep_tycon tag_map tmpl_bndrs _res_kind res_tmpl new_or_data ; (res_ty, res_kind) <- tcInferLHsTypeKind hs_res_ty -- See Note [GADT return kinds] + -- For data instances (only), ensure that the return type, + -- res_ty, is a substitution instance of the header. + -- See Note [GADT return types] + ; case dd_info of + DDVanilla -> return () + DDInstance hdr_ty -> + do { (subst, _meta_tvs) <- newMetaTyVars (binderVars tc_bndrs) + ; let head_shape = substTy subst hdr_ty + ; discardResult $ + popErrCtxt $ -- Drop dataConCtxt + addErrCtxt (dataConResCtxt names) $ + unifyType Nothing res_ty head_shape } + -- See Note [Datatype return kinds] ; let exp_kind = getArgExpKind new_or_data res_kind - ; btys <- tcConGADTArgs exp_kind hs_args + ; let (arg_tys, stricts) = unzip btys ; field_lbls <- lookupConstructorFields name ; return (ctxt, arg_tys, res_ty, field_lbls, stricts) @@ -3343,9 +3366,10 @@ tcConDecl rep_tycon tag_map tmpl_bndrs _res_kind res_tmpl new_or_data ; ctxt <- zonkTcTypesToTypesX ze ctxt ; res_ty <- zonkTcTypeToTypeX ze res_ty - ; let (univ_tvs, ex_tvs, tvbndrs', eq_preds, arg_subst) - = rejigConRes tmpl_bndrs res_tmpl tvbndrs res_ty - -- See Note [Checking GADT return types] + ; let res_tmpl = mkDDHeaderTy dd_info rep_tycon tc_bndrs + (univ_tvs, ex_tvs, tvbndrs', eq_preds, arg_subst) + = rejigConRes tc_bndrs res_tmpl tvbndrs res_ty + -- See Note [rejigConRes] ctxt' = substTys arg_subst ctxt arg_tys' = substScaledTys arg_subst arg_tys @@ -3372,8 +3396,65 @@ tcConDecl rep_tycon tag_map tmpl_bndrs _res_kind res_tmpl new_or_data where skol_info = DataConSkol (unLoc (head names)) -{- Note [GADT return kinds] +{- Note [GADT return types] ~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + data family T :: forall k. k -> Type + data instance T (a :: Type) where + MkT :: forall b. T b + +What kind does `b` have in the signature for MkT? +Since the return type must be an instance of the type in the header, +we must have (b :: Type), but you can't tell that by looking only at +the type of the data constructor; you have to look at the header too. +If you wrote it out fully, it'd look like + data instance T @Type (a :: Type) where + MkT :: forall (b::Type). T @Type b + +We could reject the program, and expect the user to add kind +annotations to `MkT` to restrict the signature. But an easy, and +helpful alternative is this: simply instantiate the type from the +header with fresh unification variables, and unify with the return +type of `MkT`. That will force `b` to have kind `Type`. See #8707 +and #14111. + +Wrikles +* At first sight it looks as though this would completely subsume the + return-type check in checkValidDataCon. But it does not. Suppose we + have + data instance T [a] where + MkT :: T (F (Maybe a)) + + where F is a type function. Then maybe (F (Maybe a)) evaluates to + [a], so unifyType will succeed. But we discard the coercion + returned by unifyType; and we really don't want to accept this + program. The check in checkValidDataCon will, however, reject it. + TL;DR: keep the check in checkValidDataCon. + +* Consider a data type, rather than a data instance, declaration + data S a where { MkS :: b -> S [b] } + In tcConDecl, S is knot-tied, so we don't want to unify (S alpha) + with (S [b]). To put it another way, unifyType should never see a + TcTycon. Simple solution: do *not* do the extra unifyType for + data types (DDVanilla) only for data instances (DDInstance); in + the latter the family constructor is not knot-tied so there is no + problem. + +* Consider this (fromn GHC itself): + + data Pass = Parsed | ... + data GhcPass (c :: Pass) where + GhcPs :: GhcPs + ... + type GhcPs = GhcPass 'Parsed + + Now GhcPs and GhcPass are mutually recursive. If we did unifyType + for datatypes like GhcPass, we would not be able to exand the type + synonym (it'd still be a TcTyCon). So again, we don't do uinfyType + for data types; we leave it to checkValidDataCon. + +Note [GADT return kinds] +~~~~~~~~~~~~~~~~~~~~~~~~ Consider type family Star where Star = Type data T :: Type where @@ -3496,8 +3577,8 @@ For example: (:--:) :: t1 -> t2 -> T Int -Note [Checking GADT return types] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [rejigConRes] +~~~~~~~~~~~~~~~~~~ There is a delicacy around checking the return types of a datacon. The central problem is dealing with a declaration like @@ -3532,9 +3613,9 @@ errors reported in one pass. See #7175, and #10836. -- TI :: forall b1 c1. (b1 ~ c1) => b1 -> :R7T b1 c1 -- In this case orig_res_ty = T (e,e) -rejigConRes :: [KnotTied TyConBinder] -> KnotTied Type -- Template for result type; e.g. - -- data instance T [a] b c ... - -- gives template ([a,b,c], T [a] b c) +rejigConRes :: [KnotTied TyConBinder] -- Template for result type; e.g. + -> KnotTied Type -- data instance T [a] b c ... + -- gives template ([a,b,c], T [a] b c) -> [InvisTVBinder] -- The constructor's type variables (both inferred and user-written) -> KnotTied Type -- res_ty -> ([TyVar], -- Universal @@ -3546,10 +3627,10 @@ rejigConRes :: [KnotTied TyConBinder] -> KnotTied Type -- Template for result -- We don't check that the TyCon given in the ResTy is -- the same as the parent tycon, because checkValidDataCon will do it -- NB: All arguments may potentially be knot-tied -rejigConRes tmpl_bndrs res_tmpl dc_tvbndrs res_ty +rejigConRes tc_tvbndrs res_tmpl dc_tvbndrs res_ty -- E.g. data T [a] b c where -- MkT :: forall x y z. T [(x,y)] z z - -- The {a,b,c} are the tmpl_tvs, and the {x,y,z} are the dc_tvs + -- The {a,b,c} are the tc_tvs, and the {x,y,z} are the dc_tvs -- (NB: unlike the H98 case, the dc_tvs are not all existential) -- Then we generate -- Univ tyvars Eq-spec @@ -3564,7 +3645,7 @@ rejigConRes tmpl_bndrs res_tmpl dc_tvbndrs res_ty -- , [], [x,y,z] -- , [a~(x,y),b~z], ) | Just subst <- tcMatchTy res_tmpl res_ty - = let (univ_tvs, raw_eqs, kind_subst) = mkGADTVars tmpl_tvs dc_tvs subst + = let (univ_tvs, raw_eqs, kind_subst) = mkGADTVars tc_tvs dc_tvs subst raw_ex_tvs = dc_tvs `minusList` univ_tvs (arg_subst, substed_ex_tvs) = substTyVarBndrs kind_subst raw_ex_tvs @@ -3590,11 +3671,11 @@ rejigConRes tmpl_bndrs res_tmpl dc_tvbndrs res_ty -- we must do *something*, not just crash. So we do something simple -- albeit bogus, relying on checkValidDataCon to check the -- bad-result-type error before seeing that the other fields look odd - -- See Note [Checking GADT return types] - = (tmpl_tvs, dc_tvs `minusList` tmpl_tvs, dc_tvbndrs, [], emptyTCvSubst) + -- See Note [rejigConRes] + = (tc_tvs, dc_tvs `minusList` tc_tvs, dc_tvbndrs, [], emptyTCvSubst) where - dc_tvs = binderVars dc_tvbndrs - tmpl_tvs = binderVars tmpl_bndrs + dc_tvs = binderVars dc_tvbndrs + tc_tvs = binderVars tc_tvbndrs {- Note [mkGADTVars] ~~~~~~~~~~~~~~~~~~~~ @@ -3634,7 +3715,7 @@ becomes We start off by matching (T k1 k2 a b) with (T x1 * (Proxy x1 y, z) z). We know this match will succeed because of the validity check (actually done -later, but laziness saves us -- see Note [Checking GADT return types]). +later, but laziness saves us -- see Note [rejigConRes]). Thus, we get subst := { k1 |-> x1, k2 |-> *, a |-> (Proxy x1 y, z), b |-> z } @@ -4081,15 +4162,9 @@ checkFieldCompat fld con1 con2 res1 res2 fty1 fty2 ------------------------------- checkValidDataCon :: DynFlags -> Bool -> TyCon -> DataCon -> TcM () checkValidDataCon dflags existential_ok tc con - = setSrcSpan (getSrcSpan con) $ - addErrCtxt (dataConCtxt con) $ - do { -- Check that the return type of the data constructor - -- matches the type constructor; eg reject this: - -- data T a where { MkT :: Bogus a } - -- It's important to do this first: - -- see Note [Checking GADT return types] - -- and c.f. Note [Check role annotations in a second pass] - let tc_tvs = tyConTyVars tc + = setSrcSpan con_loc $ + addErrCtxt (dataConCtxt [L con_loc con_name]) $ + do { let tc_tvs = tyConTyVars tc res_ty_tmpl = mkFamilyTyConApp tc (mkTyVarTys tc_tvs) orig_res_ty = dataConOrigResTy con ; traceTc "checkValidDataCon" (vcat @@ -4098,6 +4173,18 @@ checkValidDataCon dflags existential_ok tc con , ppr orig_res_ty <+> dcolon <+> ppr (tcTypeKind orig_res_ty)]) + -- Check that the return type of the data constructor + -- matches the type constructor; eg reject this: + -- data T a where { MkT :: Bogus a } + -- It's important to do this first: + -- see Note [rejigCon + -- and c.f. Note [Check role annotations in a second pass] + + -- Check that the return type of the data constructor is an instance + -- of the header of the header of data decl. This checks for + -- data T a where { MkT :: S a } + -- data instance D [a] where { MkD :: D (Maybe b) } + -- see Note [GADT return types] ; checkTc (isJust (tcMatchTyKi res_ty_tmpl orig_res_ty)) (badDataConTyCon con res_ty_tmpl) -- Note that checkTc aborts if it finds an error. This is @@ -4205,7 +4292,9 @@ checkValidDataCon dflags existential_ok tc con Just (f, _) -> ppr (tyConBinders f) ] } where - ctxt = ConArgCtxt (dataConName con) + con_name = dataConName con + con_loc = nameSrcSpan con_name + ctxt = ConArgCtxt con_name is_strict = \case NoSrcStrict -> xopt LangExt.StrictData dflags bang -> isSrcStrict bang @@ -4869,14 +4958,17 @@ fieldTypeMisMatch field_name con1 con2 = sep [text "Constructors" <+> ppr con1 <+> text "and" <+> ppr con2, text "give different types for field", quotes (ppr field_name)] -dataConCtxtName :: [Located Name] -> SDoc -dataConCtxtName [con] - = text "In the definition of data constructor" <+> quotes (ppr con) -dataConCtxtName con - = text "In the definition of data constructors" <+> interpp'SP con +dataConCtxt :: [Located Name] -> SDoc +dataConCtxt cons = text "In the definition of data constructor" <> plural cons + <+> ppr_cons cons + +dataConResCtxt :: [Located Name] -> SDoc +dataConResCtxt cons = text "In the result type of data constructor" <> plural cons + <+> ppr_cons cons -dataConCtxt :: Outputable a => a -> SDoc -dataConCtxt con = text "In the definition of data constructor" <+> quotes (ppr con) +ppr_cons :: [Located Name] -> SDoc +ppr_cons [con] = quotes (ppr con) +ppr_cons cons = interpp'SP cons classOpCtxt :: Var -> Type -> SDoc classOpCtxt sel_id tau = sep [text "When checking the class method:", ===================================== compiler/GHC/Tc/TyCl/Instance.hs ===================================== @@ -688,9 +688,8 @@ tcDataFamInstDecl mb_clsinfo tv_skol_env -- Do /not/ check that the number of patterns = tyConArity fam_tc -- See [Arity of data families] in GHC.Core.FamInstEnv ; (qtvs, pats, res_kind, stupid_theta) - <- tcDataFamInstHeader mb_clsinfo fam_tc outer_bndrs - fixity hs_ctxt hs_pats m_ksig hs_cons - new_or_data + <- tcDataFamInstHeader mb_clsinfo fam_tc outer_bndrs fixity + hs_ctxt hs_pats m_ksig new_or_data -- Eta-reduce the axiom if possible -- Quite tricky: see Note [Implementing eta reduction for data families] @@ -740,8 +739,9 @@ tcDataFamInstDecl mb_clsinfo tv_skol_env do { data_cons <- tcExtendTyVarEnv qtvs $ -- For H98 decls, the tyvars scope -- over the data constructors - tcConDecls rec_rep_tc new_or_data ty_binders final_res_kind - orig_res_ty hs_cons + tcConDecls new_or_data (DDInstance orig_res_ty) + rec_rep_tc ty_binders final_res_kind + hs_cons ; rep_tc_name <- newFamInstTyConName lfam_name pats ; axiom_name <- newFamInstAxiomName lfam_name [pats] @@ -857,7 +857,7 @@ TyVarEnv will simply be empty, and there is nothing to worry about. tcDataFamInstHeader :: AssocInstInfo -> TyCon -> HsOuterFamEqnTyVarBndrs GhcRn -> LexicalFixity -> LHsContext GhcRn - -> HsTyPats GhcRn -> Maybe (LHsKind GhcRn) -> [LConDecl GhcRn] + -> HsTyPats GhcRn -> Maybe (LHsKind GhcRn) -> NewOrData -> TcM ([TyVar], [Type], Kind, ThetaType) -- The "header" of a data family instance is the part other than @@ -865,7 +865,7 @@ tcDataFamInstHeader -- e.g. data instance D [a] :: * -> * where ... -- Here the "header" is the bit before the "where" tcDataFamInstHeader mb_clsinfo fam_tc outer_bndrs fixity - hs_ctxt hs_pats m_ksig hs_cons new_or_data + hs_ctxt hs_pats m_ksig new_or_data = do { traceTc "tcDataFamInstHeader {" (ppr fam_tc <+> ppr hs_pats) ; (tclvl, wanted, (scoped_tvs, (stupid_theta, lhs_ty, master_res_kind, instance_res_kind))) <- pushLevelAndSolveEqualitiesX "tcDataFamInstHeader" $ @@ -884,8 +884,8 @@ tcDataFamInstHeader mb_clsinfo fam_tc outer_bndrs fixity -- Add constraints from the result signature ; res_kind <- tc_kind_sig m_ksig - -- Add constraints from the data constructors - ; kcConDecls new_or_data res_kind hs_cons + -- Do not add constraints from the data constructors + -- See Note [Kind inference for data family instances] -- Check that the result kind of the TyCon applied to its args -- is compatible with the explicit signature (or Type, if there @@ -1049,6 +1049,86 @@ however, so this Note aims to describe these subtleties: themselves. Heavy sigh. But not truly hard; that's what tcbVisibilities does. +Note [Kind inference for data family instances] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider this GADT-style data type declaration, where I have used +fresh variables in the data constructor's type, to stress that c,d are +quite distinct from a,b. + data T a b where + MkT :: forall c d. c d -> T c d + +Following Note [Inferring kinds for type declarations] in GHC.Tc.TyCl, +to infer T's kind, we initially give T :: kappa, a monomorpic kind, +gather constraints from the header and data constructors, and conclude + T :: (kappa1 -> type) -> kappa1 -> Type +Then we generalise, giving + T :: forall k. (k->Type) -> k -> Type + +Now what about a data /instance/ decl + data family T :: forall k. (k->Type) -> k -> Type + + data instance T p Int where ... + +No doubt here! The poly-kinded T is instantiated with k=Type, so the +header really looks like + data instance T @Type (p :: Type->Type) Int where ... + +But what about this? + data instance T p q where + MkT :: forall r. r Int -> T r Int + +So what kind do 'p' and 'q' have? No clues from the header, but from +the data constructor we can clearly see that (r :: Type->Type). Does +that mean that the the /entire data instance/ is instantiated at Type, +like this? + data instance T @Type (p :: Type->Type) (q :: Type) where + ... + +Not at all! This is a /GADT/-style decl, so the kind argument might +be specialised in this particular data constructor, thus: + data instance T @k (p :: k->Type) (q :: k) where + MkT :: forall (r :: Type -> Type). + r Int -> T @Type r Int +(and perhaps specialised differently in some other data +constructor MkT2). + +The key difference in this case and 'data T' at the top of this Note +is that we have no known kind for 'data T'. We thus forbid different +specialisations of T in its constructors, in an attempt to avoid +inferring polymorphic recursion. In data family T, however, there is +no problem with polymorphic recursion: we already /fully know/ T's +kind -- that came from the family declaration, and is not influenced +by the data instances -- and hence we /can/ specialise T's kind +differently in different GADT data constructors. + +SHORT SUMMARY: in a data instance decl, it's not clear whether kind +constraints arising from the data constructors should be considered +local to the (GADT) data /constructor/ or should apply to the entire +data instance. + +DESIGN CHOICE: in data/newtype family instance declarations, we ignore +the /data constructor/ declarations altogether, looking only at the +data instance /header/. + +Observations: +* This choice is simple to describe, as well as simple to implment. + For a data/newtype instance decl, the instance kinds are influenced + /only/ by the header. + +* We could treat Haskell-98 style data-instance decls differently, by + taking the data constructors into account, since there are no GADT + issues. But we don't, for simplicity, and because it means you can + understand the data type instance by looking only at the header. + +* Newtypes can be declared in GADT syntax, but they can't do GADT-style + specialisation, so like Haskell-98 definitions we could take the + data constructors into account. Again we don't, for the same reason. + +So for now at least, we keep the simplest choice. See #18891 and !4419 +for more discussion of this issue. + +Kind inference for data types (Xie et al) https://arxiv.org/abs/1911.06153 +takes a slightly different approach. -} ===================================== docs/users_guide/9.2.1-notes.rst ===================================== @@ -14,6 +14,11 @@ Language (Serrano et al, ICFP 2020). More information here: :ref:`impredicative-polymorphism`. This replaces the old (undefined, flaky) behaviour of the :extension:`ImpredicativeTypes` extension. +* Kind inference for data/newtype instance declarations is slightly + more restrictive than before. See the user manual :ref:`kind-inference-data-family-instances`. + This is a breaking change, albeit a fairly obscure one that corrects a specification bug. + + Compiler ~~~~~~~~ ===================================== docs/users_guide/exts/poly_kinds.rst ===================================== @@ -130,8 +130,45 @@ This rule has occasionally-surprising consequences (see The kind-polymorphism from the class declaration makes ``D1`` kind-polymorphic, but not so ``D2``; and similarly ``F1``, ``F2``. +Kind inference in type signatures +--------------------------------- + +When kind-checking a type, GHC considers only what is written in that +type when figuring out how to generalise the type's kind. + +For example, +consider these definitions (with :extension:`ScopedTypeVariables`): :: + + data Proxy a -- Proxy :: forall k. k -> Type + p :: forall a. Proxy a + p = Proxy :: Proxy (a :: Type) + +GHC reports an error, saying that the kind of ``a`` should be a kind variable +``k``, not ``Type``. This is because, by looking at the type signature +``forall a. Proxy a``, GHC assumes ``a``'s kind should be generalised, not +restricted to be ``Type``. The function definition is then rejected for being +more specific than its type signature. + +.. _explicit-kind-quantification: + +Explicit kind quantification +---------------------------- + +Enabled by :extension:`PolyKinds`, GHC supports explicit kind quantification, +as in these examples: :: + + data Proxy :: forall k. k -> Type + f :: (forall k (a :: k). Proxy a -> ()) -> Int + +Note that the second example has a ``forall`` that binds both a kind ``k`` and +a type variable ``a`` of kind ``k``. In general, there is no limit to how +deeply nested this sort of dependency can work. However, the dependency must +be well-scoped: ``forall (a :: k) k. ...`` is an error. + + .. _inferring-variable-order: + Inferring the order of variables in a type/class declaration ------------------------------------------------------------ @@ -490,41 +527,91 @@ This also applies to GADT-style data instances: :: -- • In the data instance declaration for ‘T’ -Kind inference in closed type families --------------------------------------- +Kind inference in data type declarations +---------------------------------------- -Although all open type families are considered to have a complete -user-supplied kind signature, we can relax this condition for closed -type families, where we have equations on which to perform kind -inference. GHC will infer kinds for the arguments and result types of a -closed type family. +Consider the declaration :: -GHC supports *kind-indexed* type families, where the family matches both -on the kind and type. GHC will *not* infer this behaviour without a -complete user-supplied kind signature, as doing so would sometimes infer -non-principal types. Indeed, we can see kind-indexing as a form -of polymorphic recursion, where a type is used at a kind other than -its most general in its own definition. + data T1 f a = MkT1 (f a) + data T2 f a where + MkT2 :: f a -> T f a -For example: :: +In both cases GHC looks at the data constructor declarations to +give constraints on the kind of ``T``, yielding :: - type family F1 a where - F1 True = False - F1 False = True - F1 x = x - -- F1 fails to compile: kind-indexing is not inferred + T1, T2 :: forall k. (k -> Type) -> k -> Type - type family F2 (a :: k) where - F2 True = False - F2 False = True - F2 x = x - -- F2 fails to compile: no complete signature +Consider the type :: + + data G (a :: k) where + GInt :: G Int + GMaybe :: G Maybe + +This datatype ``G`` is GADT-like in both its kind and its type. Suppose you +have ``g :: G a``, where ``a :: k``. Then pattern matching to discover that +``g`` is in fact ``GMaybe`` tells you both that ``k ~ (Type -> Type)`` and +``a ~ Maybe``. The definition for ``G`` requires that :extension:`PolyKinds` +be in effect, but pattern-matching on ``G`` requires no extension beyond +:extension:`GADTs`. That this works is actually a straightforward extension +of regular GADTs and a consequence of the fact that kinds and types are the +same. + +Note that the datatype ``G`` is used at different kinds in its body, and +therefore that kind-indexed GADTs use a form of polymorphic recursion. +It is thus only possible to use this feature if you have provided a +complete user-supplied kind signature (CUSK) +for the datatype (:ref:`complete-kind-signatures`), or a standalone +kind signature (:ref:`standalone-kind-signatures`); +in the case of ``G`` we have a CUSK. +If you wish to see the kind indexing explicitly, you can do so by enabling :ghc-flag:`-fprint-explicit-kinds` and querying ``G`` with GHCi's :ghci-cmd:`:info` command: :: + + > :set -fprint-explicit-kinds + > :info G + type role G nominal nominal + type G :: forall k. k -> Type + data G @k a where + GInt :: G @Type Int + GMaybe :: G @(Type -> Type) Maybe + +where you can see the GADT-like nature of the two constructors. + +.. _kind-inference-data-family-instances: + +Kind inference for data/newtype instance declarations +----------------------------------------------------- + +Consider these declarations :: + + data family T :: forall k. (k->Type) -> k -> Type + + data instance T p q where + MkT :: forall r. r Int -> T r Int + +Here ``T`` has an invisible kind argument; and perhaps it is instantiated +to ``Type`` in the instance, thus :: + + data instance T @Type (p :: Type->Type) (q :: Type) where + MkT :: forall r. r Int -> T r Int + +Or perhaps we intended the specialisation to be in the GADT data +constructor, thus :: + + data instance T @k (p :: k->Type) (q :: k) where + MkT :: forall r. r Int -> T @Type r Int + +It gets more complicated if there are multiple constructors. In +general, there is no principled way to tell which type specialisation +comes from the data instance, and which from the individual GADT data +constructors. + +So GHC implements this rule: in data/newtype instance declararations +(unlike ordinary data/newtype declarations) we do *not* look at the +constructor declarations when inferring the shape of the instance +header. The principle is that *the instantiation of the data instance +should be apparent from the header alone*. This principle makes the +program easier to understand, and avoids the swamp of complexity +indicated above. - type family F3 (a :: k) :: k where - F3 True = False - F3 False = True - F3 x = x - -- OK Kind inference in class instance declarations --------------------------------------------- @@ -555,43 +642,8 @@ infrastructure, and it's not clear the payoff is worth it. If you want to restrict ``b``\ 's kind in the instance above, just use a kind signature in the instance head. -Kind inference in type signatures ---------------------------------- - -When kind-checking a type, GHC considers only what is written in that -type when figuring out how to generalise the type's kind. - -For example, -consider these definitions (with :extension:`ScopedTypeVariables`): :: - - data Proxy a -- Proxy :: forall k. k -> Type - p :: forall a. Proxy a - p = Proxy :: Proxy (a :: Type) - -GHC reports an error, saying that the kind of ``a`` should be a kind variable -``k``, not ``Type``. This is because, by looking at the type signature -``forall a. Proxy a``, GHC assumes ``a``'s kind should be generalised, not -restricted to be ``Type``. The function definition is then rejected for being -more specific than its type signature. - -.. _explicit-kind-quantification: - -Explicit kind quantification ----------------------------- - -Enabled by :extension:`PolyKinds`, GHC supports explicit kind quantification, -as in these examples: :: - - data Proxy :: forall k. k -> Type - f :: (forall k (a :: k). Proxy a -> ()) -> Int - -Note that the second example has a ``forall`` that binds both a kind ``k`` and -a type variable ``a`` of kind ``k``. In general, there is no limit to how -deeply nested this sort of dependency can work. However, the dependency must -be well-scoped: ``forall (a :: k) k. ...`` is an error. - -Implicit quantification in type synonyms and type family instances ------------------------------------------------------------------- +Kind inference in type synonyms and type family instances +--------------------------------------------------------- Consider the scoping rules for type synonyms and type family instances, such as these:: @@ -706,29 +758,44 @@ kinds. Consequently, visible dependent quantifiers are rejected in any context that is unambiguously the type of a term. They are also rejected in the types of data constructors. -Kind-indexed GADTs ------------------- +Kind inference in closed type families +-------------------------------------- -Consider the type :: +Although all open type families are considered to have a complete +user-supplied kind signature (:ref:`complete-kind-signatures`), +we can relax this condition for closed +type families, where we have equations on which to perform kind +inference. GHC will infer kinds for the arguments and result types of a +closed type family. - data G (a :: k) where - GInt :: G Int - GMaybe :: G Maybe +GHC supports *kind-indexed* type families, where the family matches both +on the kind and type. GHC will *not* infer this behaviour without a +complete user-supplied kind signature or standalone kind +signature (see :ref:`standalone-kind-signatures`), +because doing so would sometimes infer +non-principal types. Indeed, we can see kind-indexing as a form +of polymorphic recursion, where a type is used at a kind other than +its most general in its own definition. -This datatype ``G`` is GADT-like in both its kind and its type. Suppose you -have ``g :: G a``, where ``a :: k``. Then pattern matching to discover that -``g`` is in fact ``GMaybe`` tells you both that ``k ~ (Type -> Type)`` and -``a ~ Maybe``. The definition for ``G`` requires that :extension:`PolyKinds` -be in effect, but pattern-matching on ``G`` requires no extension beyond -:extension:`GADTs`. That this works is actually a straightforward extension -of regular GADTs and a consequence of the fact that kinds and types are the -same. +For example: :: -Note that the datatype ``G`` is used at different kinds in its body, and -therefore that kind-indexed GADTs use a form of polymorphic recursion. -It is thus only possible to use this feature if you have provided a -complete user-supplied kind signature -for the datatype (:ref:`complete-kind-signatures`). + type family F1 a where + F1 True = False + F1 False = True + F1 x = x + -- F1 fails to compile: kind-indexing is not inferred + + type family F2 (a :: k) where + F2 True = False + F2 False = True + F2 x = x + -- F2 fails to compile: no complete signature + + type family F3 (a :: k) :: k where + F3 True = False + F3 False = True + F3 x = x + -- OK Higher-rank kinds ----------------- ===================================== testsuite/tests/dependent/should_fail/T13780a.stderr ===================================== @@ -3,7 +3,7 @@ T13780a.hs:9:40: error: • Couldn't match kind ‘a’ with ‘Bool’ Expected kind ‘Foo a’, but ‘MkFoo’ has kind ‘Foo Bool’ ‘a’ is a rigid type variable bound by - a family instance declaration + the data constructor ‘SMkFoo’ at T13780a.hs:9:20-31 • In the second argument of ‘(~)’, namely ‘MkFoo’ In the definition of data constructor ‘SMkFoo’ ===================================== testsuite/tests/deriving/should_compile/T11416.hs ===================================== @@ -12,9 +12,11 @@ newtype T f (a :: ConstantT Type f) = T (f a) deriving Functor data family TFam1 (f :: k1) (a :: k2) -newtype instance TFam1 f (ConstantT a f) = TFam1 (f a) +newtype instance TFam1 (f :: k -> Type) (ConstantT (a :: k) f) + = TFam1 (f a) deriving Functor data family TFam2 (f :: k1) (a :: k2) -newtype instance TFam2 f (a :: ConstantT Type f) = TFam2 (f a) +newtype instance TFam2 (f :: Type -> Type) (a :: ConstantT Type f) + = TFam2 (f a) deriving Functor ===================================== testsuite/tests/deriving/should_compile/T9359.hs ===================================== @@ -9,6 +9,5 @@ data Cmp a where deriving (Show, Eq) data family CmpInterval (a :: Cmp k) (b :: Cmp k) :: Type -data instance CmpInterval (V c) Sup = Starting c +data instance CmpInterval (V (c :: Type)) Sup = Starting c deriving( Show ) - ===================================== testsuite/tests/indexed-types/should_compile/T14111.hs ===================================== @@ -0,0 +1,24 @@ +{-# LANGUAGE MagicHash, UnboxedSums, NoImplicitPrelude #-} +{-# LANGUAGE TypeFamilies #-} +-- {-# LANGUAGE PolyKinds #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE GADTs ,ExplicitNamespaces#-} +{-# LANGUAGE UnboxedTuples #-} + +module T14111 where + +import GHC.Exts +import GHC.Types +import Prelude (undefined) +import Data.Kind +import Data.Void + +data family Maybe(x :: TYPE (r :: RuntimeRep)) + +data instance Maybe (a :: Type ) where + MaybeSum :: (# a | (# #) #) -> Maybe a + +data instance Maybe (x :: TYPE 'UnliftedRep) where + MaybeSumU :: (# x | (# #) #) -> Maybe x ===================================== testsuite/tests/indexed-types/should_compile/T8707.hs ===================================== @@ -0,0 +1,11 @@ +{-# LANGUAGE TypeFamilies, PolyKinds, DataKinds, GADTs #-} + +module T8707 where + +import Data.Kind + +data family SingDF (a :: (k, k2 -> Type)) +data Ctor :: k -> Type + +data instance SingDF (a :: (Bool, Bool -> Type)) where + SFalse :: SingDF '(False, Ctor) ===================================== testsuite/tests/indexed-types/should_compile/all.T ===================================== @@ -300,3 +300,5 @@ test('T18809', normal, compile, ['-O']) test('CEqCanOccursCheck', normal, compile, ['']) test('GivenLoop', normal, compile, ['']) test('T18875', normal, compile, ['']) +test('T8707', normal, compile, ['-O']) +test('T14111', normal, compile, ['-O']) ===================================== testsuite/tests/indexed-types/should_fail/T8368.stderr ===================================== @@ -1,6 +1,5 @@ -T8368.hs:9:3: - Data constructor ‘MkFam’ returns type ‘Foo’ - instead of an instance of its parent type ‘Fam a’ - In the definition of data constructor ‘MkFam’ - In the data instance declaration for ‘Fam’ +T8368.hs:9:3: error: + • Couldn't match expected type ‘Fam a0’ with actual type ‘Foo’ + • In the result type of data constructor ‘MkFam’ + In the data instance declaration for ‘Fam’ ===================================== testsuite/tests/indexed-types/should_fail/T8368a.stderr ===================================== @@ -1,6 +1,7 @@ -T8368a.hs:7:3: - Data constructor ‘MkFam’ returns type ‘Fam Bool b’ - instead of an instance of its parent type ‘Fam Int b’ - In the definition of data constructor ‘MkFam’ - In the data instance declaration for ‘Fam’ +T8368a.hs:7:3: error: + • Couldn't match type ‘Bool’ with ‘Int’ + Expected: Fam Int b + Actual: Fam Bool b + • In the result type of data constructor ‘MkFam’ + In the data instance declaration for ‘Fam’ ===================================== testsuite/tests/patsyn/should_fail/T15685.stderr ===================================== @@ -1,13 +1,13 @@ T15685.hs:13:24: error: - • Could not deduce: a ~ [k0] - from the context: as ~ (a1 : as1) + • Could not deduce: k ~ [k0] + from the context: as ~ (a : as1) bound by a pattern with constructor: - Here :: forall {a1} (f :: a1 -> *) (a2 :: a1) (as :: [a1]). - f a2 -> NS f (a2 : as), + Here :: forall {k} (f :: k -> *) (a :: k) (as :: [k]). + f a -> NS f (a : as), in a pattern synonym declaration at T15685.hs:13:19-26 - ‘a’ is a rigid type variable bound by + ‘k’ is a rigid type variable bound by the inferred type of HereNil :: NS f as at T15685.hs:13:9-15 Possible fix: add a type signature for ‘HereNil’ ===================================== testsuite/tests/polykinds/T13659.stderr ===================================== @@ -1,6 +1,6 @@ -T13659.hs:14:27: error: - • Expected a type, but ‘a’ has kind ‘[*]’ - • In the first argument of ‘Format’, namely ‘'[Int, a]’ - In the type ‘Format '[Int, a]’ +T13659.hs:14:15: error: + • Expected kind ‘[*]’, but ‘a’ has kind ‘*’ + • In the first argument of ‘Format’, namely ‘a’ + In the type ‘Format a’ In the definition of data constructor ‘I’ ===================================== testsuite/tests/polykinds/T16221a.stderr ===================================== @@ -1,7 +1,7 @@ T16221a.hs:6:49: error: - • Expected kind ‘k’, but ‘b’ has kind ‘k1’ - ‘k1’ is a rigid type variable bound by + • Expected kind ‘k’, but ‘b’ has kind ‘k2’ + ‘k2’ is a rigid type variable bound by an explicit forall k (b :: k) at T16221a.hs:6:20 ‘k’ is a rigid type variable bound by ===================================== testsuite/tests/th/T11145.stderr ===================================== @@ -1,8 +1,7 @@ T11145.hs:8:1: error: - • Data constructor ‘MkFuggle’ returns type ‘Fuggle - Int (Maybe Bool)’ - instead of an instance of its parent type ‘Fuggle - Int (Maybe (a, b))’ - • In the definition of data constructor ‘MkFuggle’ + • Couldn't match type ‘Bool’ with ‘(a0, b0)’ + Expected: Fuggle Int (Maybe (a0, b0)) + Actual: Fuggle Int (Maybe Bool) + • In the result type of data constructor ‘MkFuggle’ In the data instance declaration for ‘Fuggle’ ===================================== testsuite/tests/th/T9692.hs ===================================== @@ -12,7 +12,7 @@ class C a where data F a (b :: k) :: Type instance C Int where - data F Int x = FInt x + data F Int (x :: Type) = FInt x $( do info <- qReify (mkName "F") runIO $ putStrLn $ pprint info ===================================== testsuite/tests/typecheck/should_compile/T18891.hs ===================================== @@ -0,0 +1,16 @@ +{-# LANGUAGE GADTs, UnliftedNewtypes, StandaloneKindSignatures, RankNTypes, TypeFamilies, PolyKinds #-} + +module T18891 where + +import GHC.Exts( TYPE ) + +data family T2 (a :: k) +data instance T2 a where + MkT2 :: T2 Maybe + +newtype N3 :: forall k -> TYPE k where + MkN3 :: N3 m -> N3 m + +type N4 :: forall k -> TYPE k +newtype N4 :: forall k -> TYPE k where + MkN4 :: N4 m -> N4 m ===================================== testsuite/tests/typecheck/should_compile/UnliftedNewtypesUnassociatedFamily.hs ===================================== @@ -4,6 +4,8 @@ {-# LANGUAGE PolyKinds #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TypeApplications #-} module UnliftedNewtypesUnassociatedFamily where @@ -20,7 +22,16 @@ newtype instance DFT ('TupleRep '[ 'IntRep, 'WordRep]) data instance DFT 'LiftedRep = MkDFT4 | MkDFT5 data family DF :: TYPE (r :: RuntimeRep) -newtype instance DF = MkDF1 Int# -newtype instance DF = MkDF2 Word# -newtype instance DF = MkDF3 (# Int#, Word# #) + +-- Use a type application +newtype instance DF @IntRep = MkDF1 Int# + +-- Use a kind signature +newtype instance DF :: TYPE 'WordRep where + MkDF2 :: Word# -> DF + +-- Also uses a kind signature +newtype instance DF :: TYPE ('TupleRep '[ 'IntRep, 'WordRep ]) where + MkDF3 :: (# Int#, Word# #) -> DF + data instance DF = MkDF4 | MkDF5 ===================================== testsuite/tests/typecheck/should_compile/UnliftedNewtypesUnifySig.hs ===================================== @@ -10,14 +10,14 @@ module UnliftedNewtypesUnassociatedFamily where import GHC.Int (Int(I#)) -import GHC.Exts (Int#,Word#,RuntimeRep(IntRep)) +import GHC.Exts (Int#,Word#,RuntimeRep(IntRep,WordRep)) import GHC.Exts (TYPE) type KindOf (a :: TYPE k) = k data family D (a :: TYPE r) :: TYPE r -newtype instance D a = MkWordD Word# +newtype instance D (a :: TYPE 'WordRep) = MkWordD Word# -newtype instance D a :: TYPE (KindOf a) where - MkIntD :: forall a. Int# -> D a +newtype instance D (a :: TYPE 'IntRep) :: TYPE (KindOf a) where + MkIntD :: forall (b :: TYPE 'IntRep). Int# -> D b ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -736,3 +736,4 @@ test('InstanceGivenOverlap', normal, compile, ['']) test('InstanceGivenOverlap2', normal, compile, ['']) test('LocalGivenEqs', normal, compile, ['']) test('LocalGivenEqs2', normal, compile, ['']) +test('T18891', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_fail/T18891a.hs ===================================== @@ -0,0 +1,13 @@ +{-# LANGUAGE GADTs, UnliftedNewtypes, StandaloneKindSignatures, RankNTypes, TypeFamilies, PolyKinds #-} + +module T18891 where + +import GHC.Exts( TYPE ) + +newtype N1 :: forall k. TYPE k where + MkN1 :: N1 -> N1 + +type N2 :: forall k. TYPE k +newtype N2 :: forall k. TYPE k where + MkN2 :: N2 -> N2 + ===================================== testsuite/tests/typecheck/should_fail/T18891a.stderr ===================================== @@ -0,0 +1,12 @@ + +T18891a.hs:8:4: error: + • A newtype constructor must have a return type of form T a1 ... an + MkN1 :: N1 -> N1 + • In the definition of data constructor ‘MkN1’ + In the newtype declaration for ‘N1’ + +T18891a.hs:12:3: error: + • A newtype constructor must have a return type of form T a1 ... an + MkN2 :: N2 -> N2 + • In the definition of data constructor ‘MkN2’ + In the newtype declaration for ‘N2’ ===================================== testsuite/tests/typecheck/should_fail/UnliftedNewtypesFamilyKindFail2.stderr ===================================== @@ -1,11 +1,5 @@ -UnliftedNewtypesFamilyKindFail2.hs:12:20: - Expected a type, but ‘5’ has kind ‘GHC.Num.Natural.Natural’ - In the first argument of ‘F’, namely ‘5’ - In the newtype instance declaration for ‘F’ - -UnliftedNewtypesFamilyKindFail2.hs:12:31: - Expected a type, but ‘5’ has kind ‘GHC.Num.Natural.Natural’ - In the first argument of ‘F’, namely ‘5’ - In the type ‘(F 5)’ - In the definition of data constructor ‘MkF’ +UnliftedNewtypesFamilyKindFail2.hs:12:20: error: + • Expected a type, but ‘5’ has kind ‘GHC.Num.Natural.Natural’ + • In the first argument of ‘F’, namely ‘5’ + In the newtype instance declaration for ‘F’ ===================================== testsuite/tests/typecheck/should_fail/UnliftedNewtypesUnassociatedFamilyFail.hs ===================================== @@ -0,0 +1,23 @@ +{-# LANGUAGE UnliftedNewtypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE GADTs #-} + +module UnliftedNewtypesUnassociatedFamily where + +import GHC.Int (Int(I#)) +import GHC.Word (Word(W#)) +import GHC.Exts (Int#,Word#) +import GHC.Exts (TYPE,RuntimeRep(LiftedRep,IntRep,WordRep,TupleRep)) + +data family DF :: TYPE (r :: RuntimeRep) + +-- All these fail: see #18891 and !4419 +-- See Note [Kind inference for data family instances] +-- in GHC.Tc.TyCl.Instance +newtype instance DF = MkDF1a Int# +newtype instance DF = MkDF2a Word# +newtype instance DF = MkDF3a (# Int#, Word# #) ===================================== testsuite/tests/typecheck/should_fail/UnliftedNewtypesUnassociatedFamilyFail.stderr ===================================== @@ -0,0 +1,18 @@ + +UnliftedNewtypesUnassociatedFamilyFail.hs:21:30: error: + • Expecting a lifted type, but ‘Int#’ is unlifted + • In the type ‘Int#’ + In the definition of data constructor ‘MkDF1a’ + In the newtype instance declaration for ‘DF’ + +UnliftedNewtypesUnassociatedFamilyFail.hs:22:30: error: + • Expecting a lifted type, but ‘Word#’ is unlifted + • In the type ‘Word#’ + In the definition of data constructor ‘MkDF2a’ + In the newtype instance declaration for ‘DF’ + +UnliftedNewtypesUnassociatedFamilyFail.hs:23:30: error: + • Expecting a lifted type, but ‘(# Int#, Word# #)’ is unlifted + • In the type ‘(# Int#, Word# #)’ + In the definition of data constructor ‘MkDF3a’ + In the newtype instance declaration for ‘DF’ ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -546,6 +546,7 @@ test('UnliftedNewtypesConstraintFamily', normal, compile_fail, ['']) test('UnliftedNewtypesMismatchedKind', normal, compile_fail, ['']) test('UnliftedNewtypesMismatchedKindRecord', normal, compile_fail, ['']) test('UnliftedNewtypesMultiFieldGadt', normal, compile_fail, ['']) +test('UnliftedNewtypesUnassociatedFamilyFail', normal, compile_fail, ['']) test('T13834', normal, compile_fail, ['']) test('T17077', normal, compile_fail, ['']) test('T16512a', normal, compile_fail, ['']) @@ -591,3 +592,4 @@ test('T18640c', normal, compile_fail, ['']) test('T10709', normal, compile_fail, ['']) test('T10709b', normal, compile_fail, ['']) test('GivenForallLoop', normal, compile_fail, ['']) +test('T18891a', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/558cabbc5fbd34d4bd47acf50a1c22d44dd41b97 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/558cabbc5fbd34d4bd47acf50a1c22d44dd41b97 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 3 23:29:29 2020 From: gitlab at gitlab.haskell.org (Alan Zimmerman) Date: Thu, 03 Dec 2020 18:29:29 -0500 Subject: [Git][ghc/ghc][wip/az/exactprint] 41 commits: nativeGen/dwarf: Fix procedure end addresses Message-ID: <5fc974d951f66_6a09bf27001632e8@gitlab.mail> Alan Zimmerman pushed to branch wip/az/exactprint at Glasgow Haskell Compiler / GHC Commits: 0a7e592c by Ben Gamari at 2020-11-15T03:35:45-05:00 nativeGen/dwarf: Fix procedure end addresses Previously the `.debug_aranges` and `.debug_info` (DIE) DWARF information would claim that procedures (represented with a `DW_TAG_subprogram` DIE) would only span the range covered by their entry block. This omitted all of the continuation blocks (represented by `DW_TAG_lexical_block` DIEs), confusing `perf`. Fix this by introducing a end-of-procedure label and using this as the `DW_AT_high_pc` of procedure `DW_TAG_subprogram` DIEs Fixes #17605. - - - - - 1e19183d by Ben Gamari at 2020-11-15T03:35:45-05:00 nativeGen/dwarf: Only produce DW_AT_source_note DIEs in -g3 Standard debugging tools don't know how to understand these so let's not produce them unless asked. - - - - - ad73370f by Ben Gamari at 2020-11-15T03:35:45-05:00 nativeGen/dwarf: Use DW_AT_linkage instead of DW_AT_MIPS_linkage - - - - - a2539650 by Ben Gamari at 2020-11-15T03:35:45-05:00 gitlab-ci: Add DWARF release jobs for Debian 10, Fedora27 - - - - - d61adb3d by Ryan Scott at 2020-11-15T03:36:21-05:00 Name (tc)SplitForAll- functions more consistently There is a zoo of `splitForAll-` functions in `GHC.Core.Type` (as well as `tcSplitForAll-` functions in `GHC.Tc.Utils.TcType`) that all do very similar things, but vary in the particular form of type variable that they return. To make things worse, the names of these functions are often quite misleading. Some particularly egregious examples: * `splitForAllTys` returns `TyCoVar`s, but `splitSomeForAllTys` returns `VarBndr`s. * `splitSomeForAllTys` returns `VarBndr`s, but `tcSplitSomeForAllTys` returns `TyVar`s. * `splitForAllTys` returns `TyCoVar`s, but `splitForAllTysInvis` returns `InvisTVBinder`s. (This in particular arose in the context of #18939, and this finally motivated me to bite the bullet and improve the status quo vis-à-vis how we name these functions.) In an attempt to bring some sanity to how these functions are named, I have opted to rename most of these functions en masse to use consistent suffixes that describe the particular form of type variable that each function returns. In concrete terms, this amounts to: * Functions that return a `TyVar` now use the suffix `-TyVar`. This caused the following functions to be renamed: * `splitTyVarForAllTys` -> `splitForAllTyVars` * `splitForAllTy_ty_maybe` -> `splitForAllTyVar_maybe` * `tcSplitForAllTys` -> `tcSplitForAllTyVars` * `tcSplitSomeForAllTys` -> `tcSplitSomeForAllTyVars` * Functions that return a `CoVar` now use the suffix `-CoVar`. This caused the following functions to be renamed: * `splitForAllTy_co_maybe` -> `splitForAllCoVar_maybe` * Functions that return a `TyCoVar` now use the suffix `-TyCoVar`. This caused the following functions to be renamed: * `splitForAllTy` -> `splitForAllTyCoVar` * `splitForAllTys` -> `splitForAllTyCoVars` * `splitForAllTys'` -> `splitForAllTyCoVars'` * `splitForAllTy_maybe` -> `splitForAllTyCoVar_maybe` * Functions that return a `VarBndr` now use the suffix corresponding to the most relevant type synonym. This caused the following functions to be renamed: * `splitForAllVarBndrs` -> `splitForAllTyCoVarBinders` * `splitForAllTysInvis` -> `splitForAllInvisTVBinders` * `splitForAllTysReq` -> `splitForAllReqTVBinders` * `splitSomeForAllTys` -> `splitSomeForAllTyCoVarBndrs` * `tcSplitForAllVarBndrs` -> `tcSplitForAllTyVarBinders` * `tcSplitForAllTysInvis` -> `tcSplitForAllInvisTVBinders` * `tcSplitForAllTysReq` -> `tcSplitForAllReqTVBinders` * `tcSplitForAllTy_maybe` -> `tcSplitForAllTyVarBinder_maybe` Note that I left the following functions alone: * Functions that split apart things besides `ForAllTy`s, such as `splitFunTys` or `splitPiTys`. Thankfully, there are far fewer of these functions than there are functions that split apart `ForAllTy`s, so there isn't much of a pressing need to apply the new naming convention elsewhere. * Functions that split apart `ForAllCo`s in `Coercion`s, such as `GHC.Core.Coercion.splitForAllCo_maybe`. We could theoretically apply the new naming convention here, but then we'd have to figure out how to disambiguate `Type`-splitting functions from `Coercion`-splitting functions. Ultimately, the `Coercion`-splitting functions aren't used nearly as much as the `Type`-splitting functions, so I decided to leave the former alone. This is purely refactoring and should cause no change in behavior. - - - - - 645444af by Ryan Scott at 2020-11-15T03:36:21-05:00 Use tcSplitForAllInvisTyVars (not tcSplitForAllTyVars) in more places The use of `tcSplitForAllTyVars` in `tcDataFamInstHeader` was the immediate cause of #18939, and replacing it with a new `tcSplitForAllInvisTyVars` function (which behaves like `tcSplitForAllTyVars` but only splits invisible type variables) fixes the issue. However, this led me to realize that _most_ uses of `tcSplitForAllTyVars` in GHC really ought to be `tcSplitForAllInvisTyVars` instead. While I was in town, I opted to replace most uses of `tcSplitForAllTys` with `tcSplitForAllTysInvis` to reduce the likelihood of such bugs in the future. I say "most uses" above since there is one notable place where we _do_ want to use `tcSplitForAllTyVars`: in `GHC.Tc.Validity.forAllTyErr`, which produces the "`Illegal polymorphic type`" error message if you try to use a higher-rank `forall` without having `RankNTypes` enabled. Here, we really do want to split all `forall`s, not just invisible ones, or we run the risk of giving an inaccurate error message in the newly added `T18939_Fail` test case. I debated at some length whether I wanted to name the new function `tcSplitForAllInvisTyVars` or `tcSplitForAllTyVarsInvisible`, but in the end, I decided that I liked the former better. For consistency's sake, I opted to rename the existing `splitPiTysInvisible` and `splitPiTysInvisibleN` functions to `splitInvisPiTys` and `splitPiTysInvisN`, respectively, so that they use the same naming convention. As a consequence, this ended up requiring a `haddock` submodule bump. Fixes #18939. - - - - - 8887102f by Moritz Angermann at 2020-11-15T03:36:56-05:00 AArch64/arm64 adjustments This addes the necessary logic to support aarch64 on elf, as well as aarch64 on mach-o, which Apple calls arm64. We change architecture name to AArch64, which is the official arm naming scheme. - - - - - fc644b1a by Ben Gamari at 2020-11-15T03:37:31-05:00 ghc-bin: Build with eventlogging by default We now have all sorts of great facilities using the eventlog which were previously unavailable without building a custom GHC. Fix this by linking with `-eventlog` by default. - - - - - 52114fa0 by Sylvain Henry at 2020-11-16T11:48:47+01:00 Add Addr# atomic primops (#17751) This reuses the codegen used for ByteArray#'s atomic primops. - - - - - 8150f654 by Sebastian Graf at 2020-11-18T23:38:40-05:00 PmCheck: Print types of uncovered patterns (#18932) In order to avoid confusion as in #18932, we display the type of the match variables in the non-exhaustiveness warning, e.g. ``` T18932.hs:14:1: warning: [-Wincomplete-patterns] Pattern match(es) are non-exhaustive In an equation for ‘g’: Patterns of type ‘T a’, ‘T a’, ‘T a’ not matched: (MkT2 _) (MkT1 _) (MkT1 _) (MkT2 _) (MkT1 _) (MkT2 _) (MkT2 _) (MkT2 _) (MkT1 _) (MkT2 _) (MkT2 _) (MkT2 _) ... | 14 | g (MkT1 x) (MkT1 _) (MkT1 _) = x | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ``` It also allows us to omit the type signature on wildcard matches which we previously showed in only some situations, particularly `-XEmptyCase`. Fixes #18932. - - - - - 165352a2 by Krzysztof Gogolewski at 2020-11-20T02:08:36-05:00 Export indexError from GHC.Ix (#18579) - - - - - b57845c3 by Kamil Dworakowski at 2020-11-20T02:09:16-05:00 Clarify interruptible FFI wrt masking state - - - - - 321d1bd8 by Sebastian Graf at 2020-11-20T02:09:51-05:00 Fix strictness signatures of `prefetchValue*#` primops Their strictness signatures said the primops are strict in their first argument, which is wrong: Handing it a thunk will prefetch the pointer to the thunk, but not evaluate it. Hence not strict. The regression test `T8256` actually tests for laziness in the first argument, so GHC apparently never exploited the strictness signature. See also https://gitlab.haskell.org/ghc/ghc/-/issues/8256#note_310867, where this came up. - - - - - 0aec78b6 by Sebastian Graf at 2020-11-20T02:09:51-05:00 Demand: Interleave usage and strictness demands (#18903) As outlined in #18903, interleaving usage and strictness demands not only means a more compact demand representation, but also allows us to express demands that we weren't easily able to express before. Call demands are *relative* in the sense that a call demand `Cn(cd)` on `g` says "`g` is called `n` times. *Whenever `g` is called*, the result is used according to `cd`". Example from #18903: ```hs h :: Int -> Int h m = let g :: Int -> (Int,Int) g 1 = (m, 0) g n = (2 * n, 2 `div` n) {-# NOINLINE g #-} in case m of 1 -> 0 2 -> snd (g m) _ -> uncurry (+) (g m) ``` Without the interleaved representation, we would just get `L` for the strictness demand on `g`. Now we are able to express that whenever `g` is called, its second component is used strictly in denoting `g` by `1C1(P(1P(U),SP(U)))`. This would allow Nested CPR to unbox the division, for example. Fixes #18903. While fixing regressions, I also discovered and fixed #18957. Metric Decrease: T13253-spj - - - - - 3a55b3a2 by Sebastian Graf at 2020-11-20T02:09:51-05:00 Update user's guide entry on demand analysis and worker/wrapper The demand signature notation has been undocumented for a long time. The only source to understand it, apart from reading the `Outputable` instance, has been an outdated wiki page. Since the previous commits have reworked the demand lattice, I took it as an opportunity to also write some documentation about notation. - - - - - fc963932 by Greg Steuck at 2020-11-20T02:10:31-05:00 Find hadrian location more reliably in cabal-install output Fix #18944 - - - - - 9f40cf6c by Ben Gamari at 2020-11-20T02:11:07-05:00 rts/linker: Align bssSize to page size when mapping symbol extras We place symbol_extras right after bss. We also need to ensure that symbol_extras can be mprotect'd independently from the rest of the image. To ensure this we round up the size of bss to a page boundary, thus ensuring that symbol_extras is also page-aligned. - - - - - b739c319 by Ben Gamari at 2020-11-20T02:11:43-05:00 gitlab-ci: Add usage message to ci.sh - - - - - 802e9180 by Ben Gamari at 2020-11-20T02:11:43-05:00 gitlab-ci: Add VERBOSE environment variable And change the make build system's default behavior to V=0, greatly reducing build log sizes. - - - - - 2a8a979c by Ben Gamari at 2020-11-21T01:13:26-05:00 users-guide: A bit of clean-up in profiling flag documentation - - - - - 56804e33 by Ben Gamari at 2020-11-21T01:13:26-05:00 testsuite: Refactor CountParserDeps - - - - - 53ad67ea by Ben Gamari at 2020-11-21T01:13:26-05:00 Introduce -fprof-callers flag This introducing a new compiler flag to provide a convenient way to introduce profiler cost-centers on all occurrences of the named identifier. Closes #18566. - - - - - ecfd0278 by Sylvain Henry at 2020-11-21T01:14:09-05:00 Move Plugins into HscEnv (#17957) Loaded plugins have nothing to do in DynFlags so this patch moves them into HscEnv (session state). "DynFlags plugins" become "Driver plugins" to still be able to register static plugins. Bump haddock submodule - - - - - 72f2257c by Sylvain Henry at 2020-11-21T01:14:09-05:00 Don't initialize plugins in the Core2Core pipeline Some plugins can be added via TH (cf addCorePlugin). Initialize them in the driver instead of in the Core2Core pipeline. - - - - - ddbeeb3c by Ryan Scott at 2020-11-21T01:14:44-05:00 Add regression test for #10504 This issue was fixed at some point between GHC 8.0 and 8.2. Let's add a regression test to ensure that it stays fixed. Fixes #10504. - - - - - a4a6dc2a by Ben Gamari at 2020-11-21T01:15:21-05:00 dwarf: Apply info table offset consistently Previously we failed to apply the info table offset to the aranges and DIEs, meaning that we often failed to unwind in gdb. For some reason this only seemed to manifest in the RTS's Cmm closures. Nevertheless, now we can unwind completely up to `main` - - - - - 69bfbc21 by Ben Gamari at 2020-11-21T01:15:56-05:00 hadrian: Disable stripping when debug information is enabled - - - - - 7e93ae8b by Ben Gamari at 2020-11-21T13:13:29-05:00 rts: Post ticky entry counts to the eventlog We currently only post the entry counters, not the other global counters as in my experience the former are more useful. We use the heap profiler's census period to decide when to dump. Also spruces up the documentation surrounding ticky-ticky a bit. - - - - - bc9c3916 by Ben Gamari at 2020-11-22T06:28:10-05:00 Implement -ddump-c-backend argument To dump output of the C backend. - - - - - 901bc220 by Ben Gamari at 2020-11-22T12:39:02-05:00 Bump time submodule to 1.11.1 Also bumps directory, Cabal, hpc, time, and unix submodules. Closes #18847. - - - - - 92c0afbf by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Dump STG when ticky is enabled This changes the "ticky" modifier to enable dumping of final STG as this is generally needed to make sense of the ticky profiles. - - - - - d23fef68 by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Introduce notion of flavour transformers This extends Hadrian's notion of "flavour", as described in #18942. - - - - - 179d0bec by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Add a viaLlvmBackend modifier Note that this also slightly changes the semantics of these flavours as we only use LLVM for >= stage1 builds. - - - - - d4d95e51 by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Add profiled_ghc and no_dynamic_ghc modifiers - - - - - 6815603f by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Drop redundant flavour definitions Drop the profiled, LLVM, and ThreadSanitizer flavour definitions as these can now be realized with flavour transformers. - - - - - f88f4339 by Ben Gamari at 2020-11-24T02:43:20-05:00 rts: Flush eventlog buffers from flushEventLog As noted in #18043, flushTrace failed flush anything beyond the writer. This means that a significant amount of data sitting in capability-local event buffers may never get flushed, despite the users' pleads for us to flush. Fix this by making flushEventLog flush all of the event buffers before flushing the writer. Fixes #18043. - - - - - 7c03cc50 by Ben Gamari at 2020-11-24T02:43:55-05:00 gitlab-ci: Run LLVM job on appropriately-labelled MRs Namely, those marked with the ~"LLVM backend" label - - - - - 9b95d815 by Ben Gamari at 2020-11-24T02:43:55-05:00 gitlab-ci: Run LLVM builds on Debian 10 The current Debian 9 image doesn't provide LLVM 7. - - - - - 2ed3e6c0 by Ben Gamari at 2020-11-24T02:43:55-05:00 CmmToLlvm: Declare signature for memcmp Otherwise `opt` fails with: error: use of undefined value '@memcmp$def' - - - - - ba0b7569 by Alan Zimmerman at 2020-11-25T17:38:53+00:00 Proof of Concept implementation of in-tree API Annotations This MR introduces a possible machinery to introduce API Annotations into the TTG extension points. It is intended to be a concrete example for discussion. It still needs to process comments. Remove LHsLocalBinds Fix up after rebasing to bring in XRec Main thing is to make type instance XRec (GhcPass p) a = GenLocated (Anno a) a type family Anno a = b But this has massive implications. - - - - - 49ec8bb9 by Alan Zimmerman at 2020-12-03T23:29:01+00:00 WIP on delta printing. Making progress - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - aclocal.m4 - compiler/GHC.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/Config.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/Dwarf/Constants.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs - compiler/GHC/CmmToAsm/Reg/Linear.hs - compiler/GHC/CmmToAsm/Reg/Linear/FreeRegs.hs - compiler/GHC/CmmToAsm/Reg/Target.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - + compiler/GHC/Core/Opt/CallerCC.hs - + compiler/GHC/Core/Opt/CallerCC.hs-boot - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/CprAnal.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Pipeline.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/48aec3ebc01d9c50148d614d75abc71e695fb3fa...49ec8bb98e2304eab04991a888f4e3c80a82ece9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/48aec3ebc01d9c50148d614d75abc71e695fb3fa...49ec8bb98e2304eab04991a888f4e3c80a82ece9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 3 23:35:17 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Thu, 03 Dec 2020 18:35:17 -0500 Subject: [Git][ghc/ghc][wip/T18891] Fix kind inference for data types. Again. Message-ID: <5fc97635e91af_6a09b8feac1655d1@gitlab.mail> Simon Peyton Jones pushed to branch wip/T18891 at Glasgow Haskell Compiler / GHC Commits: 9f5d93df by Simon Peyton Jones at 2020-12-03T23:34:16+00:00 Fix kind inference for data types. Again. This patch fixes several aspects of kind inference for data type declarations, especially data /instance/ declarations Specifically 1. In kcConDecls/kcConDecl make it clear that the tc_res_kind argument is only used in the H98 case; and in that case there is no result kind signature; and hence no need for the disgusting splitPiTys in kcConDecls (now thankfully gone). The GADT case is a bit different to before, and much nicer. This is what fixes #18891. See Note [kcConDecls: kind-checking data type decls] 2. Do not look at the constructor decls of a data/newtype instance in tcDataFamInstanceHeader. See GHC.Tc.TyCl.Instance Note [Kind inference for data family instances]. This was a new realisation that arose when doing (1) This causes a few knock-on effects in the tests suite, because we require more information than before in the instance /header/. New user-manual material about this in "Kind inference in data type declarations" and "Kind inference for data/newtype instance declarations". 3. Minor improvement in kcTyClDecl, combining GADT and H98 cases 4. Fix #14111 and #8707 by allowing the header of a data instance to affect kind inferece for the the data constructor signatures; as described at length in Note [GADT return types] in GHC.Tc.TyCl This led to a modest refactoring of the arguments (and argument order) of tcConDecl/tcConDecls. 5. Fix #19000 by inverting the sense of the test in new_locs in GHC.Tc.Solver.Canonical.canDecomposableTyConAppOK. Rather to my surprise, CI tells us that we get quite a few compile time perf improvements in compiler bytes-allocated. Here are the ones that reduced more than 1%. Good news! I have no idea why. Test Metric value New value Change --------------------------------------------------------------------------- ManyAlternatives(normal) ghc/alloc 803792416.0 800063504.0 -0.5% Naperian(optasm) ghc/alloc 54311984.0 52874144.0 -2.6% GOOD PmSeriesG(normal) ghc/alloc 57119912.0 53369856.0 -6.6% PmSeriesS(normal) ghc/alloc 71507464.0 67756248.0 -5.2% PmSeriesT(normal) ghc/alloc 104597416.0 100846208.0 -3.6% PmSeriesV(normal) ghc/alloc 70326360.0 66576336.0 -5.3% T10421(normal) ghc/alloc 132567776.0 128845672.0 -2.8% GOOD T10421a(normal) ghc/alloc 94605104.0 90858592.0 -4.0% T10547(normal) ghc/alloc 34996968.0 33557256.0 -4.1% GOOD T10858(normal) ghc/alloc 212086488.0 208375832.0 -1.7% T11195(normal) ghc/alloc 310033360.0 306391248.0 -1.2% T11276(normal) ghc/alloc 145378016.0 141657896.0 -2.6% T11303b(normal) ghc/alloc 55148504.0 51404904.0 -6.8% T11374(normal) ghc/alloc 243783840.0 240133008.0 -1.5% T11822(normal) ghc/alloc 154231136.0 150490720.0 -2.4% T12150(optasm) ghc/alloc 94489040.0 90752656.0 -4.0% GOOD T12234(optasm) ghc/alloc 69407208.0 65659624.0 -5.4% GOOD T12425(optasm) ghc/alloc 115122960.0 111397664.0 -3.2% GOOD T13035(normal) ghc/alloc 118754176.0 114795136.0 -3.3% GOOD T13253-spj(normal) ghc/alloc 168969768.0 165225400.0 -2.2% GOOD T15630(normal) ghc/alloc 201226672.0 197491904.0 -1.9% T16190(normal) ghc/alloc 289119984.0 285560848.0 -1.2% T17096(normal) ghc/alloc 326080472.0 322369512.0 -1.1% T17836b(normal) ghc/alloc 69578304.0 65830328.0 -5.4% T17977(normal) ghc/alloc 55833520.0 52094448.0 -6.7% T17977b(normal) ghc/alloc 50731152.0 46983088.0 -7.4% T18140(normal) ghc/alloc 120628376.0 116879552.0 -3.1% GOOD T18282(normal) ghc/alloc 170207168.0 166491784.0 -2.2% GOOD T18304(normal) ghc/alloc 107596576.0 103853360.0 -3.5% GOOD T3064(normal) ghc/alloc 209696560.0 205954384.0 -1.8% T4801(normal) ghc/alloc 376239392.0 372505256.0 -1.0% T5030(normal) ghc/alloc 388667176.0 384947480.0 -1.0% T5321FD(normal) ghc/alloc 332509600.0 328779208.0 -1.1% T5321Fun(normal) ghc/alloc 379067288.0 375338056.0 -1.0% T5837(normal) ghc/alloc 46272360.0 42540544.0 -8.1% GOOD T6048(optasm) ghc/alloc 99200336.0 95462744.0 -3.8% GOOD T9020(optasm) ghc/alloc 282057000.0 278339944.0 -1.3% T9233(normal) ghc/alloc 967401992.0 963669872.0 -0.4% Metric Decrease: Naperian T10421 T10547 T12150 T12234 T12425 T13035 T13253-spj T18140 T18282 T18304 T5837 T6048 - - - - - 30 changed files: - compiler/GHC/Hs/Extension.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Instance.hs - docs/users_guide/9.2.1-notes.rst - docs/users_guide/exts/poly_kinds.rst - testsuite/tests/dependent/should_fail/T13780a.stderr - testsuite/tests/deriving/should_compile/T11416.hs - testsuite/tests/deriving/should_compile/T9359.hs - + testsuite/tests/indexed-types/should_compile/T14111.hs - + testsuite/tests/indexed-types/should_compile/T8707.hs - testsuite/tests/indexed-types/should_compile/all.T - testsuite/tests/indexed-types/should_fail/T8368.stderr - testsuite/tests/indexed-types/should_fail/T8368a.stderr - testsuite/tests/patsyn/should_fail/T15685.stderr - testsuite/tests/polykinds/T13659.stderr - testsuite/tests/polykinds/T16221a.stderr - testsuite/tests/th/T11145.stderr - testsuite/tests/th/T9692.hs - + testsuite/tests/typecheck/should_compile/T18891.hs - testsuite/tests/typecheck/should_compile/UnliftedNewtypesUnassociatedFamily.hs - testsuite/tests/typecheck/should_compile/UnliftedNewtypesUnifySig.hs - testsuite/tests/typecheck/should_compile/all.T - + testsuite/tests/typecheck/should_fail/T18891a.hs - + testsuite/tests/typecheck/should_fail/T18891a.stderr - testsuite/tests/typecheck/should_fail/UnliftedNewtypesFamilyKindFail2.stderr - + testsuite/tests/typecheck/should_fail/UnliftedNewtypesUnassociatedFamilyFail.hs - + testsuite/tests/typecheck/should_fail/UnliftedNewtypesUnassociatedFamilyFail.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/Hs/Extension.hs ===================================== @@ -253,9 +253,9 @@ sure that any uses of it as a field are strict. -- | Used as a data type index for the hsSyn AST; also serves -- as a singleton type for Pass data GhcPass (c :: Pass) where - GhcPs :: GhcPs - GhcRn :: GhcRn - GhcTc :: GhcTc + GhcPs :: GhcPass 'Parsed + GhcRn :: GhcPass 'Renamed + GhcTc :: GhcPass 'Typechecked -- This really should never be entered, but the data-deriving machinery -- needs the instance to exist. ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -2986,7 +2986,7 @@ bindOuterSigTKBndrs_Tv_M :: TcTyMode -> TcM a -> TcM (HsOuterSigTyVarBndrs GhcTc, a) -- Do not push level; do not make implication constraint; use Tvs -- Two major clients of this "bind-only" path are: --- Note [Kind-checking for GADTs] in TyCl +-- Note [Using TyVarTvs for kind-checking GADTs] in GHC.Tc.TyCl -- Note [Checking partial type signatures] bindOuterSigTKBndrs_Tv_M mode = bindOuterTKBndrsX (smVanilla { sm_clone = True, sm_tvtv = True @@ -3299,8 +3299,8 @@ When we /must/ clone. When kind-checking T, we give (a :: kappa1). Then: - In kcConDecl we make a TyVarTv unification variable kappa2 for k2 - (as described in Note [Kind-checking for GADTs], even though this - example is an existential) + (as described in Note [Using TyVarTvs for kind-checking GADTs], + even though this example is an existential) - So we get (b :: kappa2) via bindExplicitTKBndrs_Tv - We end up unifying kappa1 := kappa2, because of the (SameKind a b) ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -1885,7 +1885,7 @@ canDecomposableTyConAppOK ev eq_rel tc tys1 tys2 | bndr <- tyConBinders tc , let new_loc0 | isNamedTyConBinder bndr = toKindLoc loc | otherwise = loc - new_loc | isVisibleTyConBinder bndr + new_loc | isInvisibleTyConBinder bndr = updateCtLocOrigin new_loc0 toInvisibleOrigin | otherwise = new_loc0 ] ===================================== compiler/GHC/Tc/TyCl.hs ===================================== @@ -17,7 +17,8 @@ module GHC.Tc.TyCl ( -- Functions used by GHC.Tc.TyCl.Instance to check -- data/type family instance declarations - kcConDecls, tcConDecls, dataDeclChecks, checkValidTyCon, + kcConDecls, tcConDecls, DataDeclInfo(..), + dataDeclChecks, checkValidTyCon, tcFamTyPats, tcTyFamInstEqn, tcAddTyFamInstCtxt, tcMkDataFamInstCtxt, tcAddDataFamInstCtxt, unravelFamInstPats, addConsistencyConstraints, @@ -38,7 +39,7 @@ import GHC.Tc.Solver( pushLevelAndSolveEqualities, pushLevelAndSolveEqualitiesX , reportUnsolvedEqualities ) import GHC.Tc.Utils.Monad import GHC.Tc.Utils.Env -import GHC.Tc.Utils.Unify( emitResidualTvConstraint ) +import GHC.Tc.Utils.Unify( unifyType, emitResidualTvConstraint ) import GHC.Tc.Types.Constraint( emptyWC ) import GHC.Tc.Validity import GHC.Tc.Utils.Zonk @@ -130,7 +131,7 @@ Note [Check role annotations in a second pass] Role inference potentially depends on the types of all of the datacons declared in a mutually recursive group. The validity of a role annotation, in turn, depends on the result of role inference. Because the types of datacons might -be ill-formed (see #7175 and Note [Checking GADT return types]) we must check +be ill-formed (see #7175 and Note [rejigConRes]) we must check *all* the tycons in a group for validity before checking *any* of the roles. Thus, we take two passes over the resulting tycons, first checking for general validity and then checking for valid role annotations. @@ -1529,27 +1530,16 @@ kcTyClDecl :: TyClDecl GhcRn -> TcTyCon -> TcM () -- result kind signature have already been dealt with -- by inferInitialKind, so we can ignore them here. -kcTyClDecl (DataDecl { tcdLName = (L _ name) - , tcdDataDefn = defn }) tyCon - | HsDataDefn { dd_cons = cons@((L _ (ConDeclGADT {})) : _) - , dd_ctxt = (L _ []) - , dd_ND = new_or_data } <- defn - = -- See Note [Implementation of UnliftedNewtypes] STEP 2 - kcConDecls new_or_data (tyConResKind tyCon) cons - - -- hs_tvs and dd_kindSig already dealt with in inferInitialKind - -- This must be a GADT-style decl, - -- (see invariants of DataDefn declaration) - -- so (a) we don't need to bring the hs_tvs into scope, because the - -- ConDecls bind all their own variables - -- (b) dd_ctxt is not allowed for GADT-style decls, so we can ignore it - - | HsDataDefn { dd_ctxt = ctxt - , dd_cons = cons - , dd_ND = new_or_data } <- defn +kcTyClDecl (DataDecl { tcdLName = (L _ name), tcdDataDefn = defn }) tycon + | HsDataDefn { dd_ctxt = ctxt, dd_cons = cons, dd_ND = new_or_data } <- defn = bindTyClTyVars name $ \ _ _ _ -> - do { _ <- tcHsContext ctxt - ; kcConDecls new_or_data (tyConResKind tyCon) cons + -- NB: binding these tyvars isn't necessary for GADTs, but it does no + -- harm. For GADTs, each data con brings its own tyvars into scope, + -- and the ones from this bindTyClTyVars are either not mentioned or + -- (conceivably) shadowed. + do { traceTc "kcTyClDecl" (ppr tycon $$ ppr (tyConTyVars tycon) $$ ppr (tyConResKind tycon)) + ; _ <- tcHsContext ctxt + ; kcConDecls new_or_data (tyConResKind tycon) cons } kcTyClDecl (SynDecl { tcdLName = L _ name, tcdRhs = rhs }) _tycon @@ -1606,13 +1596,12 @@ kcConGADTArgs new_or_data res_kind con_args = case con_args of kcConDecls :: NewOrData -> Kind -- The result kind signature + -- Used only in H98 case -> [LConDecl GhcRn] -- The data constructors -> TcM () -kcConDecls new_or_data res_kind cons - = mapM_ (wrapLocM_ (kcConDecl new_or_data final_res_kind)) cons - where - (_, final_res_kind) = splitPiTys res_kind - -- See Note [kcConDecls result kind] +-- See Note [kcConDecls: kind-checking data type decls] +kcConDecls new_or_data tc_res_kind cons + = mapM_ (wrapLocM_ (kcConDecl new_or_data tc_res_kind)) cons -- Kind check a data constructor. In additional to the data constructor, -- we also need to know about whether or not its corresponding type was @@ -1623,82 +1612,69 @@ kcConDecl :: NewOrData -> Kind -- Result kind of the type constructor -- Usually Type but can be TYPE UnliftedRep -- or even TYPE r, in the case of unlifted newtype + -- Used only in H98 case -> ConDecl GhcRn -> TcM () -kcConDecl new_or_data res_kind (ConDeclH98 +kcConDecl new_or_data tc_res_kind (ConDeclH98 { con_name = name, con_ex_tvs = ex_tvs , con_mb_cxt = ex_ctxt, con_args = args }) - = addErrCtxt (dataConCtxtName [name]) $ + = addErrCtxt (dataConCtxt [name]) $ discardResult $ bindExplicitTKBndrs_Tv ex_tvs $ do { _ <- tcHsMbContext ex_ctxt - ; kcConH98Args new_or_data res_kind args + ; kcConH98Args new_or_data tc_res_kind args -- We don't need to check the telescope here, -- because that's done in tcConDecl } -kcConDecl new_or_data res_kind (ConDeclGADT +kcConDecl new_or_data + _tc_res_kind -- Not used in GADT case (and doesn't make sense) + (ConDeclGADT { con_names = names, con_bndrs = L _ outer_bndrs, con_mb_cxt = cxt , con_g_args = args, con_res_ty = res_ty }) - = -- Even though the GADT-style data constructor's type is closed, - -- we must still kind-check the type, because that may influence - -- the inferred kind of the /type/ constructor. Example: - -- data T f a where - -- MkT :: f a -> T f a - -- If we don't look at MkT we won't get the correct kind - -- for the type constructor T - addErrCtxt (dataConCtxtName names) $ + = -- See Note [kcConDecls: kind-checking data type decls] + addErrCtxt (dataConCtxt names) $ discardResult $ bindOuterSigTKBndrs_Tv outer_bndrs $ - -- Why "_Tv"? See Note [Kind-checking for GADTs] + -- Why "_Tv"? See Note [Using TyVarTvs for kind-checking GADTs] do { _ <- tcHsMbContext cxt - ; kcConGADTArgs new_or_data res_kind args - ; _ <- tcHsOpenType res_ty + ; traceTc "kcConDecl:GADT {" (ppr names $$ ppr res_ty) + ; con_res_kind <- newOpenTypeKind + ; _ <- tcCheckLHsType res_ty (TheKind con_res_kind) + ; kcConGADTArgs new_or_data con_res_kind args + ; traceTc "kcConDecl:GADT }" (ppr names $$ ppr con_res_kind) ; return () } -{- Note [kcConDecls result kind] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We might have e.g. - data T a :: Type -> Type where ... -or - newtype instance N a :: Type -> Type where .. -in which case, the 'res_kind' passed to kcConDecls will be - Type->Type - -We must look past those arrows, or even foralls, to the Type in the -corner, to pass to kcConDecl c.f. #16828. Hence the splitPiTys here. - -I am a bit concerned about tycons with a declaration like - data T a :: Type -> forall k. k -> Type where ... - -It does not have a CUSK, so kcInferDeclHeader will make a TcTyCon -with tyConResKind of Type -> forall k. k -> Type. Even that is fine: -the splitPiTys will look past the forall. But I'm bothered about -what if the type "in the corner" mentions k? This is incredibly -obscure but something like this could be bad: - data T a :: Type -> foral k. k -> TYPE (F k) where ... - -I bet we are not quite right here, but my brain suffered a buffer -overflow and I thought it best to nail the common cases right now. - -Note [Recursion and promoting data constructors] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We don't want to allow promotion in a strongly connected component -when kind checking. - -Consider: - data T f = K (f (K Any)) - -When kind checking the `data T' declaration the local env contains the -mappings: - T -> ATcTyCon - K -> APromotionErr - -APromotionErr is only used for DataCons, and only used during type checking -in tcTyClGroup. - -Note [Kind-checking for GADTs] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [kcConDecls: kind-checking data type decls] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +kcConDecls is used when we are inferring the kind of the type +constructor in a data type declaration. E.g. + data T f a = MkT (f a) +we want to infer the kind of 'f' and 'a'. The basic plan is described +in Note [Inferring kinds for type declarations]; here are doing Step 2. + +In the H98 case, for unlifted newtypes only, we need the result kind of +the TyCon, to unify with the argument kind. The tycon's result kind +is not used at all in the GADT case. + +In the GADT case we may have this: + data T f a where + MkT :: forall g b. g b -> T g b +Notice that the variables f,a, and g,b are quite distinct. +Nevertheless, this decl must still influence the kind T (which is, +remember Step 1, something like T :: kappa1 -> kappa2 -> Type), otherwise +we'd infer the bogus kind T :: forall k1 k2. k1 -> k2 -> Type. + +The data constructor type influences the kind of T simply by +kind-checking the result type (T g b), which will force 'f' and 'g' to +have the same kinds. This is the call to + tcCheckLHsType res_ty (TheKind con_res_kind) +Because this is the result type of an arrow, we know the kind must be +of form (TYPE rr), and we get better error messages if we enforce that +here (e.g. test gadt10). + +Note [Using TyVarTvs for kind-checking GADTs] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider data Proxy a where @@ -1708,26 +1684,27 @@ Consider It seems reasonable that this should be accepted. But something very strange is going on here: when we're kind-checking this declaration, we need to unify the kind of `a` with k and j -- even though k and j's scopes are local to the type of -MkProxy{1,2}. The best approach we've come up with is to use TyVarTvs during -the kind-checking pass. First off, note that it's OK if the kind-checking pass -is too permissive: we'll snag the problems in the type-checking pass later. -(This extra permissiveness might happen with something like +MkProxy{1,2}. + +In effect, we are simply gathering constraints on the shape of Proxy's +kind, with no skolemisation or implication constraints involved at all. + +The best approach we've come up with is to use TyVarTvs during the +kind-checking pass, rather than ordinary skolems. This is why we use +the "_Tv" variant, bindOuterSigTKBndrs_Tv. + +Our only goal is to gather constraints on the kind of the type constructor; +we do not certify that the data declaration is well-kinded. For example: data SameKind :: k -> k -> Type data Bad a where MkBad :: forall k1 k2 (a :: k1) (b :: k2). Bad (SameKind a b) -which would be accepted if k1 and k2 were TyVarTvs. This is correctly rejected -in the second pass, though. Test case: polykinds/TyVarTvKinds3) -Recall that the kind-checking pass exists solely to collect constraints -on the kinds and to power unification. +which would be accepted by kcConDecl because k1 and k2 are +TyVarTvs. It is correctly rejected in the second pass, tcConDecl. +(Test case: polykinds/TyVarTvKinds3) -To achieve the use of TyVarTvs, we must be careful to use specialized functions -that produce TyVarTvs, not ordinary skolems. This is why we need -kcExplicitTKBndrs and kcImplicitTKBndrs in GHC.Tc.Gen.HsType, separate from their -tc... variants. - -The drawback of this approach is sometimes it will accept a definition that +One drawback of this approach is sometimes it will accept a definition that a (hypothetical) declarative specification would likely reject. As a general rule, we don't want to allow polymorphic recursion without a CUSK. Indeed, the whole point of CUSKs is to allow polymorphic recursion. Yet, the TyVarTvs @@ -1746,6 +1723,23 @@ be rejected (without a CUSK). However, the accepted definitions are indeed well-kinded and any rejected definitions would be accepted with a CUSK, and so this wrinkle need not cause anyone to lose sleep. +Note [Recursion and promoting data constructors] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We don't want to allow promotion in a strongly connected component +when kind checking. + +Consider: + data T f = K (f (K Any)) + +When kind checking the `data T' declaration the local env contains the +mappings: + T -> ATcTyCon + K -> APromotionErr + +APromotionErr is only used for DataCons, and only used during type checking +in tcTyClGroup. + + ************************************************************************ * * \subsection{Type checking} @@ -2782,18 +2776,14 @@ tcDataDefn err_ctxt roles_info tc_name ; when (isJust mb_ksig) $ checkTc (kind_signatures) (badSigTyDecl tc_name) - ; tycon <- fixM $ \ tycon -> do + ; tycon <- fixM $ \ rec_tycon -> do { let final_bndrs = tycon_binders `chkAppend` extra_bndrs - res_ty = mkTyConApp tycon (mkTyVarTys (binderVars final_bndrs)) roles = roles_info tc_name ; data_cons <- tcConDecls - tycon - new_or_data - final_bndrs - final_res_kind - res_ty + new_or_data DDVanilla + rec_tycon final_bndrs final_res_kind cons - ; tc_rhs <- mk_tc_rhs hsc_src tycon data_cons + ; tc_rhs <- mk_tc_rhs hsc_src rec_tycon data_cons ; tc_rep_nm <- newTyConRepName tc_name ; return (mkAlgTyCon tc_name final_bndrs @@ -3195,36 +3185,51 @@ consUseGadtSyntax _ = False -- All constructors have same shape ----------------------------------- -tcConDecls :: KnotTied TyCon -> NewOrData - -> [TyConBinder] -> TcKind -- binders and result kind of tycon - -> KnotTied Type -> [LConDecl GhcRn] -> TcM [DataCon] -tcConDecls rep_tycon new_or_data tmpl_bndrs res_kind res_tmpl +data DataDeclInfo + = DDVanilla -- data T a b = T1 a | T2 b + | DDInstance -- data instance D [a] = D1 a | D2 + Type -- The header D [a] + +mkDDHeaderTy :: DataDeclInfo -> TyCon -> [TyConBinder] -> Type +mkDDHeaderTy dd_info rep_tycon tc_bndrs + = case dd_info of + DDVanilla -> mkTyConApp rep_tycon $ + mkTyVarTys (binderVars tc_bndrs) + DDInstance header_ty -> header_ty + +tcConDecls :: NewOrData + -> DataDeclInfo + -> KnotTied TyCon -- Representation TyCon + -> [TyConBinder] -- Binders of representation TyCon + -> TcKind -- Result kind + -> [LConDecl GhcRn] -> TcM [DataCon] +tcConDecls new_or_data dd_info rep_tycon tmpl_bndrs res_kind = concatMapM $ addLocM $ - tcConDecl rep_tycon (mkTyConTagMap rep_tycon) - tmpl_bndrs res_kind res_tmpl new_or_data - -- It's important that we pay for tag allocation here, once per TyCon, - -- See Note [Constructor tag allocation], fixes #14657 - -tcConDecl :: KnotTied TyCon -- Representation tycon. Knot-tied! + tcConDecl new_or_data dd_info rep_tycon tmpl_bndrs res_kind + (mkTyConTagMap rep_tycon) + -- mkTyConTagMap: it's important that we pay for tag allocation here, + -- once per TyCon. See Note [Constructor tag allocation], fixes #14657 + +tcConDecl :: NewOrData + -> DataDeclInfo + -> KnotTied TyCon -- Representation tycon. Knot-tied! + -> [TyConBinder] -- Binders of representation TyCon + -> TcKind -- Result kind -> NameEnv ConTag - -> [TyConBinder] -> TcKind -- tycon binders and result kind - -> KnotTied Type - -- Return type template (T tys), where T is the family TyCon - -> NewOrData -> ConDecl GhcRn -> TcM [DataCon] -tcConDecl rep_tycon tag_map tmpl_bndrs res_kind res_tmpl new_or_data +tcConDecl new_or_data dd_info rep_tycon tc_bndrs res_kind tag_map (ConDeclH98 { con_name = lname@(L _ name) , con_ex_tvs = explicit_tkv_nms , con_mb_cxt = hs_ctxt , con_args = hs_args }) - = addErrCtxt (dataConCtxtName [lname]) $ + = addErrCtxt (dataConCtxt [lname]) $ do { -- NB: the tyvars from the declaration header are in scope -- Get hold of the existential type variables -- e.g. data T a = forall k (b::k) f. MkT a (f b) - -- Here tmpl_bndrs = {a} + -- Here tc_bndrs = {a} -- hs_qvars = HsQTvs { hsq_implicit = {k} -- , hsq_explicit = {f,b} } @@ -3242,29 +3247,35 @@ tcConDecl rep_tycon tag_map tmpl_bndrs res_kind res_tmpl new_or_data } - ; let tmpl_tvs = binderVars tmpl_bndrs - ; let fake_ty = mkSpecForAllTys tmpl_tvs $ + ; let tc_tvs = binderVars tc_bndrs + fake_ty = mkSpecForAllTys tc_tvs $ mkInvisForAllTys exp_tvbndrs $ mkPhiTy ctxt $ mkVisFunTys arg_tys $ unitTy -- That type is a lie, of course. (It shouldn't end in ()!) -- And we could construct a proper result type from the info - -- at hand. But the result would mention only the tmpl_tvs, + -- at hand. But the result would mention only the univ_tvs, -- and so it just creates more work to do it right. Really, -- we're only doing this to find the right kind variables to -- quantify over, and this type is fine for that purpose. - -- exp_tvs have explicit, user-written binding sites + -- exp_tvbndrs have explicit, user-written binding sites -- the kvs below are those kind variables entirely unmentioned by the user -- and discovered only by generalization ; kvs <- kindGeneralizeAll fake_ty - ; let skol_tvs = kvs ++ tmpl_tvs + ; let skol_tvs = tc_tvs ++ kvs ++ binderVars exp_tvbndrs ; reportUnsolvedEqualities skol_info skol_tvs tclvl wanted - - -- Zonk to Types + -- The skol_info claims that all the variables are bound + -- by the data constructor decl, whereas actually the + -- univ_tvs are bound by the data type decl itself. It + -- would be better to have a doubly-nested implication. + -- But that just doesn't seem worth it. + -- See test dependent/should_fail/T13780a + + -- Zonk to Types ; (ze, qkvs) <- zonkTyBndrs kvs ; (ze, user_qtvbndrs) <- zonkTyVarBindersX ze exp_tvbndrs ; arg_tys <- zonkScaledTcTypesToTypesX ze arg_tys @@ -3272,15 +3283,14 @@ tcConDecl rep_tycon tag_map tmpl_bndrs res_kind res_tmpl new_or_data -- Can't print univ_tvs, arg_tys etc, because we are inside the knot here ; traceTc "tcConDecl 2" (ppr name $$ ppr field_lbls) - ; let - univ_tvbs = tyConInvisTVBinders tmpl_bndrs - univ_tvs = binderVars univ_tvbs - ex_tvbs = mkTyVarBinders InferredSpec qkvs ++ user_qtvbndrs - ex_tvs = binderVars ex_tvbs - -- For H98 datatypes, the user-written tyvar binders are precisely - -- the universals followed by the existentials. - -- See Note [DataCon user type variable binders] in GHC.Core.DataCon. - user_tvbs = univ_tvbs ++ ex_tvbs + ; let univ_tvbs = tyConInvisTVBinders tc_bndrs + ex_tvbs = mkTyVarBinders InferredSpec qkvs ++ user_qtvbndrs + ex_tvs = binderVars ex_tvbs + -- For H98 datatypes, the user-written tyvar binders are precisely + -- the universals followed by the existentials. + -- See Note [DataCon user type variable binders] in GHC.Core.DataCon. + user_tvbs = univ_tvbs ++ ex_tvbs + user_res_ty = mkDDHeaderTy dd_info rep_tycon tc_bndrs ; traceTc "tcConDecl 2" (ppr name) ; is_infix <- tcConIsInfixH98 name hs_args @@ -3288,9 +3298,9 @@ tcConDecl rep_tycon tag_map tmpl_bndrs res_kind res_tmpl new_or_data ; fam_envs <- tcGetFamInstEnvs ; dc <- buildDataCon fam_envs name is_infix rep_nm stricts Nothing field_lbls - univ_tvs ex_tvs user_tvbs + tc_tvs ex_tvs user_tvbs [{- no eq_preds -}] ctxt arg_tys - res_tmpl rep_tycon tag_map + user_res_ty rep_tycon tag_map -- NB: we put data_tc, the type constructor gotten from the -- constructor type signature into the data constructor; -- that way checkValidDataCon can complain if it's wrong. @@ -3299,14 +3309,14 @@ tcConDecl rep_tycon tag_map tmpl_bndrs res_kind res_tmpl new_or_data where skol_info = DataConSkol name -tcConDecl rep_tycon tag_map tmpl_bndrs _res_kind res_tmpl new_or_data +tcConDecl new_or_data dd_info rep_tycon tc_bndrs _res_kind tag_map -- NB: don't use res_kind here, as it's ill-scoped. Instead, -- we get the res_kind by typechecking the result type. (ConDeclGADT { con_names = names , con_bndrs = L _ outer_hs_bndrs , con_mb_cxt = cxt, con_g_args = hs_args , con_res_ty = hs_res_ty }) - = addErrCtxt (dataConCtxtName names) $ + = addErrCtxt (dataConCtxt names) $ do { traceTc "tcConDecl 1 gadt" (ppr names) ; let (L _ name : _) = names @@ -3317,10 +3327,23 @@ tcConDecl rep_tycon tag_map tmpl_bndrs _res_kind res_tmpl new_or_data ; (res_ty, res_kind) <- tcInferLHsTypeKind hs_res_ty -- See Note [GADT return kinds] + -- For data instances (only), ensure that the return type, + -- res_ty, is a substitution instance of the header. + -- See Note [GADT return types] + ; case dd_info of + DDVanilla -> return () + DDInstance hdr_ty -> + do { (subst, _meta_tvs) <- newMetaTyVars (binderVars tc_bndrs) + ; let head_shape = substTy subst hdr_ty + ; discardResult $ + popErrCtxt $ -- Drop dataConCtxt + addErrCtxt (dataConResCtxt names) $ + unifyType Nothing res_ty head_shape } + -- See Note [Datatype return kinds] ; let exp_kind = getArgExpKind new_or_data res_kind - ; btys <- tcConGADTArgs exp_kind hs_args + ; let (arg_tys, stricts) = unzip btys ; field_lbls <- lookupConstructorFields name ; return (ctxt, arg_tys, res_ty, field_lbls, stricts) @@ -3343,9 +3366,10 @@ tcConDecl rep_tycon tag_map tmpl_bndrs _res_kind res_tmpl new_or_data ; ctxt <- zonkTcTypesToTypesX ze ctxt ; res_ty <- zonkTcTypeToTypeX ze res_ty - ; let (univ_tvs, ex_tvs, tvbndrs', eq_preds, arg_subst) - = rejigConRes tmpl_bndrs res_tmpl tvbndrs res_ty - -- See Note [Checking GADT return types] + ; let res_tmpl = mkDDHeaderTy dd_info rep_tycon tc_bndrs + (univ_tvs, ex_tvs, tvbndrs', eq_preds, arg_subst) + = rejigConRes tc_bndrs res_tmpl tvbndrs res_ty + -- See Note [rejigConRes] ctxt' = substTys arg_subst ctxt arg_tys' = substScaledTys arg_subst arg_tys @@ -3372,8 +3396,65 @@ tcConDecl rep_tycon tag_map tmpl_bndrs _res_kind res_tmpl new_or_data where skol_info = DataConSkol (unLoc (head names)) -{- Note [GADT return kinds] +{- Note [GADT return types] ~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + data family T :: forall k. k -> Type + data instance T (a :: Type) where + MkT :: forall b. T b + +What kind does `b` have in the signature for MkT? +Since the return type must be an instance of the type in the header, +we must have (b :: Type), but you can't tell that by looking only at +the type of the data constructor; you have to look at the header too. +If you wrote it out fully, it'd look like + data instance T @Type (a :: Type) where + MkT :: forall (b::Type). T @Type b + +We could reject the program, and expect the user to add kind +annotations to `MkT` to restrict the signature. But an easy, and +helpful alternative is this: simply instantiate the type from the +header with fresh unification variables, and unify with the return +type of `MkT`. That will force `b` to have kind `Type`. See #8707 +and #14111. + +Wrikles +* At first sight it looks as though this would completely subsume the + return-type check in checkValidDataCon. But it does not. Suppose we + have + data instance T [a] where + MkT :: T (F (Maybe a)) + + where F is a type function. Then maybe (F (Maybe a)) evaluates to + [a], so unifyType will succeed. But we discard the coercion + returned by unifyType; and we really don't want to accept this + program. The check in checkValidDataCon will, however, reject it. + TL;DR: keep the check in checkValidDataCon. + +* Consider a data type, rather than a data instance, declaration + data S a where { MkS :: b -> S [b] } + In tcConDecl, S is knot-tied, so we don't want to unify (S alpha) + with (S [b]). To put it another way, unifyType should never see a + TcTycon. Simple solution: do *not* do the extra unifyType for + data types (DDVanilla) only for data instances (DDInstance); in + the latter the family constructor is not knot-tied so there is no + problem. + +* Consider this (fromn GHC itself): + + data Pass = Parsed | ... + data GhcPass (c :: Pass) where + GhcPs :: GhcPs + ... + type GhcPs = GhcPass 'Parsed + + Now GhcPs and GhcPass are mutually recursive. If we did unifyType + for datatypes like GhcPass, we would not be able to exand the type + synonym (it'd still be a TcTyCon). So again, we don't do uinfyType + for data types; we leave it to checkValidDataCon. + +Note [GADT return kinds] +~~~~~~~~~~~~~~~~~~~~~~~~ Consider type family Star where Star = Type data T :: Type where @@ -3496,8 +3577,8 @@ For example: (:--:) :: t1 -> t2 -> T Int -Note [Checking GADT return types] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [rejigConRes] +~~~~~~~~~~~~~~~~~~ There is a delicacy around checking the return types of a datacon. The central problem is dealing with a declaration like @@ -3532,9 +3613,9 @@ errors reported in one pass. See #7175, and #10836. -- TI :: forall b1 c1. (b1 ~ c1) => b1 -> :R7T b1 c1 -- In this case orig_res_ty = T (e,e) -rejigConRes :: [KnotTied TyConBinder] -> KnotTied Type -- Template for result type; e.g. - -- data instance T [a] b c ... - -- gives template ([a,b,c], T [a] b c) +rejigConRes :: [KnotTied TyConBinder] -- Template for result type; e.g. + -> KnotTied Type -- data instance T [a] b c ... + -- gives template ([a,b,c], T [a] b c) -> [InvisTVBinder] -- The constructor's type variables (both inferred and user-written) -> KnotTied Type -- res_ty -> ([TyVar], -- Universal @@ -3546,10 +3627,10 @@ rejigConRes :: [KnotTied TyConBinder] -> KnotTied Type -- Template for result -- We don't check that the TyCon given in the ResTy is -- the same as the parent tycon, because checkValidDataCon will do it -- NB: All arguments may potentially be knot-tied -rejigConRes tmpl_bndrs res_tmpl dc_tvbndrs res_ty +rejigConRes tc_tvbndrs res_tmpl dc_tvbndrs res_ty -- E.g. data T [a] b c where -- MkT :: forall x y z. T [(x,y)] z z - -- The {a,b,c} are the tmpl_tvs, and the {x,y,z} are the dc_tvs + -- The {a,b,c} are the tc_tvs, and the {x,y,z} are the dc_tvs -- (NB: unlike the H98 case, the dc_tvs are not all existential) -- Then we generate -- Univ tyvars Eq-spec @@ -3564,7 +3645,7 @@ rejigConRes tmpl_bndrs res_tmpl dc_tvbndrs res_ty -- , [], [x,y,z] -- , [a~(x,y),b~z], ) | Just subst <- tcMatchTy res_tmpl res_ty - = let (univ_tvs, raw_eqs, kind_subst) = mkGADTVars tmpl_tvs dc_tvs subst + = let (univ_tvs, raw_eqs, kind_subst) = mkGADTVars tc_tvs dc_tvs subst raw_ex_tvs = dc_tvs `minusList` univ_tvs (arg_subst, substed_ex_tvs) = substTyVarBndrs kind_subst raw_ex_tvs @@ -3590,11 +3671,11 @@ rejigConRes tmpl_bndrs res_tmpl dc_tvbndrs res_ty -- we must do *something*, not just crash. So we do something simple -- albeit bogus, relying on checkValidDataCon to check the -- bad-result-type error before seeing that the other fields look odd - -- See Note [Checking GADT return types] - = (tmpl_tvs, dc_tvs `minusList` tmpl_tvs, dc_tvbndrs, [], emptyTCvSubst) + -- See Note [rejigConRes] + = (tc_tvs, dc_tvs `minusList` tc_tvs, dc_tvbndrs, [], emptyTCvSubst) where - dc_tvs = binderVars dc_tvbndrs - tmpl_tvs = binderVars tmpl_bndrs + dc_tvs = binderVars dc_tvbndrs + tc_tvs = binderVars tc_tvbndrs {- Note [mkGADTVars] ~~~~~~~~~~~~~~~~~~~~ @@ -3634,7 +3715,7 @@ becomes We start off by matching (T k1 k2 a b) with (T x1 * (Proxy x1 y, z) z). We know this match will succeed because of the validity check (actually done -later, but laziness saves us -- see Note [Checking GADT return types]). +later, but laziness saves us -- see Note [rejigConRes]). Thus, we get subst := { k1 |-> x1, k2 |-> *, a |-> (Proxy x1 y, z), b |-> z } @@ -4081,15 +4162,9 @@ checkFieldCompat fld con1 con2 res1 res2 fty1 fty2 ------------------------------- checkValidDataCon :: DynFlags -> Bool -> TyCon -> DataCon -> TcM () checkValidDataCon dflags existential_ok tc con - = setSrcSpan (getSrcSpan con) $ - addErrCtxt (dataConCtxt con) $ - do { -- Check that the return type of the data constructor - -- matches the type constructor; eg reject this: - -- data T a where { MkT :: Bogus a } - -- It's important to do this first: - -- see Note [Checking GADT return types] - -- and c.f. Note [Check role annotations in a second pass] - let tc_tvs = tyConTyVars tc + = setSrcSpan con_loc $ + addErrCtxt (dataConCtxt [L con_loc con_name]) $ + do { let tc_tvs = tyConTyVars tc res_ty_tmpl = mkFamilyTyConApp tc (mkTyVarTys tc_tvs) orig_res_ty = dataConOrigResTy con ; traceTc "checkValidDataCon" (vcat @@ -4098,6 +4173,18 @@ checkValidDataCon dflags existential_ok tc con , ppr orig_res_ty <+> dcolon <+> ppr (tcTypeKind orig_res_ty)]) + -- Check that the return type of the data constructor + -- matches the type constructor; eg reject this: + -- data T a where { MkT :: Bogus a } + -- It's important to do this first: + -- see Note [rejigCon + -- and c.f. Note [Check role annotations in a second pass] + + -- Check that the return type of the data constructor is an instance + -- of the header of the header of data decl. This checks for + -- data T a where { MkT :: S a } + -- data instance D [a] where { MkD :: D (Maybe b) } + -- see Note [GADT return types] ; checkTc (isJust (tcMatchTyKi res_ty_tmpl orig_res_ty)) (badDataConTyCon con res_ty_tmpl) -- Note that checkTc aborts if it finds an error. This is @@ -4205,7 +4292,9 @@ checkValidDataCon dflags existential_ok tc con Just (f, _) -> ppr (tyConBinders f) ] } where - ctxt = ConArgCtxt (dataConName con) + con_name = dataConName con + con_loc = nameSrcSpan con_name + ctxt = ConArgCtxt con_name is_strict = \case NoSrcStrict -> xopt LangExt.StrictData dflags bang -> isSrcStrict bang @@ -4869,14 +4958,17 @@ fieldTypeMisMatch field_name con1 con2 = sep [text "Constructors" <+> ppr con1 <+> text "and" <+> ppr con2, text "give different types for field", quotes (ppr field_name)] -dataConCtxtName :: [Located Name] -> SDoc -dataConCtxtName [con] - = text "In the definition of data constructor" <+> quotes (ppr con) -dataConCtxtName con - = text "In the definition of data constructors" <+> interpp'SP con +dataConCtxt :: [Located Name] -> SDoc +dataConCtxt cons = text "In the definition of data constructor" <> plural cons + <+> ppr_cons cons + +dataConResCtxt :: [Located Name] -> SDoc +dataConResCtxt cons = text "In the result type of data constructor" <> plural cons + <+> ppr_cons cons -dataConCtxt :: Outputable a => a -> SDoc -dataConCtxt con = text "In the definition of data constructor" <+> quotes (ppr con) +ppr_cons :: [Located Name] -> SDoc +ppr_cons [con] = quotes (ppr con) +ppr_cons cons = interpp'SP cons classOpCtxt :: Var -> Type -> SDoc classOpCtxt sel_id tau = sep [text "When checking the class method:", ===================================== compiler/GHC/Tc/TyCl/Instance.hs ===================================== @@ -688,9 +688,8 @@ tcDataFamInstDecl mb_clsinfo tv_skol_env -- Do /not/ check that the number of patterns = tyConArity fam_tc -- See [Arity of data families] in GHC.Core.FamInstEnv ; (qtvs, pats, res_kind, stupid_theta) - <- tcDataFamInstHeader mb_clsinfo fam_tc outer_bndrs - fixity hs_ctxt hs_pats m_ksig hs_cons - new_or_data + <- tcDataFamInstHeader mb_clsinfo fam_tc outer_bndrs fixity + hs_ctxt hs_pats m_ksig new_or_data -- Eta-reduce the axiom if possible -- Quite tricky: see Note [Implementing eta reduction for data families] @@ -740,8 +739,9 @@ tcDataFamInstDecl mb_clsinfo tv_skol_env do { data_cons <- tcExtendTyVarEnv qtvs $ -- For H98 decls, the tyvars scope -- over the data constructors - tcConDecls rec_rep_tc new_or_data ty_binders final_res_kind - orig_res_ty hs_cons + tcConDecls new_or_data (DDInstance orig_res_ty) + rec_rep_tc ty_binders final_res_kind + hs_cons ; rep_tc_name <- newFamInstTyConName lfam_name pats ; axiom_name <- newFamInstAxiomName lfam_name [pats] @@ -857,7 +857,7 @@ TyVarEnv will simply be empty, and there is nothing to worry about. tcDataFamInstHeader :: AssocInstInfo -> TyCon -> HsOuterFamEqnTyVarBndrs GhcRn -> LexicalFixity -> LHsContext GhcRn - -> HsTyPats GhcRn -> Maybe (LHsKind GhcRn) -> [LConDecl GhcRn] + -> HsTyPats GhcRn -> Maybe (LHsKind GhcRn) -> NewOrData -> TcM ([TyVar], [Type], Kind, ThetaType) -- The "header" of a data family instance is the part other than @@ -865,7 +865,7 @@ tcDataFamInstHeader -- e.g. data instance D [a] :: * -> * where ... -- Here the "header" is the bit before the "where" tcDataFamInstHeader mb_clsinfo fam_tc outer_bndrs fixity - hs_ctxt hs_pats m_ksig hs_cons new_or_data + hs_ctxt hs_pats m_ksig new_or_data = do { traceTc "tcDataFamInstHeader {" (ppr fam_tc <+> ppr hs_pats) ; (tclvl, wanted, (scoped_tvs, (stupid_theta, lhs_ty, master_res_kind, instance_res_kind))) <- pushLevelAndSolveEqualitiesX "tcDataFamInstHeader" $ @@ -884,8 +884,8 @@ tcDataFamInstHeader mb_clsinfo fam_tc outer_bndrs fixity -- Add constraints from the result signature ; res_kind <- tc_kind_sig m_ksig - -- Add constraints from the data constructors - ; kcConDecls new_or_data res_kind hs_cons + -- Do not add constraints from the data constructors + -- See Note [Kind inference for data family instances] -- Check that the result kind of the TyCon applied to its args -- is compatible with the explicit signature (or Type, if there @@ -1049,6 +1049,86 @@ however, so this Note aims to describe these subtleties: themselves. Heavy sigh. But not truly hard; that's what tcbVisibilities does. +Note [Kind inference for data family instances] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider this GADT-style data type declaration, where I have used +fresh variables in the data constructor's type, to stress that c,d are +quite distinct from a,b. + data T a b where + MkT :: forall c d. c d -> T c d + +Following Note [Inferring kinds for type declarations] in GHC.Tc.TyCl, +to infer T's kind, we initially give T :: kappa, a monomorpic kind, +gather constraints from the header and data constructors, and conclude + T :: (kappa1 -> type) -> kappa1 -> Type +Then we generalise, giving + T :: forall k. (k->Type) -> k -> Type + +Now what about a data /instance/ decl + data family T :: forall k. (k->Type) -> k -> Type + + data instance T p Int where ... + +No doubt here! The poly-kinded T is instantiated with k=Type, so the +header really looks like + data instance T @Type (p :: Type->Type) Int where ... + +But what about this? + data instance T p q where + MkT :: forall r. r Int -> T r Int + +So what kind do 'p' and 'q' have? No clues from the header, but from +the data constructor we can clearly see that (r :: Type->Type). Does +that mean that the the /entire data instance/ is instantiated at Type, +like this? + data instance T @Type (p :: Type->Type) (q :: Type) where + ... + +Not at all! This is a /GADT/-style decl, so the kind argument might +be specialised in this particular data constructor, thus: + data instance T @k (p :: k->Type) (q :: k) where + MkT :: forall (r :: Type -> Type). + r Int -> T @Type r Int +(and perhaps specialised differently in some other data +constructor MkT2). + +The key difference in this case and 'data T' at the top of this Note +is that we have no known kind for 'data T'. We thus forbid different +specialisations of T in its constructors, in an attempt to avoid +inferring polymorphic recursion. In data family T, however, there is +no problem with polymorphic recursion: we already /fully know/ T's +kind -- that came from the family declaration, and is not influenced +by the data instances -- and hence we /can/ specialise T's kind +differently in different GADT data constructors. + +SHORT SUMMARY: in a data instance decl, it's not clear whether kind +constraints arising from the data constructors should be considered +local to the (GADT) data /constructor/ or should apply to the entire +data instance. + +DESIGN CHOICE: in data/newtype family instance declarations, we ignore +the /data constructor/ declarations altogether, looking only at the +data instance /header/. + +Observations: +* This choice is simple to describe, as well as simple to implment. + For a data/newtype instance decl, the instance kinds are influenced + /only/ by the header. + +* We could treat Haskell-98 style data-instance decls differently, by + taking the data constructors into account, since there are no GADT + issues. But we don't, for simplicity, and because it means you can + understand the data type instance by looking only at the header. + +* Newtypes can be declared in GADT syntax, but they can't do GADT-style + specialisation, so like Haskell-98 definitions we could take the + data constructors into account. Again we don't, for the same reason. + +So for now at least, we keep the simplest choice. See #18891 and !4419 +for more discussion of this issue. + +Kind inference for data types (Xie et al) https://arxiv.org/abs/1911.06153 +takes a slightly different approach. -} ===================================== docs/users_guide/9.2.1-notes.rst ===================================== @@ -14,6 +14,11 @@ Language (Serrano et al, ICFP 2020). More information here: :ref:`impredicative-polymorphism`. This replaces the old (undefined, flaky) behaviour of the :extension:`ImpredicativeTypes` extension. +* Kind inference for data/newtype instance declarations is slightly + more restrictive than before. See the user manual :ref:`kind-inference-data-family-instances`. + This is a breaking change, albeit a fairly obscure one that corrects a specification bug. + + Compiler ~~~~~~~~ ===================================== docs/users_guide/exts/poly_kinds.rst ===================================== @@ -130,8 +130,45 @@ This rule has occasionally-surprising consequences (see The kind-polymorphism from the class declaration makes ``D1`` kind-polymorphic, but not so ``D2``; and similarly ``F1``, ``F2``. +Kind inference in type signatures +--------------------------------- + +When kind-checking a type, GHC considers only what is written in that +type when figuring out how to generalise the type's kind. + +For example, +consider these definitions (with :extension:`ScopedTypeVariables`): :: + + data Proxy a -- Proxy :: forall k. k -> Type + p :: forall a. Proxy a + p = Proxy :: Proxy (a :: Type) + +GHC reports an error, saying that the kind of ``a`` should be a kind variable +``k``, not ``Type``. This is because, by looking at the type signature +``forall a. Proxy a``, GHC assumes ``a``'s kind should be generalised, not +restricted to be ``Type``. The function definition is then rejected for being +more specific than its type signature. + +.. _explicit-kind-quantification: + +Explicit kind quantification +---------------------------- + +Enabled by :extension:`PolyKinds`, GHC supports explicit kind quantification, +as in these examples: :: + + data Proxy :: forall k. k -> Type + f :: (forall k (a :: k). Proxy a -> ()) -> Int + +Note that the second example has a ``forall`` that binds both a kind ``k`` and +a type variable ``a`` of kind ``k``. In general, there is no limit to how +deeply nested this sort of dependency can work. However, the dependency must +be well-scoped: ``forall (a :: k) k. ...`` is an error. + + .. _inferring-variable-order: + Inferring the order of variables in a type/class declaration ------------------------------------------------------------ @@ -490,41 +527,91 @@ This also applies to GADT-style data instances: :: -- • In the data instance declaration for ‘T’ -Kind inference in closed type families --------------------------------------- +Kind inference in data type declarations +---------------------------------------- -Although all open type families are considered to have a complete -user-supplied kind signature, we can relax this condition for closed -type families, where we have equations on which to perform kind -inference. GHC will infer kinds for the arguments and result types of a -closed type family. +Consider the declaration :: -GHC supports *kind-indexed* type families, where the family matches both -on the kind and type. GHC will *not* infer this behaviour without a -complete user-supplied kind signature, as doing so would sometimes infer -non-principal types. Indeed, we can see kind-indexing as a form -of polymorphic recursion, where a type is used at a kind other than -its most general in its own definition. + data T1 f a = MkT1 (f a) + data T2 f a where + MkT2 :: f a -> T f a -For example: :: +In both cases GHC looks at the data constructor declarations to +give constraints on the kind of ``T``, yielding :: - type family F1 a where - F1 True = False - F1 False = True - F1 x = x - -- F1 fails to compile: kind-indexing is not inferred + T1, T2 :: forall k. (k -> Type) -> k -> Type - type family F2 (a :: k) where - F2 True = False - F2 False = True - F2 x = x - -- F2 fails to compile: no complete signature +Consider the type :: + + data G (a :: k) where + GInt :: G Int + GMaybe :: G Maybe + +This datatype ``G`` is GADT-like in both its kind and its type. Suppose you +have ``g :: G a``, where ``a :: k``. Then pattern matching to discover that +``g`` is in fact ``GMaybe`` tells you both that ``k ~ (Type -> Type)`` and +``a ~ Maybe``. The definition for ``G`` requires that :extension:`PolyKinds` +be in effect, but pattern-matching on ``G`` requires no extension beyond +:extension:`GADTs`. That this works is actually a straightforward extension +of regular GADTs and a consequence of the fact that kinds and types are the +same. + +Note that the datatype ``G`` is used at different kinds in its body, and +therefore that kind-indexed GADTs use a form of polymorphic recursion. +It is thus only possible to use this feature if you have provided a +complete user-supplied kind signature (CUSK) +for the datatype (:ref:`complete-kind-signatures`), or a standalone +kind signature (:ref:`standalone-kind-signatures`); +in the case of ``G`` we have a CUSK. +If you wish to see the kind indexing explicitly, you can do so by enabling :ghc-flag:`-fprint-explicit-kinds` and querying ``G`` with GHCi's :ghci-cmd:`:info` command: :: + + > :set -fprint-explicit-kinds + > :info G + type role G nominal nominal + type G :: forall k. k -> Type + data G @k a where + GInt :: G @Type Int + GMaybe :: G @(Type -> Type) Maybe + +where you can see the GADT-like nature of the two constructors. + +.. _kind-inference-data-family-instances: + +Kind inference for data/newtype instance declarations +----------------------------------------------------- + +Consider these declarations :: + + data family T :: forall k. (k->Type) -> k -> Type + + data instance T p q where + MkT :: forall r. r Int -> T r Int + +Here ``T`` has an invisible kind argument; and perhaps it is instantiated +to ``Type`` in the instance, thus :: + + data instance T @Type (p :: Type->Type) (q :: Type) where + MkT :: forall r. r Int -> T r Int + +Or perhaps we intended the specialisation to be in the GADT data +constructor, thus :: + + data instance T @k (p :: k->Type) (q :: k) where + MkT :: forall r. r Int -> T @Type r Int + +It gets more complicated if there are multiple constructors. In +general, there is no principled way to tell which type specialisation +comes from the data instance, and which from the individual GADT data +constructors. + +So GHC implements this rule: in data/newtype instance declararations +(unlike ordinary data/newtype declarations) we do *not* look at the +constructor declarations when inferring the shape of the instance +header. The principle is that *the instantiation of the data instance +should be apparent from the header alone*. This principle makes the +program easier to understand, and avoids the swamp of complexity +indicated above. - type family F3 (a :: k) :: k where - F3 True = False - F3 False = True - F3 x = x - -- OK Kind inference in class instance declarations --------------------------------------------- @@ -555,43 +642,8 @@ infrastructure, and it's not clear the payoff is worth it. If you want to restrict ``b``\ 's kind in the instance above, just use a kind signature in the instance head. -Kind inference in type signatures ---------------------------------- - -When kind-checking a type, GHC considers only what is written in that -type when figuring out how to generalise the type's kind. - -For example, -consider these definitions (with :extension:`ScopedTypeVariables`): :: - - data Proxy a -- Proxy :: forall k. k -> Type - p :: forall a. Proxy a - p = Proxy :: Proxy (a :: Type) - -GHC reports an error, saying that the kind of ``a`` should be a kind variable -``k``, not ``Type``. This is because, by looking at the type signature -``forall a. Proxy a``, GHC assumes ``a``'s kind should be generalised, not -restricted to be ``Type``. The function definition is then rejected for being -more specific than its type signature. - -.. _explicit-kind-quantification: - -Explicit kind quantification ----------------------------- - -Enabled by :extension:`PolyKinds`, GHC supports explicit kind quantification, -as in these examples: :: - - data Proxy :: forall k. k -> Type - f :: (forall k (a :: k). Proxy a -> ()) -> Int - -Note that the second example has a ``forall`` that binds both a kind ``k`` and -a type variable ``a`` of kind ``k``. In general, there is no limit to how -deeply nested this sort of dependency can work. However, the dependency must -be well-scoped: ``forall (a :: k) k. ...`` is an error. - -Implicit quantification in type synonyms and type family instances ------------------------------------------------------------------- +Kind inference in type synonyms and type family instances +--------------------------------------------------------- Consider the scoping rules for type synonyms and type family instances, such as these:: @@ -706,29 +758,44 @@ kinds. Consequently, visible dependent quantifiers are rejected in any context that is unambiguously the type of a term. They are also rejected in the types of data constructors. -Kind-indexed GADTs ------------------- +Kind inference in closed type families +-------------------------------------- -Consider the type :: +Although all open type families are considered to have a complete +user-supplied kind signature (:ref:`complete-kind-signatures`), +we can relax this condition for closed +type families, where we have equations on which to perform kind +inference. GHC will infer kinds for the arguments and result types of a +closed type family. - data G (a :: k) where - GInt :: G Int - GMaybe :: G Maybe +GHC supports *kind-indexed* type families, where the family matches both +on the kind and type. GHC will *not* infer this behaviour without a +complete user-supplied kind signature or standalone kind +signature (see :ref:`standalone-kind-signatures`), +because doing so would sometimes infer +non-principal types. Indeed, we can see kind-indexing as a form +of polymorphic recursion, where a type is used at a kind other than +its most general in its own definition. -This datatype ``G`` is GADT-like in both its kind and its type. Suppose you -have ``g :: G a``, where ``a :: k``. Then pattern matching to discover that -``g`` is in fact ``GMaybe`` tells you both that ``k ~ (Type -> Type)`` and -``a ~ Maybe``. The definition for ``G`` requires that :extension:`PolyKinds` -be in effect, but pattern-matching on ``G`` requires no extension beyond -:extension:`GADTs`. That this works is actually a straightforward extension -of regular GADTs and a consequence of the fact that kinds and types are the -same. +For example: :: -Note that the datatype ``G`` is used at different kinds in its body, and -therefore that kind-indexed GADTs use a form of polymorphic recursion. -It is thus only possible to use this feature if you have provided a -complete user-supplied kind signature -for the datatype (:ref:`complete-kind-signatures`). + type family F1 a where + F1 True = False + F1 False = True + F1 x = x + -- F1 fails to compile: kind-indexing is not inferred + + type family F2 (a :: k) where + F2 True = False + F2 False = True + F2 x = x + -- F2 fails to compile: no complete signature + + type family F3 (a :: k) :: k where + F3 True = False + F3 False = True + F3 x = x + -- OK Higher-rank kinds ----------------- ===================================== testsuite/tests/dependent/should_fail/T13780a.stderr ===================================== @@ -3,7 +3,7 @@ T13780a.hs:9:40: error: • Couldn't match kind ‘a’ with ‘Bool’ Expected kind ‘Foo a’, but ‘MkFoo’ has kind ‘Foo Bool’ ‘a’ is a rigid type variable bound by - a family instance declaration + the data constructor ‘SMkFoo’ at T13780a.hs:9:20-31 • In the second argument of ‘(~)’, namely ‘MkFoo’ In the definition of data constructor ‘SMkFoo’ ===================================== testsuite/tests/deriving/should_compile/T11416.hs ===================================== @@ -12,9 +12,11 @@ newtype T f (a :: ConstantT Type f) = T (f a) deriving Functor data family TFam1 (f :: k1) (a :: k2) -newtype instance TFam1 f (ConstantT a f) = TFam1 (f a) +newtype instance TFam1 (f :: k -> Type) (ConstantT (a :: k) f) + = TFam1 (f a) deriving Functor data family TFam2 (f :: k1) (a :: k2) -newtype instance TFam2 f (a :: ConstantT Type f) = TFam2 (f a) +newtype instance TFam2 (f :: Type -> Type) (a :: ConstantT Type f) + = TFam2 (f a) deriving Functor ===================================== testsuite/tests/deriving/should_compile/T9359.hs ===================================== @@ -9,6 +9,5 @@ data Cmp a where deriving (Show, Eq) data family CmpInterval (a :: Cmp k) (b :: Cmp k) :: Type -data instance CmpInterval (V c) Sup = Starting c +data instance CmpInterval (V (c :: Type)) Sup = Starting c deriving( Show ) - ===================================== testsuite/tests/indexed-types/should_compile/T14111.hs ===================================== @@ -0,0 +1,24 @@ +{-# LANGUAGE MagicHash, UnboxedSums, NoImplicitPrelude #-} +{-# LANGUAGE TypeFamilies #-} +-- {-# LANGUAGE PolyKinds #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE GADTs ,ExplicitNamespaces#-} +{-# LANGUAGE UnboxedTuples #-} + +module T14111 where + +import GHC.Exts +import GHC.Types +import Prelude (undefined) +import Data.Kind +import Data.Void + +data family Maybe(x :: TYPE (r :: RuntimeRep)) + +data instance Maybe (a :: Type ) where + MaybeSum :: (# a | (# #) #) -> Maybe a + +data instance Maybe (x :: TYPE 'UnliftedRep) where + MaybeSumU :: (# x | (# #) #) -> Maybe x ===================================== testsuite/tests/indexed-types/should_compile/T8707.hs ===================================== @@ -0,0 +1,11 @@ +{-# LANGUAGE TypeFamilies, PolyKinds, DataKinds, GADTs #-} + +module T8707 where + +import Data.Kind + +data family SingDF (a :: (k, k2 -> Type)) +data Ctor :: k -> Type + +data instance SingDF (a :: (Bool, Bool -> Type)) where + SFalse :: SingDF '(False, Ctor) ===================================== testsuite/tests/indexed-types/should_compile/all.T ===================================== @@ -300,3 +300,5 @@ test('T18809', normal, compile, ['-O']) test('CEqCanOccursCheck', normal, compile, ['']) test('GivenLoop', normal, compile, ['']) test('T18875', normal, compile, ['']) +test('T8707', normal, compile, ['-O']) +test('T14111', normal, compile, ['-O']) ===================================== testsuite/tests/indexed-types/should_fail/T8368.stderr ===================================== @@ -1,6 +1,5 @@ -T8368.hs:9:3: - Data constructor ‘MkFam’ returns type ‘Foo’ - instead of an instance of its parent type ‘Fam a’ - In the definition of data constructor ‘MkFam’ - In the data instance declaration for ‘Fam’ +T8368.hs:9:3: error: + • Couldn't match expected type ‘Fam a0’ with actual type ‘Foo’ + • In the result type of data constructor ‘MkFam’ + In the data instance declaration for ‘Fam’ ===================================== testsuite/tests/indexed-types/should_fail/T8368a.stderr ===================================== @@ -1,6 +1,7 @@ -T8368a.hs:7:3: - Data constructor ‘MkFam’ returns type ‘Fam Bool b’ - instead of an instance of its parent type ‘Fam Int b’ - In the definition of data constructor ‘MkFam’ - In the data instance declaration for ‘Fam’ +T8368a.hs:7:3: error: + • Couldn't match type ‘Bool’ with ‘Int’ + Expected: Fam Int b + Actual: Fam Bool b + • In the result type of data constructor ‘MkFam’ + In the data instance declaration for ‘Fam’ ===================================== testsuite/tests/patsyn/should_fail/T15685.stderr ===================================== @@ -1,13 +1,13 @@ T15685.hs:13:24: error: - • Could not deduce: a ~ [k0] - from the context: as ~ (a1 : as1) + • Could not deduce: k ~ [k0] + from the context: as ~ (a : as1) bound by a pattern with constructor: - Here :: forall {a1} (f :: a1 -> *) (a2 :: a1) (as :: [a1]). - f a2 -> NS f (a2 : as), + Here :: forall {k} (f :: k -> *) (a :: k) (as :: [k]). + f a -> NS f (a : as), in a pattern synonym declaration at T15685.hs:13:19-26 - ‘a’ is a rigid type variable bound by + ‘k’ is a rigid type variable bound by the inferred type of HereNil :: NS f as at T15685.hs:13:9-15 Possible fix: add a type signature for ‘HereNil’ ===================================== testsuite/tests/polykinds/T13659.stderr ===================================== @@ -1,6 +1,6 @@ -T13659.hs:14:27: error: - • Expected a type, but ‘a’ has kind ‘[*]’ - • In the first argument of ‘Format’, namely ‘'[Int, a]’ - In the type ‘Format '[Int, a]’ +T13659.hs:14:15: error: + • Expected kind ‘[*]’, but ‘a’ has kind ‘*’ + • In the first argument of ‘Format’, namely ‘a’ + In the type ‘Format a’ In the definition of data constructor ‘I’ ===================================== testsuite/tests/polykinds/T16221a.stderr ===================================== @@ -1,7 +1,7 @@ T16221a.hs:6:49: error: - • Expected kind ‘k’, but ‘b’ has kind ‘k1’ - ‘k1’ is a rigid type variable bound by + • Expected kind ‘k’, but ‘b’ has kind ‘k2’ + ‘k2’ is a rigid type variable bound by an explicit forall k (b :: k) at T16221a.hs:6:20 ‘k’ is a rigid type variable bound by ===================================== testsuite/tests/th/T11145.stderr ===================================== @@ -1,8 +1,7 @@ T11145.hs:8:1: error: - • Data constructor ‘MkFuggle’ returns type ‘Fuggle - Int (Maybe Bool)’ - instead of an instance of its parent type ‘Fuggle - Int (Maybe (a, b))’ - • In the definition of data constructor ‘MkFuggle’ + • Couldn't match type ‘Bool’ with ‘(a0, b0)’ + Expected: Fuggle Int (Maybe (a0, b0)) + Actual: Fuggle Int (Maybe Bool) + • In the result type of data constructor ‘MkFuggle’ In the data instance declaration for ‘Fuggle’ ===================================== testsuite/tests/th/T9692.hs ===================================== @@ -12,7 +12,7 @@ class C a where data F a (b :: k) :: Type instance C Int where - data F Int x = FInt x + data F Int (x :: Type) = FInt x $( do info <- qReify (mkName "F") runIO $ putStrLn $ pprint info ===================================== testsuite/tests/typecheck/should_compile/T18891.hs ===================================== @@ -0,0 +1,16 @@ +{-# LANGUAGE GADTs, UnliftedNewtypes, StandaloneKindSignatures, RankNTypes, TypeFamilies, PolyKinds #-} + +module T18891 where + +import GHC.Exts( TYPE ) + +data family T2 (a :: k) +data instance T2 a where + MkT2 :: T2 Maybe + +newtype N3 :: forall k -> TYPE k where + MkN3 :: N3 m -> N3 m + +type N4 :: forall k -> TYPE k +newtype N4 :: forall k -> TYPE k where + MkN4 :: N4 m -> N4 m ===================================== testsuite/tests/typecheck/should_compile/UnliftedNewtypesUnassociatedFamily.hs ===================================== @@ -4,6 +4,8 @@ {-# LANGUAGE PolyKinds #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TypeApplications #-} module UnliftedNewtypesUnassociatedFamily where @@ -20,7 +22,16 @@ newtype instance DFT ('TupleRep '[ 'IntRep, 'WordRep]) data instance DFT 'LiftedRep = MkDFT4 | MkDFT5 data family DF :: TYPE (r :: RuntimeRep) -newtype instance DF = MkDF1 Int# -newtype instance DF = MkDF2 Word# -newtype instance DF = MkDF3 (# Int#, Word# #) + +-- Use a type application +newtype instance DF @IntRep = MkDF1 Int# + +-- Use a kind signature +newtype instance DF :: TYPE 'WordRep where + MkDF2 :: Word# -> DF + +-- Also uses a kind signature +newtype instance DF :: TYPE ('TupleRep '[ 'IntRep, 'WordRep ]) where + MkDF3 :: (# Int#, Word# #) -> DF + data instance DF = MkDF4 | MkDF5 ===================================== testsuite/tests/typecheck/should_compile/UnliftedNewtypesUnifySig.hs ===================================== @@ -10,14 +10,14 @@ module UnliftedNewtypesUnassociatedFamily where import GHC.Int (Int(I#)) -import GHC.Exts (Int#,Word#,RuntimeRep(IntRep)) +import GHC.Exts (Int#,Word#,RuntimeRep(IntRep,WordRep)) import GHC.Exts (TYPE) type KindOf (a :: TYPE k) = k data family D (a :: TYPE r) :: TYPE r -newtype instance D a = MkWordD Word# +newtype instance D (a :: TYPE 'WordRep) = MkWordD Word# -newtype instance D a :: TYPE (KindOf a) where - MkIntD :: forall a. Int# -> D a +newtype instance D (a :: TYPE 'IntRep) :: TYPE (KindOf a) where + MkIntD :: forall (b :: TYPE 'IntRep). Int# -> D b ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -736,3 +736,4 @@ test('InstanceGivenOverlap', normal, compile, ['']) test('InstanceGivenOverlap2', normal, compile, ['']) test('LocalGivenEqs', normal, compile, ['']) test('LocalGivenEqs2', normal, compile, ['']) +test('T18891', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_fail/T18891a.hs ===================================== @@ -0,0 +1,13 @@ +{-# LANGUAGE GADTs, UnliftedNewtypes, StandaloneKindSignatures, RankNTypes, TypeFamilies, PolyKinds #-} + +module T18891 where + +import GHC.Exts( TYPE ) + +newtype N1 :: forall k. TYPE k where + MkN1 :: N1 -> N1 + +type N2 :: forall k. TYPE k +newtype N2 :: forall k. TYPE k where + MkN2 :: N2 -> N2 + ===================================== testsuite/tests/typecheck/should_fail/T18891a.stderr ===================================== @@ -0,0 +1,12 @@ + +T18891a.hs:8:4: error: + • A newtype constructor must have a return type of form T a1 ... an + MkN1 :: N1 -> N1 + • In the definition of data constructor ‘MkN1’ + In the newtype declaration for ‘N1’ + +T18891a.hs:12:3: error: + • A newtype constructor must have a return type of form T a1 ... an + MkN2 :: N2 -> N2 + • In the definition of data constructor ‘MkN2’ + In the newtype declaration for ‘N2’ ===================================== testsuite/tests/typecheck/should_fail/UnliftedNewtypesFamilyKindFail2.stderr ===================================== @@ -1,11 +1,5 @@ -UnliftedNewtypesFamilyKindFail2.hs:12:20: - Expected a type, but ‘5’ has kind ‘GHC.Num.Natural.Natural’ - In the first argument of ‘F’, namely ‘5’ - In the newtype instance declaration for ‘F’ - -UnliftedNewtypesFamilyKindFail2.hs:12:31: - Expected a type, but ‘5’ has kind ‘GHC.Num.Natural.Natural’ - In the first argument of ‘F’, namely ‘5’ - In the type ‘(F 5)’ - In the definition of data constructor ‘MkF’ +UnliftedNewtypesFamilyKindFail2.hs:12:20: error: + • Expected a type, but ‘5’ has kind ‘GHC.Num.Natural.Natural’ + • In the first argument of ‘F’, namely ‘5’ + In the newtype instance declaration for ‘F’ ===================================== testsuite/tests/typecheck/should_fail/UnliftedNewtypesUnassociatedFamilyFail.hs ===================================== @@ -0,0 +1,23 @@ +{-# LANGUAGE UnliftedNewtypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE GADTs #-} + +module UnliftedNewtypesUnassociatedFamily where + +import GHC.Int (Int(I#)) +import GHC.Word (Word(W#)) +import GHC.Exts (Int#,Word#) +import GHC.Exts (TYPE,RuntimeRep(LiftedRep,IntRep,WordRep,TupleRep)) + +data family DF :: TYPE (r :: RuntimeRep) + +-- All these fail: see #18891 and !4419 +-- See Note [Kind inference for data family instances] +-- in GHC.Tc.TyCl.Instance +newtype instance DF = MkDF1a Int# +newtype instance DF = MkDF2a Word# +newtype instance DF = MkDF3a (# Int#, Word# #) ===================================== testsuite/tests/typecheck/should_fail/UnliftedNewtypesUnassociatedFamilyFail.stderr ===================================== @@ -0,0 +1,18 @@ + +UnliftedNewtypesUnassociatedFamilyFail.hs:21:30: error: + • Expecting a lifted type, but ‘Int#’ is unlifted + • In the type ‘Int#’ + In the definition of data constructor ‘MkDF1a’ + In the newtype instance declaration for ‘DF’ + +UnliftedNewtypesUnassociatedFamilyFail.hs:22:30: error: + • Expecting a lifted type, but ‘Word#’ is unlifted + • In the type ‘Word#’ + In the definition of data constructor ‘MkDF2a’ + In the newtype instance declaration for ‘DF’ + +UnliftedNewtypesUnassociatedFamilyFail.hs:23:30: error: + • Expecting a lifted type, but ‘(# Int#, Word# #)’ is unlifted + • In the type ‘(# Int#, Word# #)’ + In the definition of data constructor ‘MkDF3a’ + In the newtype instance declaration for ‘DF’ ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -546,6 +546,7 @@ test('UnliftedNewtypesConstraintFamily', normal, compile_fail, ['']) test('UnliftedNewtypesMismatchedKind', normal, compile_fail, ['']) test('UnliftedNewtypesMismatchedKindRecord', normal, compile_fail, ['']) test('UnliftedNewtypesMultiFieldGadt', normal, compile_fail, ['']) +test('UnliftedNewtypesUnassociatedFamilyFail', normal, compile_fail, ['']) test('T13834', normal, compile_fail, ['']) test('T17077', normal, compile_fail, ['']) test('T16512a', normal, compile_fail, ['']) @@ -591,3 +592,4 @@ test('T18640c', normal, compile_fail, ['']) test('T10709', normal, compile_fail, ['']) test('T10709b', normal, compile_fail, ['']) test('GivenForallLoop', normal, compile_fail, ['']) +test('T18891a', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9f5d93dfbb7eb30ce37f65e7fa0a7d2d65dd51f5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9f5d93dfbb7eb30ce37f65e7fa0a7d2d65dd51f5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 4 03:14:12 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 03 Dec 2020 22:14:12 -0500 Subject: [Git][ghc/ghc][wip/tyconapp-opts] Optimise nullary type constructor usage Message-ID: <5fc9a984d98b3_6a09ce36501766c6@gitlab.mail> Ben Gamari pushed to branch wip/tyconapp-opts at Glasgow Haskell Compiler / GHC Commits: 4a7cac45 by Ben Gamari at 2020-12-03T22:13:58-05:00 Optimise nullary type constructor usage During the compilation of programs GHC very frequently deals with the `Type` type, which is a synonym of `TYPE 'LiftedRep`. This patch teaches GHC to avoid expanding the `Type` synonym (and other nullary type synonyms) during type comparisons, saving a good amount of work. This optimisation is described in `Note [Comparing nullary type synonyms]`. To maximize the impact of this optimisation, we introduce a few special-cases to reduce `TYPE 'LiftedRep` to `Type`. See `Note [Prefer Type over TYPE 'LiftedPtrRep]`. Closes #17958. Metric Decrease: T18698b T1969 T12227 T12545 T12707 T14683 T3064 T5631 T5642 T9020 T9872a T13035 haddock.Cabal haddock.base - - - - - 22 changed files: - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - + compiler/GHC/Builtin/Types/Prim.hs-boot - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/TcType.hs - testsuite/tests/deSugar/should_compile/T2431.stderr - testsuite/tests/deriving/should_compile/T14578.stderr - testsuite/tests/plugins/plugins09.stdout - testsuite/tests/plugins/plugins10.stdout - testsuite/tests/plugins/plugins11.stdout - testsuite/tests/plugins/static-plugins.stdout - testsuite/tests/printer/T18052a.stderr - testsuite/tests/simplCore/should_compile/T13143.stderr - testsuite/tests/simplCore/should_compile/T18013.stderr - testsuite/tests/simplCore/should_compile/T7360.stderr - testsuite/tests/typecheck/should_compile/T13032.stderr Changes: ===================================== compiler/GHC/Builtin/Types.hs ===================================== @@ -170,6 +170,7 @@ import GHC.Types.Var (VarBndr (Bndr)) import GHC.Settings.Constants ( mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE, mAX_SUM_SIZE ) import GHC.Unit.Module ( Module ) import GHC.Core.Type +import qualified GHC.Core.TyCo.Rep as TyCoRep (Type(TyConApp)) import GHC.Types.RepType import GHC.Core.DataCon import GHC.Core.ConLike @@ -689,7 +690,7 @@ constraintKindTyCon :: TyCon constraintKindTyCon = pcTyCon constraintKindTyConName Nothing [] [] liftedTypeKind, typeToTypeKind, constraintKind :: Kind -liftedTypeKind = tYPE liftedRepTy +liftedTypeKind = TyCoRep.TyConApp liftedTypeKindTyCon [] typeToTypeKind = liftedTypeKind `mkVisFunTyMany` liftedTypeKind constraintKind = mkTyConApp constraintKindTyCon [] @@ -1413,8 +1414,8 @@ runtimeRepTy = mkTyConTy runtimeRepTyCon -- type Type = tYPE 'LiftedRep liftedTypeKindTyCon :: TyCon liftedTypeKindTyCon = buildSynTyCon liftedTypeKindTyConName - [] liftedTypeKind [] - (tYPE liftedRepTy) + [] liftedTypeKind [] rhs + where rhs = TyCoRep.TyConApp tYPETyCon [liftedRepTy] runtimeRepTyCon :: TyCon runtimeRepTyCon = pcTyCon runtimeRepTyConName Nothing [] ===================================== compiler/GHC/Builtin/Types/Prim.hs ===================================== @@ -551,10 +551,6 @@ mkPrimTcName built_in_syntax occ key tycon = mkWiredInName gHC_PRIM (mkTcOccFS occ) key (mkATyCon tycon) built_in_syntax ----------------------------- --- | Given a RuntimeRep, applies TYPE to it. --- see Note [TYPE and RuntimeRep] -tYPE :: Type -> Type -tYPE rr = TyConApp tYPETyCon [rr] -- Given a Multiplicity, applies FUN to it. functionWithMultiplicity :: Type -> Type ===================================== compiler/GHC/Builtin/Types/Prim.hs-boot ===================================== @@ -0,0 +1,5 @@ +module GHC.Builtin.Types.Prim where + +import GHC.Core.TyCon + +tYPETyCon :: TyCon ===================================== compiler/GHC/Core/TyCo/Rep.hs ===================================== @@ -52,6 +52,7 @@ module GHC.Core.TyCo.Rep ( mkVisFunTyMany, mkVisFunTysMany, mkInvisFunTyMany, mkInvisFunTysMany, mkTyConApp, + tYPE, -- * Functions over binders TyCoBinder(..), TyCoVarBinder, TyBinder, @@ -90,8 +91,9 @@ import GHC.Core.TyCon import GHC.Core.Coercion.Axiom -- others -import GHC.Builtin.Names ( liftedTypeKindTyConKey, manyDataConKey ) -import {-# SOURCE #-} GHC.Builtin.Types ( liftedTypeKindTyCon, manyDataConTy ) +import GHC.Builtin.Names ( liftedTypeKindTyConKey, liftedRepDataConKey, manyDataConKey, tYPETyConKey ) +import {-# SOURCE #-} GHC.Builtin.Types ( liftedTypeKindTyCon, liftedTypeKind, manyDataConTy ) +import {-# SOURCE #-} GHC.Builtin.Types.Prim ( tYPETyCon ) import GHC.Types.Basic ( LeftOrRight(..), pickLR ) import GHC.Types.Unique ( hasKey, Uniquable(..) ) import GHC.Utils.Outputable @@ -1018,12 +1020,64 @@ mkTyConApp tycon tys -- avoid reboxing every time `mkTyConApp` is called. = ASSERT2( null tys, ppr tycon $$ ppr tys ) manyDataConTy + -- See Note [Prefer Type over TYPE 'LiftedRep]. + | tycon `hasKey` tYPETyConKey + , [rep] <- tys + = tYPE rep + -- The catch-all case | otherwise = TyConApp tycon tys +{- +Note [Prefer Type over TYPE 'LiftedRep] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The Core of nearly any program will have numerous occurrences of + at TYPE 'LiftedRep@ floating about. Consequently, we try hard to ensure +that operations on such types are efficient. Specifically, we strive to + + a. Avoid heap allocation of such types + b. Use a small (shallow in the tree-depth sense) representation + for such types + +Goal (b) is particularly useful as it makes traversals (e.g. free variable +traversal, substitution, and comparison) more efficient. +Comparison in particular takes special advantage of nullary type synonym +applications, Note [Comparing nullary type synonyms] in "GHC.Core.Type". + +To accomplish these we use a number of tricks: + + * Instead of representing the lifted kind as + @TyConApp tYPETyCon [liftedRepDataCon]@ we rather prefer to + use the 'GHC.Types.Type' type synonym. This serves goal (b) + since there are no applied type arguments to traverse, e.g., during + comparison. + + * We have a top-level binding to represent `TyConApp GHC.Types.Type []` + (namely 'GHC.Builtin.Types.Prim.liftedTypeKind'), ensuring that we + don't need to allocate such types (goal (a)). + + * To avoid allocating 'TyConApp' constructors + 'GHC.Builtin.Types.Prim.tYPE' catches the lifted case and returns + `liftedTypeKind` instead of building an application (goal (a)). + + * Similarly, 'Type.mkTyConApp' catches applications of `TYPE` and + handles them using 'GHC.Builtin.Types.Prim.tYPE', ensuring + that it benefits from the optimisation described above (goal (a)). + +See #17958. +-} + +-- | Given a RuntimeRep, applies TYPE to it. +-- See Note [TYPE and RuntimeRep] in GHC.Builtin.Types.Prim. +tYPE :: Type -> Type +tYPE (TyConApp tc []) + -- See Note [Prefer Type of TYPE 'LiftedRep] + | tc `hasKey` liftedRepDataConKey = liftedTypeKind -- TYPE 'LiftedRep +tYPE rr = TyConApp tYPETyCon [rr] + -- This is a single, global definition of the type `Type` -- Defined here so it is only allocated once. --- See Note [mkTyConApp and Type] +-- See Note [mkTyConApp and Type] in this module. liftedTypeKindTyConApp :: Type liftedTypeKindTyConApp = TyConApp liftedTypeKindTyCon [] ===================================== compiler/GHC/Core/TyCo/Subst.hs ===================================== @@ -424,6 +424,7 @@ zipTCvSubst tcvs tys -- | Generates the in-scope set for the 'TCvSubst' from the types in the -- incoming environment. No CoVars, please! mkTvSubstPrs :: [(TyVar, Type)] -> TCvSubst +mkTvSubstPrs [] = emptyTCvSubst mkTvSubstPrs prs = ASSERT2( onlyTyVarsAndNoCoercionTy, text "prs" <+> ppr prs ) mkTvSubst in_scope tenv ===================================== compiler/GHC/Core/TyCon.hs ===================================== @@ -2327,12 +2327,14 @@ expandSynTyCon_maybe -- ^ Expand a type synonym application, if any expandSynTyCon_maybe tc tys | SynonymTyCon { tyConTyVars = tvs, synTcRhs = rhs, tyConArity = arity } <- tc - = case tys `listLengthCmp` arity of - GT -> Just (tvs `zip` tys, rhs, drop arity tys) - EQ -> Just (tvs `zip` tys, rhs, []) - LT -> Nothing - | otherwise - = Nothing + = case tys of + [] -> Just ([], rhs, []) -- Avoid a bit of work in the case of nullary synonyms + _ -> case tys `listLengthCmp` arity of + GT -> Just (tvs `zip` tys, rhs, drop arity tys) + EQ -> Just (tvs `zip` tys, rhs, []) + LT -> Nothing + | otherwise + = Nothing ---------------- ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -383,15 +383,16 @@ how roles in kinds might work out. -} -- | Gives the typechecker view of a type. This unwraps synonyms but --- leaves 'Constraint' alone. c.f. coreView, which turns Constraint into --- TYPE LiftedRep. Returns Nothing if no unwrapping happens. +-- leaves 'Constraint' alone. c.f. 'coreView', which turns 'Constraint' into +-- @TYPE LiftedRep at . Returns 'Nothing' if no unwrapping happens. -- See also Note [coreView vs tcView] {-# INLINE tcView #-} tcView :: Type -> Maybe Type -tcView (TyConApp tc tys) | Just (tenv, rhs, tys') <- expandSynTyCon_maybe tc tys - = Just (mkAppTys (substTy (mkTvSubstPrs tenv) rhs) tys') +tcView (TyConApp tc tys) + | res@(Just _) <- expandSynTyConApp_maybe tc tys + = res -- The free vars of 'rhs' should all be bound by 'tenv', so it's - -- ok to use 'substTy' here. + -- ok to use 'substTy' here (which is what expandSynTyConApp_maybe does). -- See also Note [The substitution invariant] in GHC.Core.TyCo.Subst. -- Its important to use mkAppTys, rather than (foldl AppTy), -- because the function part might well return a @@ -400,17 +401,16 @@ tcView _ = Nothing {-# INLINE coreView #-} coreView :: Type -> Maybe Type --- ^ This function Strips off the /top layer only/ of a type synonym +-- ^ This function strips off the /top layer only/ of a type synonym -- application (if any) its underlying representation type. --- Returns Nothing if there is nothing to look through. +-- Returns 'Nothing' if there is nothing to look through. -- This function considers 'Constraint' to be a synonym of @TYPE LiftedRep at . -- -- By being non-recursive and inlined, this case analysis gets efficiently -- joined onto the case analysis that the caller is already doing coreView ty@(TyConApp tc tys) - | Just (tenv, rhs, tys') <- expandSynTyCon_maybe tc tys - = Just (mkAppTys (substTy (mkTvSubstPrs tenv) rhs) tys') - -- This equation is exactly like tcView + | res@(Just _) <- expandSynTyConApp_maybe tc tys + = res -- At the Core level, Constraint = Type -- See Note [coreView vs tcView] @@ -420,6 +420,30 @@ coreView ty@(TyConApp tc tys) coreView _ = Nothing +----------------------------------------------- +expandSynTyConApp_maybe :: TyCon -> [Type] -> Maybe Type +expandSynTyConApp_maybe tc tys + | Just (tvs, rhs) <- synTyConDefn_maybe tc + , n_tys >= arity + = Just (expand_syn arity tvs rhs n_tys tys) + | otherwise + = Nothing + where + n_tys = length tys + arity = tyConArity tc +-- Without this INLINE the call to expandSynTyConApp_maybe in coreView +-- will result in an avoidable allocation. +{-# INLINE expandSynTyConApp_maybe #-} + +-- | A helper for 'expandSynTyConApp_maybe' to avoid inlining this cold path +-- into call-sites. +expand_syn :: Int -> [TyVar] -> Type -> Int -> [Type] -> Type +expand_syn arity tvs rhs n_tys tys + | n_tys > arity = mkAppTys rhs' (drop arity tys) + | otherwise = rhs' + where + rhs' = substTy (mkTvSubstPrs (tvs `zip` tys)) rhs + {-# INLINE coreFullView #-} coreFullView :: Type -> Type -- ^ Iterates 'coreView' until there is no more to synonym to expand. @@ -2207,6 +2231,36 @@ But the left is an AppTy while the right is a TyConApp. The solution is to use repSplitAppTy_maybe to break up the TyConApp into its pieces and then continue. Easy to do, but also easy to forget to do. + +Note [Comparing nullary type synonyms] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider the task of testing equality between two 'Type's of the form + + TyConApp tc [] + +where @tc@ is a type synonym. A naive way to perform this comparison these +would first expand the synonym and then compare the resulting expansions. + +However, this is obviously wasteful and the RHS of @tc@ may be large; it is +much better to rather compare the TyCons directly. Consequently, before +expanding type synonyms in type comparisons we first look for a nullary +TyConApp and simply compare the TyCons if we find one. Of course, if we find +that the TyCons are *not* equal then we still need to perform the expansion as +their RHSs may still be equal. + +We perform this optimisation in a number of places: + + * GHC.Core.Types.eqType + * GHC.Core.Types.nonDetCmpType + * GHC.Core.Unify.unify_ty + * TcCanonical.can_eq_nc' + * TcUnify.uType + +This optimisation is especially helpful for the ubiquitous GHC.Types.Type, +since GHC prefers to use the type synonym over @TYPE 'LiftedRep@ applications +whenever possible. See [Prefer Type over TYPE 'LiftedRep] in +GHC.Core.TyCo.Rep for details. + -} eqType :: Type -> Type -> Bool @@ -2318,6 +2372,10 @@ nonDetCmpTypeX env orig_t1 orig_t2 = -- Returns both the resulting ordering relation between the two types -- and whether either contains a cast. go :: RnEnv2 -> Type -> Type -> TypeOrdering + -- See Note [Comparing nullary type synonyms]. + go _ (TyConApp tc1 []) (TyConApp tc2 []) + | tc1 == tc2 + = TEQ go env t1 t2 | Just t1' <- coreView t1 = go env t1' t2 | Just t2' <- coreView t2 = go env t1 t2' ===================================== compiler/GHC/Core/Unify.hs ===================================== @@ -957,7 +957,12 @@ unify_ty :: UMEnv -- Respects newtypes, PredTypes unify_ty env ty1 ty2 kco - -- Use tcView, not coreView. See Note [coreView vs tcView] in GHC.Core.Type. + -- See Note [Comparing nullary type synonyms] in GHC.Core.Type. + | TyConApp tc1 [] <- ty1 + , TyConApp tc2 [] <- ty2 + , tc1 == tc2 = return () + + -- TODO: More commentary needed here | Just ty1' <- tcView ty1 = unify_ty env ty1' ty2 kco | Just ty2' <- tcView ty2 = unify_ty env ty1 ty2' kco | CastTy ty1' co <- ty1 = if um_unif env ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -956,6 +956,11 @@ can_eq_nc' -> Type -> Type -- RHS, after and before type-synonym expansion, resp -> TcS (StopOrContinue Ct) +-- See Note [Comparing nullary type synonyms] in GHC.Core.Type. +can_eq_nc' _flat _rdr_env _envs ev eq_rel ty1@(TyConApp tc1 []) _ps_ty1 (TyConApp tc2 []) _ps_ty2 + | tc1 == tc2 + = canEqReflexive ev eq_rel ty1 + -- Expand synonyms first; see Note [Type synonyms and canonicalization] can_eq_nc' rewritten rdr_env envs ev eq_rel ty1 ps_ty1 ty2 ps_ty2 | Just ty1' <- tcView ty1 = can_eq_nc' rewritten rdr_env envs ev eq_rel ty1' ps_ty1 ty2 ps_ty2 ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -120,7 +120,6 @@ import GHC.Types.Id as Id import GHC.Types.Name import GHC.Types.Var.Set import GHC.Builtin.Types -import GHC.Builtin.Types.Prim import GHC.Types.Var.Env import GHC.Types.Name.Env import GHC.Utils.Misc ===================================== compiler/GHC/Tc/Utils/TcType.hs ===================================== @@ -1581,6 +1581,11 @@ tc_eq_type keep_syns vis_only orig_ty1 orig_ty2 = go orig_env orig_ty1 orig_ty2 where go :: RnEnv2 -> Type -> Type -> Bool + -- See Note [Comparing nullary type synonyms] in GHC.Core.Type. + go _ (TyConApp tc1 []) (TyConApp tc2 []) + | tc1 == tc2 + = True + go env t1 t2 | not keep_syns, Just t1' <- tcView t1 = go env t1' t2 go env t1 t2 | not keep_syns, Just t2' <- tcView t2 = go env t1 t2' ===================================== testsuite/tests/deSugar/should_compile/T2431.stderr ===================================== @@ -1,9 +1,9 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 63, types: 43, coercions: 1, joins: 0/0} + = {terms: 63, types: 39, coercions: 1, joins: 0/0} --- RHS size: {terms: 2, types: 4, coercions: 1, joins: 0/0} +-- RHS size: {terms: 2, types: 3, coercions: 1, joins: 0/0} T2431.$WRefl [InlPrag=INLINE[final] CONLIKE] :: forall a. a :~: a [GblId[DataConWrapper], Caf=NoCafRefs, @@ -15,7 +15,7 @@ T2431.$WRefl [InlPrag=INLINE[final] CONLIKE] :: forall a. a :~: a T2431.$WRefl = \ (@a) -> T2431.Refl @a @a @~(_N :: a GHC.Prim.~# a) --- RHS size: {terms: 4, types: 8, coercions: 0, joins: 0/0} +-- RHS size: {terms: 4, types: 7, coercions: 0, joins: 0/0} absurd :: forall a. (Int :~: Bool) -> a [GblId, Arity=1, Str=b, Cpr=b, Unf=OtherCon []] absurd = \ (@a) (x :: Int :~: Bool) -> case x of { } ===================================== testsuite/tests/deriving/should_compile/T14578.stderr ===================================== @@ -16,13 +16,12 @@ Derived class instances: = GHC.Prim.coerce @(T14578.App (Data.Functor.Compose.Compose f g) a -> T14578.App (Data.Functor.Compose.Compose f g) a - -> T14578.App (Data.Functor.Compose.Compose f g) a) + -> T14578.App (Data.Functor.Compose.Compose f g) a) @(T14578.Wat f g a -> T14578.Wat f g a -> T14578.Wat f g a) ((GHC.Base.<>) @(T14578.App (Data.Functor.Compose.Compose f g) a)) GHC.Base.sconcat = GHC.Prim.coerce - @(GHC.Base.NonEmpty - (T14578.App (Data.Functor.Compose.Compose f g) a) + @(GHC.Base.NonEmpty (T14578.App (Data.Functor.Compose.Compose f g) a) -> T14578.App (Data.Functor.Compose.Compose f g) a) @(GHC.Base.NonEmpty (T14578.Wat f g a) -> T14578.Wat f g a) (GHC.Base.sconcat @@ -31,7 +30,7 @@ Derived class instances: = GHC.Prim.coerce @(b -> T14578.App (Data.Functor.Compose.Compose f g) a - -> T14578.App (Data.Functor.Compose.Compose f g) a) + -> T14578.App (Data.Functor.Compose.Compose f g) a) @(b -> T14578.Wat f g a -> T14578.Wat f g a) (GHC.Base.stimes @(T14578.App (Data.Functor.Compose.Compose f g) a)) ===================================== testsuite/tests/plugins/plugins09.stdout ===================================== @@ -3,6 +3,5 @@ interfacePlugin: Prelude interfacePlugin: GHC.Float interfacePlugin: GHC.Base typeCheckPlugin (rn) -interfacePlugin: GHC.Types typeCheckPlugin (tc) interfacePlugin: GHC.Num.BigNat ===================================== testsuite/tests/plugins/plugins10.stdout ===================================== @@ -6,7 +6,6 @@ interfacePlugin: GHC.Float interfacePlugin: GHC.Base interfacePlugin: Language.Haskell.TH.Syntax typeCheckPlugin (rn) -interfacePlugin: GHC.Types typeCheckPlugin (tc) interfacePlugin: GHC.Num.BigNat parsePlugin(a) ===================================== testsuite/tests/plugins/plugins11.stdout ===================================== @@ -3,6 +3,5 @@ interfacePlugin: Prelude interfacePlugin: GHC.Float interfacePlugin: GHC.Base typeCheckPlugin (rn) -interfacePlugin: GHC.Types typeCheckPlugin (tc) interfacePlugin: GHC.Num.BigNat ===================================== testsuite/tests/plugins/static-plugins.stdout ===================================== @@ -5,11 +5,11 @@ interfacePlugin: GHC.Float interfacePlugin: GHC.Base interfacePlugin: System.IO typeCheckPlugin (rn) -interfacePlugin: GHC.Prim -interfacePlugin: GHC.Show interfacePlugin: GHC.Types +interfacePlugin: GHC.Show interfacePlugin: GHC.TopHandler typeCheckPlugin (tc) +interfacePlugin: GHC.Prim interfacePlugin: GHC.CString interfacePlugin: GHC.Num.BigNat ==pure.1 ===================================== testsuite/tests/printer/T18052a.stderr ===================================== @@ -10,9 +10,9 @@ Dependent packages: [base-4.16.0.0, ghc-bignum-1.0, ghc-prim-0.8.0] ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 24, types: 61, coercions: 0, joins: 0/0} + = {terms: 24, types: 52, coercions: 0, joins: 0/0} --- RHS size: {terms: 7, types: 8, coercions: 0, joins: 0/0} +-- RHS size: {terms: 7, types: 6, coercions: 0, joins: 0/0} T18052a.$b:||: :: forall {a} {b}. a -> b -> (a, b) [GblId, Arity=2, Unf=OtherCon []] T18052a.$b:||: = \ (@a) (@b) (x :: a) (y :: b) -> (x, y) @@ -22,7 +22,7 @@ T18052a.$b:||: = \ (@a) (@b) (x :: a) (y :: b) -> (x, y) [GblId] (+++) = ++ --- RHS size: {terms: 13, types: 20, coercions: 0, joins: 0/0} +-- RHS size: {terms: 13, types: 18, coercions: 0, joins: 0/0} T18052a.$m:||: :: forall {rep :: GHC.Types.RuntimeRep} {r :: TYPE rep} {a} {b}. (a, b) -> (a -> b -> r) -> ((# #) -> r) -> r ===================================== testsuite/tests/simplCore/should_compile/T13143.stderr ===================================== @@ -1,17 +1,17 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 71, types: 44, coercions: 0, joins: 0/0} + = {terms: 71, types: 40, coercions: 0, joins: 0/0} Rec { --- RHS size: {terms: 4, types: 4, coercions: 0, joins: 0/0} +-- RHS size: {terms: 4, types: 3, coercions: 0, joins: 0/0} T13143.$wf [InlPrag=NOINLINE, Occ=LoopBreaker] :: forall {a}. (# #) -> a [GblId, Arity=1, Str=b, Cpr=b, Unf=OtherCon []] T13143.$wf = \ (@a) _ [Occ=Dead] -> T13143.$wf @a GHC.Prim.(##) end Rec } --- RHS size: {terms: 4, types: 4, coercions: 0, joins: 0/0} +-- RHS size: {terms: 4, types: 3, coercions: 0, joins: 0/0} f [InlPrag=[final]] :: forall a. Int -> a [GblId, Arity=1, ===================================== testsuite/tests/simplCore/should_compile/T18013.stderr ===================================== @@ -129,9 +129,9 @@ Rule fired: Class op fmap (BUILTIN) ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 52, types: 106, coercions: 17, joins: 0/1} + = {terms: 52, types: 101, coercions: 17, joins: 0/1} --- RHS size: {terms: 37, types: 87, coercions: 17, joins: 0/1} +-- RHS size: {terms: 37, types: 84, coercions: 17, joins: 0/1} mapMaybeRule :: forall a b. Rule IO a b -> Rule IO (Maybe a) (Maybe b) [GblId, ===================================== testsuite/tests/simplCore/should_compile/T7360.stderr ===================================== @@ -1,7 +1,7 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 106, types: 47, coercions: 0, joins: 0/0} + = {terms: 106, types: 45, coercions: 0, joins: 0/0} -- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} T7360.$WFoo3 [InlPrag=INLINE[final] CONLIKE] :: Int %1 -> Foo @@ -31,7 +31,7 @@ T7360.fun4 :: () WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 20 0}] T7360.fun4 = fun1 T7360.Foo1 --- RHS size: {terms: 11, types: 8, coercions: 0, joins: 0/0} +-- RHS size: {terms: 11, types: 7, coercions: 0, joins: 0/0} fun2 :: forall {a}. [a] -> ((), Int) [GblId, Arity=1, ===================================== testsuite/tests/typecheck/should_compile/T13032.stderr ===================================== @@ -1,9 +1,9 @@ ==================== Desugar (after optimization) ==================== Result size of Desugar (after optimization) - = {terms: 13, types: 24, coercions: 0, joins: 0/0} + = {terms: 13, types: 18, coercions: 0, joins: 0/0} --- RHS size: {terms: 6, types: 11, coercions: 0, joins: 0/0} +-- RHS size: {terms: 6, types: 8, coercions: 0, joins: 0/0} f :: forall a b. (a ~ b) => a -> b -> Bool [LclIdX, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4a7cac45cee742489c6fab5f95fa1f062cea97aa -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4a7cac45cee742489c6fab5f95fa1f062cea97aa You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 4 03:16:14 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 03 Dec 2020 22:16:14 -0500 Subject: [Git][ghc/ghc][wip/backports-9.0] testsuite: Add missing #include on Message-ID: <5fc9a9fea58f1_6a09af1fe0177580@gitlab.mail> Ben Gamari pushed to branch wip/backports-9.0 at Glasgow Haskell Compiler / GHC Commits: 794616b6 by Ben Gamari at 2020-12-03T22:16:06-05:00 testsuite: Add missing #include on <stdlib.h> This otherwise fails on newer Clangs, which warn more aggressively on undeclared symbols. (cherry picked from commit 3d7db1488c4bd7764e8b1fe3cfde4c5a548cde16) - - - - - 1 changed file: - testsuite/tests/concurrent/should_run/conc059_c.c Changes: ===================================== testsuite/tests/concurrent/should_run/conc059_c.c ===================================== @@ -1,6 +1,7 @@ #include "HsFFI.h" #include "conc059_stub.h" #include +#include #include #if mingw32_HOST_OS #include View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/794616b6c4ab6537304777cfb5616cd5fc031a2f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/794616b6c4ab6537304777cfb5616cd5fc031a2f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 4 03:19:56 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 03 Dec 2020 22:19:56 -0500 Subject: [Git][ghc/ghc][wip/no-fptr] 7 commits: GHC.Utils.Binary: Eliminate allocating withForeignPtr uses Message-ID: <5fc9aadcbe46a_6a09cea2d41795a@gitlab.mail> Ben Gamari pushed to branch wip/no-fptr at Glasgow Haskell Compiler / GHC Commits: d935c519 by Ben Gamari at 2020-12-03T17:18:24-05:00 GHC.Utils.Binary: Eliminate allocating withForeignPtr uses - - - - - a34cf3d0 by Ben Gamari at 2020-12-03T17:18:24-05:00 base: Eliminate allocating withForeignPtrs from GHC.Event.Array - - - - - 9787420a by Ben Gamari at 2020-12-03T17:18:24-05:00 base: Use unsafeWithForeignPtr in GHC.IO.Buffer - - - - - 397776c9 by Ben Gamari at 2020-12-03T17:18:24-05:00 base: Use unsafeWithForeignPtr in GHC.Event.IntTable - - - - - ade9666d by Ben Gamari at 2020-12-03T17:18:24-05:00 Bump bytestring submodule Teach it to use unsafeWithForeignPtr where appropriate. - - - - - 8b249760 by Ben Gamari at 2020-12-03T17:18:24-05:00 Sized - - - - - 10217769 by Ben Gamari at 2020-12-03T17:18:24-05:00 StringBuffer: Use unsafeWithForeignPtr - - - - - 7 changed files: - compiler/GHC/Data/StringBuffer.hs - compiler/GHC/Utils/Binary.hs - libraries/base/GHC/Event/Array.hs - libraries/base/GHC/Event/IntTable.hs - libraries/base/GHC/ForeignPtr/Ops.hs - libraries/base/GHC/IO/Buffer.hs - libraries/bytestring Changes: ===================================== compiler/GHC/Data/StringBuffer.hs ===================================== @@ -68,6 +68,12 @@ import GHC.IO.Encoding.Failure ( CodingFailureMode(IgnoreCodingFailure) ) import GHC.Exts import Foreign +#if MIN_VERSION_base(4,15,0) +import GHC.ForeignPtr (unsafeWithForeignPtr) +#else +unsafeWithForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b +unsafeWithForeignPtr = withForeignPtr +#endif -- ----------------------------------------------------------------------------- -- The StringBuffer type @@ -107,7 +113,7 @@ hGetStringBuffer fname = do offset_i <- skipBOM h size_i 0 -- offset is 0 initially let size = fromIntegral $ size_i - offset_i buf <- mallocForeignPtrArray (size+3) - withForeignPtr buf $ \ptr -> do + unsafeWithForeignPtr buf $ \ptr -> do r <- if size == 0 then return 0 else hGetBuf h ptr size hClose h if (r /= size) @@ -120,7 +126,7 @@ hGetStringBufferBlock handle wanted offset_i <- hTell handle >>= skipBOM handle size_i let size = min wanted (fromIntegral $ size_i-offset_i) buf <- mallocForeignPtrArray (size+3) - withForeignPtr buf $ \ptr -> + unsafeWithForeignPtr buf $ \ptr -> do r <- if size == 0 then return 0 else hGetBuf handle ptr size if r /= size then ioError (userError $ "short read of file: "++show(r,size,size_i,handle)) @@ -128,7 +134,7 @@ hGetStringBufferBlock handle wanted hPutStringBuffer :: Handle -> StringBuffer -> IO () hPutStringBuffer hdl (StringBuffer buf len cur) - = withForeignPtr (plusForeignPtr buf cur) $ \ptr -> + = unsafeWithForeignPtr (plusForeignPtr buf cur) $ \ptr -> hPutBuf hdl ptr len -- | Skip the byte-order mark if there is one (see #1744 and #6016), @@ -165,9 +171,9 @@ newUTF8StringBuffer buf ptr size = do appendStringBuffers :: StringBuffer -> StringBuffer -> IO StringBuffer appendStringBuffers sb1 sb2 = do newBuf <- mallocForeignPtrArray (size+3) - withForeignPtr newBuf $ \ptr -> - withForeignPtr (buf sb1) $ \sb1Ptr -> - withForeignPtr (buf sb2) $ \sb2Ptr -> + unsafeWithForeignPtr newBuf $ \ptr -> + unsafeWithForeignPtr (buf sb1) $ \sb1Ptr -> + unsafeWithForeignPtr (buf sb2) $ \sb2Ptr -> do copyArray ptr (sb1Ptr `advancePtr` cur sb1) sb1_len copyArray (ptr `advancePtr` sb1_len) (sb2Ptr `advancePtr` cur sb2) sb2_len pokeArray (ptr `advancePtr` size) [0,0,0] @@ -184,7 +190,7 @@ stringToStringBuffer str = unsafePerformIO $ do let size = utf8EncodedLength str buf <- mallocForeignPtrArray (size+3) - withForeignPtr buf $ \ptr -> do + unsafeWithForeignPtr buf $ \ptr -> do utf8EncodeString ptr str pokeArray (ptr `plusPtr` size :: Ptr Word8) [0,0,0] -- sentinels for UTF-8 decoding @@ -203,7 +209,7 @@ nextChar :: StringBuffer -> (Char,StringBuffer) nextChar (StringBuffer buf len (I# cur#)) = -- Getting our fingers dirty a little here, but this is performance-critical inlinePerformIO $ - withForeignPtr buf $ \(Ptr a#) -> + unsafeWithForeignPtr buf $ \(Ptr a#) -> case utf8DecodeCharAddr# (a# `plusAddr#` cur#) 0# of (# c#, nBytes# #) -> let cur' = I# (cur# +# nBytes#) in @@ -220,7 +226,7 @@ prevChar :: StringBuffer -> Char -> Char prevChar (StringBuffer _ _ 0) deflt = deflt prevChar (StringBuffer buf _ cur) _ = inlinePerformIO $ - withForeignPtr buf $ \p -> do + unsafeWithForeignPtr buf $ \p -> do p' <- utf8PrevChar (p `plusPtr` cur) return (fst (utf8DecodeChar p')) @@ -258,7 +264,7 @@ atEnd (StringBuffer _ l c) = l == c atLine :: Int -> StringBuffer -> Maybe StringBuffer atLine line sb@(StringBuffer buf len _) = inlinePerformIO $ - withForeignPtr buf $ \p -> do + unsafeWithForeignPtr buf $ \p -> do p' <- skipToLine line len p if p' == nullPtr then return Nothing @@ -309,14 +315,14 @@ lexemeToFastString :: StringBuffer lexemeToFastString _ 0 = nilFS lexemeToFastString (StringBuffer buf _ cur) len = inlinePerformIO $ - withForeignPtr buf $ \ptr -> + unsafeWithForeignPtr buf $ \ptr -> return $! mkFastStringBytes (ptr `plusPtr` cur) len -- | Return the previous @n@ characters (or fewer if we are less than @n@ -- characters into the buffer. decodePrevNChars :: Int -> StringBuffer -> String decodePrevNChars n (StringBuffer buf _ cur) = - inlinePerformIO $ withForeignPtr buf $ \p0 -> + inlinePerformIO $ unsafeWithForeignPtr buf $ \p0 -> go p0 n "" (p0 `plusPtr` (cur - 1)) where go :: Ptr Word8 -> Int -> String -> Ptr Word8 -> IO String ===================================== compiler/GHC/Utils/Binary.hs ===================================== @@ -6,6 +6,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE UnboxedTuples #-} {-# OPTIONS_GHC -O2 -funbox-strict-fields #-} -- We always optimise this, otherwise performance of a non-optimised @@ -93,10 +94,16 @@ import System.IO as IO import System.IO.Unsafe ( unsafeInterleaveIO ) import System.IO.Error ( mkIOError, eofErrorType ) import GHC.Real ( Ratio(..) ) +#if MIN_VERSION_base(4,15,0) +import GHC.ForeignPtr ( unsafeWithForeignPtr ) +#endif type BinArray = ForeignPtr Word8 - +#if !MIN_VERSION_base(4,15,0) +unsafeWithForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b +unsafeWithForeignPtr = withForeignPtr +#endif --------------------------------------------------------------- -- BinData @@ -111,14 +118,14 @@ instance Binary BinData where put_ bh (BinData sz dat) = do put_ bh sz putPrim bh sz $ \dest -> - withForeignPtr dat $ \orig -> + unsafeWithForeignPtr dat $ \orig -> copyBytes dest orig sz -- get bh = do sz <- get bh dat <- mallocForeignPtrBytes sz getPrim bh sz $ \orig -> - withForeignPtr dat $ \dest -> + unsafeWithForeignPtr dat $ \dest -> copyBytes dest orig sz return (BinData sz dat) @@ -226,7 +233,7 @@ writeBinMem (BinMem _ ix_r _ arr_r) fn = do h <- openBinaryFile fn WriteMode arr <- readIORef arr_r ix <- readFastMutInt ix_r - withForeignPtr arr $ \p -> hPutBuf h p ix + unsafeWithForeignPtr arr $ \p -> hPutBuf h p ix hClose h readBinMem :: FilePath -> IO BinHandle @@ -236,7 +243,7 @@ readBinMem filename = do filesize' <- hFileSize h let filesize = fromIntegral filesize' arr <- mallocForeignPtrBytes filesize - count <- withForeignPtr arr $ \p -> hGetBuf h p filesize + count <- unsafeWithForeignPtr arr $ \p -> hGetBuf h p filesize when (count /= filesize) $ error ("Binary.readBinMem: only read " ++ show count ++ " bytes") hClose h @@ -280,7 +287,7 @@ putPrim h@(BinMem _ ix_r sz_r arr_r) size f = do when (ix + size > sz) $ expandBin h (ix + size) arr <- readIORef arr_r - withForeignPtr arr $ \op -> f (op `plusPtr` ix) + unsafeWithForeignPtr arr $ \op -> f (op `plusPtr` ix) writeFastMutInt ix_r (ix + size) -- -- | Similar to putPrim but advances the index by the actual number of @@ -302,7 +309,9 @@ getPrim (BinMem _ ix_r sz_r arr_r) size f = do when (ix + size > sz) $ ioError (mkIOError eofErrorType "Data.Binary.getPrim" Nothing Nothing) arr <- readIORef arr_r - w <- withForeignPtr arr $ \op -> f (op `plusPtr` ix) + w <- unsafeWithForeignPtr arr $ \p -> f (p `plusPtr` ix) + -- This is safe WRT #17760 as we we guarantee that the above line doesn't + -- diverge writeFastMutInt ix_r (ix + size) return w ===================================== libraries/base/GHC/Event/Array.hs ===================================== @@ -33,7 +33,7 @@ import Foreign.ForeignPtr (ForeignPtr, withForeignPtr) import Foreign.Ptr (Ptr, nullPtr, plusPtr) import Foreign.Storable (Storable(..)) import GHC.Base hiding (empty) -import GHC.ForeignPtr (mallocPlainForeignPtrBytes, newForeignPtr_) +import GHC.ForeignPtr (mallocPlainForeignPtrBytes, newForeignPtr_, unsafeWithForeignPtr) import GHC.Num (Num(..)) import GHC.Real (fromIntegral) import GHC.Show (show) @@ -78,9 +78,9 @@ reallocArray p newSize oldSize = reallocHack undefined p reallocHack dummy src = do let size = sizeOf dummy dst <- mallocPlainForeignPtrBytes (newSize * size) - withForeignPtr src $ \s -> + unsafeWithForeignPtr src $ \s -> when (s /= nullPtr && oldSize > 0) . - withForeignPtr dst $ \d -> do + unsafeWithForeignPtr dst $ \d -> do _ <- memcpy d s (fromIntegral (oldSize * size)) return () return dst @@ -99,8 +99,8 @@ duplicate a = dupHack undefined a dupHack dummy (Array ref) = do AC es len cap <- readIORef ref ary <- allocArray cap - withForeignPtr ary $ \dest -> - withForeignPtr es $ \src -> do + unsafeWithForeignPtr ary $ \dest -> + unsafeWithForeignPtr es $ \src -> do _ <- memcpy dest src (fromIntegral (len * sizeOf dummy)) return () Array `fmap` newIORef (AC ary len cap) @@ -119,8 +119,8 @@ unsafeRead :: Storable a => Array a -> Int -> IO a unsafeRead (Array ref) ix = do AC es _ cap <- readIORef ref CHECK_BOUNDS("unsafeRead",cap,ix) - withForeignPtr es $ \p -> - peekElemOff p ix + unsafeWithForeignPtr es $ \ptr -> peekElemOff ptr ix + -- this is safe WRT #17760 as we assume that peekElemOff doesn't diverge unsafeWrite :: Storable a => Array a -> Int -> a -> IO () unsafeWrite (Array ref) ix a = do @@ -130,13 +130,15 @@ unsafeWrite (Array ref) ix a = do unsafeWrite' :: Storable a => AC a -> Int -> a -> IO () unsafeWrite' (AC es _ cap) ix a = CHECK_BOUNDS("unsafeWrite'",cap,ix) - withForeignPtr es $ \p -> - pokeElemOff p ix a + unsafeWithForeignPtr es $ \ptr -> pokeElemOff ptr ix a + -- this is safe WRT #17760 as we assume that peekElemOff doesn't diverge +-- | Precondition: continuation must not diverge due to use of +-- 'unsafeWithForeignPtr'. unsafeLoad :: Array a -> (Ptr a -> Int -> IO Int) -> IO Int unsafeLoad (Array ref) load = do AC es _ cap <- readIORef ref - len' <- withForeignPtr es $ \p -> load p cap + len' <- unsafeWithForeignPtr es $ \p -> load p cap writeIORef ref (AC es len' cap) return len' @@ -146,7 +148,7 @@ unsafeCopyFromBuffer :: Storable a => Array a -> Ptr a -> Int -> IO () unsafeCopyFromBuffer (Array ref) sptr n = readIORef ref >>= \(AC es _ cap) -> CHECK_BOUNDS("unsafeCopyFromBuffer", cap, n) - withForeignPtr es $ \pdest -> do + unsafeWithForeignPtr es $ \pdest -> do let size = sizeOfPtr sptr undefined _ <- memcpy pdest sptr (fromIntegral $ n * size) writeIORef ref (AC es n cap) @@ -198,7 +200,7 @@ forM_ ary g = forHack ary g undefined AC es len _ <- readIORef ref let size = sizeOf dummy offset = len * size - withForeignPtr es $ \p -> do + unsafeWithForeignPtr es $ \p -> do let go n | n >= offset = return () | otherwise = do f =<< peek (p `plusPtr` n) @@ -269,8 +271,8 @@ copy' d dstart s sstart maxCount = copyHack d s undefined then return dac else do AC dst dlen dcap <- ensureCapacity' dac (dstart + count) - withForeignPtr dst $ \dptr -> - withForeignPtr src $ \sptr -> do + unsafeWithForeignPtr dst $ \dptr -> + unsafeWithForeignPtr src $ \sptr -> do _ <- memcpy (dptr `plusPtr` (dstart * size)) (sptr `plusPtr` (sstart * size)) (fromIntegral (count * size)) @@ -286,7 +288,7 @@ removeAt a i = removeHack a undefined let size = sizeOf dummy newLen = oldLen - 1 when (newLen > 0 && i < newLen) . - withForeignPtr fp $ \ptr -> do + unsafeWithForeignPtr fp $ \ptr -> do _ <- memmove (ptr `plusPtr` (size * i)) (ptr `plusPtr` (size * (i+1))) (fromIntegral (size * (newLen-i))) ===================================== libraries/base/GHC/Event/IntTable.hs ===================================== @@ -17,7 +17,8 @@ module GHC.Event.IntTable import Data.Bits ((.&.), shiftL, shiftR) import Data.IORef (IORef, newIORef, readIORef, writeIORef) import Data.Maybe (Maybe(..), isJust) -import Foreign.ForeignPtr (ForeignPtr, mallocForeignPtr, withForeignPtr) +import Foreign.ForeignPtr (ForeignPtr, mallocForeignPtr) +import GHC.ForeignPtr (unsafeWithForeignPtr) import Foreign.Storable (peek, poke) import GHC.Base (Monad(..), (=<<), ($), ($!), const, liftM, otherwise, when) import GHC.Classes (Eq(..), Ord(..)) @@ -62,7 +63,7 @@ new_ :: Int -> IO (IT a) new_ capacity = do arr <- Arr.new Empty capacity size <- mallocForeignPtr - withForeignPtr size $ \ptr -> poke ptr 0 + unsafeWithForeignPtr size $ \ptr -> poke ptr 0 return IT { tabArr = arr , tabSize = size } @@ -81,7 +82,7 @@ grow oldit ref size = do copyBucket (m+1) bucketNext copyBucket n =<< Arr.read (tabArr oldit) i copySlot 0 0 - withForeignPtr (tabSize newit) $ \ptr -> poke ptr size + unsafeWithForeignPtr (tabSize newit) $ \ptr -> poke ptr size writeIORef ref newit -- | @insertWith f k v table@ inserts @k@ into @table@ with value @v at . @@ -100,7 +101,7 @@ insertWith f k v inttable@(IntTable ref) = do Arr.write tabArr idx (Bucket k v' next) return (Just bucketValue) | otherwise = go bkt { bucketNext = seen } bucketNext - go seen _ = withForeignPtr tabSize $ \ptr -> do + go seen _ = unsafeWithForeignPtr tabSize $ \ptr -> do size <- peek ptr if size + 1 >= Arr.size tabArr - (Arr.size tabArr `shiftR` 2) then grow it ref size >> insertWith f k v inttable @@ -139,7 +140,7 @@ updateWith f k (IntTable ref) = do when (isJust oldVal) $ do Arr.write tabArr idx newBucket when del $ - withForeignPtr tabSize $ \ptr -> do + unsafeWithForeignPtr tabSize $ \ptr -> do size <- peek ptr poke ptr (size - 1) return oldVal ===================================== libraries/base/GHC/ForeignPtr/Ops.hs ===================================== @@ -62,17 +62,17 @@ withFP fp f = peekWord8ForeignPtr :: ForeignPtr ty -> Int -> IO Word8 peekWord8ForeignPtr fp (I# d) = withFP fp $ \addr s0 -> case readWord8OffAddr# addr d s0 of - (# s1, r #) -> (# s1, W8# r #) + (# s1, r #) -> (# s1, W8# (narrowWord8# r) #) peekWord16ForeignPtr :: ForeignPtr ty -> Int -> IO Word16 peekWord16ForeignPtr fp (I# d) = withFP fp $ \addr s0 -> case readWord16OffAddr# addr d s0 of - (# s1, r #) -> (# s1, W16# r #) + (# s1, r #) -> (# s1, W16# (narrowWord16# r) #) peekWord32ForeignPtr :: ForeignPtr ty -> Int -> IO Word32 peekWord32ForeignPtr fp (I# d) = withFP fp $ \addr s0 -> case readWord32OffAddr# addr d s0 of - (# s1, r #) -> (# s1, W32# r #) + (# s1, r #) -> (# s1, W32# (narrowWord32# r) #) peekWord64ForeignPtr :: ForeignPtr ty -> Int -> IO Word64 peekWord64ForeignPtr fp (I# d) = withFP fp $ \addr s0 -> @@ -87,17 +87,17 @@ peekWordForeignPtr fp (I# d) = withFP fp $ \addr s0 -> peekInt8ForeignPtr :: ForeignPtr ty -> Int -> IO Int8 peekInt8ForeignPtr fp (I# d) = withFP fp $ \addr s0 -> case readInt8OffAddr# addr d s0 of - (# s1, r #) -> (# s1, I8# r #) + (# s1, r #) -> (# s1, I8# (narrowInt8# r) #) peekInt16ForeignPtr :: ForeignPtr ty -> Int -> IO Int16 peekInt16ForeignPtr fp (I# d) = withFP fp $ \addr s0 -> case readInt16OffAddr# addr d s0 of - (# s1, r #) -> (# s1, I16# r #) + (# s1, r #) -> (# s1, I16# (narrowInt16# r) #) peekInt32ForeignPtr :: ForeignPtr ty -> Int -> IO Int32 peekInt32ForeignPtr fp (I# d) = withFP fp $ \addr s0 -> case readInt32OffAddr# addr d s0 of - (# s1, r #) -> (# s1, I32# r #) + (# s1, r #) -> (# s1, I32# (narrowInt32# r) #) peekInt64ForeignPtr :: ForeignPtr ty -> Int -> IO Int64 peekInt64ForeignPtr fp (I# d) = withFP fp $ \addr s0 -> @@ -116,17 +116,17 @@ peekCharForeignPtr fp (I# d) = withFP fp $ \addr s0 -> pokeWord8ForeignPtr :: ForeignPtr ty -> Int -> Word8 -> IO () pokeWord8ForeignPtr fp (I# d) (W8# n) = withFP fp $ \addr s0 -> - case writeWord8OffAddr# addr d n s0 of + case writeWord8OffAddr# addr d (extendWord8# n) s0 of s1 -> (# s1, () #) pokeWord16ForeignPtr :: ForeignPtr ty -> Int -> Word16 -> IO () pokeWord16ForeignPtr fp (I# d) (W16# n) = withFP fp $ \addr s0 -> - case writeWord16OffAddr# addr d n s0 of + case writeWord16OffAddr# addr d (extendWord16# n) s0 of s1 -> (# s1, () #) pokeWord32ForeignPtr :: ForeignPtr ty -> Int -> Word32 -> IO () pokeWord32ForeignPtr fp (I# d) (W32# n) = withFP fp $ \addr s0 -> - case writeWord32OffAddr# addr d n s0 of + case writeWord32OffAddr# addr d (extendWord32# n) s0 of s1 -> (# s1, () #) pokeWord64ForeignPtr :: ForeignPtr ty -> Int -> Word64 -> IO () @@ -136,22 +136,22 @@ pokeWord64ForeignPtr fp (I# d) (W64# n) = withFP fp $ \addr s0 -> pokeWordForeignPtr :: ForeignPtr ty -> Int -> Word -> IO () pokeWordForeignPtr fp (I# d) (W# n) = withFP fp $ \addr s0 -> - case writeWord64OffAddr# addr d n s0 of + case writeWordOffAddr# addr d n s0 of s1 -> (# s1, () #) pokeInt8ForeignPtr :: ForeignPtr ty -> Int -> Int8 -> IO () pokeInt8ForeignPtr fp (I# d) (I8# n) = withFP fp $ \addr s0 -> - case writeInt8OffAddr# addr d n s0 of + case writeInt8OffAddr# addr d (extendInt8# n) s0 of s1 -> (# s1, () #) pokeInt16ForeignPtr :: ForeignPtr ty -> Int -> Int16 -> IO () pokeInt16ForeignPtr fp (I# d) (I16# n) = withFP fp $ \addr s0 -> - case writeInt16OffAddr# addr d n s0 of + case writeInt16OffAddr# addr d (extendInt16# n) s0 of s1 -> (# s1, () #) pokeInt32ForeignPtr :: ForeignPtr ty -> Int -> Int32 -> IO () pokeInt32ForeignPtr fp (I# d) (I32# n) = withFP fp $ \addr s0 -> - case writeInt32OffAddr# addr d n s0 of + case writeInt32OffAddr# addr d (extendInt32# n) s0 of s1 -> (# s1, () #) pokeInt64ForeignPtr :: ForeignPtr ty -> Int -> Int64 -> IO () ===================================== libraries/base/GHC/IO/Buffer.hs ===================================== @@ -73,6 +73,7 @@ import GHC.Show import GHC.Real import GHC.List import GHC.ForeignPtr.Ops +import GHC.ForeignPtr (unsafeWithForeignPtr) import Foreign.C.Types import Foreign.ForeignPtr import Foreign.Storable @@ -118,17 +119,17 @@ type CharBufElem = Char type RawCharBuffer = RawBuffer CharBufElem peekCharBuf :: RawCharBuffer -> Int -> IO Char -peekCharBuf arr ix = withForeignPtr arr $ \p -> do +peekCharBuf arr ix = unsafeWithForeignPtr arr $ \p -> do (c,_) <- readCharBufPtr p ix return c {-# INLINE readCharBuf #-} readCharBuf :: RawCharBuffer -> Int -> IO (Char, Int) -readCharBuf arr ix = withForeignPtr arr $ \p -> readCharBufPtr p ix +readCharBuf arr ix = unsafeWithForeignPtr arr $ \p -> readCharBufPtr p ix {-# INLINE writeCharBuf #-} writeCharBuf :: RawCharBuffer -> Int -> Char -> IO Int -writeCharBuf arr ix c = withForeignPtr arr $ \p -> writeCharBufPtr p ix c +writeCharBuf arr ix c = unsafeWithForeignPtr arr $ \p -> writeCharBufPtr p ix c {-# INLINE readCharBufPtr #-} readCharBufPtr :: Ptr CharBufElem -> Int -> IO (Char, Int) ===================================== libraries/bytestring ===================================== @@ -1 +1 @@ -Subproject commit 8b5d8d0da24aefdc4d950174bf396b32335d7e0f +Subproject commit 36c2df1feaf10fde8d5848ac47b98d6d62c4e1d7 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5e5f48e8b7ff3574bcfce4c788827209caf37de0...10217769a4e113b3847dda3827b79d7e2325fa72 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5e5f48e8b7ff3574bcfce4c788827209caf37de0...10217769a4e113b3847dda3827b79d7e2325fa72 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 4 03:20:00 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 03 Dec 2020 22:20:00 -0500 Subject: [Git][ghc/ghc][wip/keepAlive-the-return-of-the-primop] 16 commits: GHC.Utils.Binary: Eliminate allocating withForeignPtr uses Message-ID: <5fc9aae0940bb_6a09d7dc14179789@gitlab.mail> Ben Gamari pushed to branch wip/keepAlive-the-return-of-the-primop at Glasgow Haskell Compiler / GHC Commits: d935c519 by Ben Gamari at 2020-12-03T17:18:24-05:00 GHC.Utils.Binary: Eliminate allocating withForeignPtr uses - - - - - a34cf3d0 by Ben Gamari at 2020-12-03T17:18:24-05:00 base: Eliminate allocating withForeignPtrs from GHC.Event.Array - - - - - 9787420a by Ben Gamari at 2020-12-03T17:18:24-05:00 base: Use unsafeWithForeignPtr in GHC.IO.Buffer - - - - - 397776c9 by Ben Gamari at 2020-12-03T17:18:24-05:00 base: Use unsafeWithForeignPtr in GHC.Event.IntTable - - - - - ade9666d by Ben Gamari at 2020-12-03T17:18:24-05:00 Bump bytestring submodule Teach it to use unsafeWithForeignPtr where appropriate. - - - - - 8b249760 by Ben Gamari at 2020-12-03T17:18:24-05:00 Sized - - - - - 10217769 by Ben Gamari at 2020-12-03T17:18:24-05:00 StringBuffer: Use unsafeWithForeignPtr - - - - - 0bd3eb8d by Ben Gamari at 2020-12-03T17:26:14-05:00 genprimopcode: Add a second levity-polymorphic tyvar This will be needed shortly. - - - - - 934d56fc by GHC GitLab CI at 2020-12-03T17:26:14-05:00 Introduce keepAlive primop - - - - - da7af3b3 by Ben Gamari at 2020-12-03T17:26:14-05:00 base: Use keepAlive# in withForeignPtr - - - - - b0b95338 by Ben Gamari at 2020-12-03T17:26:14-05:00 Implement withByteArrayContents in terms of keepAlive# - - - - - 44b0f9b3 by Ben Gamari at 2020-12-03T17:26:14-05:00 base: Implement GHC.ForeignPtr.Ops in terms of keepAlive# - - - - - df0a7551 by Ben Gamari at 2020-12-03T17:26:14-05:00 base: Use keepAlive# in Foreign.Marshal.Alloc - - - - - cccd9dbe by Ben Gamari at 2020-12-03T17:26:14-05:00 ghc-compact: Use keepAlive# in GHC.Compact.Serialized - - - - - 806283f2 by Ben Gamari at 2020-12-03T17:26:14-05:00 iFix it - - - - - 8ae19c3a by Ben Gamari at 2020-12-03T17:26:14-05:00 testsuite fixes Metric Increase: T10421 T12227 T12234 T12425 T13035 T5536 - - - - - 18 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Data/ByteArray.hs - compiler/GHC/Data/StringBuffer.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/Utils/Binary.hs - libraries/base/Foreign/Marshal/Alloc.hs - libraries/base/GHC/Event/Array.hs - libraries/base/GHC/Event/IntTable.hs - libraries/base/GHC/ForeignPtr.hs - libraries/base/GHC/ForeignPtr/Ops.hs - libraries/base/GHC/IO/Buffer.hs - libraries/bytestring - libraries/ghc-compact/GHC/Compact/Serialized.hs - testsuite/tests/ghci/should_run/T16012.script - testsuite/tests/ghci/should_run/T16012.stdout - utils/genprimopcode/Main.hs Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -2983,6 +2983,20 @@ primop NumSparks "numSparks#" GenPrimOp has_side_effects = True out_of_line = True + +------------------------------------------------------------------------ +section "Controlling object lifetime" + {Ensuring that objects don't die a premature death.} +------------------------------------------------------------------------ + +-- See Note [keepAlive# magic] in GHC.CoreToStg.Prep. +primop KeepAliveOp "keepAlive#" GenPrimOp + o -> State# RealWorld -> (State# RealWorld -> p) -> p + { TODO. } + with + strictness = { \ _arity -> mkClosedStrictSig [topDmd, topDmd, strictOnceApply1Dmd] topDiv } + + ------------------------------------------------------------------------ section "Tag to enum stuff" {Convert back and forth between values of enumerated types ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -1642,6 +1642,8 @@ app_ok primop_ok fun args -> False -- for the special cases for SeqOp and DataToTagOp | DataToTagOp <- op -> False + | KeepAliveOp <- op + -> False | otherwise -> primop_ok op -- Check the primop itself ===================================== compiler/GHC/CoreToStg/Prep.hs ===================================== @@ -32,7 +32,10 @@ import GHC.Tc.Utils.Env import GHC.Unit import GHC.Builtin.Names +import GHC.Builtin.PrimOps import GHC.Builtin.Types +import GHC.Builtin.Types.Prim ( realWorldStatePrimTy ) +import GHC.Types.Id.Make ( realWorldPrimId, mkPrimOpId ) import GHC.Core.Utils import GHC.Core.Opt.Arity @@ -47,6 +50,7 @@ import GHC.Core.TyCon import GHC.Core.DataCon import GHC.Core.Opt.OccurAnal + import GHC.Data.Maybe import GHC.Data.OrdList import GHC.Data.FastString @@ -63,7 +67,6 @@ import GHC.Types.Var.Set import GHC.Types.Var.Env import GHC.Types.Id import GHC.Types.Id.Info -import GHC.Types.Id.Make ( realWorldPrimId ) import GHC.Types.Basic import GHC.Types.Name ( NamedThing(..), nameSrcSpan, isInternalName ) import GHC.Types.SrcLoc ( SrcSpan(..), realSrcLocSpan, mkRealSrcLoc ) @@ -784,6 +787,38 @@ cpeApp top_env expr -- rather than the far superior "f x y". Test case is par01. = let (terminal, args', depth') = collect_args arg in cpe_app env terminal (args' ++ args) (depth + depth' - 1) + + cpe_app env + (Var f) + args + n + | Just KeepAliveOp <- isPrimOpId_maybe f + , CpeApp (Type arg_rep) + : CpeApp (Type arg_ty) + : CpeApp (Type _result_rep) + : CpeApp (Type result_ty) + : CpeApp arg + : CpeApp s0 + : CpeApp k + : rest <- pprTrace "cpe_app keepAlive#" (ppr args) args + = do { pprTraceM "cpe_app(keepAlive#)" (ppr n) + ; y <- newVar result_ty + ; s2 <- newVar realWorldStatePrimTy + ; -- beta reduce if possible + ; (floats, k') <- case k of + Lam s body -> cpe_app (extendCorePrepEnvExpr env s s0) body rest (n-2) + _ -> cpe_app env k (CpeApp s0 : rest) (n-1) + ; let touchId = mkPrimOpId TouchOp + expr = Case k' y result_ty [(DEFAULT, [], rhs)] + rhs = let scrut = mkApps (Var touchId) [Type arg_rep, Type arg_ty, arg, Var realWorldPrimId] + in Case scrut s2 result_ty [(DEFAULT, [], Var y)] + ; pprTraceM "cpe_app(keepAlive)" (ppr expr) + ; (floats', expr') <- cpeBody env expr + ; return (floats `appendFloats` floats', expr') + } + | Just KeepAliveOp <- isPrimOpId_maybe f + = panic "invalid keepAlive# application" + cpe_app env (Var f) (CpeApp _runtimeRep at Type{} : CpeApp _type at Type{} : CpeApp arg : rest) n | f `hasKey` runRWKey -- N.B. While it may appear that n == 1 in the case of runRW# ===================================== compiler/GHC/Data/ByteArray.hs ===================================== @@ -77,10 +77,15 @@ unsafeMutableByteArrayContents :: MutableByteArray -> Ptr a unsafeMutableByteArrayContents = unsafeByteArrayContents . unsafeCoerce withByteArrayContents :: ByteArray -> (Ptr a -> IO b) -> IO b +#if MIN_VERSION_base(4,15,0) +withByteArrayContents (ByteArray ba) f = + IO $ \s -> keepAlive# ba s (unIO (f (Ptr (byteArrayContents# ba)))) +#else withByteArrayContents (ByteArray ba) f = do r <- f $ Ptr (byteArrayContents# ba) IO $ \s -> case touch# ba s of s' -> (# s', () #) return r +#endif newMutableByteArray :: Int -> IO MutableByteArray newMutableByteArray (I# size) = IO $ \s -> ===================================== compiler/GHC/Data/StringBuffer.hs ===================================== @@ -68,6 +68,12 @@ import GHC.IO.Encoding.Failure ( CodingFailureMode(IgnoreCodingFailure) ) import GHC.Exts import Foreign +#if MIN_VERSION_base(4,15,0) +import GHC.ForeignPtr (unsafeWithForeignPtr) +#else +unsafeWithForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b +unsafeWithForeignPtr = withForeignPtr +#endif -- ----------------------------------------------------------------------------- -- The StringBuffer type @@ -107,7 +113,7 @@ hGetStringBuffer fname = do offset_i <- skipBOM h size_i 0 -- offset is 0 initially let size = fromIntegral $ size_i - offset_i buf <- mallocForeignPtrArray (size+3) - withForeignPtr buf $ \ptr -> do + unsafeWithForeignPtr buf $ \ptr -> do r <- if size == 0 then return 0 else hGetBuf h ptr size hClose h if (r /= size) @@ -120,7 +126,7 @@ hGetStringBufferBlock handle wanted offset_i <- hTell handle >>= skipBOM handle size_i let size = min wanted (fromIntegral $ size_i-offset_i) buf <- mallocForeignPtrArray (size+3) - withForeignPtr buf $ \ptr -> + unsafeWithForeignPtr buf $ \ptr -> do r <- if size == 0 then return 0 else hGetBuf handle ptr size if r /= size then ioError (userError $ "short read of file: "++show(r,size,size_i,handle)) @@ -128,7 +134,7 @@ hGetStringBufferBlock handle wanted hPutStringBuffer :: Handle -> StringBuffer -> IO () hPutStringBuffer hdl (StringBuffer buf len cur) - = withForeignPtr (plusForeignPtr buf cur) $ \ptr -> + = unsafeWithForeignPtr (plusForeignPtr buf cur) $ \ptr -> hPutBuf hdl ptr len -- | Skip the byte-order mark if there is one (see #1744 and #6016), @@ -165,9 +171,9 @@ newUTF8StringBuffer buf ptr size = do appendStringBuffers :: StringBuffer -> StringBuffer -> IO StringBuffer appendStringBuffers sb1 sb2 = do newBuf <- mallocForeignPtrArray (size+3) - withForeignPtr newBuf $ \ptr -> - withForeignPtr (buf sb1) $ \sb1Ptr -> - withForeignPtr (buf sb2) $ \sb2Ptr -> + unsafeWithForeignPtr newBuf $ \ptr -> + unsafeWithForeignPtr (buf sb1) $ \sb1Ptr -> + unsafeWithForeignPtr (buf sb2) $ \sb2Ptr -> do copyArray ptr (sb1Ptr `advancePtr` cur sb1) sb1_len copyArray (ptr `advancePtr` sb1_len) (sb2Ptr `advancePtr` cur sb2) sb2_len pokeArray (ptr `advancePtr` size) [0,0,0] @@ -184,7 +190,7 @@ stringToStringBuffer str = unsafePerformIO $ do let size = utf8EncodedLength str buf <- mallocForeignPtrArray (size+3) - withForeignPtr buf $ \ptr -> do + unsafeWithForeignPtr buf $ \ptr -> do utf8EncodeString ptr str pokeArray (ptr `plusPtr` size :: Ptr Word8) [0,0,0] -- sentinels for UTF-8 decoding @@ -203,7 +209,7 @@ nextChar :: StringBuffer -> (Char,StringBuffer) nextChar (StringBuffer buf len (I# cur#)) = -- Getting our fingers dirty a little here, but this is performance-critical inlinePerformIO $ - withForeignPtr buf $ \(Ptr a#) -> + unsafeWithForeignPtr buf $ \(Ptr a#) -> case utf8DecodeCharAddr# (a# `plusAddr#` cur#) 0# of (# c#, nBytes# #) -> let cur' = I# (cur# +# nBytes#) in @@ -220,7 +226,7 @@ prevChar :: StringBuffer -> Char -> Char prevChar (StringBuffer _ _ 0) deflt = deflt prevChar (StringBuffer buf _ cur) _ = inlinePerformIO $ - withForeignPtr buf $ \p -> do + unsafeWithForeignPtr buf $ \p -> do p' <- utf8PrevChar (p `plusPtr` cur) return (fst (utf8DecodeChar p')) @@ -258,7 +264,7 @@ atEnd (StringBuffer _ l c) = l == c atLine :: Int -> StringBuffer -> Maybe StringBuffer atLine line sb@(StringBuffer buf len _) = inlinePerformIO $ - withForeignPtr buf $ \p -> do + unsafeWithForeignPtr buf $ \p -> do p' <- skipToLine line len p if p' == nullPtr then return Nothing @@ -309,14 +315,14 @@ lexemeToFastString :: StringBuffer lexemeToFastString _ 0 = nilFS lexemeToFastString (StringBuffer buf _ cur) len = inlinePerformIO $ - withForeignPtr buf $ \ptr -> + unsafeWithForeignPtr buf $ \ptr -> return $! mkFastStringBytes (ptr `plusPtr` cur) len -- | Return the previous @n@ characters (or fewer if we are less than @n@ -- characters into the buffer. decodePrevNChars :: Int -> StringBuffer -> String decodePrevNChars n (StringBuffer buf _ cur) = - inlinePerformIO $ withForeignPtr buf $ \p0 -> + inlinePerformIO $ unsafeWithForeignPtr buf $ \p0 -> go p0 n "" (p0 `plusPtr` (cur - 1)) where go :: Ptr Word8 -> Int -> String -> Ptr Word8 -> IO String ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -1551,6 +1551,8 @@ emitPrimOp dflags primop = case primop of TraceMarkerOp -> alwaysExternal SetThreadAllocationCounter -> alwaysExternal + KeepAliveOp -> panic "keepAlive# should have been eliminated in CorePrep" + where profile = targetProfile dflags platform = profilePlatform profile ===================================== compiler/GHC/Utils/Binary.hs ===================================== @@ -6,6 +6,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE UnboxedTuples #-} {-# OPTIONS_GHC -O2 -funbox-strict-fields #-} -- We always optimise this, otherwise performance of a non-optimised @@ -93,10 +94,16 @@ import System.IO as IO import System.IO.Unsafe ( unsafeInterleaveIO ) import System.IO.Error ( mkIOError, eofErrorType ) import GHC.Real ( Ratio(..) ) +#if MIN_VERSION_base(4,15,0) +import GHC.ForeignPtr ( unsafeWithForeignPtr ) +#endif type BinArray = ForeignPtr Word8 - +#if !MIN_VERSION_base(4,15,0) +unsafeWithForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b +unsafeWithForeignPtr = withForeignPtr +#endif --------------------------------------------------------------- -- BinData @@ -111,14 +118,14 @@ instance Binary BinData where put_ bh (BinData sz dat) = do put_ bh sz putPrim bh sz $ \dest -> - withForeignPtr dat $ \orig -> + unsafeWithForeignPtr dat $ \orig -> copyBytes dest orig sz -- get bh = do sz <- get bh dat <- mallocForeignPtrBytes sz getPrim bh sz $ \orig -> - withForeignPtr dat $ \dest -> + unsafeWithForeignPtr dat $ \dest -> copyBytes dest orig sz return (BinData sz dat) @@ -226,7 +233,7 @@ writeBinMem (BinMem _ ix_r _ arr_r) fn = do h <- openBinaryFile fn WriteMode arr <- readIORef arr_r ix <- readFastMutInt ix_r - withForeignPtr arr $ \p -> hPutBuf h p ix + unsafeWithForeignPtr arr $ \p -> hPutBuf h p ix hClose h readBinMem :: FilePath -> IO BinHandle @@ -236,7 +243,7 @@ readBinMem filename = do filesize' <- hFileSize h let filesize = fromIntegral filesize' arr <- mallocForeignPtrBytes filesize - count <- withForeignPtr arr $ \p -> hGetBuf h p filesize + count <- unsafeWithForeignPtr arr $ \p -> hGetBuf h p filesize when (count /= filesize) $ error ("Binary.readBinMem: only read " ++ show count ++ " bytes") hClose h @@ -280,7 +287,7 @@ putPrim h@(BinMem _ ix_r sz_r arr_r) size f = do when (ix + size > sz) $ expandBin h (ix + size) arr <- readIORef arr_r - withForeignPtr arr $ \op -> f (op `plusPtr` ix) + unsafeWithForeignPtr arr $ \op -> f (op `plusPtr` ix) writeFastMutInt ix_r (ix + size) -- -- | Similar to putPrim but advances the index by the actual number of @@ -302,7 +309,9 @@ getPrim (BinMem _ ix_r sz_r arr_r) size f = do when (ix + size > sz) $ ioError (mkIOError eofErrorType "Data.Binary.getPrim" Nothing Nothing) arr <- readIORef arr_r - w <- withForeignPtr arr $ \op -> f (op `plusPtr` ix) + w <- unsafeWithForeignPtr arr $ \p -> f (p `plusPtr` ix) + -- This is safe WRT #17760 as we we guarantee that the above line doesn't + -- diverge writeFastMutInt ix_r (ix + size) return w ===================================== libraries/base/Foreign/Marshal/Alloc.hs ===================================== @@ -116,19 +116,6 @@ alloca :: forall a b . Storable a => (Ptr a -> IO b) -> IO b alloca = allocaBytesAligned (sizeOf (undefined :: a)) (alignment (undefined :: a)) --- Note [NOINLINE for touch#] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~ --- Both allocaBytes and allocaBytesAligned use the touch#, which is notoriously --- fragile in the presence of simplification (see #14346). In particular, the --- simplifier may drop the continuation containing the touch# if it can prove --- that the action passed to allocaBytes will not return. The hack introduced to --- fix this for 8.2.2 is to mark allocaBytes as NOINLINE, ensuring that the --- simplifier can't see the divergence. --- --- These can be removed once #14375 is fixed, which suggests that we instead do --- away with touch# in favor of a primitive that will capture the scoping left --- implicit in the case of touch#. - -- |@'allocaBytes' n f@ executes the computation @f@, passing as argument -- a pointer to a temporarily allocated block of memory of @n@ bytes. -- The block of memory is sufficiently aligned for any of the basic @@ -143,12 +130,8 @@ allocaBytes (I# size) action = IO $ \ s0 -> case unsafeFreezeByteArray# mbarr# s1 of { (# s2, barr# #) -> let addr = Ptr (byteArrayContents# barr#) in case action addr of { IO action' -> - case action' s2 of { (# s3, r #) -> - case touch# barr# s3 of { s4 -> - (# s4, r #) - }}}}} --- See Note [NOINLINE for touch#] -{-# NOINLINE allocaBytes #-} + keepAlive# barr# s2 action' + }}} allocaBytesAligned :: Int -> Int -> (Ptr a -> IO b) -> IO b allocaBytesAligned (I# size) (I# align) action = IO $ \ s0 -> @@ -156,12 +139,8 @@ allocaBytesAligned (I# size) (I# align) action = IO $ \ s0 -> case unsafeFreezeByteArray# mbarr# s1 of { (# s2, barr# #) -> let addr = Ptr (byteArrayContents# barr#) in case action addr of { IO action' -> - case action' s2 of { (# s3, r #) -> - case touch# barr# s3 of { s4 -> - (# s4, r #) - }}}}} --- See Note [NOINLINE for touch#] -{-# NOINLINE allocaBytesAligned #-} + keepAlive# barr# s2 action' + }}} -- |Resize a memory area that was allocated with 'malloc' or 'mallocBytes' -- to the size needed to store values of type @b at . The returned pointer ===================================== libraries/base/GHC/Event/Array.hs ===================================== @@ -33,7 +33,7 @@ import Foreign.ForeignPtr (ForeignPtr, withForeignPtr) import Foreign.Ptr (Ptr, nullPtr, plusPtr) import Foreign.Storable (Storable(..)) import GHC.Base hiding (empty) -import GHC.ForeignPtr (mallocPlainForeignPtrBytes, newForeignPtr_) +import GHC.ForeignPtr (mallocPlainForeignPtrBytes, newForeignPtr_, unsafeWithForeignPtr) import GHC.Num (Num(..)) import GHC.Real (fromIntegral) import GHC.Show (show) @@ -78,9 +78,9 @@ reallocArray p newSize oldSize = reallocHack undefined p reallocHack dummy src = do let size = sizeOf dummy dst <- mallocPlainForeignPtrBytes (newSize * size) - withForeignPtr src $ \s -> + unsafeWithForeignPtr src $ \s -> when (s /= nullPtr && oldSize > 0) . - withForeignPtr dst $ \d -> do + unsafeWithForeignPtr dst $ \d -> do _ <- memcpy d s (fromIntegral (oldSize * size)) return () return dst @@ -99,8 +99,8 @@ duplicate a = dupHack undefined a dupHack dummy (Array ref) = do AC es len cap <- readIORef ref ary <- allocArray cap - withForeignPtr ary $ \dest -> - withForeignPtr es $ \src -> do + unsafeWithForeignPtr ary $ \dest -> + unsafeWithForeignPtr es $ \src -> do _ <- memcpy dest src (fromIntegral (len * sizeOf dummy)) return () Array `fmap` newIORef (AC ary len cap) @@ -119,8 +119,8 @@ unsafeRead :: Storable a => Array a -> Int -> IO a unsafeRead (Array ref) ix = do AC es _ cap <- readIORef ref CHECK_BOUNDS("unsafeRead",cap,ix) - withForeignPtr es $ \p -> - peekElemOff p ix + unsafeWithForeignPtr es $ \ptr -> peekElemOff ptr ix + -- this is safe WRT #17760 as we assume that peekElemOff doesn't diverge unsafeWrite :: Storable a => Array a -> Int -> a -> IO () unsafeWrite (Array ref) ix a = do @@ -130,13 +130,15 @@ unsafeWrite (Array ref) ix a = do unsafeWrite' :: Storable a => AC a -> Int -> a -> IO () unsafeWrite' (AC es _ cap) ix a = CHECK_BOUNDS("unsafeWrite'",cap,ix) - withForeignPtr es $ \p -> - pokeElemOff p ix a + unsafeWithForeignPtr es $ \ptr -> pokeElemOff ptr ix a + -- this is safe WRT #17760 as we assume that peekElemOff doesn't diverge +-- | Precondition: continuation must not diverge due to use of +-- 'unsafeWithForeignPtr'. unsafeLoad :: Array a -> (Ptr a -> Int -> IO Int) -> IO Int unsafeLoad (Array ref) load = do AC es _ cap <- readIORef ref - len' <- withForeignPtr es $ \p -> load p cap + len' <- unsafeWithForeignPtr es $ \p -> load p cap writeIORef ref (AC es len' cap) return len' @@ -146,7 +148,7 @@ unsafeCopyFromBuffer :: Storable a => Array a -> Ptr a -> Int -> IO () unsafeCopyFromBuffer (Array ref) sptr n = readIORef ref >>= \(AC es _ cap) -> CHECK_BOUNDS("unsafeCopyFromBuffer", cap, n) - withForeignPtr es $ \pdest -> do + unsafeWithForeignPtr es $ \pdest -> do let size = sizeOfPtr sptr undefined _ <- memcpy pdest sptr (fromIntegral $ n * size) writeIORef ref (AC es n cap) @@ -198,7 +200,7 @@ forM_ ary g = forHack ary g undefined AC es len _ <- readIORef ref let size = sizeOf dummy offset = len * size - withForeignPtr es $ \p -> do + unsafeWithForeignPtr es $ \p -> do let go n | n >= offset = return () | otherwise = do f =<< peek (p `plusPtr` n) @@ -269,8 +271,8 @@ copy' d dstart s sstart maxCount = copyHack d s undefined then return dac else do AC dst dlen dcap <- ensureCapacity' dac (dstart + count) - withForeignPtr dst $ \dptr -> - withForeignPtr src $ \sptr -> do + unsafeWithForeignPtr dst $ \dptr -> + unsafeWithForeignPtr src $ \sptr -> do _ <- memcpy (dptr `plusPtr` (dstart * size)) (sptr `plusPtr` (sstart * size)) (fromIntegral (count * size)) @@ -286,7 +288,7 @@ removeAt a i = removeHack a undefined let size = sizeOf dummy newLen = oldLen - 1 when (newLen > 0 && i < newLen) . - withForeignPtr fp $ \ptr -> do + unsafeWithForeignPtr fp $ \ptr -> do _ <- memmove (ptr `plusPtr` (size * i)) (ptr `plusPtr` (size * (i+1))) (fromIntegral (size * (newLen-i))) ===================================== libraries/base/GHC/Event/IntTable.hs ===================================== @@ -17,7 +17,8 @@ module GHC.Event.IntTable import Data.Bits ((.&.), shiftL, shiftR) import Data.IORef (IORef, newIORef, readIORef, writeIORef) import Data.Maybe (Maybe(..), isJust) -import Foreign.ForeignPtr (ForeignPtr, mallocForeignPtr, withForeignPtr) +import Foreign.ForeignPtr (ForeignPtr, mallocForeignPtr) +import GHC.ForeignPtr (unsafeWithForeignPtr) import Foreign.Storable (peek, poke) import GHC.Base (Monad(..), (=<<), ($), ($!), const, liftM, otherwise, when) import GHC.Classes (Eq(..), Ord(..)) @@ -62,7 +63,7 @@ new_ :: Int -> IO (IT a) new_ capacity = do arr <- Arr.new Empty capacity size <- mallocForeignPtr - withForeignPtr size $ \ptr -> poke ptr 0 + unsafeWithForeignPtr size $ \ptr -> poke ptr 0 return IT { tabArr = arr , tabSize = size } @@ -81,7 +82,7 @@ grow oldit ref size = do copyBucket (m+1) bucketNext copyBucket n =<< Arr.read (tabArr oldit) i copySlot 0 0 - withForeignPtr (tabSize newit) $ \ptr -> poke ptr size + unsafeWithForeignPtr (tabSize newit) $ \ptr -> poke ptr size writeIORef ref newit -- | @insertWith f k v table@ inserts @k@ into @table@ with value @v at . @@ -100,7 +101,7 @@ insertWith f k v inttable@(IntTable ref) = do Arr.write tabArr idx (Bucket k v' next) return (Just bucketValue) | otherwise = go bkt { bucketNext = seen } bucketNext - go seen _ = withForeignPtr tabSize $ \ptr -> do + go seen _ = unsafeWithForeignPtr tabSize $ \ptr -> do size <- peek ptr if size + 1 >= Arr.size tabArr - (Arr.size tabArr `shiftR` 2) then grow it ref size >> insertWith f k v inttable @@ -139,7 +140,7 @@ updateWith f k (IntTable ref) = do when (isJust oldVal) $ do Arr.write tabArr idx newBucket when del $ - withForeignPtr tabSize $ \ptr -> do + unsafeWithForeignPtr tabSize $ \ptr -> do size <- peek ptr poke ptr (size - 1) return oldVal ===================================== libraries/base/GHC/ForeignPtr.hs ===================================== @@ -526,7 +526,9 @@ withForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b -- or from the object pointed to by the -- 'ForeignPtr', using the operations from the -- 'Storable' class. -withForeignPtr = unsafeWithForeignPtr +withForeignPtr fo@(ForeignPtr _ r) f = IO $ \s -> + case f (unsafeForeignPtrToPtr fo) of + IO action# -> keepAlive# r s action# -- | This is similar to 'withForeignPtr' but comes with an important caveat: -- the user must guarantee that the continuation does not diverge (e.g. loop or ===================================== libraries/base/GHC/ForeignPtr/Ops.hs ===================================== @@ -51,121 +51,114 @@ import GHC.Word import GHC.Int import GHC.Base import GHC.ForeignPtr -import GHC.Ptr - -withFP :: ForeignPtr a - -> (Addr# -> State# RealWorld -> (# State# RealWorld, b #)) - -> IO b -withFP fp f = - withForeignPtr fp (\(Ptr addr) -> IO (f addr)) peekWord8ForeignPtr :: ForeignPtr ty -> Int -> IO Word8 -peekWord8ForeignPtr fp (I# d) = withFP fp $ \addr s0 -> - case readWord8OffAddr# addr d s0 of - (# s1, r #) -> (# s1, W8# r #) +peekWord8ForeignPtr (ForeignPtr addr c) (I# d) = IO $ \s0 -> + case keepAlive# c s0 (readWord8OffAddr# addr d) of + (# s1, r #) -> (# s1, W8# (narrowWord8# r) #) peekWord16ForeignPtr :: ForeignPtr ty -> Int -> IO Word16 -peekWord16ForeignPtr fp (I# d) = withFP fp $ \addr s0 -> - case readWord16OffAddr# addr d s0 of - (# s1, r #) -> (# s1, W16# r #) +peekWord16ForeignPtr (ForeignPtr addr c) (I# d) = IO $ \s0 -> + case keepAlive# c s0 (readWord16OffAddr# addr d) of + (# s1, r #) -> (# s1, W16# (narrowWord16# r) #) peekWord32ForeignPtr :: ForeignPtr ty -> Int -> IO Word32 -peekWord32ForeignPtr fp (I# d) = withFP fp $ \addr s0 -> - case readWord32OffAddr# addr d s0 of - (# s1, r #) -> (# s1, W32# r #) +peekWord32ForeignPtr (ForeignPtr addr c) (I# d) = IO $ \s0 -> + case keepAlive# c s0 (readWord32OffAddr# addr d) of + (# s1, r #) -> (# s1, W32# (narrowWord32# r) #) peekWord64ForeignPtr :: ForeignPtr ty -> Int -> IO Word64 -peekWord64ForeignPtr fp (I# d) = withFP fp $ \addr s0 -> - case readWord64OffAddr# addr d s0 of +peekWord64ForeignPtr (ForeignPtr addr c) (I# d) = IO $ \s0 -> + case keepAlive# c s0 (readWord64OffAddr# addr d) of (# s1, r #) -> (# s1, W64# r #) peekWordForeignPtr :: ForeignPtr ty -> Int -> IO Word -peekWordForeignPtr fp (I# d) = withFP fp $ \addr s0 -> - case readWordOffAddr# addr d s0 of +peekWordForeignPtr (ForeignPtr addr c) (I# d) = IO $ \s0 -> + case keepAlive# c s0 (readWordOffAddr# addr d) of (# s1, r #) -> (# s1, W# r #) peekInt8ForeignPtr :: ForeignPtr ty -> Int -> IO Int8 -peekInt8ForeignPtr fp (I# d) = withFP fp $ \addr s0 -> - case readInt8OffAddr# addr d s0 of - (# s1, r #) -> (# s1, I8# r #) +peekInt8ForeignPtr (ForeignPtr addr c) (I# d) = IO $ \s0 -> + case keepAlive# c s0 (readInt8OffAddr# addr d) of + (# s1, r #) -> (# s1, I8# (narrowInt8# r) #) peekInt16ForeignPtr :: ForeignPtr ty -> Int -> IO Int16 -peekInt16ForeignPtr fp (I# d) = withFP fp $ \addr s0 -> - case readInt16OffAddr# addr d s0 of - (# s1, r #) -> (# s1, I16# r #) +peekInt16ForeignPtr (ForeignPtr addr c) (I# d) = IO $ \s0 -> + case keepAlive# c s0 (readInt16OffAddr# addr d) of + (# s1, r #) -> (# s1, I16# (narrowInt16# r) #) peekInt32ForeignPtr :: ForeignPtr ty -> Int -> IO Int32 -peekInt32ForeignPtr fp (I# d) = withFP fp $ \addr s0 -> - case readInt32OffAddr# addr d s0 of - (# s1, r #) -> (# s1, I32# r #) +peekInt32ForeignPtr (ForeignPtr addr c) (I# d) = IO $ \s0 -> + case keepAlive# c s0 (readInt32OffAddr# addr d) of + (# s1, r #) -> (# s1, I32# (narrowInt32# r) #) peekInt64ForeignPtr :: ForeignPtr ty -> Int -> IO Int64 -peekInt64ForeignPtr fp (I# d) = withFP fp $ \addr s0 -> - case readInt64OffAddr# addr d s0 of +peekInt64ForeignPtr (ForeignPtr addr c) (I# d) = IO $ \s0 -> + case keepAlive# c s0 (readInt64OffAddr# addr d) of (# s1, r #) -> (# s1, I64# r #) peekIntForeignPtr :: ForeignPtr ty -> Int -> IO Int -peekIntForeignPtr fp (I# d) = withFP fp $ \addr s0 -> - case readIntOffAddr# addr d s0 of +peekIntForeignPtr (ForeignPtr addr c) (I# d) = IO $ \s0 -> + case keepAlive# c s0 (readIntOffAddr# addr d) of (# s1, r #) -> (# s1, I# r #) peekCharForeignPtr :: ForeignPtr ty -> Int -> IO Char -peekCharForeignPtr fp (I# d) = withFP fp $ \addr s0 -> - case readCharOffAddr# addr d s0 of +peekCharForeignPtr (ForeignPtr addr c) (I# d) = IO $ \s0 -> + case keepAlive# c s0 (readCharOffAddr# addr d) of (# s1, r #) -> (# s1, C# r #) pokeWord8ForeignPtr :: ForeignPtr ty -> Int -> Word8 -> IO () -pokeWord8ForeignPtr fp (I# d) (W8# n) = withFP fp $ \addr s0 -> - case writeWord8OffAddr# addr d n s0 of +pokeWord8ForeignPtr (ForeignPtr addr c) (I# d) (W8# n) = IO $ \s0 -> + case keepAlive# c s0 (writeWord8OffAddr# addr d (extendWord8# n)) of s1 -> (# s1, () #) pokeWord16ForeignPtr :: ForeignPtr ty -> Int -> Word16 -> IO () -pokeWord16ForeignPtr fp (I# d) (W16# n) = withFP fp $ \addr s0 -> - case writeWord16OffAddr# addr d n s0 of +pokeWord16ForeignPtr (ForeignPtr addr c) (I# d) (W16# n) = IO $ \s0 -> + case keepAlive# c s0 (writeWord16OffAddr# addr d (extendWord16# n)) of s1 -> (# s1, () #) pokeWord32ForeignPtr :: ForeignPtr ty -> Int -> Word32 -> IO () -pokeWord32ForeignPtr fp (I# d) (W32# n) = withFP fp $ \addr s0 -> - case writeWord32OffAddr# addr d n s0 of +pokeWord32ForeignPtr (ForeignPtr addr c) (I# d) (W32# n) = IO $ \s0 -> + case keepAlive# c s0 (writeWord32OffAddr# addr d (extendWord32# n)) of s1 -> (# s1, () #) pokeWord64ForeignPtr :: ForeignPtr ty -> Int -> Word64 -> IO () -pokeWord64ForeignPtr fp (I# d) (W64# n) = withFP fp $ \addr s0 -> - case writeWord64OffAddr# addr d n s0 of +pokeWord64ForeignPtr (ForeignPtr addr c) (I# d) (W64# n) = IO $ \s0 -> + case keepAlive# c s0 (writeWord64OffAddr# addr d n) of s1 -> (# s1, () #) pokeWordForeignPtr :: ForeignPtr ty -> Int -> Word -> IO () -pokeWordForeignPtr fp (I# d) (W# n) = withFP fp $ \addr s0 -> - case writeWord64OffAddr# addr d n s0 of +pokeWordForeignPtr (ForeignPtr addr c) (I# d) (W# n) = IO $ \s0 -> + case keepAlive# c s0 (writeWordOffAddr# addr d n) of s1 -> (# s1, () #) pokeInt8ForeignPtr :: ForeignPtr ty -> Int -> Int8 -> IO () -pokeInt8ForeignPtr fp (I# d) (I8# n) = withFP fp $ \addr s0 -> - case writeInt8OffAddr# addr d n s0 of +pokeInt8ForeignPtr (ForeignPtr addr c) (I# d) (I8# n) = IO $ \s0 -> + case keepAlive# c s0 (writeInt8OffAddr# addr d (extendInt8# n)) of s1 -> (# s1, () #) pokeInt16ForeignPtr :: ForeignPtr ty -> Int -> Int16 -> IO () -pokeInt16ForeignPtr fp (I# d) (I16# n) = withFP fp $ \addr s0 -> - case writeInt16OffAddr# addr d n s0 of +pokeInt16ForeignPtr (ForeignPtr addr c) (I# d) (I16# n) = IO $ \s0 -> + case keepAlive# c s0 (writeInt16OffAddr# addr d (extendInt16# n)) of s1 -> (# s1, () #) pokeInt32ForeignPtr :: ForeignPtr ty -> Int -> Int32 -> IO () -pokeInt32ForeignPtr fp (I# d) (I32# n) = withFP fp $ \addr s0 -> - case writeInt32OffAddr# addr d n s0 of +pokeInt32ForeignPtr (ForeignPtr addr c) (I# d) (I32# n) = IO $ \s0 -> + case keepAlive# c s0 (writeInt32OffAddr# addr d (extendInt32# n)) of s1 -> (# s1, () #) pokeInt64ForeignPtr :: ForeignPtr ty -> Int -> Int64 -> IO () -pokeInt64ForeignPtr fp (I# d) (I64# n) = withFP fp $ \addr s0 -> - case writeInt64OffAddr# addr d n s0 of +pokeInt64ForeignPtr (ForeignPtr addr c) (I# d) (I64# n) = IO $ \s0 -> + case keepAlive# c s0 (writeInt64OffAddr# addr d n) of s1 -> (# s1, () #) pokeIntForeignPtr :: ForeignPtr ty -> Int -> Int -> IO () -pokeIntForeignPtr fp (I# d) (I# n) = withFP fp $ \addr s0 -> - case writeIntOffAddr# addr d n s0 of +pokeIntForeignPtr (ForeignPtr addr c) (I# d) (I# n) = IO $ \s0 -> + case keepAlive# c s0 (writeIntOffAddr# addr d n) of s1 -> (# s1, () #) pokeCharForeignPtr :: ForeignPtr ty -> Int -> Char -> IO () -pokeCharForeignPtr fp (I# d) (C# n) = withFP fp $ \addr s0 -> - case writeCharOffAddr# addr d n s0 of +pokeCharForeignPtr (ForeignPtr addr c) (I# d) (C# n) = IO $ \s0 -> + case keepAlive# c s0 (writeCharOffAddr# addr d n) of s1 -> (# s1, () #) ===================================== libraries/base/GHC/IO/Buffer.hs ===================================== @@ -73,6 +73,7 @@ import GHC.Show import GHC.Real import GHC.List import GHC.ForeignPtr.Ops +import GHC.ForeignPtr (unsafeWithForeignPtr) import Foreign.C.Types import Foreign.ForeignPtr import Foreign.Storable @@ -118,17 +119,17 @@ type CharBufElem = Char type RawCharBuffer = RawBuffer CharBufElem peekCharBuf :: RawCharBuffer -> Int -> IO Char -peekCharBuf arr ix = withForeignPtr arr $ \p -> do +peekCharBuf arr ix = unsafeWithForeignPtr arr $ \p -> do (c,_) <- readCharBufPtr p ix return c {-# INLINE readCharBuf #-} readCharBuf :: RawCharBuffer -> Int -> IO (Char, Int) -readCharBuf arr ix = withForeignPtr arr $ \p -> readCharBufPtr p ix +readCharBuf arr ix = unsafeWithForeignPtr arr $ \p -> readCharBufPtr p ix {-# INLINE writeCharBuf #-} writeCharBuf :: RawCharBuffer -> Int -> Char -> IO Int -writeCharBuf arr ix c = withForeignPtr arr $ \p -> writeCharBufPtr p ix c +writeCharBuf arr ix c = unsafeWithForeignPtr arr $ \p -> writeCharBufPtr p ix c {-# INLINE readCharBufPtr #-} readCharBufPtr :: Ptr CharBufElem -> Int -> IO (Char, Int) ===================================== libraries/bytestring ===================================== @@ -1 +1 @@ -Subproject commit 8b5d8d0da24aefdc4d950174bf396b32335d7e0f +Subproject commit 36c2df1feaf10fde8d5848ac47b98d6d62c4e1d7 ===================================== libraries/ghc-compact/GHC/Compact/Serialized.hs ===================================== @@ -29,6 +29,7 @@ module GHC.Compact.Serialized( import GHC.Prim import GHC.Types import GHC.Word (Word8) +import GHC.IO (unIO) import GHC.Ptr (Ptr(..), plusPtr) @@ -74,12 +75,6 @@ mkBlockList buffer = compactGetFirstBlock buffer >>= go rest <- go next return $ item : rest --- We MUST mark withSerializedCompact as NOINLINE --- Otherwise the compiler will eliminate the call to touch# --- causing the Compact# to be potentially GCed too eagerly, --- before func had a chance to copy everything into its own --- buffers/sockets/whatever - -- | Serialize the 'Compact', and call the provided function with -- with the 'Compact' serialized representation. It is not safe -- to return the pointer from the action and use it after @@ -89,7 +84,6 @@ mkBlockList buffer = compactGetFirstBlock buffer >>= go -- unsound to use 'unsafeInterleaveIO' to lazily construct -- a lazy bytestring from the 'Ptr'. -- -{-# NOINLINE withSerializedCompact #-} withSerializedCompact :: Compact a -> (SerializedCompact a -> IO c) -> IO c withSerializedCompact (Compact buffer root lock) func = withMVar lock $ \_ -> do @@ -97,9 +91,7 @@ withSerializedCompact (Compact buffer root lock) func = withMVar lock $ \_ -> do (# s', rootAddr #) -> (# s', Ptr rootAddr #) ) blockList <- mkBlockList buffer let serialized = SerializedCompact blockList rootPtr - r <- func serialized - IO (\s -> case touch# buffer s of - s' -> (# s', r #) ) + IO $ \s -> keepAlive# buffer s (unIO $ func serialized) fixupPointers :: Addr# -> Addr# -> State# RealWorld -> (# State# RealWorld, Maybe (Compact a) #) ===================================== testsuite/tests/ghci/should_run/T16012.script ===================================== @@ -3,4 +3,4 @@ -- should always return a reasonably low result. n <- System.Mem.getAllocationCounter -if (n < 0 && n >= -160000) then putStrLn "Alloction counter in expected range" else (putStrLn $ "Unexpected allocation counter result:" ++ show n) +if (n < 0 && n >= -200000) then putStrLn "Allocation counter in expected range" else (putStrLn $ "Unexpected allocation counter result:" ++ show n) ===================================== testsuite/tests/ghci/should_run/T16012.stdout ===================================== @@ -1 +1 @@ -Alloction counter in expected range +Allocation counter in expected range ===================================== utils/genprimopcode/Main.hs ===================================== @@ -503,6 +503,7 @@ gen_latex_doc (Info defaults entries) tvars = tvars_of typ tbinds [] = ". " tbinds ("o":tbs) = "(o::?) " ++ (tbinds tbs) + tbinds ("p":tbs) = "(p::?) " ++ (tbinds tbs) tbinds (tv:tbs) = tv ++ " " ++ (tbinds tbs) tvars_of (TyF t1 t2) = tvars_of t1 `union` tvars_of t2 tvars_of (TyC t1 t2) = tvars_of t1 `union` tvars_of t2 @@ -852,6 +853,7 @@ ppTyVar "b" = "betaTyVar" ppTyVar "c" = "gammaTyVar" ppTyVar "s" = "deltaTyVar" ppTyVar "o" = "runtimeRep1TyVar, openAlphaTyVar" +ppTyVar "p" = "runtimeRep2TyVar, openBetaTyVar" ppTyVar _ = error "Unknown type var" ppType :: Ty -> String @@ -885,6 +887,7 @@ ppType (TyVar "b") = "betaTy" ppType (TyVar "c") = "gammaTy" ppType (TyVar "s") = "deltaTy" ppType (TyVar "o") = "openAlphaTy" +ppType (TyVar "p") = "openBetaTy" ppType (TyApp (TyCon "State#") [x]) = "mkStatePrimTy " ++ ppType x ppType (TyApp (TyCon "MutVar#") [x,y]) = "mkMutVarPrimTy " ++ ppType x View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/30c6583356d13284f470f9104d6838bb0a7a6f3b...8ae19c3ab8176ec8be5b9a5e1b441e529b814f8b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/30c6583356d13284f470f9104d6838bb0a7a6f3b...8ae19c3ab8176ec8be5b9a5e1b441e529b814f8b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 4 03:22:50 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 03 Dec 2020 22:22:50 -0500 Subject: [Git][ghc/ghc][ghc-9.0] 29 commits: nonmoving: Fix regression from TSAN work Message-ID: <5fc9ab8aefe28_6a09dfe56c1823a7@gitlab.mail> Ben Gamari pushed to branch ghc-9.0 at Glasgow Haskell Compiler / GHC Commits: c2eaeda5 by GHC GitLab CI at 2020-11-29T18:48:41-05:00 nonmoving: Fix regression from TSAN work The TSAN rework (specifically aad1f803) introduced a subtle regression in GC.c, swapping `g0` in place of `gen`. Whoops! Fixes #18997. (cherry picked from commit 21c807df67afe1aee7bf4a964a00cc78ef19e00f) - - - - - 7629341d by GHC GitLab CI at 2020-11-29T18:48:41-05:00 rts/Messages: Add missing write barrier in THROWTO message update After a THROWTO message has been handle the message closure is overwritten by a NULL message. We must ensure that the original closure's pointers continue to be visible to the nonmoving GC. (cherry picked from commit 6c2faf158fd26fc06b03c9bd11b6d2cf8e8db572) - - - - - 8ceec852 by GHC GitLab CI at 2020-11-29T18:48:41-05:00 nonmoving: Add missing write barrier in shrinkSmallByteArray (cherry picked from commit 35c22991ae5c22b10ca1a81f0aa888d1939f0b3f) - - - - - 29873608 by GHC GitLab CI at 2020-11-29T18:48:41-05:00 Updates: Don't zero slop until closure has been pushed Ensure that the the free variables have been pushed to the update remembered set before we zero the slop. (cherry picked from commit 134f759926bb4163d7ab97e72ce7209ed42f98b9) - - - - - 84684501 by GHC GitLab CI at 2020-11-29T18:48:41-05:00 OSThreads: Fix error code checking pthread_join returns its error code and apparently doesn't set errno. (cherry picked from commit c488ac737e8ca3813fe6db069cbeb7abba00cfb9) - - - - - fda49d26 by GHC GitLab CI at 2020-11-29T18:48:42-05:00 nonmoving: Don't join to mark_thread on shutdown The mark thread is not joinable as we detach from it on creation. (cherry picked from commit ca1ef0e758a3fb787691529a0f8149e9d10b1d00) - - - - - 6567e49a by Ben Gamari at 2020-11-29T18:48:42-05:00 nonmoving: Add reference to Ueno 2016 (cherry picked from commit a3b8375eeb2ce9d2e30f8269f5b489c5bcacc69f) - - - - - cb365f51 by GHC GitLab CI at 2020-11-29T18:50:27-05:00 nonmoving: Ensure that evacuated large objects are marked See Note [Non-moving GC: Marking evacuated objects]. (cherry picked from commit b416189e4004506b89f06f147be37e76f4cd507f) - - - - - 824332c4 by Andreas Klebinger at 2020-11-30T18:56:35-05:00 WinIO: Small changes related to atomic request swaps. Move the atomix exchange over the Ptr type to an internal module. Fix a bug caused by us passing ptr-to-ptr instead of ptr to atomic exchange. Renamed interlockedExchange to exchangePtr. I've also added an cas primitive. It turned out we don't need it for WinIO but I'm leaving it in as it's useful for other things. (cherry picked from commit 401a64b80fb210fa1b403afe5b28d16f961f21bc) - - - - - 7cb92dec by Krzysztof Gogolewski at 2020-11-30T18:56:35-05:00 Force argument in setIdMult (#18925) (cherry picked from commit 5506f1342e51bad71a7525ddad0650d1ac63afeb) - - - - - 77a239ec by Moritz Angermann at 2020-11-30T18:56:35-05:00 AArch64/arm64 adjustments This addes the necessary logic to support aarch64 on elf, as well as aarch64 on mach-o, which Apple calls arm64. We change architecture name to AArch64, which is the official arm naming scheme. (cherry picked from commit 8887102fc4ed8ed1089c1aafd19bab424ad706f3) - - - - - 7da4e588 by Krzysztof Gogolewski at 2020-11-30T18:56:35-05:00 Export indexError from GHC.Ix (#18579) (cherry picked from commit 165352a2d163537afb01a835bccc7cd0a667410a) - - - - - 4b83b6a8 by Ben Gamari at 2020-11-30T18:56:35-05:00 rts/linker: Align bssSize to page size when mapping symbol extras We place symbol_extras right after bss. We also need to ensure that symbol_extras can be mprotect'd independently from the rest of the image. To ensure this we round up the size of bss to a page boundary, thus ensuring that symbol_extras is also page-aligned. (cherry picked from commit 9f40cf6ca9fb24dbc55f7eae43e2b89aa12bf251) - - - - - e0d7563a by Ben Gamari at 2020-11-30T18:56:35-05:00 testsuite: Add testcase for #18733 (cherry picked from commit 787e93ae141ae0f33bc36895494d48a2a5e49e08) - - - - - 3d59089b by Ben Gamari at 2020-11-30T18:56:35-05:00 compiler: Fix recompilation checking In ticket #18733 we noticed a rather serious deficiency in the current fingerprinting logic for recursive groups. I have described the old fingerprinting story and its problems in Note [Fingerprinting recursive groups] and have reworked the story accordingly to avoid these issues. Fixes #18733. (cherry picked from commit 5353fd500b1e92636cd9d45274585fd88a915ff6) - - - - - eaa632ba by Ben Gamari at 2020-11-30T18:56:35-05:00 rts: Allocate MBlocks with MAP_TOP_DOWN on Windows As noted in #18991, we would previously allocate heap in low memory. Due to this the linker, which typically *needs* low memory, would end up competing with the heap. In longer builds we end up running out of low memory entirely, leading to linking failures. (cherry picked from commit a1a75aa9be2c133dd1372a08eeb6a92c31688df7) - - - - - 0bba6516 by Ben Gamari at 2020-11-30T18:56:35-05:00 gitlab-ci: Run LLVM job on appropriately-labelled MRs Namely, those marked with the ~"LLVM backend" label (cherry picked from commit 7c03cc5010999d0f0f9dfc549984023b3a1f2c8d) - - - - - be408b86 by Ben Gamari at 2020-11-30T18:56:35-05:00 rts/linker: Ensure that .rodata is aligned to 16 bytes Pulled out of !4310. - - - - - 3a09acdc by Ömer Sinan Ağacan at 2020-11-30T18:56:35-05:00 Fix and enable object unloading in GHCi Fixes #16525 by tracking dependencies between object file symbols and marking symbol liveness during garbage collection See Note [Object unloading] in CheckUnload.c for details. (cherry picked from commit c34a4b98b1f09ea3096d39a839a86f2d7185c796) - - - - - 01f5126b by Ray Shih at 2020-11-30T18:56:35-05:00 Add loadNativeObj and unloadNativeObj (This change is originally written by niteria) This adds two functions: * `loadNativeObj` * `unloadNativeObj` and implements them for Linux. They are useful if you want to load a shared object with Haskell code using the system linker and have GHC call dlclose() after the code is no longer referenced from the heap. Using the system linker allows you to load the shared object above outside the low-mem region. It also loads the DWARF sections in a way that `perf` understands. `dl_iterate_phdr` is what makes this implementation Linux specific. (cherry picked from commit 2782487f5f6ad9df4dc8725226a47f07fec77f9f) - - - - - a1a0ec33 by GHC GitLab CI at 2020-11-30T18:56:35-05:00 rts: Introduce highMemDynamic (cherry picked from commit 7a65f9e140906087273ce95f062775f18f6a708d) - - - - - cae06fc4 by GHC GitLab CI at 2020-11-30T18:56:35-05:00 Introduce test for dynamic library unloading This uses the highMemDynamic flag introduced earlier to verify that dynamic objects are properly unloaded. (cherry picked from commit e9e1b2e75de17be47ab887a26943f5517a8463ac) - - - - - f72f27a3 by GHC GitLab CI at 2020-11-30T19:21:56-05:00 ThreadPaused: Don't zero slop until free vars are pushed When threadPaused blackholes a thunk it calls `OVERWRITING_CLOSURE` to zero the slop for the benefit of the sanity checker. Previously this was done *before* pushing the thunk's free variables to the update remembered set. Consequently we would pull zero'd pointers to the update remembered set. (cherry picked from commit 3e75b0dbaca5fbd8abc529d70c1df159f5bfbaa4) - - - - - 43ff60b5 by Ben Gamari at 2020-12-01T00:55:55-05:00 rts: Refactor foreign export tracking This avoids calling `libc` in the initializers which are responsible for registering foreign exports. We believe this should avoid the corruption observed in #18548. See Note [Tracking foreign exports] in rts/ForeignExports.c for an overview of the new scheme. (cherry picked from commit c492134912e5270180881b7345ee86dc32756bdd) - - - - - 85822a88 by Ben Gamari at 2020-12-01T00:57:01-05:00 rts: Refactor unloading of foreign export StablePtrs Previously we would allocate a linked list cell for each foreign export. Now we can avoid this by taking advantage of the fact that they are already broken into groups. (cherry picked from commit 40dc91069d15bfc1d81f1722b39e06cac8fdddd1) - - - - - 2a622d0f by Ben Gamari at 2020-12-01T21:39:09+00:00 hadrian: Pass input file to makeindex Strangely I find that on Alpine (and apparently only on Alpine) the latex makeindex command expects to be given a filename, lest it reads from stdin. (cherry picked from commit 389a668343c0d4f5fa095112ff98d0da6998e99d) - - - - - 553ec815 by GHC GitLab CI at 2020-12-01T22:19:04+00:00 Fix various documentation issues - - - - - 007055cc by GHC GitLab CI at 2020-12-01T22:19:12+00:00 Fix cas_int - - - - - 794616b6 by Ben Gamari at 2020-12-03T22:16:06-05:00 testsuite: Add missing #include on <stdlib.h> This otherwise fails on newer Clangs, which warn more aggressively on undeclared symbols. (cherry picked from commit 3d7db1488c4bd7764e8b1fe3cfde4c5a548cde16) - - - - - 30 changed files: - .gitlab-ci.yml - aclocal.m4 - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs - compiler/GHC/CmmToAsm/Reg/Linear.hs - compiler/GHC/CmmToAsm/Reg/Linear/FreeRegs.hs - compiler/GHC/CmmToAsm/Reg/Target.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToC.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Foreign/Decl.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Platform/ARM64.hs → compiler/GHC/Platform/AArch64.hs - compiler/GHC/Platform/Regs.hs - compiler/GHC/Runtime/Linker.hs - compiler/GHC/Types/Var.hs - compiler/ghc.cabal.in - config.sub - docs/users_guide/9.0.1-notes.rst - docs/users_guide/ghci.rst - docs/users_guide/runtime_control.rst - hadrian/src/Builder.hs - includes/CodeGen.Platform.hs - includes/Rts.h - includes/rts/Flags.h - + includes/rts/ForeignExports.h - includes/rts/Linker.h - includes/rts/storage/ClosureMacros.h - includes/rts/storage/GC.h The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b944fd08884527c4fee7286ac60e0a9bd6ebf424...794616b6c4ab6537304777cfb5616cd5fc031a2f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b944fd08884527c4fee7286ac60e0a9bd6ebf424...794616b6c4ab6537304777cfb5616cd5fc031a2f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 4 04:02:25 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 03 Dec 2020 23:02:25 -0500 Subject: [Git][ghc/ghc][wip/tyconapp-opts] Optimise nullary type constructor usage Message-ID: <5fc9b4d1bbca3_6b213946828ad@gitlab.mail> Ben Gamari pushed to branch wip/tyconapp-opts at Glasgow Haskell Compiler / GHC Commits: fe5e455f by Ben Gamari at 2020-12-03T23:02:15-05:00 Optimise nullary type constructor usage During the compilation of programs GHC very frequently deals with the `Type` type, which is a synonym of `TYPE 'LiftedRep`. This patch teaches GHC to avoid expanding the `Type` synonym (and other nullary type synonyms) during type comparisons, saving a good amount of work. This optimisation is described in `Note [Comparing nullary type synonyms]`. To maximize the impact of this optimisation, we introduce a few special-cases to reduce `TYPE 'LiftedRep` to `Type`. See `Note [Prefer Type over TYPE 'LiftedPtrRep]`. Closes #17958. Metric Decrease: T18698b T1969 T12227 T12545 T12707 T14683 T3064 T5631 T5642 T9020 T9872a T13035 haddock.Cabal haddock.base - - - - - 22 changed files: - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - + compiler/GHC/Builtin/Types/Prim.hs-boot - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/TcType.hs - testsuite/tests/deSugar/should_compile/T2431.stderr - testsuite/tests/deriving/should_compile/T14578.stderr - testsuite/tests/plugins/plugins09.stdout - testsuite/tests/plugins/plugins10.stdout - testsuite/tests/plugins/plugins11.stdout - testsuite/tests/plugins/static-plugins.stdout - testsuite/tests/printer/T18052a.stderr - testsuite/tests/simplCore/should_compile/T13143.stderr - testsuite/tests/simplCore/should_compile/T18013.stderr - testsuite/tests/simplCore/should_compile/T7360.stderr - testsuite/tests/typecheck/should_compile/T13032.stderr Changes: ===================================== compiler/GHC/Builtin/Types.hs ===================================== @@ -170,6 +170,7 @@ import GHC.Types.Var (VarBndr (Bndr)) import GHC.Settings.Constants ( mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE, mAX_SUM_SIZE ) import GHC.Unit.Module ( Module ) import GHC.Core.Type +import qualified GHC.Core.TyCo.Rep as TyCoRep (Type(TyConApp)) import GHC.Types.RepType import GHC.Core.DataCon import GHC.Core.ConLike @@ -689,7 +690,7 @@ constraintKindTyCon :: TyCon constraintKindTyCon = pcTyCon constraintKindTyConName Nothing [] [] liftedTypeKind, typeToTypeKind, constraintKind :: Kind -liftedTypeKind = tYPE liftedRepTy +liftedTypeKind = TyCoRep.TyConApp liftedTypeKindTyCon [] typeToTypeKind = liftedTypeKind `mkVisFunTyMany` liftedTypeKind constraintKind = mkTyConApp constraintKindTyCon [] @@ -1413,8 +1414,8 @@ runtimeRepTy = mkTyConTy runtimeRepTyCon -- type Type = tYPE 'LiftedRep liftedTypeKindTyCon :: TyCon liftedTypeKindTyCon = buildSynTyCon liftedTypeKindTyConName - [] liftedTypeKind [] - (tYPE liftedRepTy) + [] liftedTypeKind [] rhs + where rhs = TyCoRep.TyConApp tYPETyCon [liftedRepTy] runtimeRepTyCon :: TyCon runtimeRepTyCon = pcTyCon runtimeRepTyConName Nothing [] ===================================== compiler/GHC/Builtin/Types/Prim.hs ===================================== @@ -551,10 +551,6 @@ mkPrimTcName built_in_syntax occ key tycon = mkWiredInName gHC_PRIM (mkTcOccFS occ) key (mkATyCon tycon) built_in_syntax ----------------------------- --- | Given a RuntimeRep, applies TYPE to it. --- see Note [TYPE and RuntimeRep] -tYPE :: Type -> Type -tYPE rr = TyConApp tYPETyCon [rr] -- Given a Multiplicity, applies FUN to it. functionWithMultiplicity :: Type -> Type ===================================== compiler/GHC/Builtin/Types/Prim.hs-boot ===================================== @@ -0,0 +1,5 @@ +module GHC.Builtin.Types.Prim where + +import GHC.Core.TyCon + +tYPETyCon :: TyCon ===================================== compiler/GHC/Core/TyCo/Rep.hs ===================================== @@ -52,6 +52,7 @@ module GHC.Core.TyCo.Rep ( mkVisFunTyMany, mkVisFunTysMany, mkInvisFunTyMany, mkInvisFunTysMany, mkTyConApp, + tYPE, -- * Functions over binders TyCoBinder(..), TyCoVarBinder, TyBinder, @@ -90,8 +91,9 @@ import GHC.Core.TyCon import GHC.Core.Coercion.Axiom -- others -import GHC.Builtin.Names ( liftedTypeKindTyConKey, manyDataConKey ) -import {-# SOURCE #-} GHC.Builtin.Types ( liftedTypeKindTyCon, manyDataConTy ) +import GHC.Builtin.Names ( liftedTypeKindTyConKey, liftedRepDataConKey, manyDataConKey, tYPETyConKey ) +import {-# SOURCE #-} GHC.Builtin.Types ( liftedTypeKindTyCon, liftedTypeKind, manyDataConTy ) +import {-# SOURCE #-} GHC.Builtin.Types.Prim ( tYPETyCon ) import GHC.Types.Basic ( LeftOrRight(..), pickLR ) import GHC.Types.Unique ( hasKey, Uniquable(..) ) import GHC.Utils.Outputable @@ -1018,12 +1020,64 @@ mkTyConApp tycon tys -- avoid reboxing every time `mkTyConApp` is called. = ASSERT2( null tys, ppr tycon $$ ppr tys ) manyDataConTy + -- See Note [Prefer Type over TYPE 'LiftedRep]. + | tycon `hasKey` tYPETyConKey + , [rep] <- tys + = tYPE rep + -- The catch-all case | otherwise = TyConApp tycon tys +{- +Note [Prefer Type over TYPE 'LiftedRep] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The Core of nearly any program will have numerous occurrences of + at TYPE 'LiftedRep@ floating about. Consequently, we try hard to ensure +that operations on such types are efficient. Specifically, we strive to + + a. Avoid heap allocation of such types + b. Use a small (shallow in the tree-depth sense) representation + for such types + +Goal (b) is particularly useful as it makes traversals (e.g. free variable +traversal, substitution, and comparison) more efficient. +Comparison in particular takes special advantage of nullary type synonym +applications, Note [Comparing nullary type synonyms] in "GHC.Core.Type". + +To accomplish these we use a number of tricks: + + * Instead of representing the lifted kind as + @TyConApp tYPETyCon [liftedRepDataCon]@ we rather prefer to + use the 'GHC.Types.Type' type synonym. This serves goal (b) + since there are no applied type arguments to traverse, e.g., during + comparison. + + * We have a top-level binding to represent `TyConApp GHC.Types.Type []` + (namely 'GHC.Builtin.Types.Prim.liftedTypeKind'), ensuring that we + don't need to allocate such types (goal (a)). + + * To avoid allocating 'TyConApp' constructors + 'GHC.Builtin.Types.Prim.tYPE' catches the lifted case and returns + `liftedTypeKind` instead of building an application (goal (a)). + + * Similarly, 'Type.mkTyConApp' catches applications of `TYPE` and + handles them using 'GHC.Builtin.Types.Prim.tYPE', ensuring + that it benefits from the optimisation described above (goal (a)). + +See #17958. +-} + +-- | Given a RuntimeRep, applies TYPE to it. +-- See Note [TYPE and RuntimeRep] in GHC.Builtin.Types.Prim. +tYPE :: Type -> Type +tYPE (TyConApp tc []) + -- See Note [Prefer Type of TYPE 'LiftedRep] + | tc `hasKey` liftedRepDataConKey = liftedTypeKind -- TYPE 'LiftedRep +tYPE rr = TyConApp tYPETyCon [rr] + -- This is a single, global definition of the type `Type` -- Defined here so it is only allocated once. --- See Note [mkTyConApp and Type] +-- See Note [mkTyConApp and Type] in this module. liftedTypeKindTyConApp :: Type liftedTypeKindTyConApp = TyConApp liftedTypeKindTyCon [] ===================================== compiler/GHC/Core/TyCo/Subst.hs ===================================== @@ -424,6 +424,7 @@ zipTCvSubst tcvs tys -- | Generates the in-scope set for the 'TCvSubst' from the types in the -- incoming environment. No CoVars, please! mkTvSubstPrs :: [(TyVar, Type)] -> TCvSubst +mkTvSubstPrs [] = emptyTCvSubst mkTvSubstPrs prs = ASSERT2( onlyTyVarsAndNoCoercionTy, text "prs" <+> ppr prs ) mkTvSubst in_scope tenv ===================================== compiler/GHC/Core/TyCon.hs ===================================== @@ -2327,12 +2327,14 @@ expandSynTyCon_maybe -- ^ Expand a type synonym application, if any expandSynTyCon_maybe tc tys | SynonymTyCon { tyConTyVars = tvs, synTcRhs = rhs, tyConArity = arity } <- tc - = case tys `listLengthCmp` arity of - GT -> Just (tvs `zip` tys, rhs, drop arity tys) - EQ -> Just (tvs `zip` tys, rhs, []) - LT -> Nothing - | otherwise - = Nothing + = case tys of + [] -> Just ([], rhs, []) -- Avoid a bit of work in the case of nullary synonyms + _ -> case tys `listLengthCmp` arity of + GT -> Just (tvs `zip` tys, rhs, drop arity tys) + EQ -> Just (tvs `zip` tys, rhs, []) + LT -> Nothing + | otherwise + = Nothing ---------------- ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -383,15 +383,16 @@ how roles in kinds might work out. -} -- | Gives the typechecker view of a type. This unwraps synonyms but --- leaves 'Constraint' alone. c.f. coreView, which turns Constraint into --- TYPE LiftedRep. Returns Nothing if no unwrapping happens. +-- leaves 'Constraint' alone. c.f. 'coreView', which turns 'Constraint' into +-- @TYPE LiftedRep at . Returns 'Nothing' if no unwrapping happens. -- See also Note [coreView vs tcView] {-# INLINE tcView #-} tcView :: Type -> Maybe Type -tcView (TyConApp tc tys) | Just (tenv, rhs, tys') <- expandSynTyCon_maybe tc tys - = Just (mkAppTys (substTy (mkTvSubstPrs tenv) rhs) tys') +tcView (TyConApp tc tys) + | res@(Just _) <- expandSynTyConApp_maybe tc tys + = res -- The free vars of 'rhs' should all be bound by 'tenv', so it's - -- ok to use 'substTy' here. + -- ok to use 'substTy' here (which is what expandSynTyConApp_maybe does). -- See also Note [The substitution invariant] in GHC.Core.TyCo.Subst. -- Its important to use mkAppTys, rather than (foldl AppTy), -- because the function part might well return a @@ -400,17 +401,16 @@ tcView _ = Nothing {-# INLINE coreView #-} coreView :: Type -> Maybe Type --- ^ This function Strips off the /top layer only/ of a type synonym +-- ^ This function strips off the /top layer only/ of a type synonym -- application (if any) its underlying representation type. --- Returns Nothing if there is nothing to look through. +-- Returns 'Nothing' if there is nothing to look through. -- This function considers 'Constraint' to be a synonym of @TYPE LiftedRep at . -- -- By being non-recursive and inlined, this case analysis gets efficiently -- joined onto the case analysis that the caller is already doing coreView ty@(TyConApp tc tys) - | Just (tenv, rhs, tys') <- expandSynTyCon_maybe tc tys - = Just (mkAppTys (substTy (mkTvSubstPrs tenv) rhs) tys') - -- This equation is exactly like tcView + | res@(Just _) <- expandSynTyConApp_maybe tc tys + = res -- At the Core level, Constraint = Type -- See Note [coreView vs tcView] @@ -420,6 +420,30 @@ coreView ty@(TyConApp tc tys) coreView _ = Nothing +----------------------------------------------- +expandSynTyConApp_maybe :: TyCon -> [Type] -> Maybe Type +expandSynTyConApp_maybe tc tys + | Just (tvs, rhs) <- synTyConDefn_maybe tc + , n_tys >= arity + = Just (expand_syn arity tvs rhs n_tys tys) + | otherwise + = Nothing + where + n_tys = length tys + arity = tyConArity tc +-- Without this INLINE the call to expandSynTyConApp_maybe in coreView +-- will result in an avoidable allocation. +{-# INLINE expandSynTyConApp_maybe #-} + +-- | A helper for 'expandSynTyConApp_maybe' to avoid inlining this cold path +-- into call-sites. +expand_syn :: Int -> [TyVar] -> Type -> Int -> [Type] -> Type +expand_syn arity tvs rhs n_tys tys + | n_tys > arity = mkAppTys rhs' (drop arity tys) + | otherwise = rhs' + where + rhs' = substTy (mkTvSubstPrs (tvs `zip` tys)) rhs + {-# INLINE coreFullView #-} coreFullView :: Type -> Type -- ^ Iterates 'coreView' until there is no more to synonym to expand. @@ -2207,6 +2231,36 @@ But the left is an AppTy while the right is a TyConApp. The solution is to use repSplitAppTy_maybe to break up the TyConApp into its pieces and then continue. Easy to do, but also easy to forget to do. + +Note [Comparing nullary type synonyms] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider the task of testing equality between two 'Type's of the form + + TyConApp tc [] + +where @tc@ is a type synonym. A naive way to perform this comparison these +would first expand the synonym and then compare the resulting expansions. + +However, this is obviously wasteful and the RHS of @tc@ may be large; it is +much better to rather compare the TyCons directly. Consequently, before +expanding type synonyms in type comparisons we first look for a nullary +TyConApp and simply compare the TyCons if we find one. Of course, if we find +that the TyCons are *not* equal then we still need to perform the expansion as +their RHSs may still be equal. + +We perform this optimisation in a number of places: + + * GHC.Core.Types.eqType + * GHC.Core.Types.nonDetCmpType + * GHC.Core.Unify.unify_ty + * TcCanonical.can_eq_nc' + * TcUnify.uType + +This optimisation is especially helpful for the ubiquitous GHC.Types.Type, +since GHC prefers to use the type synonym over @TYPE 'LiftedRep@ applications +whenever possible. See [Prefer Type over TYPE 'LiftedRep] in +GHC.Core.TyCo.Rep for details. + -} eqType :: Type -> Type -> Bool @@ -2318,6 +2372,10 @@ nonDetCmpTypeX env orig_t1 orig_t2 = -- Returns both the resulting ordering relation between the two types -- and whether either contains a cast. go :: RnEnv2 -> Type -> Type -> TypeOrdering + -- See Note [Comparing nullary type synonyms]. + go _ (TyConApp tc1 []) (TyConApp tc2 []) + | tc1 == tc2 + = TEQ go env t1 t2 | Just t1' <- coreView t1 = go env t1' t2 | Just t2' <- coreView t2 = go env t1 t2' ===================================== compiler/GHC/Core/Unify.hs ===================================== @@ -957,7 +957,12 @@ unify_ty :: UMEnv -- Respects newtypes, PredTypes unify_ty env ty1 ty2 kco - -- Use tcView, not coreView. See Note [coreView vs tcView] in GHC.Core.Type. + -- See Note [Comparing nullary type synonyms] in GHC.Core.Type. + | TyConApp tc1 [] <- ty1 + , TyConApp tc2 [] <- ty2 + , tc1 == tc2 = return () + + -- TODO: More commentary needed here | Just ty1' <- tcView ty1 = unify_ty env ty1' ty2 kco | Just ty2' <- tcView ty2 = unify_ty env ty1 ty2' kco | CastTy ty1' co <- ty1 = if um_unif env ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -956,6 +956,11 @@ can_eq_nc' -> Type -> Type -- RHS, after and before type-synonym expansion, resp -> TcS (StopOrContinue Ct) +-- See Note [Comparing nullary type synonyms] in GHC.Core.Type. +can_eq_nc' _flat _rdr_env _envs ev eq_rel ty1@(TyConApp tc1 []) _ps_ty1 (TyConApp tc2 []) _ps_ty2 + | tc1 == tc2 + = canEqReflexive ev eq_rel ty1 + -- Expand synonyms first; see Note [Type synonyms and canonicalization] can_eq_nc' rewritten rdr_env envs ev eq_rel ty1 ps_ty1 ty2 ps_ty2 | Just ty1' <- tcView ty1 = can_eq_nc' rewritten rdr_env envs ev eq_rel ty1' ps_ty1 ty2 ps_ty2 ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -120,7 +120,6 @@ import GHC.Types.Id as Id import GHC.Types.Name import GHC.Types.Var.Set import GHC.Builtin.Types -import GHC.Builtin.Types.Prim import GHC.Types.Var.Env import GHC.Types.Name.Env import GHC.Utils.Misc ===================================== compiler/GHC/Tc/Utils/TcType.hs ===================================== @@ -1581,6 +1581,11 @@ tc_eq_type keep_syns vis_only orig_ty1 orig_ty2 = go orig_env orig_ty1 orig_ty2 where go :: RnEnv2 -> Type -> Type -> Bool + -- See Note [Comparing nullary type synonyms] in GHC.Core.Type. + go _ (TyConApp tc1 []) (TyConApp tc2 []) + | tc1 == tc2 + = True + go env t1 t2 | not keep_syns, Just t1' <- tcView t1 = go env t1' t2 go env t1 t2 | not keep_syns, Just t2' <- tcView t2 = go env t1 t2' ===================================== testsuite/tests/deSugar/should_compile/T2431.stderr ===================================== @@ -1,9 +1,9 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 63, types: 43, coercions: 1, joins: 0/0} + = {terms: 63, types: 39, coercions: 1, joins: 0/0} --- RHS size: {terms: 2, types: 4, coercions: 1, joins: 0/0} +-- RHS size: {terms: 2, types: 3, coercions: 1, joins: 0/0} T2431.$WRefl [InlPrag=INLINE[final] CONLIKE] :: forall a. a :~: a [GblId[DataConWrapper], Caf=NoCafRefs, @@ -15,7 +15,7 @@ T2431.$WRefl [InlPrag=INLINE[final] CONLIKE] :: forall a. a :~: a T2431.$WRefl = \ (@a) -> T2431.Refl @a @a @~(_N :: a GHC.Prim.~# a) --- RHS size: {terms: 4, types: 8, coercions: 0, joins: 0/0} +-- RHS size: {terms: 4, types: 7, coercions: 0, joins: 0/0} absurd :: forall a. (Int :~: Bool) -> a [GblId, Arity=1, Str=b, Cpr=b, Unf=OtherCon []] absurd = \ (@a) (x :: Int :~: Bool) -> case x of { } ===================================== testsuite/tests/deriving/should_compile/T14578.stderr ===================================== @@ -16,13 +16,12 @@ Derived class instances: = GHC.Prim.coerce @(T14578.App (Data.Functor.Compose.Compose f g) a -> T14578.App (Data.Functor.Compose.Compose f g) a - -> T14578.App (Data.Functor.Compose.Compose f g) a) + -> T14578.App (Data.Functor.Compose.Compose f g) a) @(T14578.Wat f g a -> T14578.Wat f g a -> T14578.Wat f g a) ((GHC.Base.<>) @(T14578.App (Data.Functor.Compose.Compose f g) a)) GHC.Base.sconcat = GHC.Prim.coerce - @(GHC.Base.NonEmpty - (T14578.App (Data.Functor.Compose.Compose f g) a) + @(GHC.Base.NonEmpty (T14578.App (Data.Functor.Compose.Compose f g) a) -> T14578.App (Data.Functor.Compose.Compose f g) a) @(GHC.Base.NonEmpty (T14578.Wat f g a) -> T14578.Wat f g a) (GHC.Base.sconcat @@ -31,7 +30,7 @@ Derived class instances: = GHC.Prim.coerce @(b -> T14578.App (Data.Functor.Compose.Compose f g) a - -> T14578.App (Data.Functor.Compose.Compose f g) a) + -> T14578.App (Data.Functor.Compose.Compose f g) a) @(b -> T14578.Wat f g a -> T14578.Wat f g a) (GHC.Base.stimes @(T14578.App (Data.Functor.Compose.Compose f g) a)) ===================================== testsuite/tests/plugins/plugins09.stdout ===================================== @@ -3,6 +3,5 @@ interfacePlugin: Prelude interfacePlugin: GHC.Float interfacePlugin: GHC.Base typeCheckPlugin (rn) -interfacePlugin: GHC.Types typeCheckPlugin (tc) interfacePlugin: GHC.Num.BigNat ===================================== testsuite/tests/plugins/plugins10.stdout ===================================== @@ -6,7 +6,6 @@ interfacePlugin: GHC.Float interfacePlugin: GHC.Base interfacePlugin: Language.Haskell.TH.Syntax typeCheckPlugin (rn) -interfacePlugin: GHC.Types typeCheckPlugin (tc) interfacePlugin: GHC.Num.BigNat parsePlugin(a) ===================================== testsuite/tests/plugins/plugins11.stdout ===================================== @@ -3,6 +3,5 @@ interfacePlugin: Prelude interfacePlugin: GHC.Float interfacePlugin: GHC.Base typeCheckPlugin (rn) -interfacePlugin: GHC.Types typeCheckPlugin (tc) interfacePlugin: GHC.Num.BigNat ===================================== testsuite/tests/plugins/static-plugins.stdout ===================================== @@ -5,11 +5,11 @@ interfacePlugin: GHC.Float interfacePlugin: GHC.Base interfacePlugin: System.IO typeCheckPlugin (rn) -interfacePlugin: GHC.Prim -interfacePlugin: GHC.Show interfacePlugin: GHC.Types +interfacePlugin: GHC.Show interfacePlugin: GHC.TopHandler typeCheckPlugin (tc) +interfacePlugin: GHC.Prim interfacePlugin: GHC.CString interfacePlugin: GHC.Num.BigNat ==pure.1 ===================================== testsuite/tests/printer/T18052a.stderr ===================================== @@ -10,9 +10,9 @@ Dependent packages: [base-4.16.0.0, ghc-bignum-1.0, ghc-prim-0.8.0] ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 24, types: 61, coercions: 0, joins: 0/0} + = {terms: 24, types: 52, coercions: 0, joins: 0/0} --- RHS size: {terms: 7, types: 8, coercions: 0, joins: 0/0} +-- RHS size: {terms: 7, types: 6, coercions: 0, joins: 0/0} T18052a.$b:||: :: forall {a} {b}. a -> b -> (a, b) [GblId, Arity=2, Unf=OtherCon []] T18052a.$b:||: = \ (@a) (@b) (x :: a) (y :: b) -> (x, y) @@ -22,7 +22,7 @@ T18052a.$b:||: = \ (@a) (@b) (x :: a) (y :: b) -> (x, y) [GblId] (+++) = ++ --- RHS size: {terms: 13, types: 20, coercions: 0, joins: 0/0} +-- RHS size: {terms: 13, types: 18, coercions: 0, joins: 0/0} T18052a.$m:||: :: forall {rep :: GHC.Types.RuntimeRep} {r :: TYPE rep} {a} {b}. (a, b) -> (a -> b -> r) -> ((# #) -> r) -> r ===================================== testsuite/tests/simplCore/should_compile/T13143.stderr ===================================== @@ -1,17 +1,17 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 71, types: 44, coercions: 0, joins: 0/0} + = {terms: 71, types: 40, coercions: 0, joins: 0/0} Rec { --- RHS size: {terms: 4, types: 4, coercions: 0, joins: 0/0} +-- RHS size: {terms: 4, types: 3, coercions: 0, joins: 0/0} T13143.$wf [InlPrag=NOINLINE, Occ=LoopBreaker] :: forall {a}. (# #) -> a [GblId, Arity=1, Str=b, Cpr=b, Unf=OtherCon []] T13143.$wf = \ (@a) _ [Occ=Dead] -> T13143.$wf @a GHC.Prim.(##) end Rec } --- RHS size: {terms: 4, types: 4, coercions: 0, joins: 0/0} +-- RHS size: {terms: 4, types: 3, coercions: 0, joins: 0/0} f [InlPrag=[final]] :: forall a. Int -> a [GblId, Arity=1, ===================================== testsuite/tests/simplCore/should_compile/T18013.stderr ===================================== @@ -129,9 +129,9 @@ Rule fired: Class op fmap (BUILTIN) ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 52, types: 106, coercions: 17, joins: 0/1} + = {terms: 52, types: 101, coercions: 17, joins: 0/1} --- RHS size: {terms: 37, types: 87, coercions: 17, joins: 0/1} +-- RHS size: {terms: 37, types: 84, coercions: 17, joins: 0/1} mapMaybeRule :: forall a b. Rule IO a b -> Rule IO (Maybe a) (Maybe b) [GblId, ===================================== testsuite/tests/simplCore/should_compile/T7360.stderr ===================================== @@ -1,7 +1,7 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 106, types: 47, coercions: 0, joins: 0/0} + = {terms: 106, types: 45, coercions: 0, joins: 0/0} -- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} T7360.$WFoo3 [InlPrag=INLINE[final] CONLIKE] :: Int %1 -> Foo @@ -31,7 +31,7 @@ T7360.fun4 :: () WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 20 0}] T7360.fun4 = fun1 T7360.Foo1 --- RHS size: {terms: 11, types: 8, coercions: 0, joins: 0/0} +-- RHS size: {terms: 11, types: 7, coercions: 0, joins: 0/0} fun2 :: forall {a}. [a] -> ((), Int) [GblId, Arity=1, ===================================== testsuite/tests/typecheck/should_compile/T13032.stderr ===================================== @@ -1,9 +1,9 @@ ==================== Desugar (after optimization) ==================== Result size of Desugar (after optimization) - = {terms: 13, types: 24, coercions: 0, joins: 0/0} + = {terms: 13, types: 18, coercions: 0, joins: 0/0} --- RHS size: {terms: 6, types: 11, coercions: 0, joins: 0/0} +-- RHS size: {terms: 6, types: 8, coercions: 0, joins: 0/0} f :: forall a b. (a ~ b) => a -> b -> Bool [LclIdX, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fe5e455f177cd4f845c953a194397dc57846c253 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fe5e455f177cd4f845c953a194397dc57846c253 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 4 04:11:36 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 03 Dec 2020 23:11:36 -0500 Subject: [Git][ghc/ghc][wip/ci-fixes] gitlab-ci: Run linters through ci.sh Message-ID: <5fc9b6f885012_6b21391c0844d@gitlab.mail> Ben Gamari pushed to branch wip/ci-fixes at Glasgow Haskell Compiler / GHC Commits: 33ec3a06 by Ben Gamari at 2020-12-03T23:11:31-05:00 gitlab-ci: Run linters through ci.sh Ensuring that the right toolchain is used. - - - - - 2 changed files: - .gitlab-ci.yml - .gitlab/ci.sh Changes: ===================================== .gitlab-ci.yml ===================================== @@ -299,12 +299,11 @@ hadrian-ghc-in-ghci: tags: - x86_64-linux script: + - git clean -xdf && git submodule foreach git clean -xdf - .gitlab/ci.sh setup + - .gitlab/ci.sh configure - cabal update - cd hadrian; cabal new-build -j`../mk/detect-cpu-count.sh` --with-compiler=$GHC --project-file=ci.project; cd .. - - git clean -xdf && git submodule foreach git clean -xdf - - ./boot - - ./configure $CONFIGURE_ARGS # Load ghc-in-ghci then immediately exit and check the modules loaded - echo ":q" | hadrian/ghci -j`mk/detect-cpu-count.sh`| tail -n2 | grep "Ok," after_script: @@ -345,9 +344,13 @@ hadrian-ghc-in-ghci: lint-base: extends: .lint-params + variables: + BUILD_FLAVOUR: default script: - - hadrian/build -c -j stage1:lib:base - - hadrian/build -j lint:base + - .gitlab/ci.sh setup + - .gitlab/ci.sh configure + - .gitlab/ci.sh run_hadrian stage1:lib:base + - .gitlab/ci.sh run_hadrian lint:base ############################################################ # Validation via Pipelines (make) ===================================== .gitlab/ci.sh ===================================== @@ -442,9 +442,6 @@ function test_make() { } function build_hadrian() { - if [ -z "$BUILD_FLAVOUR" ]; then - fail "BUILD_FLAVOUR not set" - fi if [ -z "$BIN_DIST_NAME" ]; then fail "BIN_DIST_NAME not set" fi @@ -506,6 +503,9 @@ function clean() { } function run_hadrian() { + if [ -z "$BUILD_FLAVOUR" ]; then + fail "BUILD_FLAVOUR not set" + fi if [ -z "$BIGNUM_BACKEND" ]; then BIGNUM_BACKEND="gmp"; fi if [ -n "$VERBOSE" ]; then HADRIAN_ARGS="$HADRIAN_ARGS -V"; fi run hadrian/build-cabal \ @@ -575,7 +575,7 @@ case $1 in test_hadrian || res=$? push_perf_notes exit $res ;; - run_hadrian) run_hadrian $@ ;; + run_hadrian) shift; run_hadrian $@ ;; perf_test) run_perf_test ;; clean) clean ;; shell) shell $@ ;; View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/33ec3a0600fe8c009ab8ed6d86941a8fd88fb033 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/33ec3a0600fe8c009ab8ed6d86941a8fd88fb033 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 4 08:45:28 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Fri, 04 Dec 2020 03:45:28 -0500 Subject: [Git][ghc/ghc][wip/T18894] 2 commits: DmdAnal: Annotate top-level function bindings with demands (#18894) Message-ID: <5fc9f728bcb14_6b2122cc84121e5@gitlab.mail> Sebastian Graf pushed to branch wip/T18894 at Glasgow Haskell Compiler / GHC Commits: f5596240 by Sebastian Graf at 2020-12-04T09:45:18+01:00 DmdAnal: Annotate top-level function bindings with demands (#18894) It's useful to annotate a non-exported top-level function like `g` in ```hs module Lib (h) where g :: Int -> Int -> (Int,Int) g m 1 = (m, 0) g m n = (2 * m, 2 `div` n) {-# NOINLINE g #-} h :: Int -> Int h 1 = 0 h m | odd m = snd (g m 2) | otherwise = uncurry (+) (g 2 m) ``` with its demand `UCU(CS(P(1P(U),SP(U))`, which tells us that whenever `g` was called, the second component of the returned pair was evaluated strictly. Since #18903 we do so for local functions, where we can see all calls. For top-level functions, we can assume that all *exported* functions are demanded according to `topDmd` and thus get sound demands for non-exported top-level functions. The demand on `g` is crucial information for Nested CPR, which may the go on and unbox `g` for the second pair component. That is true even if that pair component may diverge, as is the case for the call site `g 13 0`, which throws a div-by-zero exception. In `T18894b`, you can even see the new demand annotation enabling us to eta-expand a function that we wouldn't be able to eta-expand without Call Arity. We only track bindings of function type in order not to risk huge compile-time regressions, see `isInterestingTopLevelFn`. There was a CoreLint check that rejected strict demand annotations on recursive or top-level bindings, which seems completely unjustified. All the cases I investigated were fine, so I removed it. Fixes #18894. - - - - - 20d741fa by Sebastian Graf at 2020-12-04T09:45:18+01:00 Demand: Simplify `CU(U)` to `U` (#19005) Both sub-demands encode the same information. This is a trivial change and already affects a few regression tests (e.g. `T5075`), so no separate regression test is necessary. - - - - - 18 changed files: - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Types/Demand.hs - compiler/GHC/Types/Id/Info.hs - testsuite/tests/arityanal/should_compile/Arity11.stderr - testsuite/tests/arityanal/should_compile/Arity16.stderr - + testsuite/tests/stranal/should_compile/T18894.hs - + testsuite/tests/stranal/should_compile/T18894.stderr - + testsuite/tests/stranal/should_compile/T18894b.hs - + testsuite/tests/stranal/should_compile/T18894b.stderr - testsuite/tests/stranal/should_compile/all.T - testsuite/tests/stranal/sigs/T5075.stderr Changes: ===================================== compiler/GHC/Core/FVs.hs ===================================== @@ -525,12 +525,11 @@ ruleLhsFVIds (Rule { ru_bndrs = bndrs, ru_args = args }) = filterFV isLocalId $ addBndrs bndrs (exprs_fvs args) ruleRhsFreeIds :: CoreRule -> VarSet --- ^ This finds all locally-defined free Ids on the left hand side of a rule +-- ^ This finds all locally-defined free Ids on the right hand side of a rule -- and returns them as a non-deterministic set ruleRhsFreeIds (BuiltinRule {}) = emptyVarSet -ruleRhsFreeIds (Rule { ru_bndrs = bndrs, ru_args = args }) - = fvVarSet $ filterFV isLocalId $ - addBndrs bndrs $ exprs_fvs args +ruleRhsFreeIds (Rule { ru_bndrs = bndrs, ru_rhs = rhs }) + = fvVarSet $ filterFV isLocalId $ addBndrs bndrs $ expr_fvs rhs {- Note [Rule free var hack] (Not a hack any more) ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -623,14 +623,6 @@ lintLetBind top_lvl rec_flag binder rhs rhs_ty || exprIsTickedString rhs) (badBndrTyMsg binder (text "unlifted")) - -- Check that if the binder is top-level or recursive, it's not - -- demanded. Primitive string literals are exempt as there is no - -- computation to perform, see Note [Core top-level string literals]. - ; checkL (not (isStrictId binder) - || (isNonRec rec_flag && not (isTopLevel top_lvl)) - || exprIsTickedString rhs) - (mkStrictMsg binder) - -- Check that if the binder is at the top level and has type Addr#, -- that it is a string literal, see -- Note [Core top-level string literals]. @@ -3119,13 +3111,6 @@ badBndrTyMsg binder what = vcat [ text "The type of this binder is" <+> what <> colon <+> ppr binder , text "Binder's type:" <+> ppr (idType binder) ] -mkStrictMsg :: Id -> MsgDoc -mkStrictMsg binder - = vcat [hsep [text "Recursive or top-level binder has strict demand info:", - ppr binder], - hsep [text "Binder's demand info:", ppr (idDemandInfo binder)] - ] - mkNonTopExportedMsg :: Id -> MsgDoc mkNonTopExportedMsg binder = hsep [text "Non-top-level binder is marked as exported:", ppr binder] ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -37,6 +37,7 @@ import GHC.Core.Type import GHC.Core.FVs ( exprFreeIds, ruleRhsFreeIds ) import GHC.Core.Coercion ( Coercion, coVarsOfCo ) import GHC.Core.FamInstEnv +import GHC.Core.Opt.Arity ( typeArity ) import GHC.Utils.Misc import GHC.Utils.Panic import GHC.Data.Maybe ( isJust ) @@ -64,28 +65,54 @@ data DmdAnalOpts = DmdAnalOpts -- -- Note: use `seqBinds` on the result to avoid leaks due to lazyness (cf Note -- [Stamp out space leaks in demand analysis]) -dmdAnalProgram :: DmdAnalOpts -> FamInstEnvs -> CoreProgram -> CoreProgram -dmdAnalProgram opts fam_envs binds = binds_plus_dmds - where - env = emptyAnalEnv opts fam_envs - binds_plus_dmds = snd $ mapAccumL dmdAnalTopBind env binds - --- Analyse a (group of) top-level binding(s) -dmdAnalTopBind :: AnalEnv - -> CoreBind - -> (AnalEnv, CoreBind) -dmdAnalTopBind env (NonRec id rhs) - = ( extendAnalEnv TopLevel env id sig - , NonRec (setIdStrictness id sig) rhs') +dmdAnalProgram :: DmdAnalOpts -> FamInstEnvs -> [CoreRule] -> CoreProgram -> CoreProgram +dmdAnalProgram opts fam_envs rules binds + = snd $ go (emptyAnalEnv opts fam_envs) binds where - ( _, sig, rhs') = dmdAnalRhsLetDown Nothing env topSubDmd id rhs - -dmdAnalTopBind env (Rec pairs) - = (env', Rec pairs') - where - (env', _, pairs') = dmdFix TopLevel env topSubDmd pairs - -- We get two iterations automatically - -- c.f. the NonRec case above + -- See Note [Analysing top-level bindings] + -- TLDR; We analyse them like + -- let ex1 = ... in (ex1, let nex1 = ... in let ex2 = ... in (ex2, ...))) + -- where ex* are exported (or RULE mentions) and nex* are not. + go _ [] = (nopDmdType, []) + go env (b:bs) = cons_up $ dmdAnalBind TopLevel env topSubDmd b anal_body + where + anal_body env' + | (body_ty, bs') <- go env' bs + = (add_exported_uses env' body_ty (bindersOf b), bs') + + cons_up :: (a, b, [b]) -> (a, [b]) + cons_up (dmd_ty, b', bs') = (dmd_ty, b':bs') + + add_exported_uses :: AnalEnv -> DmdType -> [Id] -> DmdType + add_exported_uses env = foldl' (add_exported_use env) + + -- | If @e@ is denoted by @dmd_ty@, then @add_exported_use _ dmd_ty id@ + -- corresponds to the demand type of @(id, e)@, but is a lot more direct. + -- See Note [Analysing top-level bindings]. + add_exported_use :: AnalEnv -> DmdType -> Id -> DmdType + add_exported_use env dmd_ty id + | isExportedId id || elemVarSet id rule_fvs + -- See Note [Absence analysis for stable unfoldings and RULES] + = dmd_ty `plusDmdType` fst (dmdAnalStar env topDmd (Var id)) + | otherwise = dmd_ty + + rule_fvs :: IdSet + rule_fvs = foldr (unionVarSet . ruleRhsFreeIds) emptyVarSet rules + +-- | Whether we want to store demands on a top-level Id or just default +-- to 'topDmd'. +-- +-- Basically, we want to now how top-level *functions* are *used* +-- (e.g. called), but aren't interested in whether they were called strictly +-- or not. Other top-level bindings are boring. +isInterestingTopLevelFn :: Id -> Bool +-- SG tried to set this to True and got a +2% ghc/alloc regression in T5642 +-- (which is dominated by the Simplifier) at no gain in analysis precision. +-- If there was a gain, that regression might be acceptable. +-- Plus, we could use LetUp for thunks and share some code with local let +-- bindings. +isInterestingTopLevelFn id = + typeArity (idType id) `lengthExceeds` 0 {- Note [Stamp out space leaks in demand analysis] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -105,8 +132,56 @@ generation would hold on to an extra copy of the Core program, via unforced thunks in demand or strictness information; and it is the most memory-intensive part of the compilation process, so this added seqBinds makes a big difference in peak memory usage. --} +Note [Analysing top-level bindings] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider a CoreProgram like + e1 = ... + n1 = ... + e2 = \a b -> ... fst (n1 a b) ... + n2 = \c d -> ... snd (e2 c d) ... + ... +where e* are exported, but n* are not. +Intuitively, we can see that @n1@ is only ever called with two arguments +and in every call site, the first component of the result of the call +is evaluated. Thus, we'd like it to have idDemandInfo @UCU(C1(P(SU,A))@. + +(This can be exploited by a Nested CPR pass which may then unbox the +first component of the pair returned from @n1 at . Or if @n1@ had arity +1 before, we may now eta-expand to arity 2.) + +NB: We may *not* give e2 a similar annotation, because it is exported and +external callers might use it in arbitrary ways, expressed by 'topDmd'. + +How do we get this result? Answer: By analysing the program as if it was a let +expression of this form: + let e1 = ... in + (e1, let n1 = ... in + ( let e2 = ... in + (e2, let n2 = ... in + ( ...)))) +E.g. putting all bindings in nested lets, where whenever it binds an exported +binding, the body is a *pair* of an occurrence of the exported binder and +the other nested lets. Of course, we will not actually build that CoreExpr! +Instead we faithfully simulate analysis of said expression by adding the +free variable 'DmdEnv' of @e*@'s strictness signatures to the 'DmdType' we +get from analysing the nested bindings. + +You might also wonder why we didn't analyse in terms of the simpler + let e1 = ... in + let n1 = ... in + let e2 = ... in + let n2 = ... in + (e1,e2, ...) +The reason is analysis performance: If @e1@ uses many free variables, we'll +unnecessarily carry their demands around with us from the moment we analyse +the pair to the moment we bubble back up to the binding for @e1 at . +This blows up e.g. @T10370 at . + +A final note about variables occuring free in RULE RHSs: They are to be handled +pretty much like exported Ids. +See also Note [Absence analysis for stable unfoldings and RULES] +-} {- ************************************************************************ @@ -114,7 +189,103 @@ seqBinds makes a big difference in peak memory usage. \subsection{The analyser itself} * * ************************************************************************ +-} + +-- | Analyse a binding group and its \"body\", e.g. where it is in scope. +-- +-- It calls a function that knows how to analyse this \"body\" given +-- an 'AnalEnv' with updated demand signatures for the binding group +-- (reflecting their 'idStrictnessInfo') and expects to receive a +-- 'DmdType' in return, which it uses to annotate the binding group with their +-- 'idDemandInfo'. +dmdAnalBind + :: TopLevelFlag + -> AnalEnv + -> SubDemand -- ^ Demand put on the "body" + -- (important for join points) + -> CoreBind + -> (AnalEnv -> (DmdType, a)) -- ^ How to analyse the "body", e.g. + -- where the binding is in scope + -> (DmdType, CoreBind, a) +dmdAnalBind top_lvl env dmd bind anal_body = case bind of + NonRec id rhs + | useLetUp top_lvl id + -> dmdAnalBindLetUp top_lvl env id rhs anal_body + _ -> dmdAnalBindLetDown top_lvl env dmd bind anal_body + +-- | Annotates uninteresting top level functions ('isInterestingTopLevelFn') +-- with 'topDmd', the rest with the given demand. +setBindIdDemandInfo :: TopLevelFlag -> Id -> Demand -> Id +setBindIdDemandInfo top_lvl id dmd = setIdDemandInfo id $ case top_lvl of + TopLevel | not (isInterestingTopLevelFn id) -> topDmd + _ -> dmd + +-- | Let bindings can be processed in two ways: +-- Down (RHS before body) or Up (body before RHS). +-- This function handles the up variant. +-- +-- It is very simple. For let x = rhs in body +-- * Demand-analyse 'body' in the current environment +-- * Find the demand, 'rhs_dmd' placed on 'x' by 'body' +-- * Demand-analyse 'rhs' in 'rhs_dmd' +-- +-- This is used for a non-recursive local let without manifest lambdas (see +-- 'useLetUp'). +-- +-- This is the LetUp rule in the paper “Higher-Order Cardinality Analysis”. +dmdAnalBindLetUp :: TopLevelFlag -> AnalEnv -> Id -> CoreExpr -> (AnalEnv -> (DmdType, a)) -> (DmdType, CoreBind, a) +dmdAnalBindLetUp top_lvl env id rhs anal_body = (final_ty, NonRec id' rhs', body') + where + (body_ty, body') = anal_body env + (body_ty', id_dmd) = findBndrDmd env notArgOfDfun body_ty id + id' = setBindIdDemandInfo top_lvl id id_dmd + (rhs_ty, rhs') = dmdAnalStar env (dmdTransformThunkDmd rhs id_dmd) rhs + final_ty = body_ty' `plusDmdType` rhs_ty + +-- | Let bindings can be processed in two ways: +-- Down (RHS before body) or Up (body before RHS). +-- This function handles the down variant. +-- +-- It computes a demand signature (by means of 'dmdAnalRhsSig') and uses +-- that at call sites in the body. +-- +-- It is used for toplevel definitions, recursive definitions and local +-- non-recursive definitions that have manifest lambdas (cf. 'useLetUp'). +-- Local non-recursive definitions without a lambda are handled with LetUp. +-- +-- This is the LetDown rule in the paper “Higher-Order Cardinality Analysis”. +dmdAnalBindLetDown :: TopLevelFlag -> AnalEnv -> SubDemand -> CoreBind -> (AnalEnv -> (DmdType, a)) -> (DmdType, CoreBind, a) +dmdAnalBindLetDown top_lvl env dmd bind anal_body = case bind of + NonRec id rhs + | (env', lazy_fv, id1, rhs1) <- + dmdAnalRhsSig top_lvl NonRecursive env dmd id rhs + -> do_rest env' lazy_fv [(id1, rhs1)] (uncurry NonRec . only) + Rec pairs + | (env', lazy_fv, pairs') <- dmdFix top_lvl env dmd pairs + -> do_rest env' lazy_fv pairs' Rec + where + do_rest env' lazy_fv pairs1 build_bind = (final_ty, build_bind pairs2, body') + where + (body_ty, body') = anal_body env' + -- see Note [Lazy and unleashable free variables] + dmd_ty = addLazyFVs body_ty lazy_fv + (!final_ty, id_dmds) = findBndrsDmds env' dmd_ty (map fst pairs1) + pairs2 = zipWith do_one pairs1 id_dmds + do_one (id', rhs') dmd = (setBindIdDemandInfo top_lvl id' dmd, rhs') + -- If the actual demand is better than the vanilla call + -- demand, you might think that we might do better to re-analyse + -- the RHS with the stronger demand. + -- But (a) That seldom happens, because it means that *every* path in + -- the body of the let has to use that stronger demand + -- (b) It often happens temporarily in when fixpointing, because + -- the recursive function at first seems to place a massive demand. + -- But we don't want to go to extra work when the function will + -- probably iterate to something less demanding. + -- In practice, all the times the actual demand on id2 is more than + -- the vanilla call demand seem to be due to (b). So we don't + -- bother to re-analyse the RHS. +{- Note [Ensure demand is strict] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ It's important not to analyse e with a lazy demand because @@ -194,7 +365,7 @@ dmdAnal' env dmd (App fun arg) -- Crucially, coercions /are/ handled here, because they are -- value arguments (#10288) let - call_dmd = mkCallDmd dmd + call_dmd = mkCalledOnceDmd dmd (fun_ty, fun') = dmdAnal env call_dmd fun (arg_dmd, res_ty) = splitDmdTy fun_ty (arg_ty, arg') = dmdAnalStar env (dmdTransformThunkDmd arg arg_dmd) arg @@ -295,60 +466,11 @@ dmdAnal' env dmd (Case scrut case_bndr ty alts) -- , text "res_ty" <+> ppr res_ty ]) $ (res_ty, Case scrut' case_bndr' ty alts') --- Let bindings can be processed in two ways: --- Down (RHS before body) or Up (body before RHS). --- The following case handle the up variant. --- --- It is very simple. For let x = rhs in body --- * Demand-analyse 'body' in the current environment --- * Find the demand, 'rhs_dmd' placed on 'x' by 'body' --- * Demand-analyse 'rhs' in 'rhs_dmd' --- --- This is used for a non-recursive local let without manifest lambdas. --- This is the LetUp rule in the paper “Higher-Order Cardinality Analysis”. -dmdAnal' env dmd (Let (NonRec id rhs) body) - | useLetUp id - = (final_ty, Let (NonRec id' rhs') body') +dmdAnal' env dmd (Let bind body) + = (final_ty, Let bind' body') where - (body_ty, body') = dmdAnal env dmd body - (body_ty', id_dmd) = findBndrDmd env notArgOfDfun body_ty id - id' = setIdDemandInfo id id_dmd - - (rhs_ty, rhs') = dmdAnalStar env (dmdTransformThunkDmd rhs id_dmd) rhs - final_ty = body_ty' `plusDmdType` rhs_ty - -dmdAnal' env dmd (Let (NonRec id rhs) body) - = (body_ty2, Let (NonRec id2 rhs') body') - where - (lazy_fv, sig, rhs') = dmdAnalRhsLetDown Nothing env dmd id rhs - id1 = setIdStrictness id sig - env1 = extendAnalEnv NotTopLevel env id sig - (body_ty, body') = dmdAnal env1 dmd body - (body_ty1, id2) = annotateBndr env body_ty id1 - body_ty2 = addLazyFVs body_ty1 lazy_fv -- see Note [Lazy and unleashable free variables] - - -- If the actual demand is better than the vanilla call - -- demand, you might think that we might do better to re-analyse - -- the RHS with the stronger demand. - -- But (a) That seldom happens, because it means that *every* path in - -- the body of the let has to use that stronger demand - -- (b) It often happens temporarily in when fixpointing, because - -- the recursive function at first seems to place a massive demand. - -- But we don't want to go to extra work when the function will - -- probably iterate to something less demanding. - -- In practice, all the times the actual demand on id2 is more than - -- the vanilla call demand seem to be due to (b). So we don't - -- bother to re-analyse the RHS. - -dmdAnal' env dmd (Let (Rec pairs) body) - = let - (env', lazy_fv, pairs') = dmdFix NotTopLevel env dmd pairs - (body_ty, body') = dmdAnal env' dmd body - body_ty1 = deleteFVs body_ty (map fst pairs) - body_ty2 = addLazyFVs body_ty1 lazy_fv -- see Note [Lazy and unleashable free variables] - in - body_ty2 `seq` - (body_ty2, Let (Rec pairs') body') + (final_ty, bind', body') = dmdAnalBind NotTopLevel env dmd bind go' + go' env' = dmdAnal env' dmd body -- | A simple, syntactic analysis of whether an expression MAY throw a precise -- exception when evaluated. It's always sound to return 'True'. @@ -582,9 +704,13 @@ dmdTransform env var dmd | Just (sig, top_lvl) <- lookupSigEnv env var , let fn_ty = dmdTransformSig sig dmd = -- pprTrace "dmdTransform:LetDown" (vcat [ppr var, ppr sig, ppr dmd, ppr fn_ty]) $ - if isTopLevel top_lvl - then fn_ty -- Don't record demand on top-level things - else addVarDmd fn_ty var (C_11 :* dmd) + case top_lvl of + NotTopLevel -> addVarDmd fn_ty var (C_11 :* dmd) + TopLevel + | isInterestingTopLevelFn var + -> addVarDmd fn_ty var (C_0N `multDmd` (C_11 :* dmd)) -- discard strictness + | otherwise + -> fn_ty -- don't bother tracking; just annotate with 'topDmd' later -- Everything else: -- * Local let binders for which we use LetUp (cf. 'useLetUp') -- * Lambda binders @@ -599,46 +725,46 @@ dmdTransform env var dmd * * ********************************************************************* -} --- Let bindings can be processed in two ways: --- Down (RHS before body) or Up (body before RHS). --- dmdAnalRhsLetDown implements the Down variant: --- * assuming a demand of +-- | @dmdAnalRhsSig@ analyses the given RHS to compute a demand signature +-- for the LetDown rule. It works as follows: +-- +-- * assuming a demand of -- * looking at the definition -- * determining a strictness signature -- --- It is used for toplevel definition, recursive definitions and local --- non-recursive definitions that have manifest lambdas. --- Local non-recursive definitions without a lambda are handled with LetUp. --- --- This is the LetDown rule in the paper “Higher-Order Cardinality Analysis”. -dmdAnalRhsLetDown - :: Maybe [Id] -- Just bs <=> recursive, Nothing <=> non-recursive +-- Since it assumed a demand of , the resulting signature is applicable at +-- any call site. +dmdAnalRhsSig + :: TopLevelFlag + -> RecFlag -> AnalEnv -> SubDemand -> Id -> CoreExpr - -> (DmdEnv, StrictSig, CoreExpr) + -> (AnalEnv, DmdEnv, Id, CoreExpr) -- Process the RHS of the binding, add the strictness signature -- to the Id, and augment the environment with the signature as well. -- See Note [NOINLINE and strictness] -dmdAnalRhsLetDown rec_flag env let_dmd id rhs - = -- pprTrace "dmdAnalRhsLetDown" (ppr id $$ ppr let_dmd $$ ppr sig $$ ppr lazy_fv) $ - (lazy_fv, sig, rhs') +dmdAnalRhsSig top_lvl rec_flag env let_dmd id rhs + = -- pprTrace "dmdAnalRhsSig" (ppr id $$ ppr let_dmd $$ ppr sig $$ ppr lazy_fv) $ + (env', lazy_fv, id', rhs') where rhs_arity = idArity id + -- See Note [Demand signatures are computed for a threshold demand based on idArity] rhs_dmd -- See Note [Demand analysis for join points] -- See Note [Invariants on join points] invariant 2b, in GHC.Core -- rhs_arity matches the join arity of the join point | isJoinId id - = mkCallDmds rhs_arity let_dmd + = mkCalledOnceDmds rhs_arity let_dmd | otherwise - -- NB: rhs_arity - -- See Note [Demand signatures are computed for a threshold demand based on idArity] - = mkRhsDmd env rhs_arity rhs + = mkCalledOnceDmds rhs_arity topSubDmd (rhs_dmd_ty, rhs') = dmdAnal env rhs_dmd rhs DmdType rhs_fv rhs_dmds rhs_div = rhs_dmd_ty sig = mkStrictSigForArity rhs_arity (DmdType sig_fv rhs_dmds rhs_div) + id' = id `setIdStrictness` sig + env' = extendAnalEnv top_lvl env id' sig + -- See Note [Aggregated demand for cardinality] -- FIXME: That Note doesn't explain the following lines at all. The reason -- is really much different: When we have a recursive function, we'd @@ -651,8 +777,8 @@ dmdAnalRhsLetDown rec_flag env let_dmd id rhs -- we'd have to do an additional iteration. reuseEnv makes sure that -- we never get used-once info for FVs of recursive functions. rhs_fv1 = case rec_flag of - Just bs -> reuseEnv (delVarEnvList rhs_fv bs) - Nothing -> rhs_fv + Recursive -> reuseEnv rhs_fv + NonRecursive -> rhs_fv rhs_fv2 = rhs_fv1 `keepAliveDmdEnv` extra_fvs -- Find the RHS free vars of the unfoldings and RULES @@ -669,13 +795,6 @@ dmdAnalRhsLetDown rec_flag env let_dmd id rhs = exprFreeIds unf_body | otherwise = emptyVarSet --- | @mkRhsDmd env rhs_arity rhs@ creates a 'SubDemand' for --- unleashing on the given function's @rhs@, by creating --- a call demand of @rhs_arity@ --- See Historical Note [Product demands for function body] -mkRhsDmd :: AnalEnv -> Arity -> CoreExpr -> SubDemand -mkRhsDmd _env rhs_arity _rhs = mkCallDmds rhs_arity topSubDmd - -- | If given the (local, non-recursive) let-bound 'Id', 'useLetUp' determines -- whether we should process the binding up (body before rhs) or down (rhs -- before body). @@ -720,8 +839,8 @@ mkRhsDmd _env rhs_arity _rhs = mkCallDmds rhs_arity topSubDmd -- * For a more convincing example with join points, see Note [Demand analysis -- for join points]. -- -useLetUp :: Var -> Bool -useLetUp f = idArity f == 0 && not (isJoinId f) +useLetUp :: TopLevelFlag -> Var -> Bool +useLetUp top_lvl f = isNotTopLevel top_lvl && idArity f == 0 && not (isJoinId f) {- Note [Demand analysis for join points] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -939,8 +1058,6 @@ dmdFix :: TopLevelFlag dmdFix top_lvl env let_dmd orig_pairs = loop 1 initial_pairs where - bndrs = map fst orig_pairs - -- See Note [Initialising strictness] initial_pairs | ae_virgin env = [(setIdStrictness id botSig, rhs) | (id, rhs) <- orig_pairs ] | otherwise = orig_pairs @@ -990,10 +1107,8 @@ dmdFix top_lvl env let_dmd orig_pairs = -- pprTrace "my_downRhs" (ppr id $$ ppr (idStrictness id) $$ ppr sig) $ ((env', lazy_fv'), (id', rhs')) where - (lazy_fv1, sig, rhs') = dmdAnalRhsLetDown (Just bndrs) env let_dmd id rhs - lazy_fv' = plusVarEnv_C plusDmd lazy_fv lazy_fv1 - env' = extendAnalEnv top_lvl env id sig - id' = setIdStrictness id sig + (env', lazy_fv1, id', rhs') = dmdAnalRhsSig top_lvl Recursive env let_dmd id rhs + lazy_fv' = plusVarEnv_C plusDmd lazy_fv lazy_fv1 zapIdStrictness :: [(Id, CoreExpr)] -> [(Id, CoreExpr)] zapIdStrictness pairs = [(setIdStrictness id nopSig, rhs) | (id, rhs) <- pairs ] @@ -1090,7 +1205,7 @@ addLazyFVs dmd_ty lazy_fvs -- demand with the bottom coming up from 'error' -- -- I got a loop in the fixpointer without this, due to an interaction - -- with the lazy_fv filtering in dmdAnalRhsLetDown. Roughly, it was + -- with the lazy_fv filtering in dmdAnalRhsSig. Roughly, it was -- letrec f n x -- = letrec g y = x `fatbar` -- letrec h z = z + ...g... @@ -1156,10 +1271,6 @@ annotateLamIdBndr env arg_of_dfun dmd_ty id main_ty = addDemand dmd dmd_ty' (dmd_ty', dmd) = findBndrDmd env arg_of_dfun dmd_ty id -deleteFVs :: DmdType -> [Var] -> DmdType -deleteFVs (DmdType fvs dmds res) bndrs - = DmdType (delVarEnvList fvs bndrs) dmds res - {- Note [NOINLINE and strictness] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Core/Opt/Pipeline.hs ===================================== @@ -65,6 +65,7 @@ import GHC.Types.SrcLoc import GHC.Types.Id import GHC.Types.Id.Info import GHC.Types.Basic +import GHC.Types.Demand ( zapDmdEnvSig ) import GHC.Types.Var.Set import GHC.Types.Var.Env import GHC.Types.Unique.Supply ( UniqSupply, mkSplitUniqSupply, splitUniqSupply ) @@ -495,7 +496,7 @@ doCorePass CoreDoExitify = {-# SCC "Exitify" #-} doPass exitifyProgram doCorePass CoreDoDemand = {-# SCC "DmdAnal" #-} - doPassDFM dmdAnal + doPassDFRM dmdAnal doCorePass CoreDoCpr = {-# SCC "CprAnal" #-} doPassDFM cprAnalProgram @@ -575,6 +576,13 @@ doPassDFM do_pass guts = do let fam_envs = (p_fam_env, mg_fam_inst_env guts) doPassM (liftIO . do_pass dflags fam_envs) guts +doPassDFRM :: (DynFlags -> FamInstEnvs -> [CoreRule] -> CoreProgram -> IO CoreProgram) -> ModGuts -> CoreM ModGuts +doPassDFRM do_pass guts = do + dflags <- getDynFlags + p_fam_env <- getPackageFamInstEnv + let fam_envs = (p_fam_env, mg_fam_inst_env guts) + doPassM (liftIO . do_pass dflags fam_envs (mg_rules guts)) guts + doPassDFU :: (DynFlags -> FamInstEnvs -> UniqSupply -> CoreProgram -> CoreProgram) -> ModGuts -> CoreM ModGuts doPassDFU do_pass guts = do dflags <- getDynFlags @@ -1088,13 +1096,13 @@ transferIdInfo exported_id local_id -dmdAnal :: DynFlags -> FamInstEnvs -> CoreProgram -> IO CoreProgram -dmdAnal dflags fam_envs binds = do +dmdAnal :: DynFlags -> FamInstEnvs -> [CoreRule] -> CoreProgram -> IO CoreProgram +dmdAnal dflags fam_envs rules binds = do let opts = DmdAnalOpts { dmd_strict_dicts = gopt Opt_DictsStrict dflags } - binds_plus_dmds = dmdAnalProgram opts fam_envs binds + binds_plus_dmds = dmdAnalProgram opts fam_envs rules binds Err.dumpIfSet_dyn dflags Opt_D_dump_str_signatures "Strictness signatures" FormatText $ - dumpIdInfoOfProgram (ppr . strictnessInfo) binds_plus_dmds + dumpIdInfoOfProgram (ppr . zapDmdEnvSig . strictnessInfo) binds_plus_dmds -- See Note [Stamp out space leaks in demand analysis] in GHC.Core.Opt.DmdAnal seqBinds binds_plus_dmds `seq` return binds_plus_dmds ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -598,11 +598,10 @@ addJoinFlts = appOL mkRecFloats :: SimplFloats -> SimplFloats -- Flattens the floats into a single Rec group, -- They must either all be lifted LetFloats or all JoinFloats -mkRecFloats floats@(SimplFloats { sfLetFloats = LetFloats bs ff +mkRecFloats floats@(SimplFloats { sfLetFloats = LetFloats bs _ff , sfJoinFloats = jbs , sfInScope = in_scope }) - = ASSERT2( case ff of { FltLifted -> True; _ -> False }, ppr (fromOL bs) ) - ASSERT2( isNilOL bs || isNilOL jbs, ppr floats ) + = ASSERT2( isNilOL bs || isNilOL jbs, ppr floats ) SimplFloats { sfLetFloats = floats' , sfJoinFloats = jfloats' , sfInScope = in_scope } ===================================== compiler/GHC/Core/Opt/WorkWrap.hs ===================================== @@ -484,7 +484,7 @@ tryWW dflags fam_envs is_rec fn_id rhs | is_fun && is_eta_exp = splitFun dflags fam_envs new_fn_id fn_info wrap_dmds div cpr rhs - | is_thunk -- See Note [Thunk splitting] + | isNonRec is_rec, is_thunk -- See Note [Thunk splitting] = splitThunk dflags fam_envs is_rec new_fn_id rhs | otherwise ===================================== compiler/GHC/Core/Opt/WorkWrap/Utils.hs ===================================== @@ -1275,10 +1275,14 @@ mk_absent_let dflags fam_envs arg abs_rhs = mkAbsentErrorApp arg_ty msg msg = showSDoc (gopt_set dflags Opt_SuppressUniques) - (ppr arg <+> ppr (idType arg) <+> file_msg) + (vcat + [ text "Arg:" <+> ppr arg + , text "Type:" <+> ppr arg_ty + , file_msg + ]) file_msg = case outputFile dflags of Nothing -> empty - Just f -> text "in output file " <+> quotes (text f) + Just f -> text "In output file " <+> quotes (text f) -- We need to suppress uniques here because otherwise they'd -- end up in the generated code as strings. This is bad for -- determinism, because with different uniques the strings ===================================== compiler/GHC/Core/Tidy.hs ===================================== @@ -21,7 +21,7 @@ import GHC.Core import GHC.Core.Seq ( seqUnfolding ) import GHC.Types.Id import GHC.Types.Id.Info -import GHC.Types.Demand ( zapUsageEnvSig ) +import GHC.Types.Demand ( zapDmdEnvSig ) import GHC.Core.Type ( tidyType, tidyVarBndr ) import GHC.Core.Coercion ( tidyCo ) import GHC.Types.Var @@ -206,7 +206,7 @@ tidyLetBndr rec_tidy_env env@(tidy_env, var_env) id new_info = vanillaIdInfo `setOccInfo` occInfo old_info `setArityInfo` arityInfo old_info - `setStrictnessInfo` zapUsageEnvSig (strictnessInfo old_info) + `setStrictnessInfo` zapDmdEnvSig (strictnessInfo old_info) `setDemandInfo` demandInfo old_info `setInlinePragInfo` inlinePragInfo old_info `setUnfoldingInfo` new_unf ===================================== compiler/GHC/Types/Demand.hs ===================================== @@ -34,7 +34,7 @@ module GHC.Types.Demand ( lazyApply1Dmd, lazyApply2Dmd, strictOnceApply1Dmd, strictManyApply1Dmd, -- ** Other @Demand@ operations oneifyCard, oneifyDmd, strictifyDmd, strictifyDictDmd, mkWorkerDemand, - peelCallDmd, peelManyCalls, mkCallDmd, mkCallDmds, + peelCallDmd, peelManyCalls, mkCalledOnceDmd, mkCalledOnceDmds, addCaseBndrDmd, -- ** Extracting one-shot information argOneShots, argsOneShots, saturatedByOneShots, @@ -73,7 +73,7 @@ module GHC.Types.Demand ( seqDemand, seqDemandList, seqDmdType, seqStrictSig, -- * Zapping usage information - zapUsageDemand, zapUsageEnvSig, zapUsedOnceDemand, zapUsedOnceSig + zapUsageDemand, zapDmdEnvSig, zapUsedOnceDemand, zapUsedOnceSig ) where #include "HsVersions.h" @@ -278,7 +278,8 @@ data SubDemand -- ^ @Call n sd@ describes the evaluation context of @n@ function -- applications, where every individual result is evaluated according to @sd at . -- @sd@ is /relative/ to a single call, cf. Note [Call demands are relative]. - -- Used only for values of function type. + -- Used only for values of function type. Use the smart constructor 'mkCall' + -- whenever possible! | Prod ![Demand] -- ^ @Prod ds@ describes the evaluation context of a case scrutinisation -- on an expression of product type, where the product components are @@ -306,7 +307,7 @@ polyDmd C_1N = C_1N :* poly1N polyDmd C_10 = C_10 :* poly10 -- | A smart constructor for 'Prod', applying rewrite rules along the semantic --- equalities @Prod [polyDmd n, ...] === polyDmd n@, simplifying to 'Poly' +-- equality @Prod [polyDmd n, ...] === polyDmd n@, simplifying to 'Poly' -- 'SubDemand's when possible. Note that this degrades boxity information! E.g. a -- polymorphic demand will never unbox. mkProd :: [Demand] -> SubDemand @@ -335,6 +336,13 @@ viewProd _ _ = Nothing {-# INLINE viewProd #-} -- we want to fuse away the replicate and the allocation -- for Arity. Otherwise, #18304 bites us. +-- | A smart constructor for 'Call', applying rewrite rules along the semantic +-- equality @Call n (Poly n) === Poly n@, simplifying to 'Poly' 'SubDemand's +-- when possible. +mkCall :: Card -> SubDemand -> SubDemand +mkCall n cd@(Poly m) | n == m = cd +mkCall n cd = Call n cd + -- | @viewCall sd@ interprets @sd@ as a 'Call', expanding 'Poly' demands as -- necessary. viewCall :: SubDemand -> Maybe (Card, SubDemand) @@ -356,8 +364,8 @@ lubSubDmd (Prod ds1) (viewProd (length ds1) -> Just ds2) = -- Handle Call lubSubDmd (Call n1 d1) (viewCall -> Just (n2, d2)) -- See Note [Call demands are relative] - | isAbs n2 = Call (lubCard n1 n2) (lubSubDmd d1 botSubDmd) - | otherwise = Call (lubCard n1 n2) (lubSubDmd d1 d2) + | isAbs n2 = mkCall (lubCard n1 n2) (lubSubDmd d1 botSubDmd) + | otherwise = mkCall (lubCard n1 n2) (lubSubDmd d1 d2) -- Handle Poly lubSubDmd (Poly n1) (Poly n2) = Poly (lubCard n1 n2) -- Make use of reflexivity (so we'll match the Prod or Call cases again). @@ -377,8 +385,8 @@ plusSubDmd (Prod ds1) (viewProd (length ds1) -> Just ds2) = -- Handle Call plusSubDmd (Call n1 d1) (viewCall -> Just (n2, d2)) -- See Note [Call demands are relative] - | isAbs n2 = Call (plusCard n1 n2) (lubSubDmd d1 botSubDmd) - | otherwise = Call (plusCard n1 n2) (lubSubDmd d1 d2) + | isAbs n2 = mkCall (plusCard n1 n2) (lubSubDmd d1 botSubDmd) + | otherwise = mkCall (plusCard n1 n2) (lubSubDmd d1 d2) -- Handle Poly plusSubDmd (Poly n1) (Poly n2) = Poly (plusCard n1 n2) -- Make use of reflexivity (so we'll match the Prod or Call cases again). @@ -407,7 +415,7 @@ multSubDmd :: Card -> SubDemand -> SubDemand multSubDmd n sd | Just sd' <- multTrivial n seqSubDmd sd = sd' multSubDmd n (Poly n') = Poly (multCard n n') -multSubDmd n (Call n' sd) = Call (multCard n n') sd -- See Note [Call demands are relative] +multSubDmd n (Call n' sd) = mkCall (multCard n n') sd -- See Note [Call demands are relative] multSubDmd n (Prod ds) = Prod (map (multDmd n) ds) multDmd :: Card -> Demand -> Demand @@ -457,22 +465,22 @@ evalDmd = C_1N :* topSubDmd -- | First argument of 'GHC.Exts.maskAsyncExceptions#': @SCS(U)@. -- Called exactly once. strictOnceApply1Dmd :: Demand -strictOnceApply1Dmd = C_11 :* Call C_11 topSubDmd +strictOnceApply1Dmd = C_11 :* mkCall C_11 topSubDmd -- | First argument of 'GHC.Exts.atomically#': @MCM(U)@. -- Called at least once, possibly many times. strictManyApply1Dmd :: Demand -strictManyApply1Dmd = C_1N :* Call C_1N topSubDmd +strictManyApply1Dmd = C_1N :* mkCall C_1N topSubDmd -- | First argument of catch#: @1C1(U)@. -- Evaluates its arg lazily, but then applies it exactly once to one argument. lazyApply1Dmd :: Demand -lazyApply1Dmd = C_01 :* Call C_01 topSubDmd +lazyApply1Dmd = C_01 :* mkCall C_01 topSubDmd -- | Second argument of catch#: @1C1(CS(U))@. -- Calls its arg lazily, but then applies it exactly once to an additional argument. lazyApply2Dmd :: Demand -lazyApply2Dmd = C_01 :* Call C_01 (Call C_11 topSubDmd) +lazyApply2Dmd = C_01 :* mkCall C_01 (mkCall C_11 topSubDmd) -- | Make a 'Demand' evaluated at-most-once. oneifyDmd :: Demand -> Demand @@ -512,12 +520,12 @@ strictifyDictDmd ty (n :* Prod ds) strictifyDictDmd _ dmd = dmd -- | Wraps the 'SubDemand' with a one-shot call demand: @d@ -> @CS(d)@. -mkCallDmd :: SubDemand -> SubDemand -mkCallDmd sd = Call C_11 sd +mkCalledOnceDmd :: SubDemand -> SubDemand +mkCalledOnceDmd sd = mkCall C_11 sd --- | @mkCallDmds n d@ returns @CS(CS...(CS d))@ where there are @n@ @CS@'s. -mkCallDmds :: Arity -> SubDemand -> SubDemand -mkCallDmds arity sd = iterate mkCallDmd sd !! arity +-- | @mkCalledOnceDmds n d@ returns @CS(CS...(CS d))@ where there are @n@ @CS@'s. +mkCalledOnceDmds :: Arity -> SubDemand -> SubDemand +mkCalledOnceDmds arity sd = iterate mkCalledOnceDmd sd !! arity -- | Peels one call level from the sub-demand, and also returns how many -- times we entered the lambda body. @@ -669,7 +677,7 @@ This is needed even for non-product types, in case the case-binder is used but the components of the case alternative are not. Note [Don't optimise UP(U,U,...) to U] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ These two SubDemands: UP(U,U) (@Prod [topDmd, topDmd]@) and U (@topSubDmd@) are semantically equivalent, but we do not turn the former into @@ -1571,9 +1579,9 @@ This is weird, so I'm not worried about whether this optimises brilliantly; but it should not fall over. -} -zapUsageEnvSig :: StrictSig -> StrictSig --- Remove the usage environment from the demand -zapUsageEnvSig (StrictSig (DmdType _ ds r)) = mkClosedStrictSig ds r +-- | Remove the demand environment from the signature. +zapDmdEnvSig :: StrictSig -> StrictSig +zapDmdEnvSig (StrictSig (DmdType _ ds r)) = mkClosedStrictSig ds r zapUsageDemand :: Demand -> Demand -- Remove the usage info, but not the strictness info, from the demand @@ -1615,8 +1623,8 @@ kill_usage kfs (n :* sd) = kill_usage_card kfs n :* kill_usage_sd kfs sd kill_usage_sd :: KillFlags -> SubDemand -> SubDemand kill_usage_sd kfs (Call n sd) - | kf_called_once kfs = Call (lubCard C_1N n) (kill_usage_sd kfs sd) - | otherwise = Call n (kill_usage_sd kfs sd) + | kf_called_once kfs = mkCall (lubCard C_1N n) (kill_usage_sd kfs sd) + | otherwise = mkCall n (kill_usage_sd kfs sd) kill_usage_sd kfs (Prod ds) = Prod (map (kill_usage kfs) ds) kill_usage_sd _ sd = sd @@ -1640,7 +1648,7 @@ trimToType (n :* sd) ts where go (Prod ds) (TsProd tss) | equalLength ds tss = Prod (zipWith trimToType ds tss) - go (Call n sd) (TsFun ts) = Call n (go sd ts) + go (Call n sd) (TsFun ts) = mkCall n (go sd ts) go sd at Poly{} _ = sd go _ _ = topSubDmd @@ -1804,7 +1812,7 @@ instance Binary SubDemand where h <- getByte bh case h of 0 -> Poly <$> get bh - 1 -> Call <$> get bh <*> get bh + 1 -> mkCall <$> get bh <*> get bh 2 -> Prod <$> get bh _ -> pprPanic "Binary:SubDemand" (ppr (fromIntegral h :: Int)) ===================================== compiler/GHC/Types/Id/Info.hs ===================================== @@ -650,7 +650,7 @@ zapUsageInfo info = Just (info {demandInfo = zapUsageDemand (demandInfo info)}) zapUsageEnvInfo :: IdInfo -> Maybe IdInfo zapUsageEnvInfo info | hasDemandEnvSig (strictnessInfo info) - = Just (info {strictnessInfo = zapUsageEnvSig (strictnessInfo info)}) + = Just (info {strictnessInfo = zapDmdEnvSig (strictnessInfo info)}) | otherwise = Nothing ===================================== testsuite/tests/arityanal/should_compile/Arity11.stderr ===================================== @@ -35,7 +35,7 @@ end Rec } -- RHS size: {terms: 52, types: 28, coercions: 0, joins: 0/5} F11.$wfib [InlPrag=[2]] :: forall {a} {p}. (a -> a -> Bool) -> (Num a, Num p) => a -> p -[GblId, Arity=4, Str=, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 150 60 0] 460 0}] +[GblId, Arity=4, Str=, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 150 60 0] 460 0}] F11.$wfib = \ (@a) (@p) (ww :: a -> a -> Bool) (w :: Num a) (w1 :: Num p) (w2 :: a) -> let { @@ -73,7 +73,7 @@ F11.$wfib fib [InlPrag=[2]] :: forall {a} {p}. (Eq a, Num a, Num p) => a -> p [GblId, Arity=4, - Str=, + Str=, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=4,unsat_ok=True,boring_ok=False) Tmpl= \ (@a) (@p) (w [Occ=Once1!] :: Eq a) (w1 [Occ=Once1] :: Num a) (w2 [Occ=Once1] :: Num p) (w3 [Occ=Once1] :: a) -> case w of { GHC.Classes.C:Eq ww1 [Occ=Once1] _ [Occ=Dead] -> F11.$wfib @a @p ww1 w1 w2 w3 }}] fib = \ (@a) (@p) (w :: Eq a) (w1 :: Num a) (w2 :: Num p) (w3 :: a) -> case w of { GHC.Classes.C:Eq ww1 ww2 -> F11.$wfib @a @p ww1 w1 w2 w3 } ===================================== testsuite/tests/arityanal/should_compile/Arity16.stderr ===================================== @@ -5,7 +5,7 @@ Result size of Tidy Core = {terms: 52, types: 87, coercions: 0, joins: 0/0} Rec { -- RHS size: {terms: 15, types: 17, coercions: 0, joins: 0/0} map2 [Occ=LoopBreaker] :: forall {t} {a}. (t -> a) -> [t] -> [a] -[GblId, Arity=2, Str=, Unf=OtherCon []] +[GblId, Arity=2, Str=, Unf=OtherCon []] map2 = \ (@t) (@a) (f :: t -> a) (ds :: [t]) -> case ds of { ===================================== testsuite/tests/stranal/should_compile/T18894.hs ===================================== @@ -0,0 +1,28 @@ +{-# OPTIONS_GHC -O2 -fforce-recomp #-} + +-- | The point of this test is that @g*@ get's a demand that says +-- "whenever @g*@ is called, the second component of the pair is evaluated strictly". +module T18894 (h1, h2) where + +g1 :: Int -> (Int,Int) +g1 1 = (15, 0) +g1 n = (2 * n, 2 `div` n) +{-# NOINLINE g1 #-} + +h1 :: Int -> Int +h1 1 = 0 +-- Sadly, the @g1 2@ subexpression will be floated to top-level, where we +-- don't see the specific demand placed on it by @snd at . Tracked in #19001. +h1 2 = snd (g1 2) +h1 m = uncurry (+) (g1 m) + +g2 :: Int -> Int -> (Int,Int) +g2 m 1 = (m, 0) +g2 m n = (2 * m, 2 `div` n) +{-# NOINLINE g2 #-} + +h2 :: Int -> Int +h2 1 = 0 +h2 m + | odd m = snd (g2 m 2) + | otherwise = uncurry (+) (g2 2 m) ===================================== testsuite/tests/stranal/should_compile/T18894.stderr ===================================== @@ -0,0 +1,404 @@ + +==================== Demand analysis ==================== +Result size of Demand analysis + = {terms: 177, types: 97, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 36, types: 16, coercions: 0, joins: 0/0} +g2 [InlPrag=NOINLINE, Dmd=UCU(CS(P(1P(U),SP(U))))] + :: Int -> Int -> (Int, Int) +[LclId, + Arity=2, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20 20] 161 20}] +g2 + = \ (m [Dmd=UP(U)] :: Int) (ds [Dmd=SP(SU)] :: Int) -> + case ds of { GHC.Types.I# ds [Dmd=SU] -> + case ds of ds [Dmd=1U] { + __DEFAULT -> + (case m of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.*# 2# y) }, + case ds of wild { + __DEFAULT -> + case GHC.Classes.divInt# 2# wild of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> GHC.Types.I# -2#; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + }); + 1# -> (m, lvl) + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 36, types: 19, coercions: 0, joins: 0/0} +h2 :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 162 10}] +h2 + = \ (ds [Dmd=SP(MU)] :: Int) -> + case ds of wild [Dmd=UP(U)] { GHC.Types.I# ds [Dmd=MU] -> + case ds of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> + case g2 wild lvl of { (ds1 [Dmd=A], y [Dmd=SU]) -> y }; + 0# -> + case g2 lvl wild of { (x [Dmd=SP(U)], ds [Dmd=SP(U)]) -> + case x of { GHC.Types.I# x -> + case ds of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + } + }; + 1# -> lvl + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 15# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +lvl :: (Int, Int) +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = (lvl, lvl) + +-- RHS size: {terms: 30, types: 11, coercions: 0, joins: 0/0} +g1 [InlPrag=NOINLINE, Dmd=UCU(P(UP(U),UP(U)))] :: Int -> (Int, Int) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 141 10}] +g1 + = \ (ds [Dmd=SP(SU)] :: Int) -> + case ds of { GHC.Types.I# ds [Dmd=SU] -> + case ds of ds { + __DEFAULT -> + (GHC.Types.I# (GHC.Prim.*# 2# ds), + case ds of wild { + __DEFAULT -> + case GHC.Classes.divInt# 2# wild of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> GHC.Types.I# -2#; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + }); + 1# -> lvl + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +lvl :: (Int, Int) +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=False, ConLike=False, + WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 30 0}] +lvl = g1 (GHC.Types.I# 2#) + +-- RHS size: {terms: 28, types: 18, coercions: 0, joins: 0/0} +h1 :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 111 10}] +h1 + = \ (ds [Dmd=SP(MU)] :: Int) -> + case ds of wild [Dmd=1P(1U)] { GHC.Types.I# ds [Dmd=MU] -> + case ds of { + __DEFAULT -> + case g1 wild of { (x [Dmd=SP(U)], ds [Dmd=SP(U)]) -> + case x of { GHC.Types.I# x -> + case ds of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + }; + 1# -> lvl; + 2# -> case lvl of { (ds1 [Dmd=A], y [Dmd=SU]) -> y } + } + } + + + + +==================== Demand analysis ==================== +Result size of Demand analysis + = {terms: 171, types: 120, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# -2# + +-- RHS size: {terms: 32, types: 18, coercions: 0, joins: 0/0} +$wg2 [InlPrag=NOINLINE, Dmd=UCU(CS(P(1P(U),SP(U))))] + :: Int -> GHC.Prim.Int# -> (# Int, Int #) +[LclId, + Arity=2, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20 30] 121 20}] +$wg2 + = \ (w [Dmd=UP(U)] :: Int) (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + (# case w of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.*# 2# y) }, + case ds of { + __DEFAULT -> + case GHC.Classes.divInt# 2# ds of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> lvl; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + } #); + 1# -> (# w, lvl #) + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 34, types: 21, coercions: 0, joins: 0/0} +$wh2 [InlPrag=[2]] :: GHC.Prim.Int# -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 162 10}] +$wh2 + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> + case $wg2 (GHC.Types.I# ds) 2# of + { (# ww [Dmd=A], ww [Dmd=SU] #) -> + ww + }; + 0# -> + case $wg2 lvl ds of { (# ww [Dmd=SP(U)], ww [Dmd=SP(U)] #) -> + case ww of { GHC.Types.I# x -> + case ww of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + } + }; + 1# -> lvl + } + +-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} +h2 [InlPrag=[2]] :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (w [Occ=Once1!] :: Int) -> + case w of { GHC.Types.I# ww [Occ=Once1, Dmd=MU] -> $wh2 ww }}] +h2 + = \ (w [Dmd=SP(SU)] :: Int) -> + case w of { GHC.Types.I# ww [Dmd=SU] -> $wh2 ww } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 15# + +-- RHS size: {terms: 28, types: 15, coercions: 0, joins: 0/0} +$wg1 [InlPrag=NOINLINE, Dmd=UCU(P(UP(U),UP(U)))] + :: GHC.Prim.Int# -> (# Int, Int #) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 111 20}] +$wg1 + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + (# GHC.Types.I# (GHC.Prim.*# 2# ds), + case ds of { + __DEFAULT -> + case GHC.Classes.divInt# 2# ds of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> lvl; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + } #); + 1# -> (# lvl, lvl #) + } + +-- RHS size: {terms: 7, types: 9, coercions: 0, joins: 0/0} +lvl :: (Int, Int) +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=False, ConLike=False, + WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 40 10}] +lvl = case $wg1 2# of { (# ww, ww #) -> (ww, ww) } + +-- RHS size: {terms: 25, types: 18, coercions: 0, joins: 0/0} +$wh1 [InlPrag=[2]] :: GHC.Prim.Int# -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [50] 101 10}] +$wh1 + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds [Dmd=1U] { + __DEFAULT -> + case $wg1 ds of { (# ww [Dmd=SP(U)], ww [Dmd=SP(U)] #) -> + case ww of { GHC.Types.I# x -> + case ww of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + }; + 1# -> lvl; + 2# -> case lvl of { (ds1 [Dmd=A], y [Dmd=SU]) -> y } + } + +-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} +h1 [InlPrag=[2]] :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (w [Occ=Once1!] :: Int) -> + case w of { GHC.Types.I# ww [Occ=Once1, Dmd=MU] -> $wh1 ww }}] +h1 + = \ (w [Dmd=SP(SU)] :: Int) -> + case w of { GHC.Types.I# ww [Dmd=SU] -> $wh1 ww } + + + ===================================== testsuite/tests/stranal/should_compile/T18894b.hs ===================================== @@ -0,0 +1,20 @@ +{-# OPTIONS_GHC -O -fno-call-arity -fforce-recomp #-} + +module T18894 (f) where + +expensive :: Int -> (Int, Int) +expensive n = (n+1, n+2) +{-# NOINLINE expensive #-} + +-- arity 1 by itself, but not exported, thus can be eta-expanded based on usage +eta :: Int -> Int -> Int +eta x = if fst (expensive x) == 13 + then \y -> x + y + else \y -> x * y +{-# NOINLINE eta #-} + +f :: Int -> Int +f 1 = 0 +f m + | odd m = eta m 2 + | otherwise = eta 2 m ===================================== testsuite/tests/stranal/should_compile/T18894b.stderr ===================================== @@ -0,0 +1,187 @@ + +==================== Demand analysis ==================== +Result size of Demand analysis = {terms: 83, types: 40, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 16, types: 7, coercions: 0, joins: 0/0} +expensive [InlPrag=NOINLINE, Dmd=UCU(P(SP(SU),A))] :: Int -> (Int, Int) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [40] 52 10}] +expensive + = \ (n [Dmd=UP(U)] :: Int) -> + (case n of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 1#) }, case n of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 2#) }) + +-- RHS size: {terms: 20, types: 11, coercions: 0, joins: 0/0} +eta [InlPrag=NOINLINE, Dmd=UCU(CS(U))] :: Int -> Int -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [0] 140 120}] +eta + = \ (x [Dmd=UP(U)] :: Int) -> + case expensive x of { (x [Dmd=SP(SU)], ds1 [Dmd=A]) -> + case x of { GHC.Types.I# x [Dmd=SU] -> + case x of { + __DEFAULT -> \ (y [Dmd=SP(U)] :: Int) -> GHC.Num.$fNumInt_$c* x y; + 13# -> \ (y [Dmd=SP(U)] :: Int) -> GHC.Num.$fNumInt_$c+ x y + } + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 21, types: 5, coercions: 0, joins: 0/0} +f :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 111 0}] +f = \ (ds [Dmd=SP(MU)] :: Int) -> + case ds of wild [Dmd=UP(U)] { GHC.Types.I# ds [Dmd=MU] -> + case ds of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> eta wild lvl; + 0# -> eta lvl wild + }; + 1# -> lvl + } + } + + + + +==================== Demand analysis ==================== +Result size of Demand analysis = {terms: 85, types: 47, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 16, types: 9, coercions: 0, joins: 0/0} +$wexpensive [InlPrag=NOINLINE, Dmd=UCU(P(SP(SU),A))] :: Int -> (# Int, Int #) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [40] 42 10}] +$wexpensive + = \ (w [Dmd=UP(U)] :: Int) -> + (# case w of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 1#) }, + case w of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 2#) } #) + +-- RHS size: {terms: 19, types: 12, coercions: 0, joins: 0/0} +eta [InlPrag=NOINLINE, Dmd=UCU(CS(U))] :: Int -> Int -> Int +[LclId, + Arity=2, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [0 0] 120 0}] +eta + = \ (x [Dmd=MP(U)] :: Int) (eta [Dmd=SP(U), OS=OneShot] :: Int) -> + case $wexpensive x of { (# ww [Dmd=SP(SU)], ww [Dmd=A] #) -> + case ww of { GHC.Types.I# x [Dmd=SU] -> + case x of { + __DEFAULT -> GHC.Num.$fNumInt_$c* x eta; + 13# -> GHC.Num.$fNumInt_$c+ x eta + } + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 20, types: 3, coercions: 0, joins: 0/0} +$wf [InlPrag=[2]] :: GHC.Prim.Int# -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 121 0}] +$wf + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> eta (GHC.Types.I# ds) lvl; + 0# -> eta lvl (GHC.Types.I# ds) + }; + 1# -> lvl + } + +-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} +f [InlPrag=[2]] :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (w [Occ=Once1!] :: Int) -> case w of { GHC.Types.I# ww [Occ=Once1, Dmd=MU] -> $wf ww }}] +f = \ (w [Dmd=SP(SU)] :: Int) -> case w of { GHC.Types.I# ww [Dmd=SU] -> $wf ww } + + + ===================================== testsuite/tests/stranal/should_compile/all.T ===================================== @@ -58,3 +58,7 @@ test('T18122', [ grep_errmsg(r'wfoo =') ], compile, ['-ddump-simpl']) # We care about the call demand on $wg test('T18903', [ grep_errmsg(r'Dmd=\S+C\S+') ], compile, ['-ddump-simpl -dsuppress-uniques']) +# We care about the call demand on $wg1 and $wg2 +test('T18894', [ grep_errmsg(r'Dmd=\S+C\S+') ], compile, ['-ddump-stranal -dsuppress-uniques']) +# We care about the Arity 2 on eta, as a result of the annotated Dmd +test('T18894b', [ grep_errmsg(r'Arity=2') ], compile, ['-ddump-stranal -dsuppress-uniques -fno-call-arity -dppr-cols=200']) ===================================== testsuite/tests/stranal/sigs/T5075.stderr ===================================== @@ -1,7 +1,7 @@ ==================== Strictness signatures ==================== T5075.$trModule: -T5075.loop: +T5075.loop: @@ -13,6 +13,6 @@ T5075.loop: ==================== Strictness signatures ==================== T5075.$trModule: -T5075.loop: +T5075.loop: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/314cbee31b1ec9a167228fba236cc125f7f9cc68...20d741fad5b3ac799f4a2aab3880831e73f9204e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/314cbee31b1ec9a167228fba236cc125f7f9cc68...20d741fad5b3ac799f4a2aab3880831e73f9204e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 4 09:15:17 2020 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Fri, 04 Dec 2020 04:15:17 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/con-info-ci Message-ID: <5fc9fe25c59eb_6b211e3944128de@gitlab.mail> Matthew Pickering pushed new branch wip/con-info-ci at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/con-info-ci You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 4 10:04:51 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Fri, 04 Dec 2020 05:04:51 -0500 Subject: [Git][ghc/ghc][wip/sgraf-dmdanal-stuff] 4 commits: DmdAnal: Annotate top-level function bindings with demands (#18894) Message-ID: <5fca09c3863ed_6b212a3014134d6@gitlab.mail> Sebastian Graf pushed to branch wip/sgraf-dmdanal-stuff at Glasgow Haskell Compiler / GHC Commits: f5596240 by Sebastian Graf at 2020-12-04T09:45:18+01:00 DmdAnal: Annotate top-level function bindings with demands (#18894) It's useful to annotate a non-exported top-level function like `g` in ```hs module Lib (h) where g :: Int -> Int -> (Int,Int) g m 1 = (m, 0) g m n = (2 * m, 2 `div` n) {-# NOINLINE g #-} h :: Int -> Int h 1 = 0 h m | odd m = snd (g m 2) | otherwise = uncurry (+) (g 2 m) ``` with its demand `UCU(CS(P(1P(U),SP(U))`, which tells us that whenever `g` was called, the second component of the returned pair was evaluated strictly. Since #18903 we do so for local functions, where we can see all calls. For top-level functions, we can assume that all *exported* functions are demanded according to `topDmd` and thus get sound demands for non-exported top-level functions. The demand on `g` is crucial information for Nested CPR, which may the go on and unbox `g` for the second pair component. That is true even if that pair component may diverge, as is the case for the call site `g 13 0`, which throws a div-by-zero exception. In `T18894b`, you can even see the new demand annotation enabling us to eta-expand a function that we wouldn't be able to eta-expand without Call Arity. We only track bindings of function type in order not to risk huge compile-time regressions, see `isInterestingTopLevelFn`. There was a CoreLint check that rejected strict demand annotations on recursive or top-level bindings, which seems completely unjustified. All the cases I investigated were fine, so I removed it. Fixes #18894. - - - - - 20d741fa by Sebastian Graf at 2020-12-04T09:45:18+01:00 Demand: Simplify `CU(U)` to `U` (#19005) Both sub-demands encode the same information. This is a trivial change and already affects a few regression tests (e.g. `T5075`), so no separate regression test is necessary. - - - - - 84bef92f by Sebastian Graf at 2020-12-04T11:03:31+01:00 DmdAnal: Keep alive RULE vars in LetUp (#18971) I also took the liberty to refactor the logic around `ruleFVs`. - - - - - 0f32bf5e by Sebastian Graf at 2020-12-04T11:04:30+01:00 WorkWrap: Unbox constructors with existentials (#18982) I found that by relaxing the "no existential" checks in `isDataProductType_maybe` and `isDataSumType_maybe`, the former becomes identical to `tyConSingleAlgDataCon_maybe`. So I deleted both and introduced a new function, `tyConAlgDataCons_maybe` for the sum case. I cleaned up a couple of call sites, some of which weren't very explicit about whether they cared for existentials or not. Most of the new stuff happens in worker/wrapper, where handling of existentials means more substitution work because we have to clone the existential binders of the DataCon when matching on it in the unboxing `Case`. The test output of `T18013` changed, because we now unbox the `Rule` data type. Its constructor carries existential state and will be w/w'd now. In the particular example, the worker functions inlines right back into the wrapper, which then unnecessarily has a (quite big) stable unfolding. I think this kind of fallout is inevitable; see also Note [Don't w/w inline small non-loop-breaker things]. There's a new regression test case `T18982`. Fixes #18982. - - - - - 30 changed files: - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/CprAnal.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/HsToCore/Foreign/Call.hs - compiler/GHC/HsToCore/Foreign/Decl.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Tc/Deriv/Utils.hs - compiler/GHC/Types/Demand.hs - compiler/GHC/Types/Id/Info.hs - testsuite/tests/arityanal/should_compile/Arity11.stderr - testsuite/tests/arityanal/should_compile/Arity16.stderr - testsuite/tests/simplCore/should_compile/T18013.stderr - + testsuite/tests/stranal/should_compile/T18894.hs - + testsuite/tests/stranal/should_compile/T18894.stderr - + testsuite/tests/stranal/should_compile/T18894b.hs - + testsuite/tests/stranal/should_compile/T18894b.stderr - + testsuite/tests/stranal/should_compile/T18982.hs - + testsuite/tests/stranal/should_compile/T18982.stderr - testsuite/tests/stranal/should_compile/all.T - testsuite/tests/stranal/sigs/T5075.stderr Changes: ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -48,7 +48,7 @@ module GHC.Core.DataCon ( dataConImplicitTyThings, dataConRepStrictness, dataConImplBangs, dataConBoxer, - splitDataProductType_maybe, + splitNonExDataProductType_maybe, -- ** Predicates on DataCons isNullarySrcDataCon, isNullaryRepDataCon, @@ -1564,29 +1564,28 @@ promoteDataCon (MkData { dcPromoted = tc }) = tc -- | Extract the type constructor, type argument, data constructor and it's -- /representation/ argument types from a type if it is a product type. -- --- Precisely, we return @Just@ for any type that is all of: +-- Precisely, we return @Just@ for any data type that is all of: -- -- * Concrete (i.e. constructors visible) --- -- * Single-constructor +-- * ... which has no existentials -- --- * Not existentially quantified --- --- Whether the type is a @data@ type or a @newtype@ -splitDataProductType_maybe +-- Whether the type is a @data@ type or a @newtype at . +splitNonExDataProductType_maybe :: Type -- ^ A product type, perhaps -> Maybe (TyCon, -- The type constructor [Type], -- Type args of the tycon DataCon, -- The data constructor [Scaled Type]) -- Its /representation/ arg types - -- Rejecting existentials is conservative. Maybe some things - -- could be made to work with them, but I'm not going to sweat - -- it through till someone finds it's important. + -- Rejecting existentials means we don't have to worry about + -- freshening and substituting type variables + -- (See "GHC.Type.Id.Make.dataConArgUnpack") -splitDataProductType_maybe ty +splitNonExDataProductType_maybe ty | Just (tycon, ty_args) <- splitTyConApp_maybe ty - , Just con <- isDataProductTyCon_maybe tycon + , Just con <- tyConSingleDataCon_maybe tycon + , null (dataConExTyCoVars con) -- no existentials! See above = Just (tycon, ty_args, con, dataConInstArgTys con ty_args) | otherwise = Nothing ===================================== compiler/GHC/Core/FVs.hs ===================================== @@ -28,12 +28,13 @@ module GHC.Core.FVs ( varTypeTyCoFVs, idUnfoldingVars, idFreeVars, dIdFreeVars, bndrRuleAndUnfoldingVarsDSet, + bndrRuleAndUnfoldingIds, idFVs, idRuleVars, idRuleRhsVars, stableUnfoldingVars, ruleFreeVars, rulesFreeVars, rulesFreeVarsDSet, mkRuleInfo, ruleLhsFreeIds, ruleLhsFreeIdsList, - ruleRhsFreeVars, ruleRhsFreeIds, + ruleRhsFreeVars, rulesRhsFreeIds, expr_fvs, @@ -450,46 +451,75 @@ orph_names_of_fun_ty_con _ = emptyNameSet ************************************************************************ -} +data RuleFVsFrom + = LhsOnly + | RhsOnly + | BothSides + +-- | Those locally-defined variables free in the left and/or right hand sides +-- of the rule, depending on the first argument. Returns an 'FV' computation. +ruleFVs :: RuleFVsFrom -> CoreRule -> FV +ruleFVs !_ (BuiltinRule {}) = emptyFV +ruleFVs from (Rule { ru_fn = _do_not_include + -- See Note [Rule free var hack] + , ru_bndrs = bndrs + , ru_rhs = rhs, ru_args = args }) + = filterFV isLocalVar $ addBndrs bndrs (exprs_fvs exprs) + where + exprs = case from of + LhsOnly -> args + RhsOnly -> [rhs] + BothSides -> rhs:args + +-- | Those locally-defined variables free in the left and/or right hand sides +-- from several rules, depending on the first argument. +-- Returns an 'FV' computation. +rulesFVs :: RuleFVsFrom -> [CoreRule] -> FV +rulesFVs from = mapUnionFV (ruleFVs from) + -- | Those variables free in the right hand side of a rule returned as a -- non-deterministic set ruleRhsFreeVars :: CoreRule -> VarSet -ruleRhsFreeVars (BuiltinRule {}) = noFVs -ruleRhsFreeVars (Rule { ru_fn = _, ru_bndrs = bndrs, ru_rhs = rhs }) - = fvVarSet $ filterFV isLocalVar $ addBndrs bndrs (expr_fvs rhs) - -- See Note [Rule free var hack] +ruleRhsFreeVars = fvVarSet . ruleFVs RhsOnly --- | Those variables free in the both the left right hand sides of a rule +-- | Those locally-defined free 'Id's in the right hand side of several rules -- returned as a non-deterministic set -ruleFreeVars :: CoreRule -> VarSet -ruleFreeVars = fvVarSet . ruleFVs +rulesRhsFreeIds :: [CoreRule] -> VarSet +rulesRhsFreeIds = fvVarSet . filterFV isLocalId . rulesFVs RhsOnly --- | Those variables free in the both the left right hand sides of a rule --- returned as FV computation -ruleFVs :: CoreRule -> FV -ruleFVs (BuiltinRule {}) = emptyFV -ruleFVs (Rule { ru_fn = _do_not_include - -- See Note [Rule free var hack] - , ru_bndrs = bndrs - , ru_rhs = rhs, ru_args = args }) - = filterFV isLocalVar $ addBndrs bndrs (exprs_fvs (rhs:args)) +ruleLhsFreeIds :: CoreRule -> VarSet +-- ^ This finds all locally-defined free Ids on the left hand side of a rule +-- and returns them as a non-deterministic set +ruleLhsFreeIds = fvVarSet . filterFV isLocalId . ruleFVs LhsOnly --- | Those variables free in the both the left right hand sides of rules --- returned as FV computation -rulesFVs :: [CoreRule] -> FV -rulesFVs = mapUnionFV ruleFVs +ruleLhsFreeIdsList :: CoreRule -> [Var] +-- ^ This finds all locally-defined free Ids on the left hand side of a rule +-- and returns them as a deterministically ordered list +ruleLhsFreeIdsList = fvVarList . filterFV isLocalId . ruleFVs LhsOnly + +-- | Those variables free in the both the left right hand sides of a rule +-- returned as a non-deterministic set +ruleFreeVars :: CoreRule -> VarSet +ruleFreeVars = fvVarSet . ruleFVs BothSides -- | Those variables free in the both the left right hand sides of rules -- returned as a deterministic set rulesFreeVarsDSet :: [CoreRule] -> DVarSet -rulesFreeVarsDSet rules = fvDVarSet $ rulesFVs rules +rulesFreeVarsDSet rules = fvDVarSet $ rulesFVs BothSides rules + +-- | Those variables free in both the left right hand sides of several rules +rulesFreeVars :: [CoreRule] -> VarSet +rulesFreeVars rules = fvVarSet $ rulesFVs BothSides rules -- | Make a 'RuleInfo' containing a number of 'CoreRule's, suitable -- for putting into an 'IdInfo' mkRuleInfo :: [CoreRule] -> RuleInfo mkRuleInfo rules = RuleInfo rules (rulesFreeVarsDSet rules) +-- | Just the variables free on the *rhs* of a rule idRuleRhsVars :: (Activation -> Bool) -> Id -> VarSet --- Just the variables free on the *rhs* of a rule +-- SG: Seems very ad-hoc. Why doesn't this call ruleFV? It does something +-- with ru_fn, probably related to Hack [Rule free var hack]. idRuleRhsVars is_active id = mapUnionVarSet get_fvs (idCoreRules id) where @@ -503,35 +533,6 @@ idRuleRhsVars is_active id fvs = fvVarSet $ filterFV isLocalVar $ addBndrs bndrs (expr_fvs rhs) get_fvs _ = noFVs --- | Those variables free in the right hand side of several rules -rulesFreeVars :: [CoreRule] -> VarSet -rulesFreeVars rules = mapUnionVarSet ruleFreeVars rules - -ruleLhsFreeIds :: CoreRule -> VarSet --- ^ This finds all locally-defined free Ids on the left hand side of a rule --- and returns them as a non-deterministic set -ruleLhsFreeIds = fvVarSet . ruleLhsFVIds - -ruleLhsFreeIdsList :: CoreRule -> [Var] --- ^ This finds all locally-defined free Ids on the left hand side of a rule --- and returns them as a deterministically ordered list -ruleLhsFreeIdsList = fvVarList . ruleLhsFVIds - -ruleLhsFVIds :: CoreRule -> FV --- ^ This finds all locally-defined free Ids on the left hand side of a rule --- and returns an FV computation -ruleLhsFVIds (BuiltinRule {}) = emptyFV -ruleLhsFVIds (Rule { ru_bndrs = bndrs, ru_args = args }) - = filterFV isLocalId $ addBndrs bndrs (exprs_fvs args) - -ruleRhsFreeIds :: CoreRule -> VarSet --- ^ This finds all locally-defined free Ids on the left hand side of a rule --- and returns them as a non-deterministic set -ruleRhsFreeIds (BuiltinRule {}) = emptyVarSet -ruleRhsFreeIds (Rule { ru_bndrs = bndrs, ru_args = args }) - = fvVarSet $ filterFV isLocalId $ - addBndrs bndrs $ exprs_fvs args - {- Note [Rule free var hack] (Not a hack any more) ~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -661,6 +662,9 @@ idFVs id = ASSERT( isId id) bndrRuleAndUnfoldingVarsDSet :: Id -> DVarSet bndrRuleAndUnfoldingVarsDSet id = fvDVarSet $ bndrRuleAndUnfoldingFVs id +bndrRuleAndUnfoldingIds :: Id -> IdSet +bndrRuleAndUnfoldingIds id = fvVarSet $ filterFV isId $ bndrRuleAndUnfoldingFVs id + bndrRuleAndUnfoldingFVs :: Id -> FV bndrRuleAndUnfoldingFVs id | isId id = idRuleFVs id `unionFV` idUnfoldingFVs id ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -623,14 +623,6 @@ lintLetBind top_lvl rec_flag binder rhs rhs_ty || exprIsTickedString rhs) (badBndrTyMsg binder (text "unlifted")) - -- Check that if the binder is top-level or recursive, it's not - -- demanded. Primitive string literals are exempt as there is no - -- computation to perform, see Note [Core top-level string literals]. - ; checkL (not (isStrictId binder) - || (isNonRec rec_flag && not (isTopLevel top_lvl)) - || exprIsTickedString rhs) - (mkStrictMsg binder) - -- Check that if the binder is at the top level and has type Addr#, -- that it is a string literal, see -- Note [Core top-level string literals]. @@ -3119,13 +3111,6 @@ badBndrTyMsg binder what = vcat [ text "The type of this binder is" <+> what <> colon <+> ppr binder , text "Binder's type:" <+> ppr (idType binder) ] -mkStrictMsg :: Id -> MsgDoc -mkStrictMsg binder - = vcat [hsep [text "Recursive or top-level binder has strict demand info:", - ppr binder], - hsep [text "Binder's demand info:", ppr (idDemandInfo binder)] - ] - mkNonTopExportedMsg :: Id -> MsgDoc mkNonTopExportedMsg binder = hsep [text "Non-top-level binder is marked as exported:", ppr binder] ===================================== compiler/GHC/Core/Opt/CprAnal.hs ===================================== @@ -446,14 +446,13 @@ extendEnvForDataAlt env scrut case_bndr dc bndrs ids_w_strs = filter isId bndrs `zip` dataConRepStrictness dc - tycon = dataConTyCon dc - is_product = isJust (isDataProductTyCon_maybe tycon) - is_sum = isJust (isDataSumTyCon_maybe tycon) + is_algebraic = isJust (tyConAlgDataCons_maybe (dataConTyCon dc)) + no_exs = null (dataConExTyCoVars dc) case_bndr_ty - | is_product || is_sum = conCprType (dataConTag dc) - -- Any of the constructors had existentials. This is a little too - -- conservative (after all, we only care about the particular data con), - -- but there is no easy way to write is_sum and this won't happen much. + | is_algebraic, no_exs = conCprType (dataConTag dc) + -- The tycon wasn't algebraic or the datacon had existentials. + -- CPR'ing existentials would need first class existentials/dependent sums + -- to exploit, so we return topCprType here. | otherwise = topCprType -- We could have much deeper CPR info here with Nested CPR, which could ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -34,9 +34,10 @@ import GHC.Types.Id import GHC.Core.Utils import GHC.Core.TyCon import GHC.Core.Type -import GHC.Core.FVs ( exprFreeIds, ruleRhsFreeIds ) +import GHC.Core.FVs ( rulesRhsFreeIds, bndrRuleAndUnfoldingIds ) import GHC.Core.Coercion ( Coercion, coVarsOfCo ) import GHC.Core.FamInstEnv +import GHC.Core.Opt.Arity ( typeArity ) import GHC.Utils.Misc import GHC.Utils.Panic import GHC.Data.Maybe ( isJust ) @@ -64,28 +65,54 @@ data DmdAnalOpts = DmdAnalOpts -- -- Note: use `seqBinds` on the result to avoid leaks due to lazyness (cf Note -- [Stamp out space leaks in demand analysis]) -dmdAnalProgram :: DmdAnalOpts -> FamInstEnvs -> CoreProgram -> CoreProgram -dmdAnalProgram opts fam_envs binds = binds_plus_dmds - where - env = emptyAnalEnv opts fam_envs - binds_plus_dmds = snd $ mapAccumL dmdAnalTopBind env binds - --- Analyse a (group of) top-level binding(s) -dmdAnalTopBind :: AnalEnv - -> CoreBind - -> (AnalEnv, CoreBind) -dmdAnalTopBind env (NonRec id rhs) - = ( extendAnalEnv TopLevel env id sig - , NonRec (setIdStrictness id sig) rhs') +dmdAnalProgram :: DmdAnalOpts -> FamInstEnvs -> [CoreRule] -> CoreProgram -> CoreProgram +dmdAnalProgram opts fam_envs rules binds + = snd $ go (emptyAnalEnv opts fam_envs) binds where - ( _, sig, rhs') = dmdAnalRhsLetDown Nothing env topSubDmd id rhs - -dmdAnalTopBind env (Rec pairs) - = (env', Rec pairs') - where - (env', _, pairs') = dmdFix TopLevel env topSubDmd pairs - -- We get two iterations automatically - -- c.f. the NonRec case above + -- See Note [Analysing top-level bindings] + -- TLDR; We analyse them like + -- let ex1 = ... in (ex1, let nex1 = ... in let ex2 = ... in (ex2, ...))) + -- where ex* are exported (or RULE mentions) and nex* are not. + go _ [] = (nopDmdType, []) + go env (b:bs) = cons_up $ dmdAnalBind TopLevel env topSubDmd b anal_body + where + anal_body env' + | (body_ty, bs') <- go env' bs + = (add_exported_uses env' body_ty (bindersOf b), bs') + + cons_up :: (a, b, [b]) -> (a, [b]) + cons_up (dmd_ty, b', bs') = (dmd_ty, b':bs') + + add_exported_uses :: AnalEnv -> DmdType -> [Id] -> DmdType + add_exported_uses env = foldl' (add_exported_use env) + + -- | If @e@ is denoted by @dmd_ty@, then @add_exported_use _ dmd_ty id@ + -- corresponds to the demand type of @(id, e)@, but is a lot more direct. + -- See Note [Analysing top-level bindings]. + add_exported_use :: AnalEnv -> DmdType -> Id -> DmdType + add_exported_use env dmd_ty id + | isExportedId id || elemVarSet id rule_fvs + -- See Note [Absence analysis for stable unfoldings and RULES] + = dmd_ty `plusDmdType` fst (dmdAnalStar env topDmd (Var id)) + | otherwise = dmd_ty + + rule_fvs :: IdSet + rule_fvs = rulesRhsFreeIds rules + +-- | Whether we want to store demands on a top-level Id or just default +-- to 'topDmd'. +-- +-- Basically, we want to now how top-level *functions* are *used* +-- (e.g. called), but aren't interested in whether they were called strictly +-- or not. Other top-level bindings are boring. +isInterestingTopLevelFn :: Id -> Bool +-- SG tried to set this to True and got a +2% ghc/alloc regression in T5642 +-- (which is dominated by the Simplifier) at no gain in analysis precision. +-- If there was a gain, that regression might be acceptable. +-- Plus, we could use LetUp for thunks and share some code with local let +-- bindings. +isInterestingTopLevelFn id = + typeArity (idType id) `lengthExceeds` 0 {- Note [Stamp out space leaks in demand analysis] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -105,8 +132,56 @@ generation would hold on to an extra copy of the Core program, via unforced thunks in demand or strictness information; and it is the most memory-intensive part of the compilation process, so this added seqBinds makes a big difference in peak memory usage. --} +Note [Analysing top-level bindings] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider a CoreProgram like + e1 = ... + n1 = ... + e2 = \a b -> ... fst (n1 a b) ... + n2 = \c d -> ... snd (e2 c d) ... + ... +where e* are exported, but n* are not. +Intuitively, we can see that @n1@ is only ever called with two arguments +and in every call site, the first component of the result of the call +is evaluated. Thus, we'd like it to have idDemandInfo @UCU(C1(P(SU,A))@. + +(This can be exploited by a Nested CPR pass which may then unbox the +first component of the pair returned from @n1 at . Or if @n1@ had arity +1 before, we may now eta-expand to arity 2.) + +NB: We may *not* give e2 a similar annotation, because it is exported and +external callers might use it in arbitrary ways, expressed by 'topDmd'. + +How do we get this result? Answer: By analysing the program as if it was a let +expression of this form: + let e1 = ... in + (e1, let n1 = ... in + ( let e2 = ... in + (e2, let n2 = ... in + ( ...)))) +E.g. putting all bindings in nested lets, where whenever it binds an exported +binding, the body is a *pair* of an occurrence of the exported binder and +the other nested lets. Of course, we will not actually build that CoreExpr! +Instead we faithfully simulate analysis of said expression by adding the +free variable 'DmdEnv' of @e*@'s strictness signatures to the 'DmdType' we +get from analysing the nested bindings. + +You might also wonder why we didn't analyse in terms of the simpler + let e1 = ... in + let n1 = ... in + let e2 = ... in + let n2 = ... in + (e1,e2, ...) +The reason is analysis performance: If @e1@ uses many free variables, we'll +unnecessarily carry their demands around with us from the moment we analyse +the pair to the moment we bubble back up to the binding for @e1 at . +This blows up e.g. @T10370 at . + +A final note about variables occuring free in RULE RHSs: They are to be handled +pretty much like exported Ids. +See also Note [Absence analysis for stable unfoldings and RULES] +-} {- ************************************************************************ @@ -114,7 +189,105 @@ seqBinds makes a big difference in peak memory usage. \subsection{The analyser itself} * * ************************************************************************ +-} + +-- | Analyse a binding group and its \"body\", e.g. where it is in scope. +-- +-- It calls a function that knows how to analyse this \"body\" given +-- an 'AnalEnv' with updated demand signatures for the binding group +-- (reflecting their 'idStrictnessInfo') and expects to receive a +-- 'DmdType' in return, which it uses to annotate the binding group with their +-- 'idDemandInfo'. +dmdAnalBind + :: TopLevelFlag + -> AnalEnv + -> SubDemand -- ^ Demand put on the "body" + -- (important for join points) + -> CoreBind + -> (AnalEnv -> (DmdType, a)) -- ^ How to analyse the "body", e.g. + -- where the binding is in scope + -> (DmdType, CoreBind, a) +dmdAnalBind top_lvl env dmd bind anal_body = case bind of + NonRec id rhs + | useLetUp top_lvl id + -> dmdAnalBindLetUp top_lvl env id rhs anal_body + _ -> dmdAnalBindLetDown top_lvl env dmd bind anal_body + +-- | Annotates uninteresting top level functions ('isInterestingTopLevelFn') +-- with 'topDmd', the rest with the given demand. +setBindIdDemandInfo :: TopLevelFlag -> Id -> Demand -> Id +setBindIdDemandInfo top_lvl id dmd = setIdDemandInfo id $ case top_lvl of + TopLevel | not (isInterestingTopLevelFn id) -> topDmd + _ -> dmd + +-- | Let bindings can be processed in two ways: +-- Down (RHS before body) or Up (body before RHS). +-- This function handles the up variant. +-- +-- It is very simple. For let x = rhs in body +-- * Demand-analyse 'body' in the current environment +-- * Find the demand, 'rhs_dmd' placed on 'x' by 'body' +-- * Demand-analyse 'rhs' in 'rhs_dmd' +-- +-- This is used for a non-recursive local let without manifest lambdas (see +-- 'useLetUp'). +-- +-- This is the LetUp rule in the paper “Higher-Order Cardinality Analysis”. +dmdAnalBindLetUp :: TopLevelFlag -> AnalEnv -> Id -> CoreExpr -> (AnalEnv -> (DmdType, a)) -> (DmdType, CoreBind, a) +dmdAnalBindLetUp top_lvl env id rhs anal_body = (final_ty, NonRec id' rhs', body') + where + (body_ty, body') = anal_body env + (body_ty', id_dmd) = findBndrDmd env notArgOfDfun body_ty id + id' = setBindIdDemandInfo top_lvl id id_dmd + (rhs_ty, rhs') = dmdAnalStar env (dmdTransformThunkDmd rhs id_dmd) rhs + -- See Note [Absence analysis for stable unfoldings and RULES] + rule_fvs = bndrRuleAndUnfoldingIds id + final_ty = body_ty' `plusDmdType` rhs_ty `keepAliveDmdType` rule_fvs + +-- | Let bindings can be processed in two ways: +-- Down (RHS before body) or Up (body before RHS). +-- This function handles the down variant. +-- +-- It computes a demand signature (by means of 'dmdAnalRhsSig') and uses +-- that at call sites in the body. +-- +-- It is used for toplevel definitions, recursive definitions and local +-- non-recursive definitions that have manifest lambdas (cf. 'useLetUp'). +-- Local non-recursive definitions without a lambda are handled with LetUp. +-- +-- This is the LetDown rule in the paper “Higher-Order Cardinality Analysis”. +dmdAnalBindLetDown :: TopLevelFlag -> AnalEnv -> SubDemand -> CoreBind -> (AnalEnv -> (DmdType, a)) -> (DmdType, CoreBind, a) +dmdAnalBindLetDown top_lvl env dmd bind anal_body = case bind of + NonRec id rhs + | (env', lazy_fv, id1, rhs1) <- + dmdAnalRhsSig top_lvl NonRecursive env dmd id rhs + -> do_rest env' lazy_fv [(id1, rhs1)] (uncurry NonRec . only) + Rec pairs + | (env', lazy_fv, pairs') <- dmdFix top_lvl env dmd pairs + -> do_rest env' lazy_fv pairs' Rec + where + do_rest env' lazy_fv pairs1 build_bind = (final_ty, build_bind pairs2, body') + where + (body_ty, body') = anal_body env' + -- see Note [Lazy and unleashable free variables] + dmd_ty = addLazyFVs body_ty lazy_fv + (!final_ty, id_dmds) = findBndrsDmds env' dmd_ty (map fst pairs1) + pairs2 = zipWith do_one pairs1 id_dmds + do_one (id', rhs') dmd = (setBindIdDemandInfo top_lvl id' dmd, rhs') + -- If the actual demand is better than the vanilla call + -- demand, you might think that we might do better to re-analyse + -- the RHS with the stronger demand. + -- But (a) That seldom happens, because it means that *every* path in + -- the body of the let has to use that stronger demand + -- (b) It often happens temporarily in when fixpointing, because + -- the recursive function at first seems to place a massive demand. + -- But we don't want to go to extra work when the function will + -- probably iterate to something less demanding. + -- In practice, all the times the actual demand on id2 is more than + -- the vanilla call demand seem to be due to (b). So we don't + -- bother to re-analyse the RHS. +{- Note [Ensure demand is strict] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ It's important not to analyse e with a lazy demand because @@ -194,7 +367,7 @@ dmdAnal' env dmd (App fun arg) -- Crucially, coercions /are/ handled here, because they are -- value arguments (#10288) let - call_dmd = mkCallDmd dmd + call_dmd = mkCalledOnceDmd dmd (fun_ty, fun') = dmdAnal env call_dmd fun (arg_dmd, res_ty) = splitDmdTy fun_ty (arg_ty, arg') = dmdAnalStar env (dmdTransformThunkDmd arg arg_dmd) arg @@ -227,8 +400,8 @@ dmdAnal' env dmd (Lam var body) dmdAnal' env dmd (Case scrut case_bndr ty [(alt, bndrs, rhs)]) -- Only one alternative. - -- If it's a DataAlt, it should be a product constructor. - | is_non_sum_alt alt + -- If it's a DataAlt, it should be the only constructor of the type. + | is_single_data_alt alt = let (rhs_ty, rhs') = dmdAnal env dmd rhs (alt_ty1, dmds) = findBndrsDmds env rhs_ty bndrs @@ -267,8 +440,8 @@ dmdAnal' env dmd (Case scrut case_bndr ty [(alt, bndrs, rhs)]) -- , text "res_ty" <+> ppr res_ty ]) $ (res_ty, Case scrut' case_bndr' ty [(alt, bndrs', rhs')]) where - is_non_sum_alt (DataAlt dc) = isJust $ isDataProductTyCon_maybe $ dataConTyCon dc - is_non_sum_alt _ = True + is_single_data_alt (DataAlt dc) = isJust $ tyConSingleAlgDataCon_maybe $ dataConTyCon dc + is_single_data_alt _ = True dmdAnal' env dmd (Case scrut case_bndr ty alts) = let -- Case expression with multiple alternatives @@ -295,60 +468,11 @@ dmdAnal' env dmd (Case scrut case_bndr ty alts) -- , text "res_ty" <+> ppr res_ty ]) $ (res_ty, Case scrut' case_bndr' ty alts') --- Let bindings can be processed in two ways: --- Down (RHS before body) or Up (body before RHS). --- The following case handle the up variant. --- --- It is very simple. For let x = rhs in body --- * Demand-analyse 'body' in the current environment --- * Find the demand, 'rhs_dmd' placed on 'x' by 'body' --- * Demand-analyse 'rhs' in 'rhs_dmd' --- --- This is used for a non-recursive local let without manifest lambdas. --- This is the LetUp rule in the paper “Higher-Order Cardinality Analysis”. -dmdAnal' env dmd (Let (NonRec id rhs) body) - | useLetUp id - = (final_ty, Let (NonRec id' rhs') body') +dmdAnal' env dmd (Let bind body) + = (final_ty, Let bind' body') where - (body_ty, body') = dmdAnal env dmd body - (body_ty', id_dmd) = findBndrDmd env notArgOfDfun body_ty id - id' = setIdDemandInfo id id_dmd - - (rhs_ty, rhs') = dmdAnalStar env (dmdTransformThunkDmd rhs id_dmd) rhs - final_ty = body_ty' `plusDmdType` rhs_ty - -dmdAnal' env dmd (Let (NonRec id rhs) body) - = (body_ty2, Let (NonRec id2 rhs') body') - where - (lazy_fv, sig, rhs') = dmdAnalRhsLetDown Nothing env dmd id rhs - id1 = setIdStrictness id sig - env1 = extendAnalEnv NotTopLevel env id sig - (body_ty, body') = dmdAnal env1 dmd body - (body_ty1, id2) = annotateBndr env body_ty id1 - body_ty2 = addLazyFVs body_ty1 lazy_fv -- see Note [Lazy and unleashable free variables] - - -- If the actual demand is better than the vanilla call - -- demand, you might think that we might do better to re-analyse - -- the RHS with the stronger demand. - -- But (a) That seldom happens, because it means that *every* path in - -- the body of the let has to use that stronger demand - -- (b) It often happens temporarily in when fixpointing, because - -- the recursive function at first seems to place a massive demand. - -- But we don't want to go to extra work when the function will - -- probably iterate to something less demanding. - -- In practice, all the times the actual demand on id2 is more than - -- the vanilla call demand seem to be due to (b). So we don't - -- bother to re-analyse the RHS. - -dmdAnal' env dmd (Let (Rec pairs) body) - = let - (env', lazy_fv, pairs') = dmdFix NotTopLevel env dmd pairs - (body_ty, body') = dmdAnal env' dmd body - body_ty1 = deleteFVs body_ty (map fst pairs) - body_ty2 = addLazyFVs body_ty1 lazy_fv -- see Note [Lazy and unleashable free variables] - in - body_ty2 `seq` - (body_ty2, Let (Rec pairs') body') + (final_ty, bind', body') = dmdAnalBind NotTopLevel env dmd bind go' + go' env' = dmdAnal env' dmd body -- | A simple, syntactic analysis of whether an expression MAY throw a precise -- exception when evaluated. It's always sound to return 'True'. @@ -377,10 +501,11 @@ forcesRealWorld :: FamInstEnvs -> Type -> Bool forcesRealWorld fam_envs ty | ty `eqType` realWorldStatePrimTy = True - | Just DataConAppContext{ dcac_dc = dc, dcac_arg_tys = field_tys } + | Just DataConAppContext{ dcac_dc = dc, dcac_tc_args = tc_args } <- deepSplitProductType_maybe fam_envs ty , isUnboxedTupleDataCon dc - = any (\(ty,_) -> scaledThing ty `eqType` realWorldStatePrimTy) field_tys + , let field_tys = dataConInstArgTys dc tc_args + = any (eqType realWorldStatePrimTy . scaledThing) field_tys | otherwise = False @@ -582,9 +707,13 @@ dmdTransform env var dmd | Just (sig, top_lvl) <- lookupSigEnv env var , let fn_ty = dmdTransformSig sig dmd = -- pprTrace "dmdTransform:LetDown" (vcat [ppr var, ppr sig, ppr dmd, ppr fn_ty]) $ - if isTopLevel top_lvl - then fn_ty -- Don't record demand on top-level things - else addVarDmd fn_ty var (C_11 :* dmd) + case top_lvl of + NotTopLevel -> addVarDmd fn_ty var (C_11 :* dmd) + TopLevel + | isInterestingTopLevelFn var + -> addVarDmd fn_ty var (C_0N `multDmd` (C_11 :* dmd)) -- discard strictness + | otherwise + -> fn_ty -- don't bother tracking; just annotate with 'topDmd' later -- Everything else: -- * Local let binders for which we use LetUp (cf. 'useLetUp') -- * Lambda binders @@ -599,46 +728,46 @@ dmdTransform env var dmd * * ********************************************************************* -} --- Let bindings can be processed in two ways: --- Down (RHS before body) or Up (body before RHS). --- dmdAnalRhsLetDown implements the Down variant: --- * assuming a demand of +-- | @dmdAnalRhsSig@ analyses the given RHS to compute a demand signature +-- for the LetDown rule. It works as follows: +-- +-- * assuming a demand of -- * looking at the definition -- * determining a strictness signature -- --- It is used for toplevel definition, recursive definitions and local --- non-recursive definitions that have manifest lambdas. --- Local non-recursive definitions without a lambda are handled with LetUp. --- --- This is the LetDown rule in the paper “Higher-Order Cardinality Analysis”. -dmdAnalRhsLetDown - :: Maybe [Id] -- Just bs <=> recursive, Nothing <=> non-recursive +-- Since it assumed a demand of , the resulting signature is applicable at +-- any call site. +dmdAnalRhsSig + :: TopLevelFlag + -> RecFlag -> AnalEnv -> SubDemand -> Id -> CoreExpr - -> (DmdEnv, StrictSig, CoreExpr) + -> (AnalEnv, DmdEnv, Id, CoreExpr) -- Process the RHS of the binding, add the strictness signature -- to the Id, and augment the environment with the signature as well. -- See Note [NOINLINE and strictness] -dmdAnalRhsLetDown rec_flag env let_dmd id rhs - = -- pprTrace "dmdAnalRhsLetDown" (ppr id $$ ppr let_dmd $$ ppr sig $$ ppr lazy_fv) $ - (lazy_fv, sig, rhs') +dmdAnalRhsSig top_lvl rec_flag env let_dmd id rhs + = -- pprTrace "dmdAnalRhsSig" (ppr id $$ ppr let_dmd $$ ppr sig $$ ppr lazy_fv) $ + (env', lazy_fv, id', rhs') where rhs_arity = idArity id + -- See Note [Demand signatures are computed for a threshold demand based on idArity] rhs_dmd -- See Note [Demand analysis for join points] -- See Note [Invariants on join points] invariant 2b, in GHC.Core -- rhs_arity matches the join arity of the join point | isJoinId id - = mkCallDmds rhs_arity let_dmd + = mkCalledOnceDmds rhs_arity let_dmd | otherwise - -- NB: rhs_arity - -- See Note [Demand signatures are computed for a threshold demand based on idArity] - = mkRhsDmd env rhs_arity rhs + = mkCalledOnceDmds rhs_arity topSubDmd (rhs_dmd_ty, rhs') = dmdAnal env rhs_dmd rhs DmdType rhs_fv rhs_dmds rhs_div = rhs_dmd_ty sig = mkStrictSigForArity rhs_arity (DmdType sig_fv rhs_dmds rhs_div) + id' = id `setIdStrictness` sig + env' = extendAnalEnv top_lvl env id' sig + -- See Note [Aggregated demand for cardinality] -- FIXME: That Note doesn't explain the following lines at all. The reason -- is really much different: When we have a recursive function, we'd @@ -651,31 +780,15 @@ dmdAnalRhsLetDown rec_flag env let_dmd id rhs -- we'd have to do an additional iteration. reuseEnv makes sure that -- we never get used-once info for FVs of recursive functions. rhs_fv1 = case rec_flag of - Just bs -> reuseEnv (delVarEnvList rhs_fv bs) - Nothing -> rhs_fv + Recursive -> reuseEnv rhs_fv + NonRecursive -> rhs_fv - rhs_fv2 = rhs_fv1 `keepAliveDmdEnv` extra_fvs - -- Find the RHS free vars of the unfoldings and RULES -- See Note [Absence analysis for stable unfoldings and RULES] - extra_fvs = foldr (unionVarSet . ruleRhsFreeIds) unf_fvs $ - idCoreRules id + rhs_fv2 = rhs_fv1 `keepAliveDmdEnv` bndrRuleAndUnfoldingIds id -- See Note [Lazy and unleashable free variables] (lazy_fv, sig_fv) = partitionVarEnv isWeakDmd rhs_fv2 - unf = realIdUnfolding id - unf_fvs | isStableUnfolding unf - , Just unf_body <- maybeUnfoldingTemplate unf - = exprFreeIds unf_body - | otherwise = emptyVarSet - --- | @mkRhsDmd env rhs_arity rhs@ creates a 'SubDemand' for --- unleashing on the given function's @rhs@, by creating --- a call demand of @rhs_arity@ --- See Historical Note [Product demands for function body] -mkRhsDmd :: AnalEnv -> Arity -> CoreExpr -> SubDemand -mkRhsDmd _env rhs_arity _rhs = mkCallDmds rhs_arity topSubDmd - -- | If given the (local, non-recursive) let-bound 'Id', 'useLetUp' determines -- whether we should process the binding up (body before rhs) or down (rhs -- before body). @@ -720,8 +833,8 @@ mkRhsDmd _env rhs_arity _rhs = mkCallDmds rhs_arity topSubDmd -- * For a more convincing example with join points, see Note [Demand analysis -- for join points]. -- -useLetUp :: Var -> Bool -useLetUp f = idArity f == 0 && not (isJoinId f) +useLetUp :: TopLevelFlag -> Var -> Bool +useLetUp top_lvl f = isNotTopLevel top_lvl && idArity f == 0 && not (isJoinId f) {- Note [Demand analysis for join points] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -939,8 +1052,6 @@ dmdFix :: TopLevelFlag dmdFix top_lvl env let_dmd orig_pairs = loop 1 initial_pairs where - bndrs = map fst orig_pairs - -- See Note [Initialising strictness] initial_pairs | ae_virgin env = [(setIdStrictness id botSig, rhs) | (id, rhs) <- orig_pairs ] | otherwise = orig_pairs @@ -990,10 +1101,8 @@ dmdFix top_lvl env let_dmd orig_pairs = -- pprTrace "my_downRhs" (ppr id $$ ppr (idStrictness id) $$ ppr sig) $ ((env', lazy_fv'), (id', rhs')) where - (lazy_fv1, sig, rhs') = dmdAnalRhsLetDown (Just bndrs) env let_dmd id rhs - lazy_fv' = plusVarEnv_C plusDmd lazy_fv lazy_fv1 - env' = extendAnalEnv top_lvl env id sig - id' = setIdStrictness id sig + (env', lazy_fv1, id', rhs') = dmdAnalRhsSig top_lvl Recursive env let_dmd id rhs + lazy_fv' = plusVarEnv_C plusDmd lazy_fv lazy_fv1 zapIdStrictness :: [(Id, CoreExpr)] -> [(Id, CoreExpr)] zapIdStrictness pairs = [(setIdStrictness id nopSig, rhs) | (id, rhs) <- pairs ] @@ -1090,7 +1199,7 @@ addLazyFVs dmd_ty lazy_fvs -- demand with the bottom coming up from 'error' -- -- I got a loop in the fixpointer without this, due to an interaction - -- with the lazy_fv filtering in dmdAnalRhsLetDown. Roughly, it was + -- with the lazy_fv filtering in dmdAnalRhsSig. Roughly, it was -- letrec f n x -- = letrec g y = x `fatbar` -- letrec h z = z + ...g... @@ -1156,10 +1265,6 @@ annotateLamIdBndr env arg_of_dfun dmd_ty id main_ty = addDemand dmd dmd_ty' (dmd_ty', dmd) = findBndrDmd env arg_of_dfun dmd_ty id -deleteFVs :: DmdType -> [Var] -> DmdType -deleteFVs (DmdType fvs dmds res) bndrs - = DmdType (delVarEnvList fvs bndrs) dmds res - {- Note [NOINLINE and strictness] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Core/Opt/Pipeline.hs ===================================== @@ -65,6 +65,7 @@ import GHC.Types.SrcLoc import GHC.Types.Id import GHC.Types.Id.Info import GHC.Types.Basic +import GHC.Types.Demand ( zapDmdEnvSig ) import GHC.Types.Var.Set import GHC.Types.Var.Env import GHC.Types.Unique.Supply ( UniqSupply, mkSplitUniqSupply, splitUniqSupply ) @@ -495,7 +496,7 @@ doCorePass CoreDoExitify = {-# SCC "Exitify" #-} doPass exitifyProgram doCorePass CoreDoDemand = {-# SCC "DmdAnal" #-} - doPassDFM dmdAnal + doPassDFRM dmdAnal doCorePass CoreDoCpr = {-# SCC "CprAnal" #-} doPassDFM cprAnalProgram @@ -575,6 +576,13 @@ doPassDFM do_pass guts = do let fam_envs = (p_fam_env, mg_fam_inst_env guts) doPassM (liftIO . do_pass dflags fam_envs) guts +doPassDFRM :: (DynFlags -> FamInstEnvs -> [CoreRule] -> CoreProgram -> IO CoreProgram) -> ModGuts -> CoreM ModGuts +doPassDFRM do_pass guts = do + dflags <- getDynFlags + p_fam_env <- getPackageFamInstEnv + let fam_envs = (p_fam_env, mg_fam_inst_env guts) + doPassM (liftIO . do_pass dflags fam_envs (mg_rules guts)) guts + doPassDFU :: (DynFlags -> FamInstEnvs -> UniqSupply -> CoreProgram -> CoreProgram) -> ModGuts -> CoreM ModGuts doPassDFU do_pass guts = do dflags <- getDynFlags @@ -1088,13 +1096,13 @@ transferIdInfo exported_id local_id -dmdAnal :: DynFlags -> FamInstEnvs -> CoreProgram -> IO CoreProgram -dmdAnal dflags fam_envs binds = do +dmdAnal :: DynFlags -> FamInstEnvs -> [CoreRule] -> CoreProgram -> IO CoreProgram +dmdAnal dflags fam_envs rules binds = do let opts = DmdAnalOpts { dmd_strict_dicts = gopt Opt_DictsStrict dflags } - binds_plus_dmds = dmdAnalProgram opts fam_envs binds + binds_plus_dmds = dmdAnalProgram opts fam_envs rules binds Err.dumpIfSet_dyn dflags Opt_D_dump_str_signatures "Strictness signatures" FormatText $ - dumpIdInfoOfProgram (ppr . strictnessInfo) binds_plus_dmds + dumpIdInfoOfProgram (ppr . zapDmdEnvSig . strictnessInfo) binds_plus_dmds -- See Note [Stamp out space leaks in demand analysis] in GHC.Core.Opt.DmdAnal seqBinds binds_plus_dmds `seq` return binds_plus_dmds ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -598,11 +598,10 @@ addJoinFlts = appOL mkRecFloats :: SimplFloats -> SimplFloats -- Flattens the floats into a single Rec group, -- They must either all be lifted LetFloats or all JoinFloats -mkRecFloats floats@(SimplFloats { sfLetFloats = LetFloats bs ff +mkRecFloats floats@(SimplFloats { sfLetFloats = LetFloats bs _ff , sfJoinFloats = jbs , sfInScope = in_scope }) - = ASSERT2( case ff of { FltLifted -> True; _ -> False }, ppr (fromOL bs) ) - ASSERT2( isNilOL bs || isNilOL jbs, ppr floats ) + = ASSERT2( isNilOL bs || isNilOL jbs, ppr floats ) SimplFloats { sfLetFloats = floats' , sfJoinFloats = jfloats' , sfInScope = in_scope } ===================================== compiler/GHC/Core/Opt/WorkWrap.hs ===================================== @@ -484,7 +484,7 @@ tryWW dflags fam_envs is_rec fn_id rhs | is_fun && is_eta_exp = splitFun dflags fam_envs new_fn_id fn_info wrap_dmds div cpr rhs - | is_thunk -- See Note [Thunk splitting] + | isNonRec is_rec, is_thunk -- See Note [Thunk splitting] = splitThunk dflags fam_envs is_rec new_fn_id rhs | otherwise ===================================== compiler/GHC/Core/Opt/WorkWrap/Utils.hs ===================================== @@ -609,50 +609,75 @@ mkWWstr_one dflags fam_envs has_inlineable_prag arg wantToUnbox :: FamInstEnvs -> Bool -> Type -> Demand -> Maybe ([Demand], DataConAppContext) wantToUnbox fam_envs has_inlineable_prag ty dmd = case deepSplitProductType_maybe fam_envs ty of - Just dcac at DataConAppContext{ dcac_arg_tys = con_arg_tys } + Just dcac at DataConAppContext{ dcac_dc = dc } | isStrUsedDmd dmd + , let arity = dataConRepArity dc -- See Note [Unpacking arguments with product and polymorphic demands] - , Just cs <- split_prod_dmd_arity dmd (length con_arg_tys) + , Just cs <- split_prod_dmd_arity dmd arity -- See Note [Do not unpack class dictionaries] , not (has_inlineable_prag && isClassPred ty) -- See Note [mkWWstr and unsafeCoerce] - , cs `equalLength` con_arg_tys + , cs `lengthIs` arity -> Just (cs, dcac) _ -> Nothing where - split_prod_dmd_arity dmd arty + split_prod_dmd_arity dmd arity -- For seqDmd, it should behave like , for some -- suitable arity - | isSeqDmd dmd = Just (replicate arty absDmd) + | isSeqDmd dmd = Just (replicate arity absDmd) | _ :* Prod ds <- dmd = Just ds | otherwise = Nothing +-- | Like 'dataConInstArgTys', but handles existentials by cloning and returning +-- the freshened 'TyCoVar's in addition to the instantiated argument types. +-- +-- The cloning needs a 'UniqSupply'. +dataConCloneExAndInstArgTys :: DataCon -> [Type] -> UniqSupply -> ([TyCoVar], [Scaled Type]) +dataConCloneExAndInstArgTys dc tc_args us = (ex_tvs', arg_tys) + where + subst_univ = zipTvSubst (dataConUnivTyVars dc) tc_args + (subst, ex_tvs') = cloneTyVarBndrs subst_univ (dataConExTyCoVars dc) us + -- the following line is straight from 'dataConInstArgTys' + arg_tys = mapScaledType (substTy subst) <$> dataConRepArgTys dc + +-- | Exactly 'dataConInstArgTys', but lacks the (ASSERT'ed) precondition that +-- the 'DataCon' may not have existentials. The lack of cloning the existentials +-- compared to 'dataConCloneExAndInstArgTys' makes this function \"dubious\"; +-- only use it where type variables aren't substituted! +dubiousDataConInstArgTys :: DataCon -> [Type] -> [Scaled Type] +dubiousDataConInstArgTys dc tc_args = arg_tys + where + univ_tvs = dataConUnivTyVars dc + ex_tvs = dataConExTyCoVars dc + subst = extendTCvInScopeList (zipTvSubst univ_tvs tc_args) ex_tvs + arg_tys = mapScaledType (substTy subst) <$> dataConRepArgTys dc + unbox_one :: DynFlags -> FamInstEnvs -> Var -> [Demand] -> DataConAppContext -> UniqSM (Bool, [Var], CoreExpr -> CoreExpr, CoreExpr -> CoreExpr) unbox_one dflags fam_envs arg cs - DataConAppContext { dcac_dc = data_con, dcac_tys = inst_tys - , dcac_arg_tys = inst_con_arg_tys + DataConAppContext { dcac_dc = dc, dcac_tc_args = tc_args , dcac_co = co } - = do { (uniq1:uniqs) <- getUniquesM - ; let scale = scaleScaled (idMult arg) - scaled_inst_con_arg_tys = map (\(t,s) -> (scale t, s)) inst_con_arg_tys - -- See Note [Add demands for strict constructors] - cs' = addDataConStrictness data_con cs - unpk_args = zipWith3 mk_ww_arg uniqs scaled_inst_con_arg_tys cs' - unbox_fn = mkUnpackCase (Var arg) co (idMult arg) uniq1 - data_con unpk_args - arg_no_unf = zapStableUnfolding arg - -- See Note [Zap unfolding when beta-reducing] - -- in GHC.Core.Opt.Simplify; and see #13890 - rebox_fn = Let (NonRec arg_no_unf con_app) - con_app = mkConApp2 data_con inst_tys unpk_args `mkCast` mkSymCo co - ; (_, worker_args, wrap_fn, work_fn) <- mkWWstr dflags fam_envs False unpk_args - ; return (True, worker_args, unbox_fn . wrap_fn, work_fn . rebox_fn) } - -- Don't pass the arg, rebox instead - where - mk_ww_arg uniq ty sub_dmd = setIdDemandInfo (mk_ww_local uniq ty) sub_dmd + = do { (ex_tvs', arg_tys) <- dataConCloneExAndInstArgTys dc tc_args <$> getUniqueSupplyM + ; (case_bndr_uniq:arg_uniqs) <- getUniquesM + ; let scaled_arg_tys = map (scaleScaled (idMult arg)) arg_tys + str_marks = dataConRepStrictness dc + -- See Note [Add demands for strict constructors] + cs' = addDataConStrictness dc cs + arg_ids = zipWithEqual "unbox_one" setIdDemandInfo + (zipWith3 mk_ww_local arg_uniqs str_marks scaled_arg_tys) + cs' + unbox_fn = mkUnpackCase (Var arg) co (idMult arg) case_bndr_uniq + dc (ex_tvs' ++ arg_ids) + arg_no_unf = zapStableUnfolding arg + -- See Note [Zap unfolding when beta-reducing] + -- in GHC.Core.Opt.Simplify; and see #13890 + rebox_fn = Let (NonRec arg_no_unf con_app) + con_app = mkConApp2 dc tc_args (ex_tvs' ++ arg_ids) `mkCast` mkSymCo co + ; (_, worker_args, wrap_fn, work_fn) <- mkWWstr dflags fam_envs False (ex_tvs' ++ arg_ids) + ; return (True, worker_args, unbox_fn . wrap_fn, work_fn . rebox_fn) } + -- Don't pass the arg, rebox instead ---------------------- nop_fn :: CoreExpr -> CoreExpr @@ -932,72 +957,67 @@ off the unpacking in mkWWstr_one (see the isClassPred test). Historical note: #14955 describes how I got this fix wrong the first time. -} --- | Context for a 'DataCon' application with a hole for every field, including --- surrounding coercions. +-- | Context for a 'DataCon' application wrapped in a cast, where we know the +-- type arguments of the 'TyCon' but not any of the arguments to the 'DataCon' +-- (type or term). +-- -- The result of 'deepSplitProductType_maybe' and 'deepSplitCprType_maybe'. -- -- Example: -- --- > DataConAppContext Just [Int] [(Lazy, Int)] (co :: Maybe Int ~ First Int) +-- > DataConAppContext Just [Int] (co :: Maybe Int ~ First Int) -- -- represents -- --- > Just @Int (_1 :: Int) |> co :: First Int +-- > (Just @_1 _2 :: Maybe Int) |> co :: First Int -- --- where _1 is a hole for the first argument. The number of arguments is --- determined by the length of @arg_tys at . data DataConAppContext = DataConAppContext - { dcac_dc :: !DataCon - , dcac_tys :: ![Type] - , dcac_arg_tys :: ![(Scaled Type, StrictnessMark)] - , dcac_co :: !Coercion + { dcac_dc :: !DataCon + , dcac_tc_args :: ![Type] + , dcac_co :: !Coercion } +-- | If @deepSplitProductType_maybe ty = Just (dc, tys, co)@ +-- then @dc \@tys \@_ex_tys (_args::_arg_tys) :: tc tys@ +-- and @co :: ty ~ tc tys@ +-- where underscore prefixes are holes, e.g. yet unspecified. deepSplitProductType_maybe :: FamInstEnvs -> Type -> Maybe DataConAppContext --- If deepSplitProductType_maybe ty = Just (dc, tys, arg_tys, co) --- then dc @ tys (args::arg_tys) :: rep_ty --- co :: ty ~ rep_ty --- Why do we return the strictness of the data-con arguments? --- Answer: see Note [Record evaluated-ness in worker/wrapper] deepSplitProductType_maybe fam_envs ty | let (co, ty1) = topNormaliseType_maybe fam_envs ty `orElse` (mkRepReflCo ty, ty) , Just (tc, tc_args) <- splitTyConApp_maybe ty1 - , Just con <- isDataProductTyCon_maybe tc - , let arg_tys = dataConInstArgTys con tc_args - strict_marks = dataConRepStrictness con - = Just DataConAppContext { dcac_dc = con - , dcac_tys = tc_args - , dcac_arg_tys = zipEqual "dspt" arg_tys strict_marks - , dcac_co = co } + , Just con <- tyConSingleAlgDataCon_maybe tc + = Just DataConAppContext { dcac_dc = con + , dcac_tc_args = tc_args + , dcac_co = co } deepSplitProductType_maybe _ _ = Nothing -deepSplitCprType_maybe - :: FamInstEnvs -> ConTag -> Type -> Maybe DataConAppContext --- If deepSplitCprType_maybe n ty = Just (dc, tys, arg_tys, co) --- then dc @ tys (args::arg_tys) :: rep_ty --- co :: ty ~ rep_ty --- Why do we return the strictness of the data-con arguments? --- Answer: see Note [Record evaluated-ness in worker/wrapper] +-- | If @deepSplitCprType_maybe n ty = Just (dc, tys, co)@ +-- then @dc \@tys \@_ex_tys (_args::_arg_tys) :: tc tys@ +-- and @co :: ty ~ tc tys@ +-- where underscore prefixes are holes, e.g. yet unspecified. +-- @dc@ is the @n at th data constructor of @tc at . +deepSplitCprType_maybe :: FamInstEnvs -> ConTag -> Type -> Maybe DataConAppContext deepSplitCprType_maybe fam_envs con_tag ty | let (co, ty1) = topNormaliseType_maybe fam_envs ty `orElse` (mkRepReflCo ty, ty) , Just (tc, tc_args) <- splitTyConApp_maybe ty1 - , isDataTyCon tc + , isDataTyCon tc -- NB: rules out unboxed sums and pairs! , let cons = tyConDataCons tc , cons `lengthAtLeast` con_tag -- This might not be true if we import the - -- type constructor via a .hs-bool file (#8743) + -- type constructor via a .hs-boot file (#8743) , let con = cons `getNth` (con_tag - fIRST_TAG) - arg_tys = dataConInstArgTys con tc_args - strict_marks = dataConRepStrictness con - , all isLinear arg_tys + , null (dataConExTyCoVars con) -- no existentials; + -- See Note [Product types] in "GHC.Core.TyCon" + -- and GHC.Core.Opt.CprAnal.extendEnvForDataAlt + -- where we also check this. + , all isLinear (dataConInstArgTys con tc_args) -- Deactivates CPR worker/wrapper splits on constructors with non-linear -- arguments, for the moment, because they require unboxed tuple with variable -- multiplicity fields. = Just DataConAppContext { dcac_dc = con - , dcac_tys = tc_args - , dcac_arg_tys = zipEqual "dspt" arg_tys strict_marks + , dcac_tc_args = tc_args , dcac_co = co } deepSplitCprType_maybe _ _ _ = Nothing @@ -1035,13 +1055,15 @@ findTypeShape fam_envs ty | Just (_, rhs, _) <- topReduceTyFamApp_maybe fam_envs tc tc_args = go rec_tc rhs - | Just con <- isDataProductTyCon_maybe tc + | Just con <- tyConSingleAlgDataCon_maybe tc , Just rec_tc <- if isTupleTyCon tc then Just rec_tc else checkRecTc rec_tc tc -- We treat tuples specially because they can't cause loops. -- Maybe we should do so in checkRecTc. - = TsProd (map (go rec_tc . scaledThing) (dataConInstArgTys con tc_args)) + -- The use of 'dubiousDataConInstArgTys' is OK, since this + -- function performs no substitution at all. + = TsProd (map (go rec_tc . scaledThing) (dubiousDataConInstArgTys con tc_args)) | Just (ty', _) <- instNewTyCon_maybe tc tc_args , Just rec_tc <- checkRecTc rec_tc tc @@ -1093,25 +1115,26 @@ mkWWcpr opt_CprAnal fam_envs body_ty cpr mkWWcpr_help :: DataConAppContext -> UniqSM (Bool, CoreExpr -> CoreExpr, CoreExpr -> CoreExpr, Type) -mkWWcpr_help (DataConAppContext { dcac_dc = data_con, dcac_tys = inst_tys - , dcac_arg_tys = arg_tys, dcac_co = co }) - | [arg1@(arg_ty1, _)] <- arg_tys - , isUnliftedType (scaledThing arg_ty1) - , isLinear arg_ty1 +mkWWcpr_help (DataConAppContext { dcac_dc = dc, dcac_tc_args = tc_args + , dcac_co = co }) + | [arg_ty] <- arg_tys + , [str_mark] <- str_marks + , isUnliftedType (scaledThing arg_ty) + , isLinear arg_ty -- Special case when there is a single result of unlifted, linear, type -- -- Wrapper: case (..call worker..) of x -> C x -- Worker: case ( ..body.. ) of C x -> x = do { (work_uniq : arg_uniq : _) <- getUniquesM - ; let arg = mk_ww_local arg_uniq arg1 - con_app = mkConApp2 data_con inst_tys [arg] `mkCast` mkSymCo co + ; let arg_id = mk_ww_local arg_uniq str_mark arg_ty + con_app = mkConApp2 dc tc_args [arg_id] `mkCast` mkSymCo co ; return ( True - , \ wkr_call -> mkDefaultCase wkr_call arg con_app - , \ body -> mkUnpackCase body co One work_uniq data_con [arg] (varToCoreExpr arg) + , \ wkr_call -> mkDefaultCase wkr_call arg_id con_app + , \ body -> mkUnpackCase body co One work_uniq dc [arg_id] (varToCoreExpr arg_id) -- varToCoreExpr important here: arg can be a coercion -- Lacking this caused #10658 - , scaledThing arg_ty1 ) } + , scaledThing arg_ty ) } | otherwise -- The general case -- Wrapper: case (..call worker..) of (# a, b #) -> C a b @@ -1124,18 +1147,21 @@ mkWWcpr_help (DataConAppContext { dcac_dc = data_con, dcac_tys = inst_tys -- instance, the multiplicity of the fields of (#,#) is chosen to be the -- same as those of C. = do { (work_uniq : wild_uniq : uniqs) <- getUniquesM - ; let wrap_wild = mk_ww_local wild_uniq (linear ubx_tup_ty,MarkedStrict) - args = zipWith mk_ww_local uniqs arg_tys + ; let wrap_wild = mk_ww_local wild_uniq MarkedStrict (linear ubx_tup_ty) + arg_ids = zipWith3 mk_ww_local uniqs str_marks arg_tys ubx_tup_ty = exprType ubx_tup_app - ubx_tup_app = mkCoreUbxTup (map (scaledThing . fst) arg_tys) (map varToCoreExpr args) - con_app = mkConApp2 data_con inst_tys args `mkCast` mkSymCo co + ubx_tup_app = mkCoreUbxTup (map scaledThing arg_tys) (map varToCoreExpr arg_ids) + con_app = mkConApp2 dc tc_args arg_ids `mkCast` mkSymCo co tup_con = tupleDataCon Unboxed (length arg_tys) ; return (True , \ wkr_call -> mkSingleAltCase wkr_call wrap_wild - (DataAlt tup_con) args con_app - , \ body -> mkUnpackCase body co One work_uniq data_con args ubx_tup_app + (DataAlt tup_con) arg_ids con_app + , \ body -> mkUnpackCase body co One work_uniq dc arg_ids ubx_tup_app , ubx_tup_ty ) } + where + arg_tys = dataConInstArgTys dc tc_args -- NB: No existentials! + str_marks = dataConRepStrictness dc mkUnpackCase :: CoreExpr -> Coercion -> Mult -> Unique -> DataCon -> [Id] -> CoreExpr -> CoreExpr -- (mkUnpackCase e co uniq Con args body) @@ -1149,7 +1175,7 @@ mkUnpackCase scrut co mult uniq boxing_con unpk_args body (DataAlt boxing_con) unpk_args body where casted_scrut = scrut `mkCast` co - bndr = mk_ww_local uniq (Scaled mult (exprType casted_scrut), MarkedStrict) + bndr = mk_ww_local uniq MarkedStrict (Scaled mult (exprType casted_scrut)) -- An unpacking case can always be chosen linear, because the variables -- are always passed to a constructor. This limits the {- @@ -1275,10 +1301,14 @@ mk_absent_let dflags fam_envs arg abs_rhs = mkAbsentErrorApp arg_ty msg msg = showSDoc (gopt_set dflags Opt_SuppressUniques) - (ppr arg <+> ppr (idType arg) <+> file_msg) + (vcat + [ text "Arg:" <+> ppr arg + , text "Type:" <+> ppr arg_ty + , file_msg + ]) file_msg = case outputFile dflags of Nothing -> empty - Just f -> text "in output file " <+> quotes (text f) + Just f -> text "In output file " <+> quotes (text f) -- We need to suppress uniques here because otherwise they'd -- end up in the generated code as strings. This is bad for -- determinism, because with different uniques the strings @@ -1287,10 +1317,10 @@ mk_absent_let dflags fam_envs arg -- See also Note [Unique Determinism] in GHC.Types.Unique unlifted_rhs = mkTyApps (Lit rubbishLit) [arg_ty] -mk_ww_local :: Unique -> (Scaled Type, StrictnessMark) -> Id +mk_ww_local :: Unique -> StrictnessMark -> Scaled Type -> Id -- The StrictnessMark comes form the data constructor and says -- whether this field is strict -- See Note [Record evaluated-ness in worker/wrapper] -mk_ww_local uniq (Scaled w ty,str) +mk_ww_local uniq str (Scaled w ty) = setCaseBndrEvald str $ mkSysLocalOrCoVar (fsLit "ww") uniq w ty ===================================== compiler/GHC/Core/Tidy.hs ===================================== @@ -21,7 +21,7 @@ import GHC.Core import GHC.Core.Seq ( seqUnfolding ) import GHC.Types.Id import GHC.Types.Id.Info -import GHC.Types.Demand ( zapUsageEnvSig ) +import GHC.Types.Demand ( zapDmdEnvSig ) import GHC.Core.Type ( tidyType, tidyVarBndr ) import GHC.Core.Coercion ( tidyCo ) import GHC.Types.Var @@ -206,7 +206,7 @@ tidyLetBndr rec_tidy_env env@(tidy_env, var_env) id new_info = vanillaIdInfo `setOccInfo` occInfo old_info `setArityInfo` arityInfo old_info - `setStrictnessInfo` zapUsageEnvSig (strictnessInfo old_info) + `setStrictnessInfo` zapDmdEnvSig (strictnessInfo old_info) `setDemandInfo` demandInfo old_info `setInlinePragInfo` inlinePragInfo old_info `setUnfoldingInfo` new_unf ===================================== compiler/GHC/Core/TyCon.hs ===================================== @@ -58,8 +58,7 @@ module GHC.Core.TyCon( isKindTyCon, isLiftedTypeKindTyConName, isTauTyCon, isFamFreeTyCon, - isDataTyCon, isProductTyCon, isDataProductTyCon_maybe, - isDataSumTyCon_maybe, + isDataTyCon, isEnumerationTyCon, isNewTyCon, isAbstractTyCon, isFamilyTyCon, isOpenFamilyTyCon, @@ -84,6 +83,7 @@ module GHC.Core.TyCon( tyConCType, tyConCType_maybe, tyConDataCons, tyConDataCons_maybe, tyConSingleDataCon_maybe, tyConSingleDataCon, + tyConAlgDataCons_maybe, tyConSingleAlgDataCon_maybe, tyConFamilySize, tyConStupidTheta, @@ -143,7 +143,7 @@ import {-# SOURCE #-} GHC.Builtin.Types , multiplicityTyCon , vecCountTyCon, vecElemTyCon, liftedTypeKind ) import {-# SOURCE #-} GHC.Core.DataCon - ( DataCon, dataConExTyCoVars, dataConFieldLabels + ( DataCon, dataConFieldLabels , dataConTyCon, dataConFullSig , isUnboxedSumDataCon ) import GHC.Builtin.Uniques @@ -1970,72 +1970,6 @@ unwrapNewTyConEtad_maybe (AlgTyCon { algTcRhs = NewTyCon { nt_co = co, = Just (tvs, rhs, co) unwrapNewTyConEtad_maybe _ = Nothing -isProductTyCon :: TyCon -> Bool --- True of datatypes or newtypes that have --- one, non-existential, data constructor --- See Note [Product types] -isProductTyCon tc@(AlgTyCon {}) - = case algTcRhs tc of - TupleTyCon {} -> True - DataTyCon{ data_cons = [data_con] } - -> null (dataConExTyCoVars data_con) - NewTyCon {} -> True - _ -> False -isProductTyCon _ = False - -isDataProductTyCon_maybe :: TyCon -> Maybe DataCon --- True of datatypes (not newtypes) with --- one, vanilla, data constructor --- See Note [Product types] -isDataProductTyCon_maybe (AlgTyCon { algTcRhs = rhs }) - = case rhs of - DataTyCon { data_cons = [con] } - | null (dataConExTyCoVars con) -- non-existential - -> Just con - TupleTyCon { data_con = con } - -> Just con - _ -> Nothing -isDataProductTyCon_maybe _ = Nothing - -isDataSumTyCon_maybe :: TyCon -> Maybe [DataCon] -isDataSumTyCon_maybe (AlgTyCon { algTcRhs = rhs }) - = case rhs of - DataTyCon { data_cons = cons } - | cons `lengthExceeds` 1 - , all (null . dataConExTyCoVars) cons -- FIXME(osa): Why do we need this? - -> Just cons - SumTyCon { data_cons = cons } - | all (null . dataConExTyCoVars) cons -- FIXME(osa): Why do we need this? - -> Just cons - _ -> Nothing -isDataSumTyCon_maybe _ = Nothing - -{- Note [Product types] -~~~~~~~~~~~~~~~~~~~~~~~ -A product type is - * A data type (not a newtype) - * With one, boxed data constructor - * That binds no existential type variables - -The main point is that product types are amenable to unboxing for - * Strict function calls; we can transform - f (D a b) = e - to - fw a b = e - via the worker/wrapper transformation. (Question: couldn't this - work for existentials too?) - - * CPR for function results; we can transform - f x y = let ... in D a b - to - fw x y = let ... in (# a, b #) - -Note that the data constructor /can/ have evidence arguments: equality -constraints, type classes etc. So it can be GADT. These evidence -arguments are simply value arguments, and should not get in the way. --} - - -- | Is this a 'TyCon' representing a regular H98 type synonym (@type@)? {-# INLINE isTypeSynonymTyCon #-} -- See Note [Inlining coreView] in GHC.Core.Type isTypeSynonymTyCon :: TyCon -> Bool @@ -2363,8 +2297,7 @@ tyConDataCons_maybe _ = Nothing -- | If the given 'TyCon' has a /single/ data constructor, i.e. it is a @data@ -- type with one alternative, a tuple type or a @newtype@ then that constructor -- is returned. If the 'TyCon' has more than one constructor, or represents a --- primitive or function type constructor then @Nothing@ is returned. In any --- other case, the function panics +-- primitive or function type constructor then @Nothing@ is returned. tyConSingleDataCon_maybe :: TyCon -> Maybe DataCon tyConSingleDataCon_maybe (AlgTyCon { algTcRhs = rhs }) = case rhs of @@ -2374,21 +2307,31 @@ tyConSingleDataCon_maybe (AlgTyCon { algTcRhs = rhs }) _ -> Nothing tyConSingleDataCon_maybe _ = Nothing +-- | Like 'tyConSingleDataCon_maybe', but panics if 'Nothing'. tyConSingleDataCon :: TyCon -> DataCon tyConSingleDataCon tc = case tyConSingleDataCon_maybe tc of Just c -> c Nothing -> pprPanic "tyConDataCon" (ppr tc) +-- | Like 'tyConSingleDataCon_maybe', but returns 'Nothing' for newtypes. +-- +-- These are the 'TyCon's we want to unbox. See Note [Product types]. tyConSingleAlgDataCon_maybe :: TyCon -> Maybe DataCon --- Returns (Just con) for single-constructor --- *algebraic* data types *not* newtypes -tyConSingleAlgDataCon_maybe (AlgTyCon { algTcRhs = rhs }) - = case rhs of - DataTyCon { data_cons = [c] } -> Just c - TupleTyCon { data_con = c } -> Just c - _ -> Nothing -tyConSingleAlgDataCon_maybe _ = Nothing +tyConSingleAlgDataCon_maybe tycon + | isNewTyCon tycon = Nothing + | otherwise = tyConSingleDataCon_maybe tycon + +-- | Returns @Just dcs@ if the given 'TyCon' is a @data@ type, a tuple type +-- or a sum type with data constructors dcs. If the 'TyCon' has more than one +-- constructor, or represents a primitive or function type constructor then +-- @Nothing@ is returned. +-- +-- Like 'tyConDataCons_maybe', but returns 'Nothing' for newtypes. +tyConAlgDataCons_maybe :: TyCon -> Maybe [DataCon] +tyConAlgDataCons_maybe tycon + | isNewTyCon tycon = Nothing + | otherwise = tyConDataCons_maybe tycon -- | Determine the number of value constructors a 'TyCon' has. Panics if the -- 'TyCon' is not algebraic or a tuple @@ -2408,6 +2351,31 @@ algTyConRhs :: TyCon -> AlgTyConRhs algTyConRhs (AlgTyCon {algTcRhs = rhs}) = rhs algTyConRhs other = pprPanic "algTyConRhs" (ppr other) +{- Note [Product types] +~~~~~~~~~~~~~~~~~~~~~~~ +A product type is + * A data type (not a newtype) + * With one data constructor + +The main point is that product types are amenable to unboxing for + * Strict function calls; we can transform + f (D @ex a b) = e + to + fw @ex a b = e + via the worker/wrapper transformation. + + * CPR for function results (if the data con has no existentials); we can + transform + f x y = let ... in D a b + to + fw x y = let ... in (# a, b #) + +Note that the data constructor /can/ have evidence arguments: equality +constraints, type classes etc. So it can be GADT. These evidence +arguments are simply value arguments, and should not get in the way. +-} + + -- | Extract type variable naming the result of injective type family tyConFamilyResVar_maybe :: TyCon -> Maybe Name tyConFamilyResVar_maybe (FamilyTyCon {famTcResVar = res}) = res ===================================== compiler/GHC/CoreToIface.hs ===================================== @@ -245,7 +245,7 @@ toIfaceTyCon tc , Just tsort <- tupleSort tc' = tsort | isUnboxedSumTyCon tc - , Just cons <- isDataSumTyCon_maybe tc = IfaceSumTyCon (length cons) + , Just cons <- tyConDataCons_maybe tc = IfaceSumTyCon (length cons) | otherwise = IfaceNormalTyCon ===================================== compiler/GHC/Hs/Pat.hs ===================================== @@ -771,8 +771,6 @@ isIrrefutableHsPat L _ (PatSynCon _pat) -> False -- Conservative L _ (RealDataCon con) -> isJust (tyConSingleDataCon_maybe (dataConTyCon con)) - -- NB: tyConSingleDataCon_maybe, *not* isProductTyCon, because - -- the latter is false of existentials. See #4439 && all goL (hsConPatArgs details) go (LitPat {}) = False go (NPat {}) = False ===================================== compiler/GHC/HsToCore/Foreign/Call.hs ===================================== @@ -195,7 +195,7 @@ unboxArg arg pprPanic "unboxArg: " (ppr l <+> ppr arg_ty) where arg_ty = exprType arg - maybe_product_type = splitDataProductType_maybe arg_ty + maybe_product_type = splitNonExDataProductType_maybe arg_ty is_product_type = isJust maybe_product_type Just (_, _, data_con, scaled_data_con_arg_tys) = maybe_product_type data_con_arg_tys = map scaledThing scaled_data_con_arg_tys @@ -353,7 +353,8 @@ resultWrapper result_ty -- Data types with a single constructor, which has a single arg -- This includes types like Ptr and ForeignPtr | Just (tycon, tycon_arg_tys) <- maybe_tc_app - , Just data_con <- isDataProductTyCon_maybe tycon -- One constructor, no existentials + , Just data_con <- tyConSingleAlgDataCon_maybe tycon -- One constructor + , null (dataConExTyCoVars data_con) -- no existentials , [Scaled _ unwrapped_res_ty] <- dataConInstOrigArgTys data_con tycon_arg_tys -- One argument = do { dflags <- getDynFlags ; let platform = targetPlatform dflags ===================================== compiler/GHC/HsToCore/Foreign/Decl.hs ===================================== @@ -830,7 +830,7 @@ getPrimTyOf ty -- Except for Bool, the types we are interested in have a single constructor -- with a single primitive-typed argument (see TcType.legalFEArgTyCon). | otherwise = - case splitDataProductType_maybe rep_ty of + case splitNonExDataProductType_maybe rep_ty of Just (_, _, data_con, [Scaled _ prim_ty]) -> ASSERT(dataConSourceArity data_con == 1) ASSERT2(isUnliftedType prim_ty, ppr prim_ty) ===================================== compiler/GHC/HsToCore/Utils.hs ===================================== @@ -737,7 +737,7 @@ is_flat_prod_pat (TuplePat _ ps Boxed) = all is_triv_lpat ps is_flat_prod_pat (ConPat { pat_con = L _ pcon , pat_args = ps}) | RealDataCon con <- pcon - , isProductTyCon (dataConTyCon con) + , Just _ <- tyConSingleDataCon_maybe (dataConTyCon con) = all is_triv_lpat (hsConPatArgs ps) is_flat_prod_pat _ = False ===================================== compiler/GHC/Tc/Deriv/Utils.hs ===================================== @@ -928,8 +928,8 @@ cond_isEnumeration _ _ rep_tc cond_isProduct :: Condition cond_isProduct _ _ rep_tc - | isProductTyCon rep_tc = IsValid - | otherwise = NotValid why + | Just _ <- tyConSingleDataCon_maybe rep_tc = IsValid + | otherwise = NotValid why where why = quotes (pprSourceTyCon rep_tc) <+> text "must have precisely one constructor" ===================================== compiler/GHC/Types/Demand.hs ===================================== @@ -34,7 +34,7 @@ module GHC.Types.Demand ( lazyApply1Dmd, lazyApply2Dmd, strictOnceApply1Dmd, strictManyApply1Dmd, -- ** Other @Demand@ operations oneifyCard, oneifyDmd, strictifyDmd, strictifyDictDmd, mkWorkerDemand, - peelCallDmd, peelManyCalls, mkCallDmd, mkCallDmds, + peelCallDmd, peelManyCalls, mkCalledOnceDmd, mkCalledOnceDmds, addCaseBndrDmd, -- ** Extracting one-shot information argOneShots, argsOneShots, saturatedByOneShots, @@ -55,6 +55,7 @@ module GHC.Types.Demand ( PlusDmdArg, mkPlusDmdArg, toPlusDmdArg, -- ** Other operations peelFV, findIdDemand, addDemand, splitDmdTy, deferAfterPreciseException, + keepAliveDmdType, -- * Demand signatures StrictSig(..), mkStrictSigForArity, mkClosedStrictSig, @@ -73,7 +74,7 @@ module GHC.Types.Demand ( seqDemand, seqDemandList, seqDmdType, seqStrictSig, -- * Zapping usage information - zapUsageDemand, zapUsageEnvSig, zapUsedOnceDemand, zapUsedOnceSig + zapUsageDemand, zapDmdEnvSig, zapUsedOnceDemand, zapUsedOnceSig ) where #include "HsVersions.h" @@ -89,7 +90,7 @@ import GHC.Data.Maybe ( orElse ) import GHC.Core.Type ( Type ) import GHC.Core.TyCon ( isNewTyCon, isClassTyCon ) -import GHC.Core.DataCon ( splitDataProductType_maybe ) +import GHC.Core.DataCon ( splitNonExDataProductType_maybe ) import GHC.Core.Multiplicity ( scaledThing ) import GHC.Utils.Binary @@ -278,7 +279,8 @@ data SubDemand -- ^ @Call n sd@ describes the evaluation context of @n@ function -- applications, where every individual result is evaluated according to @sd at . -- @sd@ is /relative/ to a single call, cf. Note [Call demands are relative]. - -- Used only for values of function type. + -- Used only for values of function type. Use the smart constructor 'mkCall' + -- whenever possible! | Prod ![Demand] -- ^ @Prod ds@ describes the evaluation context of a case scrutinisation -- on an expression of product type, where the product components are @@ -306,7 +308,7 @@ polyDmd C_1N = C_1N :* poly1N polyDmd C_10 = C_10 :* poly10 -- | A smart constructor for 'Prod', applying rewrite rules along the semantic --- equalities @Prod [polyDmd n, ...] === polyDmd n@, simplifying to 'Poly' +-- equality @Prod [polyDmd n, ...] === polyDmd n@, simplifying to 'Poly' -- 'SubDemand's when possible. Note that this degrades boxity information! E.g. a -- polymorphic demand will never unbox. mkProd :: [Demand] -> SubDemand @@ -335,6 +337,13 @@ viewProd _ _ = Nothing {-# INLINE viewProd #-} -- we want to fuse away the replicate and the allocation -- for Arity. Otherwise, #18304 bites us. +-- | A smart constructor for 'Call', applying rewrite rules along the semantic +-- equality @Call n (Poly n) === Poly n@, simplifying to 'Poly' 'SubDemand's +-- when possible. +mkCall :: Card -> SubDemand -> SubDemand +mkCall n cd@(Poly m) | n == m = cd +mkCall n cd = Call n cd + -- | @viewCall sd@ interprets @sd@ as a 'Call', expanding 'Poly' demands as -- necessary. viewCall :: SubDemand -> Maybe (Card, SubDemand) @@ -356,8 +365,8 @@ lubSubDmd (Prod ds1) (viewProd (length ds1) -> Just ds2) = -- Handle Call lubSubDmd (Call n1 d1) (viewCall -> Just (n2, d2)) -- See Note [Call demands are relative] - | isAbs n2 = Call (lubCard n1 n2) (lubSubDmd d1 botSubDmd) - | otherwise = Call (lubCard n1 n2) (lubSubDmd d1 d2) + | isAbs n2 = mkCall (lubCard n1 n2) (lubSubDmd d1 botSubDmd) + | otherwise = mkCall (lubCard n1 n2) (lubSubDmd d1 d2) -- Handle Poly lubSubDmd (Poly n1) (Poly n2) = Poly (lubCard n1 n2) -- Make use of reflexivity (so we'll match the Prod or Call cases again). @@ -377,8 +386,8 @@ plusSubDmd (Prod ds1) (viewProd (length ds1) -> Just ds2) = -- Handle Call plusSubDmd (Call n1 d1) (viewCall -> Just (n2, d2)) -- See Note [Call demands are relative] - | isAbs n2 = Call (plusCard n1 n2) (lubSubDmd d1 botSubDmd) - | otherwise = Call (plusCard n1 n2) (lubSubDmd d1 d2) + | isAbs n2 = mkCall (plusCard n1 n2) (lubSubDmd d1 botSubDmd) + | otherwise = mkCall (plusCard n1 n2) (lubSubDmd d1 d2) -- Handle Poly plusSubDmd (Poly n1) (Poly n2) = Poly (plusCard n1 n2) -- Make use of reflexivity (so we'll match the Prod or Call cases again). @@ -407,7 +416,7 @@ multSubDmd :: Card -> SubDemand -> SubDemand multSubDmd n sd | Just sd' <- multTrivial n seqSubDmd sd = sd' multSubDmd n (Poly n') = Poly (multCard n n') -multSubDmd n (Call n' sd) = Call (multCard n n') sd -- See Note [Call demands are relative] +multSubDmd n (Call n' sd) = mkCall (multCard n n') sd -- See Note [Call demands are relative] multSubDmd n (Prod ds) = Prod (map (multDmd n) ds) multDmd :: Card -> Demand -> Demand @@ -457,22 +466,22 @@ evalDmd = C_1N :* topSubDmd -- | First argument of 'GHC.Exts.maskAsyncExceptions#': @SCS(U)@. -- Called exactly once. strictOnceApply1Dmd :: Demand -strictOnceApply1Dmd = C_11 :* Call C_11 topSubDmd +strictOnceApply1Dmd = C_11 :* mkCall C_11 topSubDmd -- | First argument of 'GHC.Exts.atomically#': @MCM(U)@. -- Called at least once, possibly many times. strictManyApply1Dmd :: Demand -strictManyApply1Dmd = C_1N :* Call C_1N topSubDmd +strictManyApply1Dmd = C_1N :* mkCall C_1N topSubDmd -- | First argument of catch#: @1C1(U)@. -- Evaluates its arg lazily, but then applies it exactly once to one argument. lazyApply1Dmd :: Demand -lazyApply1Dmd = C_01 :* Call C_01 topSubDmd +lazyApply1Dmd = C_01 :* mkCall C_01 topSubDmd -- | Second argument of catch#: @1C1(CS(U))@. -- Calls its arg lazily, but then applies it exactly once to an additional argument. lazyApply2Dmd :: Demand -lazyApply2Dmd = C_01 :* Call C_01 (Call C_11 topSubDmd) +lazyApply2Dmd = C_01 :* mkCall C_01 (mkCall C_11 topSubDmd) -- | Make a 'Demand' evaluated at-most-once. oneifyDmd :: Demand -> Demand @@ -503,7 +512,7 @@ strictifyDictDmd ty (n :* Prod ds) -- type is a non-newtype dictionary type as_non_newtype_dict ty | Just (tycon, _arg_tys, _data_con, map scaledThing -> inst_con_arg_tys) - <- splitDataProductType_maybe ty + <- splitNonExDataProductType_maybe ty , not (isNewTyCon tycon) , isClassTyCon tycon = Just inst_con_arg_tys @@ -512,12 +521,12 @@ strictifyDictDmd ty (n :* Prod ds) strictifyDictDmd _ dmd = dmd -- | Wraps the 'SubDemand' with a one-shot call demand: @d@ -> @CS(d)@. -mkCallDmd :: SubDemand -> SubDemand -mkCallDmd sd = Call C_11 sd +mkCalledOnceDmd :: SubDemand -> SubDemand +mkCalledOnceDmd sd = mkCall C_11 sd --- | @mkCallDmds n d@ returns @CS(CS...(CS d))@ where there are @n@ @CS@'s. -mkCallDmds :: Arity -> SubDemand -> SubDemand -mkCallDmds arity sd = iterate mkCallDmd sd !! arity +-- | @mkCalledOnceDmds n d@ returns @CS(CS...(CS d))@ where there are @n@ @CS@'s. +mkCalledOnceDmds :: Arity -> SubDemand -> SubDemand +mkCalledOnceDmds arity sd = iterate mkCalledOnceDmd sd !! arity -- | Peels one call level from the sub-demand, and also returns how many -- times we entered the lambda body. @@ -669,7 +678,7 @@ This is needed even for non-product types, in case the case-binder is used but the components of the case alternative are not. Note [Don't optimise UP(U,U,...) to U] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ These two SubDemands: UP(U,U) (@Prod [topDmd, topDmd]@) and U (@topSubDmd@) are semantically equivalent, but we do not turn the former into @@ -1184,6 +1193,11 @@ findIdDemand (DmdType fv _ res) id deferAfterPreciseException :: DmdType -> DmdType deferAfterPreciseException = lubDmdType exnDmdType +-- | See 'keepAliveDmdEnv'. +keepAliveDmdType :: DmdType -> VarSet -> DmdType +keepAliveDmdType (DmdType fvs ds res) vars = + DmdType (fvs `keepAliveDmdEnv` vars) ds res + {- Note [Demand type Divergence] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1571,9 +1585,9 @@ This is weird, so I'm not worried about whether this optimises brilliantly; but it should not fall over. -} -zapUsageEnvSig :: StrictSig -> StrictSig --- Remove the usage environment from the demand -zapUsageEnvSig (StrictSig (DmdType _ ds r)) = mkClosedStrictSig ds r +-- | Remove the demand environment from the signature. +zapDmdEnvSig :: StrictSig -> StrictSig +zapDmdEnvSig (StrictSig (DmdType _ ds r)) = mkClosedStrictSig ds r zapUsageDemand :: Demand -> Demand -- Remove the usage info, but not the strictness info, from the demand @@ -1615,8 +1629,8 @@ kill_usage kfs (n :* sd) = kill_usage_card kfs n :* kill_usage_sd kfs sd kill_usage_sd :: KillFlags -> SubDemand -> SubDemand kill_usage_sd kfs (Call n sd) - | kf_called_once kfs = Call (lubCard C_1N n) (kill_usage_sd kfs sd) - | otherwise = Call n (kill_usage_sd kfs sd) + | kf_called_once kfs = mkCall (lubCard C_1N n) (kill_usage_sd kfs sd) + | otherwise = mkCall n (kill_usage_sd kfs sd) kill_usage_sd kfs (Prod ds) = Prod (map (kill_usage kfs) ds) kill_usage_sd _ sd = sd @@ -1640,7 +1654,7 @@ trimToType (n :* sd) ts where go (Prod ds) (TsProd tss) | equalLength ds tss = Prod (zipWith trimToType ds tss) - go (Call n sd) (TsFun ts) = Call n (go sd ts) + go (Call n sd) (TsFun ts) = mkCall n (go sd ts) go sd at Poly{} _ = sd go _ _ = topSubDmd @@ -1804,7 +1818,7 @@ instance Binary SubDemand where h <- getByte bh case h of 0 -> Poly <$> get bh - 1 -> Call <$> get bh <*> get bh + 1 -> mkCall <$> get bh <*> get bh 2 -> Prod <$> get bh _ -> pprPanic "Binary:SubDemand" (ppr (fromIntegral h :: Int)) ===================================== compiler/GHC/Types/Id/Info.hs ===================================== @@ -650,7 +650,7 @@ zapUsageInfo info = Just (info {demandInfo = zapUsageDemand (demandInfo info)}) zapUsageEnvInfo :: IdInfo -> Maybe IdInfo zapUsageEnvInfo info | hasDemandEnvSig (strictnessInfo info) - = Just (info {strictnessInfo = zapUsageEnvSig (strictnessInfo info)}) + = Just (info {strictnessInfo = zapDmdEnvSig (strictnessInfo info)}) | otherwise = Nothing ===================================== testsuite/tests/arityanal/should_compile/Arity11.stderr ===================================== @@ -35,7 +35,7 @@ end Rec } -- RHS size: {terms: 52, types: 28, coercions: 0, joins: 0/5} F11.$wfib [InlPrag=[2]] :: forall {a} {p}. (a -> a -> Bool) -> (Num a, Num p) => a -> p -[GblId, Arity=4, Str=, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 150 60 0] 460 0}] +[GblId, Arity=4, Str=, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 150 60 0] 460 0}] F11.$wfib = \ (@a) (@p) (ww :: a -> a -> Bool) (w :: Num a) (w1 :: Num p) (w2 :: a) -> let { @@ -73,7 +73,7 @@ F11.$wfib fib [InlPrag=[2]] :: forall {a} {p}. (Eq a, Num a, Num p) => a -> p [GblId, Arity=4, - Str=, + Str=, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=4,unsat_ok=True,boring_ok=False) Tmpl= \ (@a) (@p) (w [Occ=Once1!] :: Eq a) (w1 [Occ=Once1] :: Num a) (w2 [Occ=Once1] :: Num p) (w3 [Occ=Once1] :: a) -> case w of { GHC.Classes.C:Eq ww1 [Occ=Once1] _ [Occ=Dead] -> F11.$wfib @a @p ww1 w1 w2 w3 }}] fib = \ (@a) (@p) (w :: Eq a) (w1 :: Num a) (w2 :: Num p) (w3 :: a) -> case w of { GHC.Classes.C:Eq ww1 ww2 -> F11.$wfib @a @p ww1 w1 w2 w3 } ===================================== testsuite/tests/arityanal/should_compile/Arity16.stderr ===================================== @@ -5,7 +5,7 @@ Result size of Tidy Core = {terms: 52, types: 87, coercions: 0, joins: 0/0} Rec { -- RHS size: {terms: 15, types: 17, coercions: 0, joins: 0/0} map2 [Occ=LoopBreaker] :: forall {t} {a}. (t -> a) -> [t] -> [a] -[GblId, Arity=2, Str=, Unf=OtherCon []] +[GblId, Arity=2, Str=, Unf=OtherCon []] map2 = \ (@t) (@a) (f :: t -> a) (ds :: [t]) -> case ds of { ===================================== testsuite/tests/simplCore/should_compile/T18013.stderr ===================================== @@ -132,33 +132,58 @@ Result size of Tidy Core = {terms: 52, types: 106, coercions: 17, joins: 0/1} -- RHS size: {terms: 37, types: 87, coercions: 17, joins: 0/1} -mapMaybeRule +mapMaybeRule [InlPrag=[2]] :: forall a b. Rule IO a b -> Rule IO (Maybe a) (Maybe b) [GblId, Arity=1, - Str=, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 150 10}] + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (@a) (@b) (w [Occ=Once1!] :: Rule IO a b) -> + case w of { Rule @s ww1 ww2 [Occ=OnceL1!] -> + T18013a.Rule + @IO + @(Maybe a) + @(Maybe b) + @s + ww1 + ((\ (s2 [Occ=Once1] :: s) + (a1 [Occ=Once1!] :: Maybe a) + (s1 [Occ=Once2] :: GHC.Prim.State# GHC.Prim.RealWorld) -> + case a1 of { + Nothing -> + (# s1, T18013a.Result @s @(Maybe b) ww1 (GHC.Maybe.Nothing @b) #); + Just x [Occ=Once1] -> + case ((ww2 s2 x) `cast` ) s1 of + { (# ipv [Occ=Once1], ipv1 [Occ=Once1!] #) -> + case ipv1 of { Result t2 [Occ=Once1] c1 [Occ=Once1] -> + (# ipv, T18013a.Result @s @(Maybe b) t2 (GHC.Maybe.Just @b c1) #) + } + } + }) + `cast` ) + }}] mapMaybeRule - = \ (@a) (@b) (f :: Rule IO a b) -> - case f of { Rule @s t0 g -> + = \ (@a) (@b) (w :: Rule IO a b) -> + case w of { Rule @s ww1 ww2 -> let { lvl :: Result s (Maybe b) [LclId, Unf=OtherCon []] - lvl = T18013a.Result @s @(Maybe b) t0 (GHC.Maybe.Nothing @b) } in + lvl = T18013a.Result @s @(Maybe b) ww1 (GHC.Maybe.Nothing @b) } in T18013a.Rule @IO @(Maybe a) @(Maybe b) @s - t0 + ww1 ((\ (s2 :: s) (a1 :: Maybe a) (s1 :: GHC.Prim.State# GHC.Prim.RealWorld) -> case a1 of { Nothing -> (# s1, lvl #); Just x -> - case ((g s2 x) `cast` ) s1 of { (# ipv, ipv1 #) -> + case ((ww2 s2 x) `cast` ) s1 of { (# ipv, ipv1 #) -> case ipv1 of { Result t2 c1 -> (# ipv, T18013a.Result @s @(Maybe b) t2 (GHC.Maybe.Just @b c1) #) } ===================================== testsuite/tests/stranal/should_compile/T18894.hs ===================================== @@ -0,0 +1,28 @@ +{-# OPTIONS_GHC -O2 -fforce-recomp #-} + +-- | The point of this test is that @g*@ get's a demand that says +-- "whenever @g*@ is called, the second component of the pair is evaluated strictly". +module T18894 (h1, h2) where + +g1 :: Int -> (Int,Int) +g1 1 = (15, 0) +g1 n = (2 * n, 2 `div` n) +{-# NOINLINE g1 #-} + +h1 :: Int -> Int +h1 1 = 0 +-- Sadly, the @g1 2@ subexpression will be floated to top-level, where we +-- don't see the specific demand placed on it by @snd at . Tracked in #19001. +h1 2 = snd (g1 2) +h1 m = uncurry (+) (g1 m) + +g2 :: Int -> Int -> (Int,Int) +g2 m 1 = (m, 0) +g2 m n = (2 * m, 2 `div` n) +{-# NOINLINE g2 #-} + +h2 :: Int -> Int +h2 1 = 0 +h2 m + | odd m = snd (g2 m 2) + | otherwise = uncurry (+) (g2 2 m) ===================================== testsuite/tests/stranal/should_compile/T18894.stderr ===================================== @@ -0,0 +1,404 @@ + +==================== Demand analysis ==================== +Result size of Demand analysis + = {terms: 177, types: 97, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 36, types: 16, coercions: 0, joins: 0/0} +g2 [InlPrag=NOINLINE, Dmd=UCU(CS(P(1P(U),SP(U))))] + :: Int -> Int -> (Int, Int) +[LclId, + Arity=2, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20 20] 161 20}] +g2 + = \ (m [Dmd=UP(U)] :: Int) (ds [Dmd=SP(SU)] :: Int) -> + case ds of { GHC.Types.I# ds [Dmd=SU] -> + case ds of ds [Dmd=1U] { + __DEFAULT -> + (case m of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.*# 2# y) }, + case ds of wild { + __DEFAULT -> + case GHC.Classes.divInt# 2# wild of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> GHC.Types.I# -2#; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + }); + 1# -> (m, lvl) + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 36, types: 19, coercions: 0, joins: 0/0} +h2 :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 162 10}] +h2 + = \ (ds [Dmd=SP(MU)] :: Int) -> + case ds of wild [Dmd=UP(U)] { GHC.Types.I# ds [Dmd=MU] -> + case ds of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> + case g2 wild lvl of { (ds1 [Dmd=A], y [Dmd=SU]) -> y }; + 0# -> + case g2 lvl wild of { (x [Dmd=SP(U)], ds [Dmd=SP(U)]) -> + case x of { GHC.Types.I# x -> + case ds of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + } + }; + 1# -> lvl + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 15# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +lvl :: (Int, Int) +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = (lvl, lvl) + +-- RHS size: {terms: 30, types: 11, coercions: 0, joins: 0/0} +g1 [InlPrag=NOINLINE, Dmd=UCU(P(UP(U),UP(U)))] :: Int -> (Int, Int) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 141 10}] +g1 + = \ (ds [Dmd=SP(SU)] :: Int) -> + case ds of { GHC.Types.I# ds [Dmd=SU] -> + case ds of ds { + __DEFAULT -> + (GHC.Types.I# (GHC.Prim.*# 2# ds), + case ds of wild { + __DEFAULT -> + case GHC.Classes.divInt# 2# wild of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> GHC.Types.I# -2#; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + }); + 1# -> lvl + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +lvl :: (Int, Int) +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=False, ConLike=False, + WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 30 0}] +lvl = g1 (GHC.Types.I# 2#) + +-- RHS size: {terms: 28, types: 18, coercions: 0, joins: 0/0} +h1 :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 111 10}] +h1 + = \ (ds [Dmd=SP(MU)] :: Int) -> + case ds of wild [Dmd=1P(1U)] { GHC.Types.I# ds [Dmd=MU] -> + case ds of { + __DEFAULT -> + case g1 wild of { (x [Dmd=SP(U)], ds [Dmd=SP(U)]) -> + case x of { GHC.Types.I# x -> + case ds of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + }; + 1# -> lvl; + 2# -> case lvl of { (ds1 [Dmd=A], y [Dmd=SU]) -> y } + } + } + + + + +==================== Demand analysis ==================== +Result size of Demand analysis + = {terms: 171, types: 120, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# -2# + +-- RHS size: {terms: 32, types: 18, coercions: 0, joins: 0/0} +$wg2 [InlPrag=NOINLINE, Dmd=UCU(CS(P(1P(U),SP(U))))] + :: Int -> GHC.Prim.Int# -> (# Int, Int #) +[LclId, + Arity=2, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20 30] 121 20}] +$wg2 + = \ (w [Dmd=UP(U)] :: Int) (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + (# case w of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.*# 2# y) }, + case ds of { + __DEFAULT -> + case GHC.Classes.divInt# 2# ds of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> lvl; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + } #); + 1# -> (# w, lvl #) + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 34, types: 21, coercions: 0, joins: 0/0} +$wh2 [InlPrag=[2]] :: GHC.Prim.Int# -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 162 10}] +$wh2 + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> + case $wg2 (GHC.Types.I# ds) 2# of + { (# ww [Dmd=A], ww [Dmd=SU] #) -> + ww + }; + 0# -> + case $wg2 lvl ds of { (# ww [Dmd=SP(U)], ww [Dmd=SP(U)] #) -> + case ww of { GHC.Types.I# x -> + case ww of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + } + }; + 1# -> lvl + } + +-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} +h2 [InlPrag=[2]] :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (w [Occ=Once1!] :: Int) -> + case w of { GHC.Types.I# ww [Occ=Once1, Dmd=MU] -> $wh2 ww }}] +h2 + = \ (w [Dmd=SP(SU)] :: Int) -> + case w of { GHC.Types.I# ww [Dmd=SU] -> $wh2 ww } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 15# + +-- RHS size: {terms: 28, types: 15, coercions: 0, joins: 0/0} +$wg1 [InlPrag=NOINLINE, Dmd=UCU(P(UP(U),UP(U)))] + :: GHC.Prim.Int# -> (# Int, Int #) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 111 20}] +$wg1 + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + (# GHC.Types.I# (GHC.Prim.*# 2# ds), + case ds of { + __DEFAULT -> + case GHC.Classes.divInt# 2# ds of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> lvl; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + } #); + 1# -> (# lvl, lvl #) + } + +-- RHS size: {terms: 7, types: 9, coercions: 0, joins: 0/0} +lvl :: (Int, Int) +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=False, ConLike=False, + WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 40 10}] +lvl = case $wg1 2# of { (# ww, ww #) -> (ww, ww) } + +-- RHS size: {terms: 25, types: 18, coercions: 0, joins: 0/0} +$wh1 [InlPrag=[2]] :: GHC.Prim.Int# -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [50] 101 10}] +$wh1 + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds [Dmd=1U] { + __DEFAULT -> + case $wg1 ds of { (# ww [Dmd=SP(U)], ww [Dmd=SP(U)] #) -> + case ww of { GHC.Types.I# x -> + case ww of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + }; + 1# -> lvl; + 2# -> case lvl of { (ds1 [Dmd=A], y [Dmd=SU]) -> y } + } + +-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} +h1 [InlPrag=[2]] :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (w [Occ=Once1!] :: Int) -> + case w of { GHC.Types.I# ww [Occ=Once1, Dmd=MU] -> $wh1 ww }}] +h1 + = \ (w [Dmd=SP(SU)] :: Int) -> + case w of { GHC.Types.I# ww [Dmd=SU] -> $wh1 ww } + + + ===================================== testsuite/tests/stranal/should_compile/T18894b.hs ===================================== @@ -0,0 +1,20 @@ +{-# OPTIONS_GHC -O -fno-call-arity -fforce-recomp #-} + +module T18894 (f) where + +expensive :: Int -> (Int, Int) +expensive n = (n+1, n+2) +{-# NOINLINE expensive #-} + +-- arity 1 by itself, but not exported, thus can be eta-expanded based on usage +eta :: Int -> Int -> Int +eta x = if fst (expensive x) == 13 + then \y -> x + y + else \y -> x * y +{-# NOINLINE eta #-} + +f :: Int -> Int +f 1 = 0 +f m + | odd m = eta m 2 + | otherwise = eta 2 m ===================================== testsuite/tests/stranal/should_compile/T18894b.stderr ===================================== @@ -0,0 +1,187 @@ + +==================== Demand analysis ==================== +Result size of Demand analysis = {terms: 83, types: 40, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 16, types: 7, coercions: 0, joins: 0/0} +expensive [InlPrag=NOINLINE, Dmd=UCU(P(SP(SU),A))] :: Int -> (Int, Int) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [40] 52 10}] +expensive + = \ (n [Dmd=UP(U)] :: Int) -> + (case n of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 1#) }, case n of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 2#) }) + +-- RHS size: {terms: 20, types: 11, coercions: 0, joins: 0/0} +eta [InlPrag=NOINLINE, Dmd=UCU(CS(U))] :: Int -> Int -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [0] 140 120}] +eta + = \ (x [Dmd=UP(U)] :: Int) -> + case expensive x of { (x [Dmd=SP(SU)], ds1 [Dmd=A]) -> + case x of { GHC.Types.I# x [Dmd=SU] -> + case x of { + __DEFAULT -> \ (y [Dmd=SP(U)] :: Int) -> GHC.Num.$fNumInt_$c* x y; + 13# -> \ (y [Dmd=SP(U)] :: Int) -> GHC.Num.$fNumInt_$c+ x y + } + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 21, types: 5, coercions: 0, joins: 0/0} +f :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 111 0}] +f = \ (ds [Dmd=SP(MU)] :: Int) -> + case ds of wild [Dmd=UP(U)] { GHC.Types.I# ds [Dmd=MU] -> + case ds of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> eta wild lvl; + 0# -> eta lvl wild + }; + 1# -> lvl + } + } + + + + +==================== Demand analysis ==================== +Result size of Demand analysis = {terms: 85, types: 47, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 16, types: 9, coercions: 0, joins: 0/0} +$wexpensive [InlPrag=NOINLINE, Dmd=UCU(P(SP(SU),A))] :: Int -> (# Int, Int #) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [40] 42 10}] +$wexpensive + = \ (w [Dmd=UP(U)] :: Int) -> + (# case w of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 1#) }, + case w of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 2#) } #) + +-- RHS size: {terms: 19, types: 12, coercions: 0, joins: 0/0} +eta [InlPrag=NOINLINE, Dmd=UCU(CS(U))] :: Int -> Int -> Int +[LclId, + Arity=2, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [0 0] 120 0}] +eta + = \ (x [Dmd=MP(U)] :: Int) (eta [Dmd=SP(U), OS=OneShot] :: Int) -> + case $wexpensive x of { (# ww [Dmd=SP(SU)], ww [Dmd=A] #) -> + case ww of { GHC.Types.I# x [Dmd=SU] -> + case x of { + __DEFAULT -> GHC.Num.$fNumInt_$c* x eta; + 13# -> GHC.Num.$fNumInt_$c+ x eta + } + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 20, types: 3, coercions: 0, joins: 0/0} +$wf [InlPrag=[2]] :: GHC.Prim.Int# -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 121 0}] +$wf + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> eta (GHC.Types.I# ds) lvl; + 0# -> eta lvl (GHC.Types.I# ds) + }; + 1# -> lvl + } + +-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} +f [InlPrag=[2]] :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (w [Occ=Once1!] :: Int) -> case w of { GHC.Types.I# ww [Occ=Once1, Dmd=MU] -> $wf ww }}] +f = \ (w [Dmd=SP(SU)] :: Int) -> case w of { GHC.Types.I# ww [Dmd=SU] -> $wf ww } + + + ===================================== testsuite/tests/stranal/should_compile/T18982.hs ===================================== @@ -0,0 +1,33 @@ +{-# OPTIONS_GHC -O -fforce-recomp #-} +{-# LANGUAGE GADTs #-} + +module T18982 where + +data Box a where + Box :: a -> Box a + +data Ex a where + Ex :: e -> a -> Ex a + +data GADT a where + GADT :: Int -> GADT Int + +data ExGADT a where + ExGADT :: (e ~ Int) => e -> Int -> ExGADT Int + +f :: Box Int -> Int +f (Box n) = n + 1 +{-# NOINLINE f #-} + +g :: Ex Int -> Int +g (Ex e n) = e `seq` n + 1 +{-# NOINLINE g #-} + +h :: GADT a -> Int +h (GADT n) = n + 1 +{-# NOINLINE h #-} + +i :: ExGADT a -> Int +i (ExGADT e n) = e `seq` n + 1 +{-# NOINLINE i #-} + ===================================== testsuite/tests/stranal/should_compile/T18982.stderr ===================================== @@ -0,0 +1,246 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core = {terms: 311, types: 249, coercions: 4, joins: 0/0} + +-- RHS size: {terms: 8, types: 11, coercions: 1, joins: 0/0} +T18982.$WExGADT :: forall e. (e ~ Int) => e %1 -> Int %1 -> ExGADT Int +T18982.$WExGADT = \ (@e) (dt :: e ~ Int) (dt :: e) (dt :: Int) -> T18982.ExGADT @Int @e @~(_N :: Int GHC.Prim.~# Int) dt dt dt + +-- RHS size: {terms: 3, types: 2, coercions: 1, joins: 0/0} +T18982.$WGADT :: Int %1 -> GADT Int +T18982.$WGADT = \ (dt :: Int) -> T18982.GADT @Int @~(_N :: Int GHC.Prim.~# Int) dt + +-- RHS size: {terms: 7, types: 8, coercions: 0, joins: 0/0} +T18982.$WEx :: forall e a. e %1 -> a %1 -> Ex a +T18982.$WEx = \ (@e) (@a) (dt :: e) (dt :: a) -> T18982.Ex @a @e dt dt + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$trModule4 :: GHC.Prim.Addr# +T18982.$trModule4 = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$trModule3 :: GHC.Types.TrName +T18982.$trModule3 = GHC.Types.TrNameS T18982.$trModule4 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$trModule2 :: GHC.Prim.Addr# +T18982.$trModule2 = "T18982"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$trModule1 :: GHC.Types.TrName +T18982.$trModule1 = GHC.Types.TrNameS T18982.$trModule2 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18982.$trModule :: GHC.Types.Module +T18982.$trModule = GHC.Types.Module T18982.$trModule3 T18982.$trModule1 + +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} +$krep :: GHC.Types.KindRep +$krep = GHC.Types.KindRepTyConApp GHC.Types.$tcInt (GHC.Types.[] @GHC.Types.KindRep) + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$krep1 :: GHC.Types.KindRep +$krep1 = GHC.Types.KindRepVar 1# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$krep2 :: GHC.Types.KindRep +$krep2 = GHC.Types.KindRepVar 0# + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +$krep3 :: [GHC.Types.KindRep] +$krep3 = GHC.Types.: @GHC.Types.KindRep $krep (GHC.Types.[] @GHC.Types.KindRep) + +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} +$krep4 :: [GHC.Types.KindRep] +$krep4 = GHC.Types.: @GHC.Types.KindRep $krep2 $krep3 + +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} +$krep5 :: [GHC.Types.KindRep] +$krep5 = GHC.Types.: @GHC.Types.KindRep GHC.Types.krep$* $krep4 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep6 :: GHC.Types.KindRep +$krep6 = GHC.Types.KindRepTyConApp GHC.Types.$tc~ $krep5 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tcBox2 :: GHC.Prim.Addr# +T18982.$tcBox2 = "Box"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tcBox1 :: GHC.Types.TrName +T18982.$tcBox1 = GHC.Types.TrNameS T18982.$tcBox2 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tcBox :: GHC.Types.TyCon +T18982.$tcBox = GHC.Types.TyCon 16948648223906549518## 2491460178135962649## T18982.$trModule T18982.$tcBox1 0# GHC.Types.krep$*Arr* + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +$krep7 :: [GHC.Types.KindRep] +$krep7 = GHC.Types.: @GHC.Types.KindRep $krep2 (GHC.Types.[] @GHC.Types.KindRep) + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep8 :: GHC.Types.KindRep +$krep8 = GHC.Types.KindRepTyConApp T18982.$tcBox $krep7 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Box1 :: GHC.Types.KindRep +T18982.$tc'Box1 = GHC.Types.KindRepFun $krep2 $krep8 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Box3 :: GHC.Prim.Addr# +T18982.$tc'Box3 = "'Box"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Box2 :: GHC.Types.TrName +T18982.$tc'Box2 = GHC.Types.TrNameS T18982.$tc'Box3 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Box :: GHC.Types.TyCon +T18982.$tc'Box = GHC.Types.TyCon 1412068769125067428## 8727214667407894081## T18982.$trModule T18982.$tc'Box2 1# T18982.$tc'Box1 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tcEx2 :: GHC.Prim.Addr# +T18982.$tcEx2 = "Ex"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tcEx1 :: GHC.Types.TrName +T18982.$tcEx1 = GHC.Types.TrNameS T18982.$tcEx2 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tcEx :: GHC.Types.TyCon +T18982.$tcEx = GHC.Types.TyCon 4376661818164435927## 18005417598910668817## T18982.$trModule T18982.$tcEx1 0# GHC.Types.krep$*Arr* + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +$krep9 :: [GHC.Types.KindRep] +$krep9 = GHC.Types.: @GHC.Types.KindRep $krep1 (GHC.Types.[] @GHC.Types.KindRep) + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep10 :: GHC.Types.KindRep +$krep10 = GHC.Types.KindRepTyConApp T18982.$tcEx $krep9 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep11 :: GHC.Types.KindRep +$krep11 = GHC.Types.KindRepFun $krep1 $krep10 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Ex1 :: GHC.Types.KindRep +T18982.$tc'Ex1 = GHC.Types.KindRepFun $krep2 $krep11 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Ex3 :: GHC.Prim.Addr# +T18982.$tc'Ex3 = "'Ex"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Ex2 :: GHC.Types.TrName +T18982.$tc'Ex2 = GHC.Types.TrNameS T18982.$tc'Ex3 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Ex :: GHC.Types.TyCon +T18982.$tc'Ex = GHC.Types.TyCon 14609381081172201359## 3077219645053200509## T18982.$trModule T18982.$tc'Ex2 2# T18982.$tc'Ex1 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tcGADT2 :: GHC.Prim.Addr# +T18982.$tcGADT2 = "GADT"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tcGADT1 :: GHC.Types.TrName +T18982.$tcGADT1 = GHC.Types.TrNameS T18982.$tcGADT2 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tcGADT :: GHC.Types.TyCon +T18982.$tcGADT = GHC.Types.TyCon 9243924476135839950## 5096619276488416461## T18982.$trModule T18982.$tcGADT1 0# GHC.Types.krep$*Arr* + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep12 :: GHC.Types.KindRep +$krep12 = GHC.Types.KindRepTyConApp T18982.$tcGADT $krep3 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'GADT1 :: GHC.Types.KindRep +T18982.$tc'GADT1 = GHC.Types.KindRepFun $krep $krep12 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'GADT3 :: GHC.Prim.Addr# +T18982.$tc'GADT3 = "'GADT"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'GADT2 :: GHC.Types.TrName +T18982.$tc'GADT2 = GHC.Types.TrNameS T18982.$tc'GADT3 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'GADT :: GHC.Types.TyCon +T18982.$tc'GADT = GHC.Types.TyCon 2077850259354179864## 16731205864486799217## T18982.$trModule T18982.$tc'GADT2 0# T18982.$tc'GADT1 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tcExGADT2 :: GHC.Prim.Addr# +T18982.$tcExGADT2 = "ExGADT"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tcExGADT1 :: GHC.Types.TrName +T18982.$tcExGADT1 = GHC.Types.TrNameS T18982.$tcExGADT2 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tcExGADT :: GHC.Types.TyCon +T18982.$tcExGADT = GHC.Types.TyCon 6470898418160489500## 10361108917441214060## T18982.$trModule T18982.$tcExGADT1 0# GHC.Types.krep$*Arr* + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep13 :: GHC.Types.KindRep +$krep13 = GHC.Types.KindRepTyConApp T18982.$tcExGADT $krep3 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep14 :: GHC.Types.KindRep +$krep14 = GHC.Types.KindRepFun $krep $krep13 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep15 :: GHC.Types.KindRep +$krep15 = GHC.Types.KindRepFun $krep2 $krep14 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'ExGADT1 :: GHC.Types.KindRep +T18982.$tc'ExGADT1 = GHC.Types.KindRepFun $krep6 $krep15 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'ExGADT3 :: GHC.Prim.Addr# +T18982.$tc'ExGADT3 = "'ExGADT"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'ExGADT2 :: GHC.Types.TrName +T18982.$tc'ExGADT2 = GHC.Types.TrNameS T18982.$tc'ExGADT3 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'ExGADT :: GHC.Types.TyCon +T18982.$tc'ExGADT = GHC.Types.TyCon 8468257409157161049## 5503123603717080600## T18982.$trModule T18982.$tc'ExGADT2 1# T18982.$tc'ExGADT1 + +-- RHS size: {terms: 11, types: 14, coercions: 0, joins: 0/0} +T18982.$wi :: forall {a} {e}. (a GHC.Prim.~# Int) -> e -> GHC.Prim.Int# -> GHC.Prim.Int# +T18982.$wi = \ (@a) (@e) (ww :: a GHC.Prim.~# Int) (ww1 :: e) (ww2 :: GHC.Prim.Int#) -> case ww1 of { __DEFAULT -> GHC.Prim.+# ww2 1# } + +-- RHS size: {terms: 15, types: 27, coercions: 1, joins: 0/0} +i :: forall a. ExGADT a -> Int +i = \ (@a) (w :: ExGADT a) -> case w of { ExGADT @e ww1 ww2 ww3 ww4 -> case ww4 of { GHC.Types.I# ww6 -> case T18982.$wi @a @e @~(ww1 :: a GHC.Prim.~# Int) ww3 ww6 of ww7 { __DEFAULT -> GHC.Types.I# ww7 } } } + +-- RHS size: {terms: 6, types: 10, coercions: 0, joins: 0/0} +T18982.$wh :: forall {a}. (a GHC.Prim.~# Int) -> GHC.Prim.Int# -> GHC.Prim.Int# +T18982.$wh = \ (@a) (ww :: a GHC.Prim.~# Int) (ww1 :: GHC.Prim.Int#) -> GHC.Prim.+# ww1 1# + +-- RHS size: {terms: 14, types: 18, coercions: 1, joins: 0/0} +h :: forall a. GADT a -> Int +h = \ (@a) (w :: GADT a) -> case w of { GADT ww1 ww2 -> case ww2 of { GHC.Types.I# ww4 -> case T18982.$wh @a @~(ww1 :: a GHC.Prim.~# Int) ww4 of ww5 { __DEFAULT -> GHC.Types.I# ww5 } } } + +-- RHS size: {terms: 9, types: 5, coercions: 0, joins: 0/0} +T18982.$wg :: forall {e}. e -> GHC.Prim.Int# -> GHC.Prim.Int# +T18982.$wg = \ (@e) (ww :: e) (ww1 :: GHC.Prim.Int#) -> case ww of { __DEFAULT -> GHC.Prim.+# ww1 1# } + +-- RHS size: {terms: 14, types: 12, coercions: 0, joins: 0/0} +g :: Ex Int -> Int +g = \ (w :: Ex Int) -> case w of { Ex @e ww1 ww2 -> case ww2 of { GHC.Types.I# ww4 -> case T18982.$wg @e ww1 ww4 of ww5 { __DEFAULT -> GHC.Types.I# ww5 } } } + +-- RHS size: {terms: 4, types: 1, coercions: 0, joins: 0/0} +T18982.$wf :: GHC.Prim.Int# -> GHC.Prim.Int# +T18982.$wf = \ (ww :: GHC.Prim.Int#) -> GHC.Prim.+# ww 1# + +-- RHS size: {terms: 13, types: 8, coercions: 0, joins: 0/0} +f :: Box Int -> Int +f = \ (w :: Box Int) -> case w of { Box ww1 -> case ww1 of { GHC.Types.I# ww3 -> case T18982.$wf ww3 of ww4 { __DEFAULT -> GHC.Types.I# ww4 } } } + + + ===================================== testsuite/tests/stranal/should_compile/all.T ===================================== @@ -58,3 +58,9 @@ test('T18122', [ grep_errmsg(r'wfoo =') ], compile, ['-ddump-simpl']) # We care about the call demand on $wg test('T18903', [ grep_errmsg(r'Dmd=\S+C\S+') ], compile, ['-ddump-simpl -dsuppress-uniques']) +# We care about the call demand on $wg1 and $wg2 +test('T18894', [ grep_errmsg(r'Dmd=\S+C\S+') ], compile, ['-ddump-stranal -dsuppress-uniques']) +# We care about the Arity 2 on eta, as a result of the annotated Dmd +test('T18894b', [ grep_errmsg(r'Arity=2') ], compile, ['-ddump-stranal -dsuppress-uniques -fno-call-arity -dppr-cols=200']) +# We care about the workers of f,g,h,i: +test('T18982', [ grep_errmsg(r'\$w. .*Int#$') ], compile, ['-dppr-cols=1000 -ddump-simpl -dsuppress-idinfo -dsuppress-uniques']) ===================================== testsuite/tests/stranal/sigs/T5075.stderr ===================================== @@ -1,7 +1,7 @@ ==================== Strictness signatures ==================== T5075.$trModule: -T5075.loop: +T5075.loop: @@ -13,6 +13,6 @@ T5075.loop: ==================== Strictness signatures ==================== T5075.$trModule: -T5075.loop: +T5075.loop: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/aff39a6a7bb75e72dd5f94440789e87a3ac5715c...0f32bf5e434a4d33013cdc0b519e008b4be62602 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/aff39a6a7bb75e72dd5f94440789e87a3ac5715c...0f32bf5e434a4d33013cdc0b519e008b4be62602 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 4 10:26:10 2020 From: gitlab at gitlab.haskell.org (Andreas Klebinger) Date: Fri, 04 Dec 2020 05:26:10 -0500 Subject: [Git][ghc/ghc][wip/andreask/bump_time] 51 commits: [Sized Cmm] properly retain sizes. Message-ID: <5fca0ec262906_6b21333dbc16739@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/bump_time at Glasgow Haskell Compiler / GHC Commits: be5d74ca by Moritz Angermann at 2020-11-26T16:00:32-05:00 [Sized Cmm] properly retain sizes. This replaces all Word<N> = W<N># Word# and Int<N> = I<N># Int# with Word<N> = W<N># Word<N># and Int<N> = I<N># Int<N>#, thus providing us with properly sized primitives in the codegenerator instead of pretending they are all full machine words. This came up when implementing darwinpcs for arm64. The darwinpcs reqires us to pack function argugments in excess of registers on the stack. While most procedure call standards (pcs) assume arguments are just passed in 8 byte slots; and thus the caller does not know the exact signature to make the call, darwinpcs requires us to adhere to the prototype, and thus have the correct sizes. If we specify CInt in the FFI call, it should correspond to the C int, and not just be Word sized, when it's only half the size. This does change the expected output of T16402 but the new result is no less correct as it eliminates the narrowing (instead of the `and` as was previously done). Bumps the array, bytestring, text, and binary submodules. Co-Authored-By: Ben Gamari <ben at well-typed.com> Metric Increase: T13701 T14697 - - - - - a84e53f9 by Andreas Klebinger at 2020-11-26T16:00:32-05:00 RTS: Fix failed inlining of copy_tag. On windows using gcc-10 gcc failed to inline copy_tag into evacuate. To fix this we now set the always_inline attribute for the various copy* functions in Evac.c. The main motivation here is not the overhead of the function call, but rather that this allows the code to "specialize" for the size of the closure we copy which is often known at compile time. An earlier commit also tried to avoid evacuate_large inlining. But didn't quite succeed. So I also marked evacuate_large as noinline. Fixes #12416 - - - - - cdbd16f5 by Sylvain Henry at 2020-11-26T16:00:33-05:00 Fix toArgRep to support 64-bit reps on all systems [This is @Ericson2314 writing a commit message for @hsyl20's patch.] (Progress towards #11953, #17377, #17375) `Int64Rep` and `Word64Rep` are currently broken on 64-bit systems. This is because they should use "native arg rep" but instead use "large arg rep" as they do on 32-bit systems, which is either a non-concept or a 128-bit rep depending on one's vantage point. Now, these reps currently aren't used during 64-bit compilation, so the brokenness isn't observed, but I don't think that constitutes reasons not to fix it. Firstly, the linked issues there is a clearly expressed desire to use explicit-bitwidth constructs in more places. Secondly, per [1], there are other bugs that *do* manifest from not threading explicit-bitwidth information all the way through the compilation pipeline. One can therefore view this as one piece of the larger effort to do that, improve ergnomics, and squash remaining bugs. Also, this is needed for !3658. I could just merge this as part of that, but I'm keen on merging fixes "as they are ready" so the fixes that aren't ready are isolated and easier to debug. [1]: https://mail.haskell.org/pipermail/ghc-devs/2020-October/019332.html - - - - - a9378e69 by Tim Barnes at 2020-11-26T16:00:34-05:00 Set dynamic users-guide TOC spacing (fixes #18554) - - - - - 86a59d93 by Ben Gamari at 2020-11-26T16:00:34-05:00 rts: Use RTS_LIKELY in CHECK Most compilers probably already infer that `barf` diverges but it nevertheless doesn't hurt to be explicit. - - - - - 5757e82b by Matthew Pickering at 2020-11-26T16:00:35-05:00 Remove special case for GHC.ByteCode.Instr This was added in https://github.com/nomeata/ghc-heap-view/commit/34935206e51b9c86902481d84d2f368a6fd93423 GHC.ByteCode.Instr.BreakInfo no longer exists so the special case is dead code. Any check like this can be easily dealt with in client code. - - - - - d9c8b5b4 by Matthew Pickering at 2020-11-26T16:00:35-05:00 Split Up getClosureDataFromHeapRep Motivation 1. Don't enforce the repeated decoding of an info table, when the client can cache it (ghc-debug) 2. Allow the constructor information decoding to be overridden, this casues segfaults in ghc-debug - - - - - 3e3555cc by Andreas Klebinger at 2020-11-26T16:00:35-05:00 RegAlloc: Add missing raPlatformfield to RegAllocStatsSpill Fixes #18994 Co-Author: Benjamin Maurer <maurer.benjamin at gmail.com> - - - - - a1a75aa9 by Ben Gamari at 2020-11-27T06:20:41-05:00 rts: Allocate MBlocks with MAP_TOP_DOWN on Windows As noted in #18991, we would previously allocate heap in low memory. Due to this the linker, which typically *needs* low memory, would end up competing with the heap. In longer builds we end up running out of low memory entirely, leading to linking failures. - - - - - 75fc1ed5 by Sylvain Henry at 2020-11-28T15:40:23-05:00 Hadrian: fix detection of ghc-pkg for cross-compilers - - - - - 7cb5df96 by Sylvain Henry at 2020-11-28T15:40:23-05:00 hadrian: fix ghc-pkg uses (#17601) Make sure ghc-pkg doesn't read the compiler "settings" file by passing --no-user-package-db. - - - - - e3fd4226 by Ben Gamari at 2020-11-28T15:40:23-05:00 gitlab-ci: Introduce a nightly cross-compilation job This adds a job to test cross-compilation from x86-64 to AArch64 with Hadrian. Fixes #18234 - - - - - 698d3d96 by Ben Gamari at 2020-11-28T15:41:00-05:00 gitlab-ci: Only deploy GitLab Pages in ghc/ghc> The deployments are quite large and yet are currently only served for the ghc/ghc> project. - - - - - 625726f9 by David Eichmann at 2020-11-28T15:41:37-05:00 ghc-heap: partial TSO/STACK decoding Co-authored-by: Sven Tennie <sven.tennie at gmail.com> Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> Co-authored-by: Ben Gamari <bgamari.foss at gmail.com> - - - - - 22ea9c29 by Andreas Klebinger at 2020-11-28T15:42:13-05:00 Small optimization to CmmSink. Inside `regsUsedIn` we can avoid some thunks by specializing the recursion. In particular we avoid the thunk for `(f e z)` in the MachOp/Load branches, where we know this will evaluate to z. Reduces allocations for T3294 by ~1%. - - - - - bba42c62 by John Ericson at 2020-11-28T15:42:49-05:00 Make primop handler indentation more consistent - - - - - c82bc8e9 by John Ericson at 2020-11-28T15:42:49-05:00 Cleanup some primop constructor names Harmonize the internal (big sum type) names of the native vs fixed-sized number primops a bit. (Mainly by renaming the former.) No user-facing names are changed. - - - - - ae14f160 by Ben Gamari at 2020-11-28T15:43:25-05:00 testsuite: Mark T14702 as fragile on Windows Due to #18953. - - - - - 1bc104b0 by Ben Gamari at 2020-11-29T15:33:18-05:00 withTimings: Emit allocations counter This will allow us to back out the allocations per compiler pass from the eventlog. Note that we dump the allocation counter rather than the difference since this will allow us to determine how much work is done *between* `withTiming` blocks. - - - - - e992ea84 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 ThreadPaused: Don't zero slop until free vars are pushed When threadPaused blackholes a thunk it calls `OVERWRITING_CLOSURE` to zero the slop for the benefit of the sanity checker. Previously this was done *before* pushing the thunk's free variables to the update remembered set. Consequently we would pull zero'd pointers to the update remembered set. - - - - - e82cd140 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Fix regression from TSAN work The TSAN rework (specifically aad1f803) introduced a subtle regression in GC.c, swapping `g0` in place of `gen`. Whoops! Fixes #18997. - - - - - 35a5207e by GHC GitLab CI at 2020-11-29T15:33:54-05:00 rts/Messages: Add missing write barrier in THROWTO message update After a THROWTO message has been handle the message closure is overwritten by a NULL message. We must ensure that the original closure's pointers continue to be visible to the nonmoving GC. - - - - - 0120829f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Add missing write barrier in shrinkSmallByteArray - - - - - 8a4d8fb6 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 Updates: Don't zero slop until closure has been pushed Ensure that the the free variables have been pushed to the update remembered set before we zero the slop. - - - - - 2793cfdc by GHC GitLab CI at 2020-11-29T15:33:54-05:00 OSThreads: Fix error code checking pthread_join returns its error code and apparently doesn't set errno. - - - - - e391a16f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Don't join to mark_thread on shutdown The mark thread is not joinable as we detach from it on creation. - - - - - 60d088ab by Ben Gamari at 2020-11-29T15:33:54-05:00 nonmoving: Add reference to Ueno 2016 - - - - - 3aa60362 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Ensure that evacuated large objects are marked See Note [Non-moving GC: Marking evacuated objects]. - - - - - 8d304a99 by Ben Gamari at 2020-11-30T10:15:22-05:00 rts/m32: Refactor handling of allocator seeding Previously, in an attempt to reduce fragmentation, each new allocator would map a region of M32_MAX_PAGES fresh pages to seed itself. However, this ends up being extremely wasteful since it turns out that we often use fewer than this. Consequently, these pages end up getting freed which, ends up fragmenting our address space more than than we would have if we had naively allocated pages on-demand. Here we refactor m32 to avoid this waste while achieving the fragmentation mitigation previously desired. In particular, we move all page allocation into the global m32_alloc_page, which will pull a page from the free page pool. If the free page pool is empty we then refill it by allocating a region of M32_MAP_PAGES and adding them to the pool. Furthermore, we do away with the initial seeding entirely. That is, the allocator starts with no active pages: pages are rather allocated on an as-needed basis. On the whole this ends up being a pleasingly simple change, simultaneously making m32 more efficient, more robust, and simpler. Fixes #18980. - - - - - b6629289 by Ben Gamari at 2020-11-30T10:15:58-05:00 rts: Use CHECK instead of assert Use the GHC wrappers instead of <assert.h>. - - - - - 9f4efa6a by Ben Gamari at 2020-11-30T10:15:58-05:00 rts/linker: Replace some ASSERTs with CHECK In the past some people have confused ASSERT, which is for checking internal invariants, which CHECK, which should be used when checking things that might fail due to bad input (and therefore should be enabled even in the release compiler). Change some of these cases in the linker to use CHECK. - - - - - 0f8a4655 by Ryan Scott at 2020-11-30T10:16:34-05:00 Allow deploy:pages job to fail See #18973. - - - - - 49ebe369 by chessai at 2020-11-30T19:47:40-05:00 Optimisations in Data.Foldable (T17867) This PR concerns the following functions from `Data.Foldable`: * minimum * maximum * sum * product * minimumBy * maximumBy - Default implementations of these functions now use `foldl'` or `foldMap'`. - All have been marked with INLINEABLE to make room for further optimisations. - - - - - 4d79ef65 by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - 6af074ce by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - ab334262 by Viktor Dukhovni at 2020-11-30T19:48:17-05:00 dirty MVAR after mutating TSO queue head While the original head and tail of the TSO queue may be in the same generation as the MVAR, interior elements of the queue could be younger after a GC run and may then be exposed by putMVar operation that updates the queue head. Resolves #18919 - - - - - 5eb163f3 by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Don't allow shared libraries to be loaded multiple times - - - - - 490aa14d by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Initialise CCSs from native shared objects - - - - - 6ac3db5f by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Move shared library loading logic into Elf.c - - - - - b6698d73 by GHC GitLab CI at 2020-11-30T19:48:53-05:00 rts/linker: Don't declare dynamic objects with image_mapped This previously resulted in warnings due to spurious unmap failures. - - - - - b94a65af by jneira at 2020-11-30T19:49:31-05:00 Include tried paths in findToolDir error - - - - - 72a87fbc by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Move core flattening algorithm to Core.Unify This sets the stage for a later change, where this algorithm will be needed from GHC.Core.InstEnv. This commit also splits GHC.Core.Map into GHC.Core.Map.Type and GHC.Core.Map.Expr, in order to avoid module import cycles with GHC.Core. - - - - - 0dd45d0a by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Bump the # of commits searched for perf baseline The previous value of 75 meant that a feature branch with more than 75 commits would get spurious CI passes. This affects #18692, but does not fix that ticket, because if a baseline cannot be found, we should fail, not succeed. - - - - - 8bb52d91 by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Remove flattening variables This patch redesigns the flattener to simplify type family applications directly instead of using flattening meta-variables and skolems. The key new innovation is the CanEqLHS type and the new CEqCan constraint (Ct). A CanEqLHS is either a type variable or exactly-saturated type family application; either can now be rewritten using a CEqCan constraint in the inert set. Because the flattener no longer reduces all type family applications to variables, there was some performance degradation if a lengthy type family application is now flattened over and over (not making progress). To compensate, this patch contains some extra optimizations in the flattener, leading to a number of performance improvements. Close #18875. Close #18910. There are many extra parts of the compiler that had to be affected in writing this patch: * The family-application cache (formerly the flat-cache) sometimes stores coercions built from Given inerts. When these inerts get kicked out, we must kick out from the cache as well. (This was, I believe, true previously, but somehow never caused trouble.) Kicking out from the cache requires adding a filterTM function to TrieMap. * This patch obviates the need to distinguish "blocking" coercion holes from non-blocking ones (which, previously, arose from CFunEqCans). There is thus some simplification around coercion holes. * Extra commentary throughout parts of the code I read through, to preserve the knowledge I gained while working. * A change in the pure unifier around unifying skolems with other types. Unifying a skolem now leads to SurelyApart, not MaybeApart, as documented in Note [Binding when looking up instances] in GHC.Core.InstEnv. * Some more use of MCoercion where appropriate. * Previously, class-instance lookup automatically noticed that e.g. C Int was a "unifier" to a target [W] C (F Bool), because the F Bool was flattened to a variable. Now, a little more care must be taken around checking for unifying instances. * Previously, tcSplitTyConApp_maybe would split (Eq a => a). This is silly, because (=>) is not a tycon in Haskell. Fixed now, but there are some knock-on changes in e.g. TrieMap code and in the canonicaliser. * New function anyFreeVarsOf{Type,Co} to check whether a free variable satisfies a certain predicate. * Type synonyms now remember whether or not they are "forgetful"; a forgetful synonym drops at least one argument. This is useful when flattening; see flattenView. * The pattern-match completeness checker invokes the solver. This invocation might need to look through newtypes when checking representational equality. Thus, the desugarer needs to keep track of the in-scope variables to know what newtype constructors are in scope. I bet this bug was around before but never noticed. * Extra-constraints wildcards are no longer simplified before printing. See Note [Do not simplify ConstraintHoles] in GHC.Tc.Solver. * Whether or not there are Given equalities has become slightly subtler. See the new HasGivenEqs datatype. * Note [Type variable cycles in Givens] in GHC.Tc.Solver.Canonical explains a significant new wrinkle in the new approach. * See Note [What might match later?] in GHC.Tc.Solver.Interact, which explains the fix to #18910. * The inert_count field of InertCans wasn't actually used, so I removed it. Though I (Richard) did the implementation, Simon PJ was very involved in design and review. This updates the Haddock submodule to avoid #18932 by adding a type signature. ------------------------- Metric Decrease: T12227 T5030 T9872a T9872b T9872c Metric Increase: T9872d ------------------------- - - - - - d66660ba by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Rename the flattener to become the rewriter. Now that flattening doesn't produce flattening variables, it's not really flattening anything: it's rewriting. This change also means that the rewriter can no longer be confused the core flattener (in GHC.Core.Unify), which is sometimes used during type-checking. - - - - - add0aeae by Ben Gamari at 2020-12-01T19:58:17-05:00 rts: Introduce mmapAnonForLinker Previously most of the uses of mmapForLinker were mapping anonymous memory, resulting in a great deal of unnecessary repetition. Factor this out into a new helper. Also fixes a few places where error checking was missing or suboptimal. - - - - - 97d71646 by Ben Gamari at 2020-12-01T19:58:17-05:00 rts/linker: Introduce munmapForLinker Consolidates munmap calls to ensure consistent error handling. - - - - - d8872af0 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/Linker: Introduce Windows implementations for mmapForLinker, et al. - - - - - c35d0e03 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/m32: Introduce NEEDS_M32 macro Instead of relying on RTS_LINKER_USE_MMAP - - - - - 41c64eb5 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/linker: Use m32 to allocate symbol extras in PEi386 - - - - - 027f49b6 by Andreas Klebinger at 2020-12-04T05:26:08-05:00 Bump time submodule. This should fix #19002. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/Reg/Graph.hs - compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs - compiler/GHC/CmmToC.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Axiom.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FamInstEnv.hs - compiler/GHC/Core/InstEnv.hs - + compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Map.hs → compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/Opt/CSE.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCon.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ac4dc12be16552abe2e441f338bf02d6828d43ed...027f49b680f6c0a300d3d27889fb709d57085b57 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ac4dc12be16552abe2e441f338bf02d6828d43ed...027f49b680f6c0a300d3d27889fb709d57085b57 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 4 11:15:43 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Fri, 04 Dec 2020 06:15:43 -0500 Subject: [Git][ghc/ghc][wip/sgraf-dmdanal-stuff] WorkWrap: Unbox constructors with existentials (#18982) Message-ID: <5fca1a5fdb94f_6b211e39442804c@gitlab.mail> Sebastian Graf pushed to branch wip/sgraf-dmdanal-stuff at Glasgow Haskell Compiler / GHC Commits: 3a879906 by Sebastian Graf at 2020-12-04T12:15:30+01:00 WorkWrap: Unbox constructors with existentials (#18982) I found that by relaxing the "no existential" checks in `isDataProductType_maybe` and `isDataSumType_maybe`, the former becomes identical to `tyConSingleAlgDataCon_maybe`. So I deleted both and introduced a new function, `tyConAlgDataCons_maybe` for the sum case. I cleaned up a couple of call sites, some of which weren't very explicit about whether they cared for existentials or not. Most of the new stuff happens in worker/wrapper, where handling of existentials means more substitution work because we have to clone the existential binders of the DataCon when matching on it in the unboxing `Case`. The test output of `T18013` changed, because we now unbox the `Rule` data type. Its constructor carries existential state and will be w/w'd now. In the particular example, the worker functions inlines right back into the wrapper, which then unnecessarily has a (quite big) stable unfolding. I think this kind of fallout is inevitable; see also Note [Don't w/w inline small non-loop-breaker things]. There's a new regression test case `T18982`. Fixes #18982. - - - - - 16 changed files: - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Opt/CprAnal.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/HsToCore/Foreign/Call.hs - compiler/GHC/HsToCore/Foreign/Decl.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Tc/Deriv/Utils.hs - compiler/GHC/Types/Demand.hs - testsuite/tests/simplCore/should_compile/T18013.stderr - + testsuite/tests/stranal/should_compile/T18982.hs - + testsuite/tests/stranal/should_compile/T18982.stderr - testsuite/tests/stranal/should_compile/all.T Changes: ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -48,7 +48,7 @@ module GHC.Core.DataCon ( dataConImplicitTyThings, dataConRepStrictness, dataConImplBangs, dataConBoxer, - splitDataProductType_maybe, + splitNonExDataProductType_maybe, -- ** Predicates on DataCons isNullarySrcDataCon, isNullaryRepDataCon, @@ -1564,29 +1564,28 @@ promoteDataCon (MkData { dcPromoted = tc }) = tc -- | Extract the type constructor, type argument, data constructor and it's -- /representation/ argument types from a type if it is a product type. -- --- Precisely, we return @Just@ for any type that is all of: +-- Precisely, we return @Just@ for any data type that is all of: -- -- * Concrete (i.e. constructors visible) --- -- * Single-constructor +-- * ... which has no existentials -- --- * Not existentially quantified --- --- Whether the type is a @data@ type or a @newtype@ -splitDataProductType_maybe +-- Whether the type is a @data@ type or a @newtype at . +splitNonExDataProductType_maybe :: Type -- ^ A product type, perhaps -> Maybe (TyCon, -- The type constructor [Type], -- Type args of the tycon DataCon, -- The data constructor [Scaled Type]) -- Its /representation/ arg types - -- Rejecting existentials is conservative. Maybe some things - -- could be made to work with them, but I'm not going to sweat - -- it through till someone finds it's important. + -- Rejecting existentials means we don't have to worry about + -- freshening and substituting type variables + -- (See "GHC.Type.Id.Make.dataConArgUnpack") -splitDataProductType_maybe ty +splitNonExDataProductType_maybe ty | Just (tycon, ty_args) <- splitTyConApp_maybe ty - , Just con <- isDataProductTyCon_maybe tycon + , Just con <- tyConSingleDataCon_maybe tycon + , null (dataConExTyCoVars con) -- no existentials! See above = Just (tycon, ty_args, con, dataConInstArgTys con ty_args) | otherwise = Nothing ===================================== compiler/GHC/Core/Opt/CprAnal.hs ===================================== @@ -446,14 +446,13 @@ extendEnvForDataAlt env scrut case_bndr dc bndrs ids_w_strs = filter isId bndrs `zip` dataConRepStrictness dc - tycon = dataConTyCon dc - is_product = isJust (isDataProductTyCon_maybe tycon) - is_sum = isJust (isDataSumTyCon_maybe tycon) + is_algebraic = isJust (tyConAlgDataCons_maybe (dataConTyCon dc)) + no_exs = null (dataConExTyCoVars dc) case_bndr_ty - | is_product || is_sum = conCprType (dataConTag dc) - -- Any of the constructors had existentials. This is a little too - -- conservative (after all, we only care about the particular data con), - -- but there is no easy way to write is_sum and this won't happen much. + | is_algebraic, no_exs = conCprType (dataConTag dc) + -- The tycon wasn't algebraic or the datacon had existentials. + -- CPR'ing existentials would need first class existentials/dependent sums + -- to exploit, so we return topCprType here. | otherwise = topCprType -- We could have much deeper CPR info here with Nested CPR, which could ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -400,8 +400,8 @@ dmdAnal' env dmd (Lam var body) dmdAnal' env dmd (Case scrut case_bndr ty [(alt, bndrs, rhs)]) -- Only one alternative. - -- If it's a DataAlt, it should be a product constructor. - | is_non_sum_alt alt + -- If it's a DataAlt, it should be the only constructor of the type. + | is_single_data_alt alt = let (rhs_ty, rhs') = dmdAnal env dmd rhs (alt_ty1, dmds) = findBndrsDmds env rhs_ty bndrs @@ -440,8 +440,8 @@ dmdAnal' env dmd (Case scrut case_bndr ty [(alt, bndrs, rhs)]) -- , text "res_ty" <+> ppr res_ty ]) $ (res_ty, Case scrut' case_bndr' ty [(alt, bndrs', rhs')]) where - is_non_sum_alt (DataAlt dc) = isJust $ isDataProductTyCon_maybe $ dataConTyCon dc - is_non_sum_alt _ = True + is_single_data_alt (DataAlt dc) = isJust $ tyConSingleAlgDataCon_maybe $ dataConTyCon dc + is_single_data_alt _ = True dmdAnal' env dmd (Case scrut case_bndr ty alts) = let -- Case expression with multiple alternatives @@ -501,10 +501,11 @@ forcesRealWorld :: FamInstEnvs -> Type -> Bool forcesRealWorld fam_envs ty | ty `eqType` realWorldStatePrimTy = True - | Just DataConAppContext{ dcac_dc = dc, dcac_arg_tys = field_tys } + | Just DataConAppContext{ dcac_dc = dc, dcac_tc_args = tc_args } <- deepSplitProductType_maybe fam_envs ty , isUnboxedTupleDataCon dc - = any (\(ty,_) -> scaledThing ty `eqType` realWorldStatePrimTy) field_tys + , let field_tys = dataConInstArgTys dc tc_args + = any (eqType realWorldStatePrimTy . scaledThing) field_tys | otherwise = False ===================================== compiler/GHC/Core/Opt/WorkWrap/Utils.hs ===================================== @@ -609,50 +609,78 @@ mkWWstr_one dflags fam_envs has_inlineable_prag arg wantToUnbox :: FamInstEnvs -> Bool -> Type -> Demand -> Maybe ([Demand], DataConAppContext) wantToUnbox fam_envs has_inlineable_prag ty dmd = case deepSplitProductType_maybe fam_envs ty of - Just dcac at DataConAppContext{ dcac_arg_tys = con_arg_tys } + Just dcac at DataConAppContext{ dcac_dc = dc } | isStrUsedDmd dmd + , let arity = dataConRepArity dc -- See Note [Unpacking arguments with product and polymorphic demands] - , Just cs <- split_prod_dmd_arity dmd (length con_arg_tys) + , Just cs <- split_prod_dmd_arity dmd arity -- See Note [Do not unpack class dictionaries] , not (has_inlineable_prag && isClassPred ty) -- See Note [mkWWstr and unsafeCoerce] - , cs `equalLength` con_arg_tys + , cs `lengthIs` arity -> Just (cs, dcac) _ -> Nothing where - split_prod_dmd_arity dmd arty + split_prod_dmd_arity dmd arity -- For seqDmd, it should behave like , for some -- suitable arity - | isSeqDmd dmd = Just (replicate arty absDmd) + | isSeqDmd dmd = Just (replicate arity absDmd) | _ :* Prod ds <- dmd = Just ds | otherwise = Nothing +-- | Like 'dataConInstArgTys', but +-- +-- * handles existentials (by cloning) +-- * and returns fresh 'Id's for the instantiated argument types +-- +-- The cloning and freshening needs 'MonadUnique'. +dataConInstExAndArgVars :: MonadUnique m => FastString -> DataCon -> [Type] -> m ([TyCoVar], [Id]) +dataConInstExAndArgVars prefix dc tc_args = do + let subst_univ = zipTvSubst (dataConUnivTyVars dc) tc_args + (subst, ex_tvs') <- cloneTyVarBndrs subst_univ (dataConExTyCoVars dc) <$> getUniqueSupplyM + -- the following line is straight from 'dataConInstArgTys' + let arg_tys = mapScaledType (substTy subst) <$> dataConRepArgTys dc + let mk_id (Scaled m ty) uniq = mkSysLocalOrCoVar prefix uniq m ty + arg_id_uniqs <- getUniquesM + let arg_ids = zipWithEqual "dataConInstExAndArgVars" mk_id arg_tys arg_id_uniqs + pure (ex_tvs', arg_ids) + +-- | Exactly 'dataConInstArgTys', but lacks the (ASSERT'ed) precondition that +-- the 'DataCon' may not have existentials. The lack of cloning the existentials +-- compared to 'dataConInstExAndArgVars' makes this function \"dubious\"; +-- only use it where type variables aren't substituted! +dubiousDataConInstArgTys :: DataCon -> [Type] -> [Scaled Type] +dubiousDataConInstArgTys dc tc_args = arg_tys + where + univ_tvs = dataConUnivTyVars dc + ex_tvs = dataConExTyCoVars dc + subst = extendTCvInScopeList (zipTvSubst univ_tvs tc_args) ex_tvs + arg_tys = mapScaledType (substTy subst) <$> dataConRepArgTys dc + unbox_one :: DynFlags -> FamInstEnvs -> Var -> [Demand] -> DataConAppContext -> UniqSM (Bool, [Var], CoreExpr -> CoreExpr, CoreExpr -> CoreExpr) unbox_one dflags fam_envs arg cs - DataConAppContext { dcac_dc = data_con, dcac_tys = inst_tys - , dcac_arg_tys = inst_con_arg_tys + DataConAppContext { dcac_dc = dc, dcac_tc_args = tc_args , dcac_co = co } - = do { (uniq1:uniqs) <- getUniquesM - ; let scale = scaleScaled (idMult arg) - scaled_inst_con_arg_tys = map (\(t,s) -> (scale t, s)) inst_con_arg_tys - -- See Note [Add demands for strict constructors] - cs' = addDataConStrictness data_con cs - unpk_args = zipWith3 mk_ww_arg uniqs scaled_inst_con_arg_tys cs' - unbox_fn = mkUnpackCase (Var arg) co (idMult arg) uniq1 - data_con unpk_args - arg_no_unf = zapStableUnfolding arg - -- See Note [Zap unfolding when beta-reducing] - -- in GHC.Core.Opt.Simplify; and see #13890 - rebox_fn = Let (NonRec arg_no_unf con_app) - con_app = mkConApp2 data_con inst_tys unpk_args `mkCast` mkSymCo co - ; (_, worker_args, wrap_fn, work_fn) <- mkWWstr dflags fam_envs False unpk_args - ; return (True, worker_args, unbox_fn . wrap_fn, work_fn . rebox_fn) } - -- Don't pass the arg, rebox instead - where - mk_ww_arg uniq ty sub_dmd = setIdDemandInfo (mk_ww_local uniq ty) sub_dmd + = do { (ex_tvs', arg_ids) <- dataConInstExAndArgVars ww_prefix dc tc_args + ; case_bndr_uniq <- getUniqueM + ; let str_marks = dataConRepStrictness dc + arg_ids1 = zipWithEqual "unbox_one" (flip setCaseBndrEvald) arg_ids str_marks + -- See Note [Add demands for strict constructors] + cs' = addDataConStrictness dc cs + arg_ids2 = zipWithEqual "unbox_one" setIdDemandInfo arg_ids1 cs' + unbox_fn = mkUnpackCase (Var arg) co (idMult arg) case_bndr_uniq + dc (ex_tvs' ++ arg_ids2) + arg_no_unf = zapStableUnfolding arg + -- See Note [Zap unfolding when beta-reducing] + -- in GHC.Core.Opt.Simplify; and see #13890 + rebox_fn = Let (NonRec arg_no_unf con_app) + con_app = mkConApp2 dc tc_args (ex_tvs' ++ arg_ids2) `mkCast` mkSymCo co + ; (_, worker_args, wrap_fn, work_fn) <- mkWWstr dflags fam_envs False (ex_tvs' ++ arg_ids2) + ; return (True, worker_args, unbox_fn . wrap_fn, work_fn . rebox_fn) } + -- Don't pass the arg, rebox instead ---------------------- nop_fn :: CoreExpr -> CoreExpr @@ -932,72 +960,67 @@ off the unpacking in mkWWstr_one (see the isClassPred test). Historical note: #14955 describes how I got this fix wrong the first time. -} --- | Context for a 'DataCon' application with a hole for every field, including --- surrounding coercions. +-- | Context for a 'DataCon' application wrapped in a cast, where we know the +-- type arguments of the 'TyCon' but not any of the arguments to the 'DataCon' +-- (type or term). +-- -- The result of 'deepSplitProductType_maybe' and 'deepSplitCprType_maybe'. -- -- Example: -- --- > DataConAppContext Just [Int] [(Lazy, Int)] (co :: Maybe Int ~ First Int) +-- > DataConAppContext Just [Int] (co :: Maybe Int ~ First Int) -- -- represents -- --- > Just @Int (_1 :: Int) |> co :: First Int +-- > (Just @_1 _2 :: Maybe Int) |> co :: First Int -- --- where _1 is a hole for the first argument. The number of arguments is --- determined by the length of @arg_tys at . data DataConAppContext = DataConAppContext - { dcac_dc :: !DataCon - , dcac_tys :: ![Type] - , dcac_arg_tys :: ![(Scaled Type, StrictnessMark)] - , dcac_co :: !Coercion + { dcac_dc :: !DataCon + , dcac_tc_args :: ![Type] + , dcac_co :: !Coercion } +-- | If @deepSplitProductType_maybe ty = Just (dc, tys, co)@ +-- then @dc \@tys \@_ex_tys (_args::_arg_tys) :: tc tys@ +-- and @co :: ty ~ tc tys@ +-- where underscore prefixes are holes, e.g. yet unspecified. deepSplitProductType_maybe :: FamInstEnvs -> Type -> Maybe DataConAppContext --- If deepSplitProductType_maybe ty = Just (dc, tys, arg_tys, co) --- then dc @ tys (args::arg_tys) :: rep_ty --- co :: ty ~ rep_ty --- Why do we return the strictness of the data-con arguments? --- Answer: see Note [Record evaluated-ness in worker/wrapper] deepSplitProductType_maybe fam_envs ty | let (co, ty1) = topNormaliseType_maybe fam_envs ty `orElse` (mkRepReflCo ty, ty) , Just (tc, tc_args) <- splitTyConApp_maybe ty1 - , Just con <- isDataProductTyCon_maybe tc - , let arg_tys = dataConInstArgTys con tc_args - strict_marks = dataConRepStrictness con - = Just DataConAppContext { dcac_dc = con - , dcac_tys = tc_args - , dcac_arg_tys = zipEqual "dspt" arg_tys strict_marks - , dcac_co = co } + , Just con <- tyConSingleAlgDataCon_maybe tc + = Just DataConAppContext { dcac_dc = con + , dcac_tc_args = tc_args + , dcac_co = co } deepSplitProductType_maybe _ _ = Nothing -deepSplitCprType_maybe - :: FamInstEnvs -> ConTag -> Type -> Maybe DataConAppContext --- If deepSplitCprType_maybe n ty = Just (dc, tys, arg_tys, co) --- then dc @ tys (args::arg_tys) :: rep_ty --- co :: ty ~ rep_ty --- Why do we return the strictness of the data-con arguments? --- Answer: see Note [Record evaluated-ness in worker/wrapper] +-- | If @deepSplitCprType_maybe n ty = Just (dc, tys, co)@ +-- then @dc \@tys \@_ex_tys (_args::_arg_tys) :: tc tys@ +-- and @co :: ty ~ tc tys@ +-- where underscore prefixes are holes, e.g. yet unspecified. +-- @dc@ is the @n at th data constructor of @tc at . +deepSplitCprType_maybe :: FamInstEnvs -> ConTag -> Type -> Maybe DataConAppContext deepSplitCprType_maybe fam_envs con_tag ty | let (co, ty1) = topNormaliseType_maybe fam_envs ty `orElse` (mkRepReflCo ty, ty) , Just (tc, tc_args) <- splitTyConApp_maybe ty1 - , isDataTyCon tc + , isDataTyCon tc -- NB: rules out unboxed sums and pairs! , let cons = tyConDataCons tc , cons `lengthAtLeast` con_tag -- This might not be true if we import the - -- type constructor via a .hs-bool file (#8743) + -- type constructor via a .hs-boot file (#8743) , let con = cons `getNth` (con_tag - fIRST_TAG) - arg_tys = dataConInstArgTys con tc_args - strict_marks = dataConRepStrictness con - , all isLinear arg_tys + , null (dataConExTyCoVars con) -- no existentials; + -- See Note [Product types] in "GHC.Core.TyCon" + -- and GHC.Core.Opt.CprAnal.extendEnvForDataAlt + -- where we also check this. + , all isLinear (dataConInstArgTys con tc_args) -- Deactivates CPR worker/wrapper splits on constructors with non-linear -- arguments, for the moment, because they require unboxed tuple with variable -- multiplicity fields. = Just DataConAppContext { dcac_dc = con - , dcac_tys = tc_args - , dcac_arg_tys = zipEqual "dspt" arg_tys strict_marks + , dcac_tc_args = tc_args , dcac_co = co } deepSplitCprType_maybe _ _ _ = Nothing @@ -1035,13 +1058,15 @@ findTypeShape fam_envs ty | Just (_, rhs, _) <- topReduceTyFamApp_maybe fam_envs tc tc_args = go rec_tc rhs - | Just con <- isDataProductTyCon_maybe tc + | Just con <- tyConSingleAlgDataCon_maybe tc , Just rec_tc <- if isTupleTyCon tc then Just rec_tc else checkRecTc rec_tc tc -- We treat tuples specially because they can't cause loops. -- Maybe we should do so in checkRecTc. - = TsProd (map (go rec_tc . scaledThing) (dataConInstArgTys con tc_args)) + -- The use of 'dubiousDataConInstArgTys' is OK, since this + -- function performs no substitution at all. + = TsProd (map (go rec_tc . scaledThing) (dubiousDataConInstArgTys con tc_args)) | Just (ty', _) <- instNewTyCon_maybe tc tc_args , Just rec_tc <- checkRecTc rec_tc tc @@ -1093,25 +1118,26 @@ mkWWcpr opt_CprAnal fam_envs body_ty cpr mkWWcpr_help :: DataConAppContext -> UniqSM (Bool, CoreExpr -> CoreExpr, CoreExpr -> CoreExpr, Type) -mkWWcpr_help (DataConAppContext { dcac_dc = data_con, dcac_tys = inst_tys - , dcac_arg_tys = arg_tys, dcac_co = co }) - | [arg1@(arg_ty1, _)] <- arg_tys - , isUnliftedType (scaledThing arg_ty1) - , isLinear arg_ty1 +mkWWcpr_help (DataConAppContext { dcac_dc = dc, dcac_tc_args = tc_args + , dcac_co = co }) + | [arg_ty] <- arg_tys + , [str_mark] <- str_marks + , isUnliftedType (scaledThing arg_ty) + , isLinear arg_ty -- Special case when there is a single result of unlifted, linear, type -- -- Wrapper: case (..call worker..) of x -> C x -- Worker: case ( ..body.. ) of C x -> x = do { (work_uniq : arg_uniq : _) <- getUniquesM - ; let arg = mk_ww_local arg_uniq arg1 - con_app = mkConApp2 data_con inst_tys [arg] `mkCast` mkSymCo co + ; let arg_id = mk_ww_local arg_uniq str_mark arg_ty + con_app = mkConApp2 dc tc_args [arg_id] `mkCast` mkSymCo co ; return ( True - , \ wkr_call -> mkDefaultCase wkr_call arg con_app - , \ body -> mkUnpackCase body co One work_uniq data_con [arg] (varToCoreExpr arg) + , \ wkr_call -> mkDefaultCase wkr_call arg_id con_app + , \ body -> mkUnpackCase body co One work_uniq dc [arg_id] (varToCoreExpr arg_id) -- varToCoreExpr important here: arg can be a coercion -- Lacking this caused #10658 - , scaledThing arg_ty1 ) } + , scaledThing arg_ty ) } | otherwise -- The general case -- Wrapper: case (..call worker..) of (# a, b #) -> C a b @@ -1124,18 +1150,21 @@ mkWWcpr_help (DataConAppContext { dcac_dc = data_con, dcac_tys = inst_tys -- instance, the multiplicity of the fields of (#,#) is chosen to be the -- same as those of C. = do { (work_uniq : wild_uniq : uniqs) <- getUniquesM - ; let wrap_wild = mk_ww_local wild_uniq (linear ubx_tup_ty,MarkedStrict) - args = zipWith mk_ww_local uniqs arg_tys + ; let wrap_wild = mk_ww_local wild_uniq MarkedStrict (linear ubx_tup_ty) + arg_ids = zipWith3 mk_ww_local uniqs str_marks arg_tys ubx_tup_ty = exprType ubx_tup_app - ubx_tup_app = mkCoreUbxTup (map (scaledThing . fst) arg_tys) (map varToCoreExpr args) - con_app = mkConApp2 data_con inst_tys args `mkCast` mkSymCo co + ubx_tup_app = mkCoreUbxTup (map scaledThing arg_tys) (map varToCoreExpr arg_ids) + con_app = mkConApp2 dc tc_args arg_ids `mkCast` mkSymCo co tup_con = tupleDataCon Unboxed (length arg_tys) ; return (True , \ wkr_call -> mkSingleAltCase wkr_call wrap_wild - (DataAlt tup_con) args con_app - , \ body -> mkUnpackCase body co One work_uniq data_con args ubx_tup_app + (DataAlt tup_con) arg_ids con_app + , \ body -> mkUnpackCase body co One work_uniq dc arg_ids ubx_tup_app , ubx_tup_ty ) } + where + arg_tys = dataConInstArgTys dc tc_args -- NB: No existentials! + str_marks = dataConRepStrictness dc mkUnpackCase :: CoreExpr -> Coercion -> Mult -> Unique -> DataCon -> [Id] -> CoreExpr -> CoreExpr -- (mkUnpackCase e co uniq Con args body) @@ -1149,7 +1178,7 @@ mkUnpackCase scrut co mult uniq boxing_con unpk_args body (DataAlt boxing_con) unpk_args body where casted_scrut = scrut `mkCast` co - bndr = mk_ww_local uniq (Scaled mult (exprType casted_scrut), MarkedStrict) + bndr = mk_ww_local uniq MarkedStrict (Scaled mult (exprType casted_scrut)) -- An unpacking case can always be chosen linear, because the variables -- are always passed to a constructor. This limits the {- @@ -1291,10 +1320,13 @@ mk_absent_let dflags fam_envs arg -- See also Note [Unique Determinism] in GHC.Types.Unique unlifted_rhs = mkTyApps (Lit rubbishLit) [arg_ty] -mk_ww_local :: Unique -> (Scaled Type, StrictnessMark) -> Id +ww_prefix :: FastString +ww_prefix = fsLit "ww" + +mk_ww_local :: Unique -> StrictnessMark -> Scaled Type -> Id -- The StrictnessMark comes form the data constructor and says -- whether this field is strict -- See Note [Record evaluated-ness in worker/wrapper] -mk_ww_local uniq (Scaled w ty,str) +mk_ww_local uniq str (Scaled w ty) = setCaseBndrEvald str $ - mkSysLocalOrCoVar (fsLit "ww") uniq w ty + mkSysLocalOrCoVar ww_prefix uniq w ty ===================================== compiler/GHC/Core/TyCon.hs ===================================== @@ -58,8 +58,7 @@ module GHC.Core.TyCon( isKindTyCon, isLiftedTypeKindTyConName, isTauTyCon, isFamFreeTyCon, - isDataTyCon, isProductTyCon, isDataProductTyCon_maybe, - isDataSumTyCon_maybe, + isDataTyCon, isEnumerationTyCon, isNewTyCon, isAbstractTyCon, isFamilyTyCon, isOpenFamilyTyCon, @@ -84,6 +83,7 @@ module GHC.Core.TyCon( tyConCType, tyConCType_maybe, tyConDataCons, tyConDataCons_maybe, tyConSingleDataCon_maybe, tyConSingleDataCon, + tyConAlgDataCons_maybe, tyConSingleAlgDataCon_maybe, tyConFamilySize, tyConStupidTheta, @@ -143,7 +143,7 @@ import {-# SOURCE #-} GHC.Builtin.Types , multiplicityTyCon , vecCountTyCon, vecElemTyCon, liftedTypeKind ) import {-# SOURCE #-} GHC.Core.DataCon - ( DataCon, dataConExTyCoVars, dataConFieldLabels + ( DataCon, dataConFieldLabels , dataConTyCon, dataConFullSig , isUnboxedSumDataCon ) import GHC.Builtin.Uniques @@ -1970,72 +1970,6 @@ unwrapNewTyConEtad_maybe (AlgTyCon { algTcRhs = NewTyCon { nt_co = co, = Just (tvs, rhs, co) unwrapNewTyConEtad_maybe _ = Nothing -isProductTyCon :: TyCon -> Bool --- True of datatypes or newtypes that have --- one, non-existential, data constructor --- See Note [Product types] -isProductTyCon tc@(AlgTyCon {}) - = case algTcRhs tc of - TupleTyCon {} -> True - DataTyCon{ data_cons = [data_con] } - -> null (dataConExTyCoVars data_con) - NewTyCon {} -> True - _ -> False -isProductTyCon _ = False - -isDataProductTyCon_maybe :: TyCon -> Maybe DataCon --- True of datatypes (not newtypes) with --- one, vanilla, data constructor --- See Note [Product types] -isDataProductTyCon_maybe (AlgTyCon { algTcRhs = rhs }) - = case rhs of - DataTyCon { data_cons = [con] } - | null (dataConExTyCoVars con) -- non-existential - -> Just con - TupleTyCon { data_con = con } - -> Just con - _ -> Nothing -isDataProductTyCon_maybe _ = Nothing - -isDataSumTyCon_maybe :: TyCon -> Maybe [DataCon] -isDataSumTyCon_maybe (AlgTyCon { algTcRhs = rhs }) - = case rhs of - DataTyCon { data_cons = cons } - | cons `lengthExceeds` 1 - , all (null . dataConExTyCoVars) cons -- FIXME(osa): Why do we need this? - -> Just cons - SumTyCon { data_cons = cons } - | all (null . dataConExTyCoVars) cons -- FIXME(osa): Why do we need this? - -> Just cons - _ -> Nothing -isDataSumTyCon_maybe _ = Nothing - -{- Note [Product types] -~~~~~~~~~~~~~~~~~~~~~~~ -A product type is - * A data type (not a newtype) - * With one, boxed data constructor - * That binds no existential type variables - -The main point is that product types are amenable to unboxing for - * Strict function calls; we can transform - f (D a b) = e - to - fw a b = e - via the worker/wrapper transformation. (Question: couldn't this - work for existentials too?) - - * CPR for function results; we can transform - f x y = let ... in D a b - to - fw x y = let ... in (# a, b #) - -Note that the data constructor /can/ have evidence arguments: equality -constraints, type classes etc. So it can be GADT. These evidence -arguments are simply value arguments, and should not get in the way. --} - - -- | Is this a 'TyCon' representing a regular H98 type synonym (@type@)? {-# INLINE isTypeSynonymTyCon #-} -- See Note [Inlining coreView] in GHC.Core.Type isTypeSynonymTyCon :: TyCon -> Bool @@ -2363,8 +2297,7 @@ tyConDataCons_maybe _ = Nothing -- | If the given 'TyCon' has a /single/ data constructor, i.e. it is a @data@ -- type with one alternative, a tuple type or a @newtype@ then that constructor -- is returned. If the 'TyCon' has more than one constructor, or represents a --- primitive or function type constructor then @Nothing@ is returned. In any --- other case, the function panics +-- primitive or function type constructor then @Nothing@ is returned. tyConSingleDataCon_maybe :: TyCon -> Maybe DataCon tyConSingleDataCon_maybe (AlgTyCon { algTcRhs = rhs }) = case rhs of @@ -2374,21 +2307,31 @@ tyConSingleDataCon_maybe (AlgTyCon { algTcRhs = rhs }) _ -> Nothing tyConSingleDataCon_maybe _ = Nothing +-- | Like 'tyConSingleDataCon_maybe', but panics if 'Nothing'. tyConSingleDataCon :: TyCon -> DataCon tyConSingleDataCon tc = case tyConSingleDataCon_maybe tc of Just c -> c Nothing -> pprPanic "tyConDataCon" (ppr tc) +-- | Like 'tyConSingleDataCon_maybe', but returns 'Nothing' for newtypes. +-- +-- These are the 'TyCon's we want to unbox. See Note [Product types]. tyConSingleAlgDataCon_maybe :: TyCon -> Maybe DataCon --- Returns (Just con) for single-constructor --- *algebraic* data types *not* newtypes -tyConSingleAlgDataCon_maybe (AlgTyCon { algTcRhs = rhs }) - = case rhs of - DataTyCon { data_cons = [c] } -> Just c - TupleTyCon { data_con = c } -> Just c - _ -> Nothing -tyConSingleAlgDataCon_maybe _ = Nothing +tyConSingleAlgDataCon_maybe tycon + | isNewTyCon tycon = Nothing + | otherwise = tyConSingleDataCon_maybe tycon + +-- | Returns @Just dcs@ if the given 'TyCon' is a @data@ type, a tuple type +-- or a sum type with data constructors dcs. If the 'TyCon' has more than one +-- constructor, or represents a primitive or function type constructor then +-- @Nothing@ is returned. +-- +-- Like 'tyConDataCons_maybe', but returns 'Nothing' for newtypes. +tyConAlgDataCons_maybe :: TyCon -> Maybe [DataCon] +tyConAlgDataCons_maybe tycon + | isNewTyCon tycon = Nothing + | otherwise = tyConDataCons_maybe tycon -- | Determine the number of value constructors a 'TyCon' has. Panics if the -- 'TyCon' is not algebraic or a tuple @@ -2408,6 +2351,31 @@ algTyConRhs :: TyCon -> AlgTyConRhs algTyConRhs (AlgTyCon {algTcRhs = rhs}) = rhs algTyConRhs other = pprPanic "algTyConRhs" (ppr other) +{- Note [Product types] +~~~~~~~~~~~~~~~~~~~~~~~ +A product type is + * A data type (not a newtype) + * With one data constructor + +The main point is that product types are amenable to unboxing for + * Strict function calls; we can transform + f (D @ex a b) = e + to + fw @ex a b = e + via the worker/wrapper transformation. + + * CPR for function results (if the data con has no existentials); we can + transform + f x y = let ... in D a b + to + fw x y = let ... in (# a, b #) + +Note that the data constructor /can/ have evidence arguments: equality +constraints, type classes etc. So it can be GADT. These evidence +arguments are simply value arguments, and should not get in the way. +-} + + -- | Extract type variable naming the result of injective type family tyConFamilyResVar_maybe :: TyCon -> Maybe Name tyConFamilyResVar_maybe (FamilyTyCon {famTcResVar = res}) = res ===================================== compiler/GHC/CoreToIface.hs ===================================== @@ -245,7 +245,7 @@ toIfaceTyCon tc , Just tsort <- tupleSort tc' = tsort | isUnboxedSumTyCon tc - , Just cons <- isDataSumTyCon_maybe tc = IfaceSumTyCon (length cons) + , Just cons <- tyConDataCons_maybe tc = IfaceSumTyCon (length cons) | otherwise = IfaceNormalTyCon ===================================== compiler/GHC/Hs/Pat.hs ===================================== @@ -771,8 +771,6 @@ isIrrefutableHsPat L _ (PatSynCon _pat) -> False -- Conservative L _ (RealDataCon con) -> isJust (tyConSingleDataCon_maybe (dataConTyCon con)) - -- NB: tyConSingleDataCon_maybe, *not* isProductTyCon, because - -- the latter is false of existentials. See #4439 && all goL (hsConPatArgs details) go (LitPat {}) = False go (NPat {}) = False ===================================== compiler/GHC/HsToCore/Foreign/Call.hs ===================================== @@ -195,7 +195,7 @@ unboxArg arg pprPanic "unboxArg: " (ppr l <+> ppr arg_ty) where arg_ty = exprType arg - maybe_product_type = splitDataProductType_maybe arg_ty + maybe_product_type = splitNonExDataProductType_maybe arg_ty is_product_type = isJust maybe_product_type Just (_, _, data_con, scaled_data_con_arg_tys) = maybe_product_type data_con_arg_tys = map scaledThing scaled_data_con_arg_tys @@ -353,7 +353,8 @@ resultWrapper result_ty -- Data types with a single constructor, which has a single arg -- This includes types like Ptr and ForeignPtr | Just (tycon, tycon_arg_tys) <- maybe_tc_app - , Just data_con <- isDataProductTyCon_maybe tycon -- One constructor, no existentials + , Just data_con <- tyConSingleAlgDataCon_maybe tycon -- One constructor + , null (dataConExTyCoVars data_con) -- no existentials , [Scaled _ unwrapped_res_ty] <- dataConInstOrigArgTys data_con tycon_arg_tys -- One argument = do { dflags <- getDynFlags ; let platform = targetPlatform dflags ===================================== compiler/GHC/HsToCore/Foreign/Decl.hs ===================================== @@ -830,7 +830,7 @@ getPrimTyOf ty -- Except for Bool, the types we are interested in have a single constructor -- with a single primitive-typed argument (see TcType.legalFEArgTyCon). | otherwise = - case splitDataProductType_maybe rep_ty of + case splitNonExDataProductType_maybe rep_ty of Just (_, _, data_con, [Scaled _ prim_ty]) -> ASSERT(dataConSourceArity data_con == 1) ASSERT2(isUnliftedType prim_ty, ppr prim_ty) ===================================== compiler/GHC/HsToCore/Utils.hs ===================================== @@ -737,7 +737,7 @@ is_flat_prod_pat (TuplePat _ ps Boxed) = all is_triv_lpat ps is_flat_prod_pat (ConPat { pat_con = L _ pcon , pat_args = ps}) | RealDataCon con <- pcon - , isProductTyCon (dataConTyCon con) + , Just _ <- tyConSingleDataCon_maybe (dataConTyCon con) = all is_triv_lpat (hsConPatArgs ps) is_flat_prod_pat _ = False ===================================== compiler/GHC/Tc/Deriv/Utils.hs ===================================== @@ -928,8 +928,8 @@ cond_isEnumeration _ _ rep_tc cond_isProduct :: Condition cond_isProduct _ _ rep_tc - | isProductTyCon rep_tc = IsValid - | otherwise = NotValid why + | Just _ <- tyConSingleDataCon_maybe rep_tc = IsValid + | otherwise = NotValid why where why = quotes (pprSourceTyCon rep_tc) <+> text "must have precisely one constructor" ===================================== compiler/GHC/Types/Demand.hs ===================================== @@ -90,7 +90,7 @@ import GHC.Data.Maybe ( orElse ) import GHC.Core.Type ( Type ) import GHC.Core.TyCon ( isNewTyCon, isClassTyCon ) -import GHC.Core.DataCon ( splitDataProductType_maybe ) +import GHC.Core.DataCon ( splitNonExDataProductType_maybe ) import GHC.Core.Multiplicity ( scaledThing ) import GHC.Utils.Binary @@ -512,7 +512,7 @@ strictifyDictDmd ty (n :* Prod ds) -- type is a non-newtype dictionary type as_non_newtype_dict ty | Just (tycon, _arg_tys, _data_con, map scaledThing -> inst_con_arg_tys) - <- splitDataProductType_maybe ty + <- splitNonExDataProductType_maybe ty , not (isNewTyCon tycon) , isClassTyCon tycon = Just inst_con_arg_tys ===================================== testsuite/tests/simplCore/should_compile/T18013.stderr ===================================== @@ -132,33 +132,58 @@ Result size of Tidy Core = {terms: 52, types: 106, coercions: 17, joins: 0/1} -- RHS size: {terms: 37, types: 87, coercions: 17, joins: 0/1} -mapMaybeRule +mapMaybeRule [InlPrag=[2]] :: forall a b. Rule IO a b -> Rule IO (Maybe a) (Maybe b) [GblId, Arity=1, - Str=, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 150 10}] + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (@a) (@b) (w [Occ=Once1!] :: Rule IO a b) -> + case w of { Rule @s ww1 ww2 [Occ=OnceL1!] -> + T18013a.Rule + @IO + @(Maybe a) + @(Maybe b) + @s + ww1 + ((\ (s2 [Occ=Once1] :: s) + (a1 [Occ=Once1!] :: Maybe a) + (s1 [Occ=Once2] :: GHC.Prim.State# GHC.Prim.RealWorld) -> + case a1 of { + Nothing -> + (# s1, T18013a.Result @s @(Maybe b) ww1 (GHC.Maybe.Nothing @b) #); + Just x [Occ=Once1] -> + case ((ww2 s2 x) `cast` ) s1 of + { (# ipv [Occ=Once1], ipv1 [Occ=Once1!] #) -> + case ipv1 of { Result t2 [Occ=Once1] c1 [Occ=Once1] -> + (# ipv, T18013a.Result @s @(Maybe b) t2 (GHC.Maybe.Just @b c1) #) + } + } + }) + `cast` ) + }}] mapMaybeRule - = \ (@a) (@b) (f :: Rule IO a b) -> - case f of { Rule @s t0 g -> + = \ (@a) (@b) (w :: Rule IO a b) -> + case w of { Rule @s ww1 ww2 -> let { lvl :: Result s (Maybe b) [LclId, Unf=OtherCon []] - lvl = T18013a.Result @s @(Maybe b) t0 (GHC.Maybe.Nothing @b) } in + lvl = T18013a.Result @s @(Maybe b) ww1 (GHC.Maybe.Nothing @b) } in T18013a.Rule @IO @(Maybe a) @(Maybe b) @s - t0 + ww1 ((\ (s2 :: s) (a1 :: Maybe a) (s1 :: GHC.Prim.State# GHC.Prim.RealWorld) -> case a1 of { Nothing -> (# s1, lvl #); Just x -> - case ((g s2 x) `cast` ) s1 of { (# ipv, ipv1 #) -> + case ((ww2 s2 x) `cast` ) s1 of { (# ipv, ipv1 #) -> case ipv1 of { Result t2 c1 -> (# ipv, T18013a.Result @s @(Maybe b) t2 (GHC.Maybe.Just @b c1) #) } ===================================== testsuite/tests/stranal/should_compile/T18982.hs ===================================== @@ -0,0 +1,33 @@ +{-# OPTIONS_GHC -O -fforce-recomp #-} +{-# LANGUAGE GADTs #-} + +module T18982 where + +data Box a where + Box :: a -> Box a + +data Ex a where + Ex :: e -> a -> Ex a + +data GADT a where + GADT :: Int -> GADT Int + +data ExGADT a where + ExGADT :: (e ~ Int) => e -> Int -> ExGADT Int + +f :: Box Int -> Int +f (Box n) = n + 1 +{-# NOINLINE f #-} + +g :: Ex Int -> Int +g (Ex e n) = e `seq` n + 1 +{-# NOINLINE g #-} + +h :: GADT a -> Int +h (GADT n) = n + 1 +{-# NOINLINE h #-} + +i :: ExGADT a -> Int +i (ExGADT e n) = e `seq` n + 1 +{-# NOINLINE i #-} + ===================================== testsuite/tests/stranal/should_compile/T18982.stderr ===================================== @@ -0,0 +1,246 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core = {terms: 311, types: 249, coercions: 4, joins: 0/0} + +-- RHS size: {terms: 8, types: 11, coercions: 1, joins: 0/0} +T18982.$WExGADT :: forall e. (e ~ Int) => e %1 -> Int %1 -> ExGADT Int +T18982.$WExGADT = \ (@e) (dt :: e ~ Int) (dt :: e) (dt :: Int) -> T18982.ExGADT @Int @e @~(_N :: Int GHC.Prim.~# Int) dt dt dt + +-- RHS size: {terms: 3, types: 2, coercions: 1, joins: 0/0} +T18982.$WGADT :: Int %1 -> GADT Int +T18982.$WGADT = \ (dt :: Int) -> T18982.GADT @Int @~(_N :: Int GHC.Prim.~# Int) dt + +-- RHS size: {terms: 7, types: 8, coercions: 0, joins: 0/0} +T18982.$WEx :: forall e a. e %1 -> a %1 -> Ex a +T18982.$WEx = \ (@e) (@a) (dt :: e) (dt :: a) -> T18982.Ex @a @e dt dt + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$trModule4 :: GHC.Prim.Addr# +T18982.$trModule4 = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$trModule3 :: GHC.Types.TrName +T18982.$trModule3 = GHC.Types.TrNameS T18982.$trModule4 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$trModule2 :: GHC.Prim.Addr# +T18982.$trModule2 = "T18982"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$trModule1 :: GHC.Types.TrName +T18982.$trModule1 = GHC.Types.TrNameS T18982.$trModule2 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18982.$trModule :: GHC.Types.Module +T18982.$trModule = GHC.Types.Module T18982.$trModule3 T18982.$trModule1 + +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} +$krep :: GHC.Types.KindRep +$krep = GHC.Types.KindRepTyConApp GHC.Types.$tcInt (GHC.Types.[] @GHC.Types.KindRep) + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$krep1 :: GHC.Types.KindRep +$krep1 = GHC.Types.KindRepVar 1# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$krep2 :: GHC.Types.KindRep +$krep2 = GHC.Types.KindRepVar 0# + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +$krep3 :: [GHC.Types.KindRep] +$krep3 = GHC.Types.: @GHC.Types.KindRep $krep (GHC.Types.[] @GHC.Types.KindRep) + +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} +$krep4 :: [GHC.Types.KindRep] +$krep4 = GHC.Types.: @GHC.Types.KindRep $krep2 $krep3 + +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} +$krep5 :: [GHC.Types.KindRep] +$krep5 = GHC.Types.: @GHC.Types.KindRep GHC.Types.krep$* $krep4 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep6 :: GHC.Types.KindRep +$krep6 = GHC.Types.KindRepTyConApp GHC.Types.$tc~ $krep5 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tcBox2 :: GHC.Prim.Addr# +T18982.$tcBox2 = "Box"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tcBox1 :: GHC.Types.TrName +T18982.$tcBox1 = GHC.Types.TrNameS T18982.$tcBox2 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tcBox :: GHC.Types.TyCon +T18982.$tcBox = GHC.Types.TyCon 16948648223906549518## 2491460178135962649## T18982.$trModule T18982.$tcBox1 0# GHC.Types.krep$*Arr* + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +$krep7 :: [GHC.Types.KindRep] +$krep7 = GHC.Types.: @GHC.Types.KindRep $krep2 (GHC.Types.[] @GHC.Types.KindRep) + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep8 :: GHC.Types.KindRep +$krep8 = GHC.Types.KindRepTyConApp T18982.$tcBox $krep7 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Box1 :: GHC.Types.KindRep +T18982.$tc'Box1 = GHC.Types.KindRepFun $krep2 $krep8 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Box3 :: GHC.Prim.Addr# +T18982.$tc'Box3 = "'Box"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Box2 :: GHC.Types.TrName +T18982.$tc'Box2 = GHC.Types.TrNameS T18982.$tc'Box3 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Box :: GHC.Types.TyCon +T18982.$tc'Box = GHC.Types.TyCon 1412068769125067428## 8727214667407894081## T18982.$trModule T18982.$tc'Box2 1# T18982.$tc'Box1 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tcEx2 :: GHC.Prim.Addr# +T18982.$tcEx2 = "Ex"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tcEx1 :: GHC.Types.TrName +T18982.$tcEx1 = GHC.Types.TrNameS T18982.$tcEx2 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tcEx :: GHC.Types.TyCon +T18982.$tcEx = GHC.Types.TyCon 4376661818164435927## 18005417598910668817## T18982.$trModule T18982.$tcEx1 0# GHC.Types.krep$*Arr* + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +$krep9 :: [GHC.Types.KindRep] +$krep9 = GHC.Types.: @GHC.Types.KindRep $krep1 (GHC.Types.[] @GHC.Types.KindRep) + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep10 :: GHC.Types.KindRep +$krep10 = GHC.Types.KindRepTyConApp T18982.$tcEx $krep9 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep11 :: GHC.Types.KindRep +$krep11 = GHC.Types.KindRepFun $krep1 $krep10 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Ex1 :: GHC.Types.KindRep +T18982.$tc'Ex1 = GHC.Types.KindRepFun $krep2 $krep11 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Ex3 :: GHC.Prim.Addr# +T18982.$tc'Ex3 = "'Ex"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Ex2 :: GHC.Types.TrName +T18982.$tc'Ex2 = GHC.Types.TrNameS T18982.$tc'Ex3 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Ex :: GHC.Types.TyCon +T18982.$tc'Ex = GHC.Types.TyCon 14609381081172201359## 3077219645053200509## T18982.$trModule T18982.$tc'Ex2 2# T18982.$tc'Ex1 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tcGADT2 :: GHC.Prim.Addr# +T18982.$tcGADT2 = "GADT"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tcGADT1 :: GHC.Types.TrName +T18982.$tcGADT1 = GHC.Types.TrNameS T18982.$tcGADT2 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tcGADT :: GHC.Types.TyCon +T18982.$tcGADT = GHC.Types.TyCon 9243924476135839950## 5096619276488416461## T18982.$trModule T18982.$tcGADT1 0# GHC.Types.krep$*Arr* + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep12 :: GHC.Types.KindRep +$krep12 = GHC.Types.KindRepTyConApp T18982.$tcGADT $krep3 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'GADT1 :: GHC.Types.KindRep +T18982.$tc'GADT1 = GHC.Types.KindRepFun $krep $krep12 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'GADT3 :: GHC.Prim.Addr# +T18982.$tc'GADT3 = "'GADT"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'GADT2 :: GHC.Types.TrName +T18982.$tc'GADT2 = GHC.Types.TrNameS T18982.$tc'GADT3 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'GADT :: GHC.Types.TyCon +T18982.$tc'GADT = GHC.Types.TyCon 2077850259354179864## 16731205864486799217## T18982.$trModule T18982.$tc'GADT2 0# T18982.$tc'GADT1 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tcExGADT2 :: GHC.Prim.Addr# +T18982.$tcExGADT2 = "ExGADT"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tcExGADT1 :: GHC.Types.TrName +T18982.$tcExGADT1 = GHC.Types.TrNameS T18982.$tcExGADT2 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tcExGADT :: GHC.Types.TyCon +T18982.$tcExGADT = GHC.Types.TyCon 6470898418160489500## 10361108917441214060## T18982.$trModule T18982.$tcExGADT1 0# GHC.Types.krep$*Arr* + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep13 :: GHC.Types.KindRep +$krep13 = GHC.Types.KindRepTyConApp T18982.$tcExGADT $krep3 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep14 :: GHC.Types.KindRep +$krep14 = GHC.Types.KindRepFun $krep $krep13 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep15 :: GHC.Types.KindRep +$krep15 = GHC.Types.KindRepFun $krep2 $krep14 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'ExGADT1 :: GHC.Types.KindRep +T18982.$tc'ExGADT1 = GHC.Types.KindRepFun $krep6 $krep15 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'ExGADT3 :: GHC.Prim.Addr# +T18982.$tc'ExGADT3 = "'ExGADT"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'ExGADT2 :: GHC.Types.TrName +T18982.$tc'ExGADT2 = GHC.Types.TrNameS T18982.$tc'ExGADT3 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'ExGADT :: GHC.Types.TyCon +T18982.$tc'ExGADT = GHC.Types.TyCon 8468257409157161049## 5503123603717080600## T18982.$trModule T18982.$tc'ExGADT2 1# T18982.$tc'ExGADT1 + +-- RHS size: {terms: 11, types: 14, coercions: 0, joins: 0/0} +T18982.$wi :: forall {a} {e}. (a GHC.Prim.~# Int) -> e -> GHC.Prim.Int# -> GHC.Prim.Int# +T18982.$wi = \ (@a) (@e) (ww :: a GHC.Prim.~# Int) (ww1 :: e) (ww2 :: GHC.Prim.Int#) -> case ww1 of { __DEFAULT -> GHC.Prim.+# ww2 1# } + +-- RHS size: {terms: 15, types: 27, coercions: 1, joins: 0/0} +i :: forall a. ExGADT a -> Int +i = \ (@a) (w :: ExGADT a) -> case w of { ExGADT @e ww1 ww2 ww3 ww4 -> case ww4 of { GHC.Types.I# ww6 -> case T18982.$wi @a @e @~(ww1 :: a GHC.Prim.~# Int) ww3 ww6 of ww7 { __DEFAULT -> GHC.Types.I# ww7 } } } + +-- RHS size: {terms: 6, types: 10, coercions: 0, joins: 0/0} +T18982.$wh :: forall {a}. (a GHC.Prim.~# Int) -> GHC.Prim.Int# -> GHC.Prim.Int# +T18982.$wh = \ (@a) (ww :: a GHC.Prim.~# Int) (ww1 :: GHC.Prim.Int#) -> GHC.Prim.+# ww1 1# + +-- RHS size: {terms: 14, types: 18, coercions: 1, joins: 0/0} +h :: forall a. GADT a -> Int +h = \ (@a) (w :: GADT a) -> case w of { GADT ww1 ww2 -> case ww2 of { GHC.Types.I# ww4 -> case T18982.$wh @a @~(ww1 :: a GHC.Prim.~# Int) ww4 of ww5 { __DEFAULT -> GHC.Types.I# ww5 } } } + +-- RHS size: {terms: 9, types: 5, coercions: 0, joins: 0/0} +T18982.$wg :: forall {e}. e -> GHC.Prim.Int# -> GHC.Prim.Int# +T18982.$wg = \ (@e) (ww :: e) (ww1 :: GHC.Prim.Int#) -> case ww of { __DEFAULT -> GHC.Prim.+# ww1 1# } + +-- RHS size: {terms: 14, types: 12, coercions: 0, joins: 0/0} +g :: Ex Int -> Int +g = \ (w :: Ex Int) -> case w of { Ex @e ww1 ww2 -> case ww2 of { GHC.Types.I# ww4 -> case T18982.$wg @e ww1 ww4 of ww5 { __DEFAULT -> GHC.Types.I# ww5 } } } + +-- RHS size: {terms: 4, types: 1, coercions: 0, joins: 0/0} +T18982.$wf :: GHC.Prim.Int# -> GHC.Prim.Int# +T18982.$wf = \ (ww :: GHC.Prim.Int#) -> GHC.Prim.+# ww 1# + +-- RHS size: {terms: 13, types: 8, coercions: 0, joins: 0/0} +f :: Box Int -> Int +f = \ (w :: Box Int) -> case w of { Box ww1 -> case ww1 of { GHC.Types.I# ww3 -> case T18982.$wf ww3 of ww4 { __DEFAULT -> GHC.Types.I# ww4 } } } + + + ===================================== testsuite/tests/stranal/should_compile/all.T ===================================== @@ -62,3 +62,5 @@ test('T18903', [ grep_errmsg(r'Dmd=\S+C\S+') ], compile, ['-ddump-simpl -dsuppr test('T18894', [ grep_errmsg(r'Dmd=\S+C\S+') ], compile, ['-ddump-stranal -dsuppress-uniques']) # We care about the Arity 2 on eta, as a result of the annotated Dmd test('T18894b', [ grep_errmsg(r'Arity=2') ], compile, ['-ddump-stranal -dsuppress-uniques -fno-call-arity -dppr-cols=200']) +# We care about the workers of f,g,h,i: +test('T18982', [ grep_errmsg(r'\$w. .*Int#$') ], compile, ['-dppr-cols=1000 -ddump-simpl -dsuppress-idinfo -dsuppress-uniques']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3a879906b27c17b145dd2c32e86b13b1f01f173a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3a879906b27c17b145dd2c32e86b13b1f01f173a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 4 12:27:09 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Fri, 04 Dec 2020 07:27:09 -0500 Subject: [Git][ghc/ghc][wip/sgraf-dmdanal-stuff] WorkWrap: Unbox constructors with existentials (#18982) Message-ID: <5fca2b1d4df2a_6b212a3028351e0@gitlab.mail> Sebastian Graf pushed to branch wip/sgraf-dmdanal-stuff at Glasgow Haskell Compiler / GHC Commits: 07b2e5dd by Sebastian Graf at 2020-12-04T13:06:05+01:00 WorkWrap: Unbox constructors with existentials (#18982) I found that by relaxing the "no existential" checks in `isDataProductType_maybe` and `isDataSumType_maybe`, the former becomes identical to `tyConSingleAlgDataCon_maybe`. So I deleted both and introduced a new function, `tyConAlgDataCons_maybe` for the sum case. I cleaned up a couple of call sites, some of which weren't very explicit about whether they cared for existentials or not. Most of the new stuff happens in worker/wrapper, where handling of existentials means a bit of substitution work carried out by `GHC.Core.Utils.dataConRepFSInstPat`. The test output of `T18013` changed, because we now unbox the `Rule` data type. Its constructor carries existential state and will be w/w'd now. In the particular example, the worker functions inlines right back into the wrapper, which then unnecessarily has a (quite big) stable unfolding. I think this kind of fallout is inevitable; see also Note [Don't w/w inline small non-loop-breaker things]. There's a new regression test case `T18982`. Fixes #18982. - - - - - 14 changed files: - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Opt/CprAnal.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/HsToCore/Foreign/Call.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Tc/Deriv/Utils.hs - testsuite/tests/simplCore/should_compile/T18013.stderr - + testsuite/tests/stranal/should_compile/T18982.hs - + testsuite/tests/stranal/should_compile/T18982.stderr - testsuite/tests/stranal/should_compile/all.T Changes: ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -1564,15 +1564,13 @@ promoteDataCon (MkData { dcPromoted = tc }) = tc -- | Extract the type constructor, type argument, data constructor and it's -- /representation/ argument types from a type if it is a product type. -- --- Precisely, we return @Just@ for any type that is all of: +-- Precisely, we return @Just@ for any data type that is all of: -- -- * Concrete (i.e. constructors visible) --- -- * Single-constructor +-- * ... which has no existentials -- --- * Not existentially quantified --- --- Whether the type is a @data@ type or a @newtype@ +-- Whether the type is a @data@ type or a @newtype at . splitDataProductType_maybe :: Type -- ^ A product type, perhaps -> Maybe (TyCon, -- The type constructor @@ -1580,13 +1578,14 @@ splitDataProductType_maybe DataCon, -- The data constructor [Scaled Type]) -- Its /representation/ arg types - -- Rejecting existentials is conservative. Maybe some things - -- could be made to work with them, but I'm not going to sweat - -- it through till someone finds it's important. + -- Rejecting existentials means we don't have to worry about + -- freshening and substituting type variables + -- (See "GHC.Type.Id.Make.dataConArgUnpack") splitDataProductType_maybe ty | Just (tycon, ty_args) <- splitTyConApp_maybe ty - , Just con <- isDataProductTyCon_maybe tycon + , Just con <- tyConSingleDataCon_maybe tycon + , null (dataConExTyCoVars con) -- no existentials! See above = Just (tycon, ty_args, con, dataConInstArgTys con ty_args) | otherwise = Nothing ===================================== compiler/GHC/Core/Opt/CprAnal.hs ===================================== @@ -446,14 +446,13 @@ extendEnvForDataAlt env scrut case_bndr dc bndrs ids_w_strs = filter isId bndrs `zip` dataConRepStrictness dc - tycon = dataConTyCon dc - is_product = isJust (isDataProductTyCon_maybe tycon) - is_sum = isJust (isDataSumTyCon_maybe tycon) + is_algebraic = isJust (tyConAlgDataCons_maybe (dataConTyCon dc)) + no_exs = null (dataConExTyCoVars dc) case_bndr_ty - | is_product || is_sum = conCprType (dataConTag dc) - -- Any of the constructors had existentials. This is a little too - -- conservative (after all, we only care about the particular data con), - -- but there is no easy way to write is_sum and this won't happen much. + | is_algebraic, no_exs = conCprType (dataConTag dc) + -- The tycon wasn't algebraic or the datacon had existentials. + -- CPR'ing existentials would need first class existentials/dependent sums + -- to exploit, so we return topCprType here. | otherwise = topCprType -- We could have much deeper CPR info here with Nested CPR, which could ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -400,8 +400,8 @@ dmdAnal' env dmd (Lam var body) dmdAnal' env dmd (Case scrut case_bndr ty [(alt, bndrs, rhs)]) -- Only one alternative. - -- If it's a DataAlt, it should be a product constructor. - | is_non_sum_alt alt + -- If it's a DataAlt, it should be the only constructor of the type. + | is_single_data_alt alt = let (rhs_ty, rhs') = dmdAnal env dmd rhs (alt_ty1, dmds) = findBndrsDmds env rhs_ty bndrs @@ -440,8 +440,8 @@ dmdAnal' env dmd (Case scrut case_bndr ty [(alt, bndrs, rhs)]) -- , text "res_ty" <+> ppr res_ty ]) $ (res_ty, Case scrut' case_bndr' ty [(alt, bndrs', rhs')]) where - is_non_sum_alt (DataAlt dc) = isJust $ isDataProductTyCon_maybe $ dataConTyCon dc - is_non_sum_alt _ = True + is_single_data_alt (DataAlt dc) = isJust $ tyConSingleAlgDataCon_maybe $ dataConTyCon dc + is_single_data_alt _ = True dmdAnal' env dmd (Case scrut case_bndr ty alts) = let -- Case expression with multiple alternatives @@ -501,10 +501,11 @@ forcesRealWorld :: FamInstEnvs -> Type -> Bool forcesRealWorld fam_envs ty | ty `eqType` realWorldStatePrimTy = True - | Just DataConAppContext{ dcac_dc = dc, dcac_arg_tys = field_tys } + | Just DataConAppContext{ dcac_dc = dc, dcac_tc_args = tc_args } <- deepSplitProductType_maybe fam_envs ty , isUnboxedTupleDataCon dc - = any (\(ty,_) -> scaledThing ty `eqType` realWorldStatePrimTy) field_tys + , let field_tys = dataConInstArgTys dc tc_args + = any (eqType realWorldStatePrimTy . scaledThing) field_tys | otherwise = False ===================================== compiler/GHC/Core/Opt/WorkWrap/Utils.hs ===================================== @@ -19,7 +19,8 @@ where import GHC.Prelude import GHC.Core -import GHC.Core.Utils ( exprType, mkCast, mkDefaultCase, mkSingleAltCase ) +import GHC.Core.Utils ( exprType, mkCast, mkDefaultCase, mkSingleAltCase + , dataConRepFSInstPat ) import GHC.Types.Id import GHC.Types.Id.Info ( JoinArity ) import GHC.Core.DataCon @@ -46,6 +47,7 @@ import GHC.Types.Unique import GHC.Data.Maybe import GHC.Utils.Misc import GHC.Utils.Outputable +import GHC.Utils.Panic import GHC.Driver.Session import GHC.Driver.Ppr import GHC.Data.FastString @@ -609,50 +611,60 @@ mkWWstr_one dflags fam_envs has_inlineable_prag arg wantToUnbox :: FamInstEnvs -> Bool -> Type -> Demand -> Maybe ([Demand], DataConAppContext) wantToUnbox fam_envs has_inlineable_prag ty dmd = case deepSplitProductType_maybe fam_envs ty of - Just dcac at DataConAppContext{ dcac_arg_tys = con_arg_tys } + Just dcac at DataConAppContext{ dcac_dc = dc } | isStrUsedDmd dmd + , let arity = dataConRepArity dc -- See Note [Unpacking arguments with product and polymorphic demands] - , Just cs <- split_prod_dmd_arity dmd (length con_arg_tys) + , Just cs <- split_prod_dmd_arity dmd arity -- See Note [Do not unpack class dictionaries] , not (has_inlineable_prag && isClassPred ty) -- See Note [mkWWstr and unsafeCoerce] - , cs `equalLength` con_arg_tys + , cs `lengthIs` arity -> Just (cs, dcac) _ -> Nothing where - split_prod_dmd_arity dmd arty + split_prod_dmd_arity dmd arity -- For seqDmd, it should behave like , for some -- suitable arity - | isSeqDmd dmd = Just (replicate arty absDmd) + | isSeqDmd dmd = Just (replicate arity absDmd) | _ :* Prod ds <- dmd = Just ds | otherwise = Nothing +-- | Exactly 'dataConInstArgTys', but lacks the (ASSERT'ed) precondition that +-- the 'DataCon' may not have existentials. The lack of cloning the existentials +-- compared to 'dataConInstExAndArgVars' makes this function \"dubious\"; +-- only use it where type variables aren't substituted! +dubiousDataConInstArgTys :: DataCon -> [Type] -> [Scaled Type] +dubiousDataConInstArgTys dc tc_args = arg_tys + where + univ_tvs = dataConUnivTyVars dc + ex_tvs = dataConExTyCoVars dc + subst = extendTCvInScopeList (zipTvSubst univ_tvs tc_args) ex_tvs + arg_tys = mapScaledType (substTy subst) <$> dataConRepArgTys dc + unbox_one :: DynFlags -> FamInstEnvs -> Var -> [Demand] -> DataConAppContext -> UniqSM (Bool, [Var], CoreExpr -> CoreExpr, CoreExpr -> CoreExpr) unbox_one dflags fam_envs arg cs - DataConAppContext { dcac_dc = data_con, dcac_tys = inst_tys - , dcac_arg_tys = inst_con_arg_tys + DataConAppContext { dcac_dc = dc, dcac_tc_args = tc_args , dcac_co = co } - = do { (uniq1:uniqs) <- getUniquesM - ; let scale = scaleScaled (idMult arg) - scaled_inst_con_arg_tys = map (\(t,s) -> (scale t, s)) inst_con_arg_tys - -- See Note [Add demands for strict constructors] - cs' = addDataConStrictness data_con cs - unpk_args = zipWith3 mk_ww_arg uniqs scaled_inst_con_arg_tys cs' - unbox_fn = mkUnpackCase (Var arg) co (idMult arg) uniq1 - data_con unpk_args - arg_no_unf = zapStableUnfolding arg - -- See Note [Zap unfolding when beta-reducing] - -- in GHC.Core.Opt.Simplify; and see #13890 - rebox_fn = Let (NonRec arg_no_unf con_app) - con_app = mkConApp2 data_con inst_tys unpk_args `mkCast` mkSymCo co - ; (_, worker_args, wrap_fn, work_fn) <- mkWWstr dflags fam_envs False unpk_args - ; return (True, worker_args, unbox_fn . wrap_fn, work_fn . rebox_fn) } - -- Don't pass the arg, rebox instead - where - mk_ww_arg uniq ty sub_dmd = setIdDemandInfo (mk_ww_local uniq ty) sub_dmd + = do { (case_bndr_uniq:pat_bndrs_uniqs) <- getUniquesM + ; let (ex_tvs', arg_ids) = + dataConRepFSInstPat (repeat ww_prefix) pat_bndrs_uniqs (idMult arg) dc tc_args + -- See Note [Add demands for strict constructors] + cs' = addDataConStrictness dc cs + arg_ids' = zipWithEqual "unbox_one" setIdDemandInfo arg_ids cs' + unbox_fn = mkUnpackCase (Var arg) co (idMult arg) case_bndr_uniq + dc (ex_tvs' ++ arg_ids') + arg_no_unf = zapStableUnfolding arg + -- See Note [Zap unfolding when beta-reducing] + -- in GHC.Core.Opt.Simplify; and see #13890 + rebox_fn = Let (NonRec arg_no_unf con_app) + con_app = mkConApp2 dc tc_args (ex_tvs' ++ arg_ids') `mkCast` mkSymCo co + ; (_, worker_args, wrap_fn, work_fn) <- mkWWstr dflags fam_envs False (ex_tvs' ++ arg_ids') + ; return (True, worker_args, unbox_fn . wrap_fn, work_fn . rebox_fn) } + -- Don't pass the arg, rebox instead ---------------------- nop_fn :: CoreExpr -> CoreExpr @@ -932,72 +944,67 @@ off the unpacking in mkWWstr_one (see the isClassPred test). Historical note: #14955 describes how I got this fix wrong the first time. -} --- | Context for a 'DataCon' application with a hole for every field, including --- surrounding coercions. +-- | Context for a 'DataCon' application wrapped in a cast, where we know the +-- type arguments of the 'TyCon' but not any of the arguments to the 'DataCon' +-- (type or term). +-- -- The result of 'deepSplitProductType_maybe' and 'deepSplitCprType_maybe'. -- -- Example: -- --- > DataConAppContext Just [Int] [(Lazy, Int)] (co :: Maybe Int ~ First Int) +-- > DataConAppContext Just [Int] (co :: Maybe Int ~ First Int) -- -- represents -- --- > Just @Int (_1 :: Int) |> co :: First Int +-- > (Just @_1 _2 :: Maybe Int) |> co :: First Int -- --- where _1 is a hole for the first argument. The number of arguments is --- determined by the length of @arg_tys at . data DataConAppContext = DataConAppContext - { dcac_dc :: !DataCon - , dcac_tys :: ![Type] - , dcac_arg_tys :: ![(Scaled Type, StrictnessMark)] - , dcac_co :: !Coercion + { dcac_dc :: !DataCon + , dcac_tc_args :: ![Type] + , dcac_co :: !Coercion } +-- | If @deepSplitProductType_maybe ty = Just (dc, tys, co)@ +-- then @dc \@tys \@_ex_tys (_args::_arg_tys) :: tc tys@ +-- and @co :: ty ~ tc tys@ +-- where underscore prefixes are holes, e.g. yet unspecified. deepSplitProductType_maybe :: FamInstEnvs -> Type -> Maybe DataConAppContext --- If deepSplitProductType_maybe ty = Just (dc, tys, arg_tys, co) --- then dc @ tys (args::arg_tys) :: rep_ty --- co :: ty ~ rep_ty --- Why do we return the strictness of the data-con arguments? --- Answer: see Note [Record evaluated-ness in worker/wrapper] deepSplitProductType_maybe fam_envs ty | let (co, ty1) = topNormaliseType_maybe fam_envs ty `orElse` (mkRepReflCo ty, ty) , Just (tc, tc_args) <- splitTyConApp_maybe ty1 - , Just con <- isDataProductTyCon_maybe tc - , let arg_tys = dataConInstArgTys con tc_args - strict_marks = dataConRepStrictness con - = Just DataConAppContext { dcac_dc = con - , dcac_tys = tc_args - , dcac_arg_tys = zipEqual "dspt" arg_tys strict_marks - , dcac_co = co } + , Just con <- tyConSingleAlgDataCon_maybe tc + = Just DataConAppContext { dcac_dc = con + , dcac_tc_args = tc_args + , dcac_co = co } deepSplitProductType_maybe _ _ = Nothing -deepSplitCprType_maybe - :: FamInstEnvs -> ConTag -> Type -> Maybe DataConAppContext --- If deepSplitCprType_maybe n ty = Just (dc, tys, arg_tys, co) --- then dc @ tys (args::arg_tys) :: rep_ty --- co :: ty ~ rep_ty --- Why do we return the strictness of the data-con arguments? --- Answer: see Note [Record evaluated-ness in worker/wrapper] +-- | If @deepSplitCprType_maybe n ty = Just (dc, tys, co)@ +-- then @dc \@tys \@_ex_tys (_args::_arg_tys) :: tc tys@ +-- and @co :: ty ~ tc tys@ +-- where underscore prefixes are holes, e.g. yet unspecified. +-- @dc@ is the @n at th data constructor of @tc at . +deepSplitCprType_maybe :: FamInstEnvs -> ConTag -> Type -> Maybe DataConAppContext deepSplitCprType_maybe fam_envs con_tag ty | let (co, ty1) = topNormaliseType_maybe fam_envs ty `orElse` (mkRepReflCo ty, ty) , Just (tc, tc_args) <- splitTyConApp_maybe ty1 - , isDataTyCon tc + , isDataTyCon tc -- NB: rules out unboxed sums and pairs! , let cons = tyConDataCons tc , cons `lengthAtLeast` con_tag -- This might not be true if we import the - -- type constructor via a .hs-bool file (#8743) + -- type constructor via a .hs-boot file (#8743) , let con = cons `getNth` (con_tag - fIRST_TAG) - arg_tys = dataConInstArgTys con tc_args - strict_marks = dataConRepStrictness con - , all isLinear arg_tys + , null (dataConExTyCoVars con) -- no existentials; + -- See Note [Product types] in "GHC.Core.TyCon" + -- and GHC.Core.Opt.CprAnal.extendEnvForDataAlt + -- where we also check this. + , all isLinear (dataConInstArgTys con tc_args) -- Deactivates CPR worker/wrapper splits on constructors with non-linear -- arguments, for the moment, because they require unboxed tuple with variable -- multiplicity fields. = Just DataConAppContext { dcac_dc = con - , dcac_tys = tc_args - , dcac_arg_tys = zipEqual "dspt" arg_tys strict_marks + , dcac_tc_args = tc_args , dcac_co = co } deepSplitCprType_maybe _ _ _ = Nothing @@ -1035,13 +1042,15 @@ findTypeShape fam_envs ty | Just (_, rhs, _) <- topReduceTyFamApp_maybe fam_envs tc tc_args = go rec_tc rhs - | Just con <- isDataProductTyCon_maybe tc + | Just con <- tyConSingleAlgDataCon_maybe tc , Just rec_tc <- if isTupleTyCon tc then Just rec_tc else checkRecTc rec_tc tc -- We treat tuples specially because they can't cause loops. -- Maybe we should do so in checkRecTc. - = TsProd (map (go rec_tc . scaledThing) (dataConInstArgTys con tc_args)) + -- The use of 'dubiousDataConInstArgTys' is OK, since this + -- function performs no substitution at all. + = TsProd (map (go rec_tc . scaledThing) (dubiousDataConInstArgTys con tc_args)) | Just (ty', _) <- instNewTyCon_maybe tc tc_args , Just rec_tc <- checkRecTc rec_tc tc @@ -1093,25 +1102,26 @@ mkWWcpr opt_CprAnal fam_envs body_ty cpr mkWWcpr_help :: DataConAppContext -> UniqSM (Bool, CoreExpr -> CoreExpr, CoreExpr -> CoreExpr, Type) -mkWWcpr_help (DataConAppContext { dcac_dc = data_con, dcac_tys = inst_tys - , dcac_arg_tys = arg_tys, dcac_co = co }) - | [arg1@(arg_ty1, _)] <- arg_tys - , isUnliftedType (scaledThing arg_ty1) - , isLinear arg_ty1 +mkWWcpr_help (DataConAppContext { dcac_dc = dc, dcac_tc_args = tc_args + , dcac_co = co }) + | [arg_ty] <- arg_tys + , [str_mark] <- str_marks + , isUnliftedType (scaledThing arg_ty) + , isLinear arg_ty -- Special case when there is a single result of unlifted, linear, type -- -- Wrapper: case (..call worker..) of x -> C x -- Worker: case ( ..body.. ) of C x -> x = do { (work_uniq : arg_uniq : _) <- getUniquesM - ; let arg = mk_ww_local arg_uniq arg1 - con_app = mkConApp2 data_con inst_tys [arg] `mkCast` mkSymCo co + ; let arg_id = mk_ww_local arg_uniq str_mark arg_ty + con_app = mkConApp2 dc tc_args [arg_id] `mkCast` mkSymCo co ; return ( True - , \ wkr_call -> mkDefaultCase wkr_call arg con_app - , \ body -> mkUnpackCase body co One work_uniq data_con [arg] (varToCoreExpr arg) + , \ wkr_call -> mkDefaultCase wkr_call arg_id con_app + , \ body -> mkUnpackCase body co One work_uniq dc [arg_id] (varToCoreExpr arg_id) -- varToCoreExpr important here: arg can be a coercion -- Lacking this caused #10658 - , scaledThing arg_ty1 ) } + , scaledThing arg_ty ) } | otherwise -- The general case -- Wrapper: case (..call worker..) of (# a, b #) -> C a b @@ -1123,19 +1133,26 @@ mkWWcpr_help (DataConAppContext { dcac_dc = data_con, dcac_tys = inst_tys -- parametrised by the multiplicity of its fields. Specifically, in this -- instance, the multiplicity of the fields of (#,#) is chosen to be the -- same as those of C. - = do { (work_uniq : wild_uniq : uniqs) <- getUniquesM - ; let wrap_wild = mk_ww_local wild_uniq (linear ubx_tup_ty,MarkedStrict) - args = zipWith mk_ww_local uniqs arg_tys - ubx_tup_ty = exprType ubx_tup_app - ubx_tup_app = mkCoreUbxTup (map (scaledThing . fst) arg_tys) (map varToCoreExpr args) - con_app = mkConApp2 data_con inst_tys args `mkCast` mkSymCo co - tup_con = tupleDataCon Unboxed (length arg_tys) + = do { (work_uniq : wild_uniq : pat_bndrs_uniqs) <- getUniquesM + ; let case_mult = One -- see above + (_exs, arg_ids) = + dataConRepFSInstPat (repeat ww_prefix) pat_bndrs_uniqs case_mult dc tc_args + wrap_wild = mk_ww_local wild_uniq MarkedStrict (Scaled case_mult ubx_tup_ty) + ubx_tup_ty = exprType ubx_tup_app + ubx_tup_app = mkCoreUbxTup (map scaledThing arg_tys) (map varToCoreExpr arg_ids) + con_app = mkConApp2 dc tc_args arg_ids `mkCast` mkSymCo co + tup_con = tupleDataCon Unboxed (length arg_tys) + + ; MASSERT( null _exs ) -- Should have been caught by deepSplitCprType_maybe ; return (True , \ wkr_call -> mkSingleAltCase wkr_call wrap_wild - (DataAlt tup_con) args con_app - , \ body -> mkUnpackCase body co One work_uniq data_con args ubx_tup_app + (DataAlt tup_con) arg_ids con_app + , \ body -> mkUnpackCase body co case_mult work_uniq dc arg_ids ubx_tup_app , ubx_tup_ty ) } + where + arg_tys = dataConInstArgTys dc tc_args -- NB: No existentials! + str_marks = dataConRepStrictness dc mkUnpackCase :: CoreExpr -> Coercion -> Mult -> Unique -> DataCon -> [Id] -> CoreExpr -> CoreExpr -- (mkUnpackCase e co uniq Con args body) @@ -1149,7 +1166,7 @@ mkUnpackCase scrut co mult uniq boxing_con unpk_args body (DataAlt boxing_con) unpk_args body where casted_scrut = scrut `mkCast` co - bndr = mk_ww_local uniq (Scaled mult (exprType casted_scrut), MarkedStrict) + bndr = mk_ww_local uniq MarkedStrict (Scaled mult (exprType casted_scrut)) -- An unpacking case can always be chosen linear, because the variables -- are always passed to a constructor. This limits the {- @@ -1291,10 +1308,13 @@ mk_absent_let dflags fam_envs arg -- See also Note [Unique Determinism] in GHC.Types.Unique unlifted_rhs = mkTyApps (Lit rubbishLit) [arg_ty] -mk_ww_local :: Unique -> (Scaled Type, StrictnessMark) -> Id +ww_prefix :: FastString +ww_prefix = fsLit "ww" + +mk_ww_local :: Unique -> StrictnessMark -> Scaled Type -> Id -- The StrictnessMark comes form the data constructor and says -- whether this field is strict -- See Note [Record evaluated-ness in worker/wrapper] -mk_ww_local uniq (Scaled w ty,str) +mk_ww_local uniq str (Scaled w ty) = setCaseBndrEvald str $ - mkSysLocalOrCoVar (fsLit "ww") uniq w ty + mkSysLocalOrCoVar ww_prefix uniq w ty ===================================== compiler/GHC/Core/TyCon.hs ===================================== @@ -58,8 +58,7 @@ module GHC.Core.TyCon( isKindTyCon, isLiftedTypeKindTyConName, isTauTyCon, isFamFreeTyCon, - isDataTyCon, isProductTyCon, isDataProductTyCon_maybe, - isDataSumTyCon_maybe, + isDataTyCon, isEnumerationTyCon, isNewTyCon, isAbstractTyCon, isFamilyTyCon, isOpenFamilyTyCon, @@ -84,6 +83,7 @@ module GHC.Core.TyCon( tyConCType, tyConCType_maybe, tyConDataCons, tyConDataCons_maybe, tyConSingleDataCon_maybe, tyConSingleDataCon, + tyConAlgDataCons_maybe, tyConSingleAlgDataCon_maybe, tyConFamilySize, tyConStupidTheta, @@ -143,7 +143,7 @@ import {-# SOURCE #-} GHC.Builtin.Types , multiplicityTyCon , vecCountTyCon, vecElemTyCon, liftedTypeKind ) import {-# SOURCE #-} GHC.Core.DataCon - ( DataCon, dataConExTyCoVars, dataConFieldLabels + ( DataCon, dataConFieldLabels , dataConTyCon, dataConFullSig , isUnboxedSumDataCon ) import GHC.Builtin.Uniques @@ -1970,72 +1970,6 @@ unwrapNewTyConEtad_maybe (AlgTyCon { algTcRhs = NewTyCon { nt_co = co, = Just (tvs, rhs, co) unwrapNewTyConEtad_maybe _ = Nothing -isProductTyCon :: TyCon -> Bool --- True of datatypes or newtypes that have --- one, non-existential, data constructor --- See Note [Product types] -isProductTyCon tc@(AlgTyCon {}) - = case algTcRhs tc of - TupleTyCon {} -> True - DataTyCon{ data_cons = [data_con] } - -> null (dataConExTyCoVars data_con) - NewTyCon {} -> True - _ -> False -isProductTyCon _ = False - -isDataProductTyCon_maybe :: TyCon -> Maybe DataCon --- True of datatypes (not newtypes) with --- one, vanilla, data constructor --- See Note [Product types] -isDataProductTyCon_maybe (AlgTyCon { algTcRhs = rhs }) - = case rhs of - DataTyCon { data_cons = [con] } - | null (dataConExTyCoVars con) -- non-existential - -> Just con - TupleTyCon { data_con = con } - -> Just con - _ -> Nothing -isDataProductTyCon_maybe _ = Nothing - -isDataSumTyCon_maybe :: TyCon -> Maybe [DataCon] -isDataSumTyCon_maybe (AlgTyCon { algTcRhs = rhs }) - = case rhs of - DataTyCon { data_cons = cons } - | cons `lengthExceeds` 1 - , all (null . dataConExTyCoVars) cons -- FIXME(osa): Why do we need this? - -> Just cons - SumTyCon { data_cons = cons } - | all (null . dataConExTyCoVars) cons -- FIXME(osa): Why do we need this? - -> Just cons - _ -> Nothing -isDataSumTyCon_maybe _ = Nothing - -{- Note [Product types] -~~~~~~~~~~~~~~~~~~~~~~~ -A product type is - * A data type (not a newtype) - * With one, boxed data constructor - * That binds no existential type variables - -The main point is that product types are amenable to unboxing for - * Strict function calls; we can transform - f (D a b) = e - to - fw a b = e - via the worker/wrapper transformation. (Question: couldn't this - work for existentials too?) - - * CPR for function results; we can transform - f x y = let ... in D a b - to - fw x y = let ... in (# a, b #) - -Note that the data constructor /can/ have evidence arguments: equality -constraints, type classes etc. So it can be GADT. These evidence -arguments are simply value arguments, and should not get in the way. --} - - -- | Is this a 'TyCon' representing a regular H98 type synonym (@type@)? {-# INLINE isTypeSynonymTyCon #-} -- See Note [Inlining coreView] in GHC.Core.Type isTypeSynonymTyCon :: TyCon -> Bool @@ -2363,8 +2297,7 @@ tyConDataCons_maybe _ = Nothing -- | If the given 'TyCon' has a /single/ data constructor, i.e. it is a @data@ -- type with one alternative, a tuple type or a @newtype@ then that constructor -- is returned. If the 'TyCon' has more than one constructor, or represents a --- primitive or function type constructor then @Nothing@ is returned. In any --- other case, the function panics +-- primitive or function type constructor then @Nothing@ is returned. tyConSingleDataCon_maybe :: TyCon -> Maybe DataCon tyConSingleDataCon_maybe (AlgTyCon { algTcRhs = rhs }) = case rhs of @@ -2374,21 +2307,31 @@ tyConSingleDataCon_maybe (AlgTyCon { algTcRhs = rhs }) _ -> Nothing tyConSingleDataCon_maybe _ = Nothing +-- | Like 'tyConSingleDataCon_maybe', but panics if 'Nothing'. tyConSingleDataCon :: TyCon -> DataCon tyConSingleDataCon tc = case tyConSingleDataCon_maybe tc of Just c -> c Nothing -> pprPanic "tyConDataCon" (ppr tc) +-- | Like 'tyConSingleDataCon_maybe', but returns 'Nothing' for newtypes. +-- +-- These are the 'TyCon's we want to unbox. See Note [Product types]. tyConSingleAlgDataCon_maybe :: TyCon -> Maybe DataCon --- Returns (Just con) for single-constructor --- *algebraic* data types *not* newtypes -tyConSingleAlgDataCon_maybe (AlgTyCon { algTcRhs = rhs }) - = case rhs of - DataTyCon { data_cons = [c] } -> Just c - TupleTyCon { data_con = c } -> Just c - _ -> Nothing -tyConSingleAlgDataCon_maybe _ = Nothing +tyConSingleAlgDataCon_maybe tycon + | isNewTyCon tycon = Nothing + | otherwise = tyConSingleDataCon_maybe tycon + +-- | Returns @Just dcs@ if the given 'TyCon' is a @data@ type, a tuple type +-- or a sum type with data constructors dcs. If the 'TyCon' has more than one +-- constructor, or represents a primitive or function type constructor then +-- @Nothing@ is returned. +-- +-- Like 'tyConDataCons_maybe', but returns 'Nothing' for newtypes. +tyConAlgDataCons_maybe :: TyCon -> Maybe [DataCon] +tyConAlgDataCons_maybe tycon + | isNewTyCon tycon = Nothing + | otherwise = tyConDataCons_maybe tycon -- | Determine the number of value constructors a 'TyCon' has. Panics if the -- 'TyCon' is not algebraic or a tuple @@ -2408,6 +2351,31 @@ algTyConRhs :: TyCon -> AlgTyConRhs algTyConRhs (AlgTyCon {algTcRhs = rhs}) = rhs algTyConRhs other = pprPanic "algTyConRhs" (ppr other) +{- Note [Product types] +~~~~~~~~~~~~~~~~~~~~~~~ +A product type is + * A data type (not a newtype) + * With one data constructor + +The main point is that product types are amenable to unboxing for + * Strict function calls; we can transform + f (D @ex a b) = e + to + fw @ex a b = e + via the worker/wrapper transformation. + + * CPR for function results (if the data con has no existentials); we can + transform + f x y = let ... in D a b + to + fw x y = let ... in (# a, b #) + +Note that the data constructor /can/ have evidence arguments: equality +constraints, type classes etc. So it can be GADT. These evidence +arguments are simply value arguments, and should not get in the way. +-} + + -- | Extract type variable naming the result of injective type family tyConFamilyResVar_maybe :: TyCon -> Maybe Name tyConFamilyResVar_maybe (FamilyTyCon {famTcResVar = res}) = res ===================================== compiler/GHC/CoreToIface.hs ===================================== @@ -245,7 +245,7 @@ toIfaceTyCon tc , Just tsort <- tupleSort tc' = tsort | isUnboxedSumTyCon tc - , Just cons <- isDataSumTyCon_maybe tc = IfaceSumTyCon (length cons) + , Just cons <- tyConDataCons_maybe tc = IfaceSumTyCon (length cons) | otherwise = IfaceNormalTyCon ===================================== compiler/GHC/Hs/Pat.hs ===================================== @@ -771,8 +771,6 @@ isIrrefutableHsPat L _ (PatSynCon _pat) -> False -- Conservative L _ (RealDataCon con) -> isJust (tyConSingleDataCon_maybe (dataConTyCon con)) - -- NB: tyConSingleDataCon_maybe, *not* isProductTyCon, because - -- the latter is false of existentials. See #4439 && all goL (hsConPatArgs details) go (LitPat {}) = False go (NPat {}) = False ===================================== compiler/GHC/HsToCore/Foreign/Call.hs ===================================== @@ -353,7 +353,8 @@ resultWrapper result_ty -- Data types with a single constructor, which has a single arg -- This includes types like Ptr and ForeignPtr | Just (tycon, tycon_arg_tys) <- maybe_tc_app - , Just data_con <- isDataProductTyCon_maybe tycon -- One constructor, no existentials + , Just data_con <- tyConSingleAlgDataCon_maybe tycon -- One constructor + , null (dataConExTyCoVars data_con) -- no existentials , [Scaled _ unwrapped_res_ty] <- dataConInstOrigArgTys data_con tycon_arg_tys -- One argument = do { dflags <- getDynFlags ; let platform = targetPlatform dflags ===================================== compiler/GHC/HsToCore/Utils.hs ===================================== @@ -737,7 +737,7 @@ is_flat_prod_pat (TuplePat _ ps Boxed) = all is_triv_lpat ps is_flat_prod_pat (ConPat { pat_con = L _ pcon , pat_args = ps}) | RealDataCon con <- pcon - , isProductTyCon (dataConTyCon con) + , Just _ <- tyConSingleDataCon_maybe (dataConTyCon con) = all is_triv_lpat (hsConPatArgs ps) is_flat_prod_pat _ = False ===================================== compiler/GHC/Tc/Deriv/Utils.hs ===================================== @@ -928,8 +928,8 @@ cond_isEnumeration _ _ rep_tc cond_isProduct :: Condition cond_isProduct _ _ rep_tc - | isProductTyCon rep_tc = IsValid - | otherwise = NotValid why + | Just _ <- tyConSingleDataCon_maybe rep_tc = IsValid + | otherwise = NotValid why where why = quotes (pprSourceTyCon rep_tc) <+> text "must have precisely one constructor" ===================================== testsuite/tests/simplCore/should_compile/T18013.stderr ===================================== @@ -132,33 +132,58 @@ Result size of Tidy Core = {terms: 52, types: 106, coercions: 17, joins: 0/1} -- RHS size: {terms: 37, types: 87, coercions: 17, joins: 0/1} -mapMaybeRule +mapMaybeRule [InlPrag=[2]] :: forall a b. Rule IO a b -> Rule IO (Maybe a) (Maybe b) [GblId, Arity=1, - Str=, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 150 10}] + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (@a) (@b) (w [Occ=Once1!] :: Rule IO a b) -> + case w of { Rule @s ww1 ww2 [Occ=OnceL1!] -> + T18013a.Rule + @IO + @(Maybe a) + @(Maybe b) + @s + ww1 + ((\ (s2 [Occ=Once1] :: s) + (a1 [Occ=Once1!] :: Maybe a) + (s1 [Occ=Once2] :: GHC.Prim.State# GHC.Prim.RealWorld) -> + case a1 of { + Nothing -> + (# s1, T18013a.Result @s @(Maybe b) ww1 (GHC.Maybe.Nothing @b) #); + Just x [Occ=Once1] -> + case ((ww2 s2 x) `cast` ) s1 of + { (# ipv [Occ=Once1], ipv1 [Occ=Once1!] #) -> + case ipv1 of { Result t2 [Occ=Once1] c1 [Occ=Once1] -> + (# ipv, T18013a.Result @s @(Maybe b) t2 (GHC.Maybe.Just @b c1) #) + } + } + }) + `cast` ) + }}] mapMaybeRule - = \ (@a) (@b) (f :: Rule IO a b) -> - case f of { Rule @s t0 g -> + = \ (@a) (@b) (w :: Rule IO a b) -> + case w of { Rule @s ww1 ww2 -> let { lvl :: Result s (Maybe b) [LclId, Unf=OtherCon []] - lvl = T18013a.Result @s @(Maybe b) t0 (GHC.Maybe.Nothing @b) } in + lvl = T18013a.Result @s @(Maybe b) ww1 (GHC.Maybe.Nothing @b) } in T18013a.Rule @IO @(Maybe a) @(Maybe b) @s - t0 + ww1 ((\ (s2 :: s) (a1 :: Maybe a) (s1 :: GHC.Prim.State# GHC.Prim.RealWorld) -> case a1 of { Nothing -> (# s1, lvl #); Just x -> - case ((g s2 x) `cast` ) s1 of { (# ipv, ipv1 #) -> + case ((ww2 s2 x) `cast` ) s1 of { (# ipv, ipv1 #) -> case ipv1 of { Result t2 c1 -> (# ipv, T18013a.Result @s @(Maybe b) t2 (GHC.Maybe.Just @b c1) #) } ===================================== testsuite/tests/stranal/should_compile/T18982.hs ===================================== @@ -0,0 +1,33 @@ +{-# OPTIONS_GHC -O -fforce-recomp #-} +{-# LANGUAGE GADTs #-} + +module T18982 where + +data Box a where + Box :: a -> Box a + +data Ex a where + Ex :: e -> a -> Ex a + +data GADT a where + GADT :: Int -> GADT Int + +data ExGADT a where + ExGADT :: (e ~ Int) => e -> Int -> ExGADT Int + +f :: Box Int -> Int +f (Box n) = n + 1 +{-# NOINLINE f #-} + +g :: Ex Int -> Int +g (Ex e n) = e `seq` n + 1 +{-# NOINLINE g #-} + +h :: GADT a -> Int +h (GADT n) = n + 1 +{-# NOINLINE h #-} + +i :: ExGADT a -> Int +i (ExGADT e n) = e `seq` n + 1 +{-# NOINLINE i #-} + ===================================== testsuite/tests/stranal/should_compile/T18982.stderr ===================================== @@ -0,0 +1,246 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core = {terms: 311, types: 249, coercions: 4, joins: 0/0} + +-- RHS size: {terms: 8, types: 11, coercions: 1, joins: 0/0} +T18982.$WExGADT :: forall e. (e ~ Int) => e %1 -> Int %1 -> ExGADT Int +T18982.$WExGADT = \ (@e) (dt :: e ~ Int) (dt :: e) (dt :: Int) -> T18982.ExGADT @Int @e @~(_N :: Int GHC.Prim.~# Int) dt dt dt + +-- RHS size: {terms: 3, types: 2, coercions: 1, joins: 0/0} +T18982.$WGADT :: Int %1 -> GADT Int +T18982.$WGADT = \ (dt :: Int) -> T18982.GADT @Int @~(_N :: Int GHC.Prim.~# Int) dt + +-- RHS size: {terms: 7, types: 8, coercions: 0, joins: 0/0} +T18982.$WEx :: forall e a. e %1 -> a %1 -> Ex a +T18982.$WEx = \ (@e) (@a) (dt :: e) (dt :: a) -> T18982.Ex @a @e dt dt + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$trModule4 :: GHC.Prim.Addr# +T18982.$trModule4 = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$trModule3 :: GHC.Types.TrName +T18982.$trModule3 = GHC.Types.TrNameS T18982.$trModule4 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$trModule2 :: GHC.Prim.Addr# +T18982.$trModule2 = "T18982"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$trModule1 :: GHC.Types.TrName +T18982.$trModule1 = GHC.Types.TrNameS T18982.$trModule2 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18982.$trModule :: GHC.Types.Module +T18982.$trModule = GHC.Types.Module T18982.$trModule3 T18982.$trModule1 + +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} +$krep :: GHC.Types.KindRep +$krep = GHC.Types.KindRepTyConApp GHC.Types.$tcInt (GHC.Types.[] @GHC.Types.KindRep) + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$krep1 :: GHC.Types.KindRep +$krep1 = GHC.Types.KindRepVar 1# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$krep2 :: GHC.Types.KindRep +$krep2 = GHC.Types.KindRepVar 0# + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +$krep3 :: [GHC.Types.KindRep] +$krep3 = GHC.Types.: @GHC.Types.KindRep $krep (GHC.Types.[] @GHC.Types.KindRep) + +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} +$krep4 :: [GHC.Types.KindRep] +$krep4 = GHC.Types.: @GHC.Types.KindRep $krep2 $krep3 + +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} +$krep5 :: [GHC.Types.KindRep] +$krep5 = GHC.Types.: @GHC.Types.KindRep GHC.Types.krep$* $krep4 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep6 :: GHC.Types.KindRep +$krep6 = GHC.Types.KindRepTyConApp GHC.Types.$tc~ $krep5 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tcBox2 :: GHC.Prim.Addr# +T18982.$tcBox2 = "Box"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tcBox1 :: GHC.Types.TrName +T18982.$tcBox1 = GHC.Types.TrNameS T18982.$tcBox2 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tcBox :: GHC.Types.TyCon +T18982.$tcBox = GHC.Types.TyCon 16948648223906549518## 2491460178135962649## T18982.$trModule T18982.$tcBox1 0# GHC.Types.krep$*Arr* + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +$krep7 :: [GHC.Types.KindRep] +$krep7 = GHC.Types.: @GHC.Types.KindRep $krep2 (GHC.Types.[] @GHC.Types.KindRep) + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep8 :: GHC.Types.KindRep +$krep8 = GHC.Types.KindRepTyConApp T18982.$tcBox $krep7 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Box1 :: GHC.Types.KindRep +T18982.$tc'Box1 = GHC.Types.KindRepFun $krep2 $krep8 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Box3 :: GHC.Prim.Addr# +T18982.$tc'Box3 = "'Box"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Box2 :: GHC.Types.TrName +T18982.$tc'Box2 = GHC.Types.TrNameS T18982.$tc'Box3 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Box :: GHC.Types.TyCon +T18982.$tc'Box = GHC.Types.TyCon 1412068769125067428## 8727214667407894081## T18982.$trModule T18982.$tc'Box2 1# T18982.$tc'Box1 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tcEx2 :: GHC.Prim.Addr# +T18982.$tcEx2 = "Ex"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tcEx1 :: GHC.Types.TrName +T18982.$tcEx1 = GHC.Types.TrNameS T18982.$tcEx2 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tcEx :: GHC.Types.TyCon +T18982.$tcEx = GHC.Types.TyCon 4376661818164435927## 18005417598910668817## T18982.$trModule T18982.$tcEx1 0# GHC.Types.krep$*Arr* + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +$krep9 :: [GHC.Types.KindRep] +$krep9 = GHC.Types.: @GHC.Types.KindRep $krep1 (GHC.Types.[] @GHC.Types.KindRep) + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep10 :: GHC.Types.KindRep +$krep10 = GHC.Types.KindRepTyConApp T18982.$tcEx $krep9 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep11 :: GHC.Types.KindRep +$krep11 = GHC.Types.KindRepFun $krep1 $krep10 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Ex1 :: GHC.Types.KindRep +T18982.$tc'Ex1 = GHC.Types.KindRepFun $krep2 $krep11 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Ex3 :: GHC.Prim.Addr# +T18982.$tc'Ex3 = "'Ex"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Ex2 :: GHC.Types.TrName +T18982.$tc'Ex2 = GHC.Types.TrNameS T18982.$tc'Ex3 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Ex :: GHC.Types.TyCon +T18982.$tc'Ex = GHC.Types.TyCon 14609381081172201359## 3077219645053200509## T18982.$trModule T18982.$tc'Ex2 2# T18982.$tc'Ex1 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tcGADT2 :: GHC.Prim.Addr# +T18982.$tcGADT2 = "GADT"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tcGADT1 :: GHC.Types.TrName +T18982.$tcGADT1 = GHC.Types.TrNameS T18982.$tcGADT2 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tcGADT :: GHC.Types.TyCon +T18982.$tcGADT = GHC.Types.TyCon 9243924476135839950## 5096619276488416461## T18982.$trModule T18982.$tcGADT1 0# GHC.Types.krep$*Arr* + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep12 :: GHC.Types.KindRep +$krep12 = GHC.Types.KindRepTyConApp T18982.$tcGADT $krep3 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'GADT1 :: GHC.Types.KindRep +T18982.$tc'GADT1 = GHC.Types.KindRepFun $krep $krep12 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'GADT3 :: GHC.Prim.Addr# +T18982.$tc'GADT3 = "'GADT"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'GADT2 :: GHC.Types.TrName +T18982.$tc'GADT2 = GHC.Types.TrNameS T18982.$tc'GADT3 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'GADT :: GHC.Types.TyCon +T18982.$tc'GADT = GHC.Types.TyCon 2077850259354179864## 16731205864486799217## T18982.$trModule T18982.$tc'GADT2 0# T18982.$tc'GADT1 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tcExGADT2 :: GHC.Prim.Addr# +T18982.$tcExGADT2 = "ExGADT"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tcExGADT1 :: GHC.Types.TrName +T18982.$tcExGADT1 = GHC.Types.TrNameS T18982.$tcExGADT2 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tcExGADT :: GHC.Types.TyCon +T18982.$tcExGADT = GHC.Types.TyCon 6470898418160489500## 10361108917441214060## T18982.$trModule T18982.$tcExGADT1 0# GHC.Types.krep$*Arr* + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep13 :: GHC.Types.KindRep +$krep13 = GHC.Types.KindRepTyConApp T18982.$tcExGADT $krep3 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep14 :: GHC.Types.KindRep +$krep14 = GHC.Types.KindRepFun $krep $krep13 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep15 :: GHC.Types.KindRep +$krep15 = GHC.Types.KindRepFun $krep2 $krep14 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'ExGADT1 :: GHC.Types.KindRep +T18982.$tc'ExGADT1 = GHC.Types.KindRepFun $krep6 $krep15 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'ExGADT3 :: GHC.Prim.Addr# +T18982.$tc'ExGADT3 = "'ExGADT"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'ExGADT2 :: GHC.Types.TrName +T18982.$tc'ExGADT2 = GHC.Types.TrNameS T18982.$tc'ExGADT3 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'ExGADT :: GHC.Types.TyCon +T18982.$tc'ExGADT = GHC.Types.TyCon 8468257409157161049## 5503123603717080600## T18982.$trModule T18982.$tc'ExGADT2 1# T18982.$tc'ExGADT1 + +-- RHS size: {terms: 11, types: 14, coercions: 0, joins: 0/0} +T18982.$wi :: forall {a} {e}. (a GHC.Prim.~# Int) -> e -> GHC.Prim.Int# -> GHC.Prim.Int# +T18982.$wi = \ (@a) (@e) (ww :: a GHC.Prim.~# Int) (ww1 :: e) (ww2 :: GHC.Prim.Int#) -> case ww1 of { __DEFAULT -> GHC.Prim.+# ww2 1# } + +-- RHS size: {terms: 15, types: 27, coercions: 1, joins: 0/0} +i :: forall a. ExGADT a -> Int +i = \ (@a) (w :: ExGADT a) -> case w of { ExGADT @e ww1 ww2 ww3 ww4 -> case ww4 of { GHC.Types.I# ww6 -> case T18982.$wi @a @e @~(ww1 :: a GHC.Prim.~# Int) ww3 ww6 of ww7 { __DEFAULT -> GHC.Types.I# ww7 } } } + +-- RHS size: {terms: 6, types: 10, coercions: 0, joins: 0/0} +T18982.$wh :: forall {a}. (a GHC.Prim.~# Int) -> GHC.Prim.Int# -> GHC.Prim.Int# +T18982.$wh = \ (@a) (ww :: a GHC.Prim.~# Int) (ww1 :: GHC.Prim.Int#) -> GHC.Prim.+# ww1 1# + +-- RHS size: {terms: 14, types: 18, coercions: 1, joins: 0/0} +h :: forall a. GADT a -> Int +h = \ (@a) (w :: GADT a) -> case w of { GADT ww1 ww2 -> case ww2 of { GHC.Types.I# ww4 -> case T18982.$wh @a @~(ww1 :: a GHC.Prim.~# Int) ww4 of ww5 { __DEFAULT -> GHC.Types.I# ww5 } } } + +-- RHS size: {terms: 9, types: 5, coercions: 0, joins: 0/0} +T18982.$wg :: forall {e}. e -> GHC.Prim.Int# -> GHC.Prim.Int# +T18982.$wg = \ (@e) (ww :: e) (ww1 :: GHC.Prim.Int#) -> case ww of { __DEFAULT -> GHC.Prim.+# ww1 1# } + +-- RHS size: {terms: 14, types: 12, coercions: 0, joins: 0/0} +g :: Ex Int -> Int +g = \ (w :: Ex Int) -> case w of { Ex @e ww1 ww2 -> case ww2 of { GHC.Types.I# ww4 -> case T18982.$wg @e ww1 ww4 of ww5 { __DEFAULT -> GHC.Types.I# ww5 } } } + +-- RHS size: {terms: 4, types: 1, coercions: 0, joins: 0/0} +T18982.$wf :: GHC.Prim.Int# -> GHC.Prim.Int# +T18982.$wf = \ (ww :: GHC.Prim.Int#) -> GHC.Prim.+# ww 1# + +-- RHS size: {terms: 13, types: 8, coercions: 0, joins: 0/0} +f :: Box Int -> Int +f = \ (w :: Box Int) -> case w of { Box ww1 -> case ww1 of { GHC.Types.I# ww3 -> case T18982.$wf ww3 of ww4 { __DEFAULT -> GHC.Types.I# ww4 } } } + + + ===================================== testsuite/tests/stranal/should_compile/all.T ===================================== @@ -62,3 +62,5 @@ test('T18903', [ grep_errmsg(r'Dmd=\S+C\S+') ], compile, ['-ddump-simpl -dsuppr test('T18894', [ grep_errmsg(r'Dmd=\S+C\S+') ], compile, ['-ddump-stranal -dsuppress-uniques']) # We care about the Arity 2 on eta, as a result of the annotated Dmd test('T18894b', [ grep_errmsg(r'Arity=2') ], compile, ['-ddump-stranal -dsuppress-uniques -fno-call-arity -dppr-cols=200']) +# We care about the workers of f,g,h,i: +test('T18982', [ grep_errmsg(r'\$w. .*Int#$') ], compile, ['-dppr-cols=1000 -ddump-simpl -dsuppress-idinfo -dsuppress-uniques']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/07b2e5ddee93745bcd2f452bb534b1f1183c4c23 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/07b2e5ddee93745bcd2f452bb534b1f1183c4c23 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 4 12:42:53 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Fri, 04 Dec 2020 07:42:53 -0500 Subject: [Git][ghc/ghc][wip/T18891] Fix kind inference for data types. Again. Message-ID: <5fca2ecd68f37_6b2147a61c3691@gitlab.mail> Simon Peyton Jones pushed to branch wip/T18891 at Glasgow Haskell Compiler / GHC Commits: e96712f9 by Simon Peyton Jones at 2020-12-04T12:42:00+00:00 Fix kind inference for data types. Again. This patch fixes several aspects of kind inference for data type declarations, especially data /instance/ declarations Specifically 1. In kcConDecls/kcConDecl make it clear that the tc_res_kind argument is only used in the H98 case; and in that case there is no result kind signature; and hence no need for the disgusting splitPiTys in kcConDecls (now thankfully gone). The GADT case is a bit different to before, and much nicer. This is what fixes #18891. See Note [kcConDecls: kind-checking data type decls] 2. Do not look at the constructor decls of a data/newtype instance in tcDataFamInstanceHeader. See GHC.Tc.TyCl.Instance Note [Kind inference for data family instances]. This was a new realisation that arose when doing (1) This causes a few knock-on effects in the tests suite, because we require more information than before in the instance /header/. New user-manual material about this in "Kind inference in data type declarations" and "Kind inference for data/newtype instance declarations". 3. Minor improvement in kcTyClDecl, combining GADT and H98 cases 4. Fix #14111 and #8707 by allowing the header of a data instance to affect kind inferece for the the data constructor signatures; as described at length in Note [GADT return types] in GHC.Tc.TyCl This led to a modest refactoring of the arguments (and argument order) of tcConDecl/tcConDecls. 5. Fix #19000 by inverting the sense of the test in new_locs in GHC.Tc.Solver.Canonical.canDecomposableTyConAppOK. Rather to my surprise, CI tells us that we get quite a few compile time perf improvements in compiler bytes-allocated. Here are the ones that reduced more than 1%. Good news! I have no idea why. Test Metric value New value Change --------------------------------------------------------------------------- ManyAlternatives(normal) ghc/alloc 803792416.0 800063504.0 -0.5% Naperian(optasm) ghc/alloc 54311984.0 52874144.0 -2.6% GOOD PmSeriesG(normal) ghc/alloc 57119912.0 53369856.0 -6.6% PmSeriesS(normal) ghc/alloc 71507464.0 67756248.0 -5.2% PmSeriesT(normal) ghc/alloc 104597416.0 100846208.0 -3.6% PmSeriesV(normal) ghc/alloc 70326360.0 66576336.0 -5.3% T10421(normal) ghc/alloc 132567776.0 128845672.0 -2.8% GOOD T10421a(normal) ghc/alloc 94605104.0 90858592.0 -4.0% T10547(normal) ghc/alloc 34996968.0 33557256.0 -4.1% GOOD T10858(normal) ghc/alloc 212086488.0 208375832.0 -1.7% T11195(normal) ghc/alloc 310033360.0 306391248.0 -1.2% T11276(normal) ghc/alloc 145378016.0 141657896.0 -2.6% T11303b(normal) ghc/alloc 55148504.0 51404904.0 -6.8% T11374(normal) ghc/alloc 243783840.0 240133008.0 -1.5% T11822(normal) ghc/alloc 154231136.0 150490720.0 -2.4% T12150(optasm) ghc/alloc 94489040.0 90752656.0 -4.0% GOOD T12234(optasm) ghc/alloc 69407208.0 65659624.0 -5.4% GOOD T12425(optasm) ghc/alloc 115122960.0 111397664.0 -3.2% GOOD T13035(normal) ghc/alloc 118754176.0 114795136.0 -3.3% GOOD T13253-spj(normal) ghc/alloc 168969768.0 165225400.0 -2.2% GOOD T15630(normal) ghc/alloc 201226672.0 197491904.0 -1.9% T16190(normal) ghc/alloc 289119984.0 285560848.0 -1.2% T17096(normal) ghc/alloc 326080472.0 322369512.0 -1.1% T17836b(normal) ghc/alloc 69578304.0 65830328.0 -5.4% T17977(normal) ghc/alloc 55833520.0 52094448.0 -6.7% T17977b(normal) ghc/alloc 50731152.0 46983088.0 -7.4% T18140(normal) ghc/alloc 120628376.0 116879552.0 -3.1% GOOD T18282(normal) ghc/alloc 170207168.0 166491784.0 -2.2% GOOD T18304(normal) ghc/alloc 107596576.0 103853360.0 -3.5% GOOD T3064(normal) ghc/alloc 209696560.0 205954384.0 -1.8% T4801(normal) ghc/alloc 376239392.0 372505256.0 -1.0% T5030(normal) ghc/alloc 388667176.0 384947480.0 -1.0% T5321FD(normal) ghc/alloc 332509600.0 328779208.0 -1.1% T5321Fun(normal) ghc/alloc 379067288.0 375338056.0 -1.0% T5837(normal) ghc/alloc 46272360.0 42540544.0 -8.1% GOOD T6048(optasm) ghc/alloc 99200336.0 95462744.0 -3.8% GOOD T9020(optasm) ghc/alloc 282057000.0 278339944.0 -1.3% T9233(normal) ghc/alloc 967401992.0 963669872.0 -0.4% Metric Decrease: Naperian T10421 T10547 T12150 T12234 T12425 T13035 T13253-spj T18140 T18282 T18304 T5837 T6048 - - - - - 30 changed files: - compiler/GHC/Hs/Extension.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Instance.hs - docs/users_guide/9.2.1-notes.rst - docs/users_guide/exts/poly_kinds.rst - testsuite/tests/dependent/should_fail/T13780a.stderr - testsuite/tests/deriving/should_compile/T11416.hs - testsuite/tests/deriving/should_compile/T9359.hs - + testsuite/tests/indexed-types/should_compile/T14111.hs - + testsuite/tests/indexed-types/should_compile/T8707.hs - testsuite/tests/indexed-types/should_compile/all.T - testsuite/tests/indexed-types/should_fail/T8368.stderr - testsuite/tests/indexed-types/should_fail/T8368a.stderr - testsuite/tests/patsyn/should_fail/T15685.stderr - testsuite/tests/polykinds/T13659.stderr - testsuite/tests/polykinds/T16221a.stderr - testsuite/tests/th/T11145.stderr - testsuite/tests/th/T9692.hs - + testsuite/tests/typecheck/should_compile/T18891.hs - testsuite/tests/typecheck/should_compile/UnliftedNewtypesUnassociatedFamily.hs - testsuite/tests/typecheck/should_compile/UnliftedNewtypesUnifySig.hs - testsuite/tests/typecheck/should_compile/all.T - + testsuite/tests/typecheck/should_fail/T18891a.hs - + testsuite/tests/typecheck/should_fail/T18891a.stderr - testsuite/tests/typecheck/should_fail/UnliftedNewtypesFamilyKindFail2.stderr - + testsuite/tests/typecheck/should_fail/UnliftedNewtypesUnassociatedFamilyFail.hs - + testsuite/tests/typecheck/should_fail/UnliftedNewtypesUnassociatedFamilyFail.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/Hs/Extension.hs ===================================== @@ -253,9 +253,9 @@ sure that any uses of it as a field are strict. -- | Used as a data type index for the hsSyn AST; also serves -- as a singleton type for Pass data GhcPass (c :: Pass) where - GhcPs :: GhcPs - GhcRn :: GhcRn - GhcTc :: GhcTc + GhcPs :: GhcPass 'Parsed + GhcRn :: GhcPass 'Renamed + GhcTc :: GhcPass 'Typechecked -- This really should never be entered, but the data-deriving machinery -- needs the instance to exist. ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -2986,7 +2986,7 @@ bindOuterSigTKBndrs_Tv_M :: TcTyMode -> TcM a -> TcM (HsOuterSigTyVarBndrs GhcTc, a) -- Do not push level; do not make implication constraint; use Tvs -- Two major clients of this "bind-only" path are: --- Note [Kind-checking for GADTs] in TyCl +-- Note [Using TyVarTvs for kind-checking GADTs] in GHC.Tc.TyCl -- Note [Checking partial type signatures] bindOuterSigTKBndrs_Tv_M mode = bindOuterTKBndrsX (smVanilla { sm_clone = True, sm_tvtv = True @@ -3299,8 +3299,8 @@ When we /must/ clone. When kind-checking T, we give (a :: kappa1). Then: - In kcConDecl we make a TyVarTv unification variable kappa2 for k2 - (as described in Note [Kind-checking for GADTs], even though this - example is an existential) + (as described in Note [Using TyVarTvs for kind-checking GADTs], + even though this example is an existential) - So we get (b :: kappa2) via bindExplicitTKBndrs_Tv - We end up unifying kappa1 := kappa2, because of the (SameKind a b) ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -1885,7 +1885,7 @@ canDecomposableTyConAppOK ev eq_rel tc tys1 tys2 | bndr <- tyConBinders tc , let new_loc0 | isNamedTyConBinder bndr = toKindLoc loc | otherwise = loc - new_loc | isVisibleTyConBinder bndr + new_loc | isInvisibleTyConBinder bndr = updateCtLocOrigin new_loc0 toInvisibleOrigin | otherwise = new_loc0 ] ===================================== compiler/GHC/Tc/TyCl.hs ===================================== @@ -17,7 +17,8 @@ module GHC.Tc.TyCl ( -- Functions used by GHC.Tc.TyCl.Instance to check -- data/type family instance declarations - kcConDecls, tcConDecls, dataDeclChecks, checkValidTyCon, + kcConDecls, tcConDecls, DataDeclInfo(..), + dataDeclChecks, checkValidTyCon, tcFamTyPats, tcTyFamInstEqn, tcAddTyFamInstCtxt, tcMkDataFamInstCtxt, tcAddDataFamInstCtxt, unravelFamInstPats, addConsistencyConstraints, @@ -38,7 +39,7 @@ import GHC.Tc.Solver( pushLevelAndSolveEqualities, pushLevelAndSolveEqualitiesX , reportUnsolvedEqualities ) import GHC.Tc.Utils.Monad import GHC.Tc.Utils.Env -import GHC.Tc.Utils.Unify( emitResidualTvConstraint ) +import GHC.Tc.Utils.Unify( unifyType, emitResidualTvConstraint ) import GHC.Tc.Types.Constraint( emptyWC ) import GHC.Tc.Validity import GHC.Tc.Utils.Zonk @@ -130,7 +131,7 @@ Note [Check role annotations in a second pass] Role inference potentially depends on the types of all of the datacons declared in a mutually recursive group. The validity of a role annotation, in turn, depends on the result of role inference. Because the types of datacons might -be ill-formed (see #7175 and Note [Checking GADT return types]) we must check +be ill-formed (see #7175 and Note [rejigConRes]) we must check *all* the tycons in a group for validity before checking *any* of the roles. Thus, we take two passes over the resulting tycons, first checking for general validity and then checking for valid role annotations. @@ -1529,27 +1530,16 @@ kcTyClDecl :: TyClDecl GhcRn -> TcTyCon -> TcM () -- result kind signature have already been dealt with -- by inferInitialKind, so we can ignore them here. -kcTyClDecl (DataDecl { tcdLName = (L _ name) - , tcdDataDefn = defn }) tyCon - | HsDataDefn { dd_cons = cons@((L _ (ConDeclGADT {})) : _) - , dd_ctxt = (L _ []) - , dd_ND = new_or_data } <- defn - = -- See Note [Implementation of UnliftedNewtypes] STEP 2 - kcConDecls new_or_data (tyConResKind tyCon) cons - - -- hs_tvs and dd_kindSig already dealt with in inferInitialKind - -- This must be a GADT-style decl, - -- (see invariants of DataDefn declaration) - -- so (a) we don't need to bring the hs_tvs into scope, because the - -- ConDecls bind all their own variables - -- (b) dd_ctxt is not allowed for GADT-style decls, so we can ignore it - - | HsDataDefn { dd_ctxt = ctxt - , dd_cons = cons - , dd_ND = new_or_data } <- defn +kcTyClDecl (DataDecl { tcdLName = (L _ name), tcdDataDefn = defn }) tycon + | HsDataDefn { dd_ctxt = ctxt, dd_cons = cons, dd_ND = new_or_data } <- defn = bindTyClTyVars name $ \ _ _ _ -> - do { _ <- tcHsContext ctxt - ; kcConDecls new_or_data (tyConResKind tyCon) cons + -- NB: binding these tyvars isn't necessary for GADTs, but it does no + -- harm. For GADTs, each data con brings its own tyvars into scope, + -- and the ones from this bindTyClTyVars are either not mentioned or + -- (conceivably) shadowed. + do { traceTc "kcTyClDecl" (ppr tycon $$ ppr (tyConTyVars tycon) $$ ppr (tyConResKind tycon)) + ; _ <- tcHsContext ctxt + ; kcConDecls new_or_data (tyConResKind tycon) cons } kcTyClDecl (SynDecl { tcdLName = L _ name, tcdRhs = rhs }) _tycon @@ -1585,7 +1575,6 @@ kcConArgTys new_or_data res_kind arg_tys = do { let exp_kind = getArgExpKind new_or_data res_kind ; forM_ arg_tys (\(HsScaled mult ty) -> do _ <- tcCheckLHsType (getBangType ty) exp_kind tcMult mult) - -- See Note [Implementation of UnliftedNewtypes], STEP 2 } @@ -1606,13 +1595,12 @@ kcConGADTArgs new_or_data res_kind con_args = case con_args of kcConDecls :: NewOrData -> Kind -- The result kind signature + -- Used only in H98 case -> [LConDecl GhcRn] -- The data constructors -> TcM () -kcConDecls new_or_data res_kind cons - = mapM_ (wrapLocM_ (kcConDecl new_or_data final_res_kind)) cons - where - (_, final_res_kind) = splitPiTys res_kind - -- See Note [kcConDecls result kind] +-- See Note [kcConDecls: kind-checking data type decls] +kcConDecls new_or_data tc_res_kind cons + = mapM_ (wrapLocM_ (kcConDecl new_or_data tc_res_kind)) cons -- Kind check a data constructor. In additional to the data constructor, -- we also need to know about whether or not its corresponding type was @@ -1623,82 +1611,77 @@ kcConDecl :: NewOrData -> Kind -- Result kind of the type constructor -- Usually Type but can be TYPE UnliftedRep -- or even TYPE r, in the case of unlifted newtype + -- Used only in H98 case -> ConDecl GhcRn -> TcM () -kcConDecl new_or_data res_kind (ConDeclH98 +kcConDecl new_or_data tc_res_kind (ConDeclH98 { con_name = name, con_ex_tvs = ex_tvs , con_mb_cxt = ex_ctxt, con_args = args }) - = addErrCtxt (dataConCtxtName [name]) $ + = addErrCtxt (dataConCtxt [name]) $ discardResult $ bindExplicitTKBndrs_Tv ex_tvs $ do { _ <- tcHsMbContext ex_ctxt - ; kcConH98Args new_or_data res_kind args + ; kcConH98Args new_or_data tc_res_kind args -- We don't need to check the telescope here, -- because that's done in tcConDecl } -kcConDecl new_or_data res_kind (ConDeclGADT +kcConDecl new_or_data + _tc_res_kind -- Not used in GADT case (and doesn't make sense) + (ConDeclGADT { con_names = names, con_bndrs = L _ outer_bndrs, con_mb_cxt = cxt , con_g_args = args, con_res_ty = res_ty }) - = -- Even though the GADT-style data constructor's type is closed, - -- we must still kind-check the type, because that may influence - -- the inferred kind of the /type/ constructor. Example: - -- data T f a where - -- MkT :: f a -> T f a - -- If we don't look at MkT we won't get the correct kind - -- for the type constructor T - addErrCtxt (dataConCtxtName names) $ + = -- See Note [kcConDecls: kind-checking data type decls] + addErrCtxt (dataConCtxt names) $ discardResult $ bindOuterSigTKBndrs_Tv outer_bndrs $ - -- Why "_Tv"? See Note [Kind-checking for GADTs] + -- Why "_Tv"? See Note [Using TyVarTvs for kind-checking GADTs] do { _ <- tcHsMbContext cxt - ; kcConGADTArgs new_or_data res_kind args - ; _ <- tcHsOpenType res_ty + ; traceTc "kcConDecl:GADT {" (ppr names $$ ppr res_ty) + ; con_res_kind <- newOpenTypeKind + ; _ <- tcCheckLHsType res_ty (TheKind con_res_kind) + ; kcConGADTArgs new_or_data con_res_kind args + ; traceTc "kcConDecl:GADT }" (ppr names $$ ppr con_res_kind) ; return () } -{- Note [kcConDecls result kind] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We might have e.g. - data T a :: Type -> Type where ... -or - newtype instance N a :: Type -> Type where .. -in which case, the 'res_kind' passed to kcConDecls will be - Type->Type - -We must look past those arrows, or even foralls, to the Type in the -corner, to pass to kcConDecl c.f. #16828. Hence the splitPiTys here. - -I am a bit concerned about tycons with a declaration like - data T a :: Type -> forall k. k -> Type where ... - -It does not have a CUSK, so kcInferDeclHeader will make a TcTyCon -with tyConResKind of Type -> forall k. k -> Type. Even that is fine: -the splitPiTys will look past the forall. But I'm bothered about -what if the type "in the corner" mentions k? This is incredibly -obscure but something like this could be bad: - data T a :: Type -> foral k. k -> TYPE (F k) where ... - -I bet we are not quite right here, but my brain suffered a buffer -overflow and I thought it best to nail the common cases right now. - -Note [Recursion and promoting data constructors] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We don't want to allow promotion in a strongly connected component -when kind checking. - -Consider: - data T f = K (f (K Any)) - -When kind checking the `data T' declaration the local env contains the -mappings: - T -> ATcTyCon - K -> APromotionErr - -APromotionErr is only used for DataCons, and only used during type checking -in tcTyClGroup. - -Note [Kind-checking for GADTs] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [kcConDecls: kind-checking data type decls] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +kcConDecls is used when we are inferring the kind of the type +constructor in a data type declaration. E.g. + data T f a = MkT (f a) +we want to infer the kind of 'f' and 'a'. The basic plan is described +in Note [Inferring kinds for type declarations]; here we are doing Step 2. + +In the GADT case we may have this: + data T f a where + MkT :: forall g b. g b -> T g b + +Notice that the variables f,a, and g,b are quite distinct. +Nevertheless, the type signature for MkT must still influence the kind +T which is (remember Step 1) something like + T :: kappa1 -> kappa2 -> Type +Otherwise we'd infer the bogus kind + T :: forall k1 k2. k1 -> k2 -> Type. + +The type signature for MkT influences the kind of T simply by +kind-checking the result type (T g b), which will force 'f' and 'g' to +have the same kinds. This is the call to + tcCheckLHsType res_ty (TheKind con_res_kind) +Because this is the result type of an arrow, we know the kind must be +of form (TYPE rr), and we get better error messages if we enforce that +here (e.g. test gadt10). + +For unlifted newtypes only, we must ensure that the argument kind +and result kind are the same: +* In the H98 case, we need the result kind of the TyCon, to unify with + the argument kind. + +* In GADT syntax, this unification happens via the result kind passed + to kcConGADTArgs. The tycon's result kind is not used at all in the + GADT case. + +Note [Using TyVarTvs for kind-checking GADTs] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider data Proxy a where @@ -1708,26 +1691,27 @@ Consider It seems reasonable that this should be accepted. But something very strange is going on here: when we're kind-checking this declaration, we need to unify the kind of `a` with k and j -- even though k and j's scopes are local to the type of -MkProxy{1,2}. The best approach we've come up with is to use TyVarTvs during -the kind-checking pass. First off, note that it's OK if the kind-checking pass -is too permissive: we'll snag the problems in the type-checking pass later. -(This extra permissiveness might happen with something like +MkProxy{1,2}. + +In effect, we are simply gathering constraints on the shape of Proxy's +kind, with no skolemisation or implication constraints involved at all. + +The best approach we've come up with is to use TyVarTvs during the +kind-checking pass, rather than ordinary skolems. This is why we use +the "_Tv" variant, bindOuterSigTKBndrs_Tv. + +Our only goal is to gather constraints on the kind of the type constructor; +we do not certify that the data declaration is well-kinded. For example: data SameKind :: k -> k -> Type data Bad a where MkBad :: forall k1 k2 (a :: k1) (b :: k2). Bad (SameKind a b) -which would be accepted if k1 and k2 were TyVarTvs. This is correctly rejected -in the second pass, though. Test case: polykinds/TyVarTvKinds3) -Recall that the kind-checking pass exists solely to collect constraints -on the kinds and to power unification. - -To achieve the use of TyVarTvs, we must be careful to use specialized functions -that produce TyVarTvs, not ordinary skolems. This is why we need -kcExplicitTKBndrs and kcImplicitTKBndrs in GHC.Tc.Gen.HsType, separate from their -tc... variants. +which would be accepted by kcConDecl because k1 and k2 are +TyVarTvs. It is correctly rejected in the second pass, tcConDecl. +(Test case: polykinds/TyVarTvKinds3) -The drawback of this approach is sometimes it will accept a definition that +One drawback of this approach is sometimes it will accept a definition that a (hypothetical) declarative specification would likely reject. As a general rule, we don't want to allow polymorphic recursion without a CUSK. Indeed, the whole point of CUSKs is to allow polymorphic recursion. Yet, the TyVarTvs @@ -1746,6 +1730,23 @@ be rejected (without a CUSK). However, the accepted definitions are indeed well-kinded and any rejected definitions would be accepted with a CUSK, and so this wrinkle need not cause anyone to lose sleep. +Note [Recursion and promoting data constructors] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We don't want to allow promotion in a strongly connected component +when kind checking. + +Consider: + data T f = K (f (K Any)) + +When kind checking the `data T' declaration the local env contains the +mappings: + T -> ATcTyCon + K -> APromotionErr + +APromotionErr is only used for DataCons, and only used during type checking +in tcTyClGroup. + + ************************************************************************ * * \subsection{Type checking} @@ -2782,18 +2783,14 @@ tcDataDefn err_ctxt roles_info tc_name ; when (isJust mb_ksig) $ checkTc (kind_signatures) (badSigTyDecl tc_name) - ; tycon <- fixM $ \ tycon -> do + ; tycon <- fixM $ \ rec_tycon -> do { let final_bndrs = tycon_binders `chkAppend` extra_bndrs - res_ty = mkTyConApp tycon (mkTyVarTys (binderVars final_bndrs)) roles = roles_info tc_name ; data_cons <- tcConDecls - tycon - new_or_data - final_bndrs - final_res_kind - res_ty + new_or_data DDataType + rec_tycon final_bndrs final_res_kind cons - ; tc_rhs <- mk_tc_rhs hsc_src tycon data_cons + ; tc_rhs <- mk_tc_rhs hsc_src rec_tycon data_cons ; tc_rep_nm <- newTyConRepName tc_name ; return (mkAlgTyCon tc_name final_bndrs @@ -3195,36 +3192,51 @@ consUseGadtSyntax _ = False -- All constructors have same shape ----------------------------------- -tcConDecls :: KnotTied TyCon -> NewOrData - -> [TyConBinder] -> TcKind -- binders and result kind of tycon - -> KnotTied Type -> [LConDecl GhcRn] -> TcM [DataCon] -tcConDecls rep_tycon new_or_data tmpl_bndrs res_kind res_tmpl +data DataDeclInfo + = DDataType -- data T a b = T1 a | T2 b + | DDataInstance -- data instance D [a] = D1 a | D2 + Type -- The header D [a] + +mkDDHeaderTy :: DataDeclInfo -> TyCon -> [TyConBinder] -> Type +mkDDHeaderTy dd_info rep_tycon tc_bndrs + = case dd_info of + DDataType -> mkTyConApp rep_tycon $ + mkTyVarTys (binderVars tc_bndrs) + DDataInstance header_ty -> header_ty + +tcConDecls :: NewOrData + -> DataDeclInfo + -> KnotTied TyCon -- Representation TyCon + -> [TyConBinder] -- Binders of representation TyCon + -> TcKind -- Result kind + -> [LConDecl GhcRn] -> TcM [DataCon] +tcConDecls new_or_data dd_info rep_tycon tmpl_bndrs res_kind = concatMapM $ addLocM $ - tcConDecl rep_tycon (mkTyConTagMap rep_tycon) - tmpl_bndrs res_kind res_tmpl new_or_data - -- It's important that we pay for tag allocation here, once per TyCon, - -- See Note [Constructor tag allocation], fixes #14657 - -tcConDecl :: KnotTied TyCon -- Representation tycon. Knot-tied! + tcConDecl new_or_data dd_info rep_tycon tmpl_bndrs res_kind + (mkTyConTagMap rep_tycon) + -- mkTyConTagMap: it's important that we pay for tag allocation here, + -- once per TyCon. See Note [Constructor tag allocation], fixes #14657 + +tcConDecl :: NewOrData + -> DataDeclInfo + -> KnotTied TyCon -- Representation tycon. Knot-tied! + -> [TyConBinder] -- Binders of representation TyCon + -> TcKind -- Result kind -> NameEnv ConTag - -> [TyConBinder] -> TcKind -- tycon binders and result kind - -> KnotTied Type - -- Return type template (T tys), where T is the family TyCon - -> NewOrData -> ConDecl GhcRn -> TcM [DataCon] -tcConDecl rep_tycon tag_map tmpl_bndrs res_kind res_tmpl new_or_data +tcConDecl new_or_data dd_info rep_tycon tc_bndrs res_kind tag_map (ConDeclH98 { con_name = lname@(L _ name) , con_ex_tvs = explicit_tkv_nms , con_mb_cxt = hs_ctxt , con_args = hs_args }) - = addErrCtxt (dataConCtxtName [lname]) $ + = addErrCtxt (dataConCtxt [lname]) $ do { -- NB: the tyvars from the declaration header are in scope -- Get hold of the existential type variables -- e.g. data T a = forall k (b::k) f. MkT a (f b) - -- Here tmpl_bndrs = {a} + -- Here tc_bndrs = {a} -- hs_qvars = HsQTvs { hsq_implicit = {k} -- , hsq_explicit = {f,b} } @@ -3242,29 +3254,35 @@ tcConDecl rep_tycon tag_map tmpl_bndrs res_kind res_tmpl new_or_data } - ; let tmpl_tvs = binderVars tmpl_bndrs - ; let fake_ty = mkSpecForAllTys tmpl_tvs $ + ; let tc_tvs = binderVars tc_bndrs + fake_ty = mkSpecForAllTys tc_tvs $ mkInvisForAllTys exp_tvbndrs $ mkPhiTy ctxt $ mkVisFunTys arg_tys $ unitTy -- That type is a lie, of course. (It shouldn't end in ()!) -- And we could construct a proper result type from the info - -- at hand. But the result would mention only the tmpl_tvs, + -- at hand. But the result would mention only the univ_tvs, -- and so it just creates more work to do it right. Really, -- we're only doing this to find the right kind variables to -- quantify over, and this type is fine for that purpose. - -- exp_tvs have explicit, user-written binding sites + -- exp_tvbndrs have explicit, user-written binding sites -- the kvs below are those kind variables entirely unmentioned by the user -- and discovered only by generalization ; kvs <- kindGeneralizeAll fake_ty - ; let skol_tvs = kvs ++ tmpl_tvs + ; let skol_tvs = tc_tvs ++ kvs ++ binderVars exp_tvbndrs ; reportUnsolvedEqualities skol_info skol_tvs tclvl wanted - - -- Zonk to Types + -- The skol_info claims that all the variables are bound + -- by the data constructor decl, whereas actually the + -- univ_tvs are bound by the data type decl itself. It + -- would be better to have a doubly-nested implication. + -- But that just doesn't seem worth it. + -- See test dependent/should_fail/T13780a + + -- Zonk to Types ; (ze, qkvs) <- zonkTyBndrs kvs ; (ze, user_qtvbndrs) <- zonkTyVarBindersX ze exp_tvbndrs ; arg_tys <- zonkScaledTcTypesToTypesX ze arg_tys @@ -3272,15 +3290,14 @@ tcConDecl rep_tycon tag_map tmpl_bndrs res_kind res_tmpl new_or_data -- Can't print univ_tvs, arg_tys etc, because we are inside the knot here ; traceTc "tcConDecl 2" (ppr name $$ ppr field_lbls) - ; let - univ_tvbs = tyConInvisTVBinders tmpl_bndrs - univ_tvs = binderVars univ_tvbs - ex_tvbs = mkTyVarBinders InferredSpec qkvs ++ user_qtvbndrs - ex_tvs = binderVars ex_tvbs - -- For H98 datatypes, the user-written tyvar binders are precisely - -- the universals followed by the existentials. - -- See Note [DataCon user type variable binders] in GHC.Core.DataCon. - user_tvbs = univ_tvbs ++ ex_tvbs + ; let univ_tvbs = tyConInvisTVBinders tc_bndrs + ex_tvbs = mkTyVarBinders InferredSpec qkvs ++ user_qtvbndrs + ex_tvs = binderVars ex_tvbs + -- For H98 datatypes, the user-written tyvar binders are precisely + -- the universals followed by the existentials. + -- See Note [DataCon user type variable binders] in GHC.Core.DataCon. + user_tvbs = univ_tvbs ++ ex_tvbs + user_res_ty = mkDDHeaderTy dd_info rep_tycon tc_bndrs ; traceTc "tcConDecl 2" (ppr name) ; is_infix <- tcConIsInfixH98 name hs_args @@ -3288,9 +3305,9 @@ tcConDecl rep_tycon tag_map tmpl_bndrs res_kind res_tmpl new_or_data ; fam_envs <- tcGetFamInstEnvs ; dc <- buildDataCon fam_envs name is_infix rep_nm stricts Nothing field_lbls - univ_tvs ex_tvs user_tvbs + tc_tvs ex_tvs user_tvbs [{- no eq_preds -}] ctxt arg_tys - res_tmpl rep_tycon tag_map + user_res_ty rep_tycon tag_map -- NB: we put data_tc, the type constructor gotten from the -- constructor type signature into the data constructor; -- that way checkValidDataCon can complain if it's wrong. @@ -3299,14 +3316,14 @@ tcConDecl rep_tycon tag_map tmpl_bndrs res_kind res_tmpl new_or_data where skol_info = DataConSkol name -tcConDecl rep_tycon tag_map tmpl_bndrs _res_kind res_tmpl new_or_data +tcConDecl new_or_data dd_info rep_tycon tc_bndrs _res_kind tag_map -- NB: don't use res_kind here, as it's ill-scoped. Instead, -- we get the res_kind by typechecking the result type. (ConDeclGADT { con_names = names , con_bndrs = L _ outer_hs_bndrs , con_mb_cxt = cxt, con_g_args = hs_args , con_res_ty = hs_res_ty }) - = addErrCtxt (dataConCtxtName names) $ + = addErrCtxt (dataConCtxt names) $ do { traceTc "tcConDecl 1 gadt" (ppr names) ; let (L _ name : _) = names @@ -3317,10 +3334,23 @@ tcConDecl rep_tycon tag_map tmpl_bndrs _res_kind res_tmpl new_or_data ; (res_ty, res_kind) <- tcInferLHsTypeKind hs_res_ty -- See Note [GADT return kinds] + -- For data instances (only), ensure that the return type, + -- res_ty, is a substitution instance of the header. + -- See Note [GADT return types] + ; case dd_info of + DDataType -> return () + DDataInstance hdr_ty -> + do { (subst, _meta_tvs) <- newMetaTyVars (binderVars tc_bndrs) + ; let head_shape = substTy subst hdr_ty + ; discardResult $ + popErrCtxt $ -- Drop dataConCtxt + addErrCtxt (dataConResCtxt names) $ + unifyType Nothing res_ty head_shape } + -- See Note [Datatype return kinds] ; let exp_kind = getArgExpKind new_or_data res_kind - ; btys <- tcConGADTArgs exp_kind hs_args + ; let (arg_tys, stricts) = unzip btys ; field_lbls <- lookupConstructorFields name ; return (ctxt, arg_tys, res_ty, field_lbls, stricts) @@ -3343,9 +3373,10 @@ tcConDecl rep_tycon tag_map tmpl_bndrs _res_kind res_tmpl new_or_data ; ctxt <- zonkTcTypesToTypesX ze ctxt ; res_ty <- zonkTcTypeToTypeX ze res_ty - ; let (univ_tvs, ex_tvs, tvbndrs', eq_preds, arg_subst) - = rejigConRes tmpl_bndrs res_tmpl tvbndrs res_ty - -- See Note [Checking GADT return types] + ; let res_tmpl = mkDDHeaderTy dd_info rep_tycon tc_bndrs + (univ_tvs, ex_tvs, tvbndrs', eq_preds, arg_subst) + = rejigConRes tc_bndrs res_tmpl tvbndrs res_ty + -- See Note [rejigConRes] ctxt' = substTys arg_subst ctxt arg_tys' = substScaledTys arg_subst arg_tys @@ -3372,8 +3403,73 @@ tcConDecl rep_tycon tag_map tmpl_bndrs _res_kind res_tmpl new_or_data where skol_info = DataConSkol (unLoc (head names)) -{- Note [GADT return kinds] +{- Note [GADT return types] ~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + data family T :: forall k. k -> Type + data instance T (a :: Type) where + MkT :: forall b. T b + +What kind does `b` have in the signature for MkT? +Since the return type must be an instance of the type in the header, +we must have (b :: Type), but you can't tell that by looking only at +the type of the data constructor; you have to look at the header too. +If you wrote it out fully, it'd look like + data instance T @Type (a :: Type) where + MkT :: forall (b::Type). T @Type b + +We could reject the program, and expect the user to add kind +annotations to `MkT` to restrict the signature. But an easy and +helpful alternative is this: simply instantiate the type from the +header with fresh unification variables, and unify with the return +type of `MkT`. That will force `b` to have kind `Type`. See #8707 +and #14111. + +Wrikles +* At first sight it looks as though this would completely subsume the + return-type check in checkValidDataCon. But it does not. Suppose we + have + data instance T [a] where + MkT :: T (F (Maybe a)) + + where F is a type function. Then maybe (F (Maybe a)) evaluates to + [a], so unifyType will succeed. But we discard the coercion + returned by unifyType; and we really don't want to accept this + program. The check in checkValidDataCon will, however, reject it. + TL;DR: keep the check in checkValidDataCon. + +* Consider a data type, rather than a data instance, declaration + data S a where { MkS :: b -> S [b] } + In tcConDecl, S is knot-tied, so we don't want to unify (S alpha) + with (S [b]). To put it another way, unifyType should never see a + TcTycon. Simple solution: do *not* do the extra unifyType for + data types (DDataType) only for data instances (DDataInstance); in + the latter the family constructor is not knot-tied so there is no + problem. + +* Consider this (from an earlier form of GHC itself): + + data Pass = Parsed | ... + data GhcPass (c :: Pass) where + GhcPs :: GhcPs + ... + type GhcPs = GhcPass 'Parsed + + Now GhcPs and GhcPass are mutually recursive. If we did unifyType + for datatypes like GhcPass, we would not be able to expand the type + synonym (it'd still be a TcTyCon). So again, we don't do unifyType + for data types; we leave it to checkValidDataCon. + + We /do/ perform the unifyType for data /instances/, but a data + instance doesn't declare a new (user-visible) type constructor, so + there is no mutual recursion with type synonyms to worry about. + All good. + + TL;DR we do support mutual recursion between type synonyms and + data type/instance declarations, as above. + +Note [GADT return kinds] +~~~~~~~~~~~~~~~~~~~~~~~~ Consider type family Star where Star = Type data T :: Type where @@ -3496,8 +3592,8 @@ For example: (:--:) :: t1 -> t2 -> T Int -Note [Checking GADT return types] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [rejigConRes] +~~~~~~~~~~~~~~~~~~ There is a delicacy around checking the return types of a datacon. The central problem is dealing with a declaration like @@ -3532,9 +3628,9 @@ errors reported in one pass. See #7175, and #10836. -- TI :: forall b1 c1. (b1 ~ c1) => b1 -> :R7T b1 c1 -- In this case orig_res_ty = T (e,e) -rejigConRes :: [KnotTied TyConBinder] -> KnotTied Type -- Template for result type; e.g. - -- data instance T [a] b c ... - -- gives template ([a,b,c], T [a] b c) +rejigConRes :: [KnotTied TyConBinder] -- Template for result type; e.g. + -> KnotTied Type -- data instance T [a] b c ... + -- gives template ([a,b,c], T [a] b c) -> [InvisTVBinder] -- The constructor's type variables (both inferred and user-written) -> KnotTied Type -- res_ty -> ([TyVar], -- Universal @@ -3546,10 +3642,10 @@ rejigConRes :: [KnotTied TyConBinder] -> KnotTied Type -- Template for result -- We don't check that the TyCon given in the ResTy is -- the same as the parent tycon, because checkValidDataCon will do it -- NB: All arguments may potentially be knot-tied -rejigConRes tmpl_bndrs res_tmpl dc_tvbndrs res_ty +rejigConRes tc_tvbndrs res_tmpl dc_tvbndrs res_ty -- E.g. data T [a] b c where -- MkT :: forall x y z. T [(x,y)] z z - -- The {a,b,c} are the tmpl_tvs, and the {x,y,z} are the dc_tvs + -- The {a,b,c} are the tc_tvs, and the {x,y,z} are the dc_tvs -- (NB: unlike the H98 case, the dc_tvs are not all existential) -- Then we generate -- Univ tyvars Eq-spec @@ -3564,7 +3660,7 @@ rejigConRes tmpl_bndrs res_tmpl dc_tvbndrs res_ty -- , [], [x,y,z] -- , [a~(x,y),b~z], ) | Just subst <- tcMatchTy res_tmpl res_ty - = let (univ_tvs, raw_eqs, kind_subst) = mkGADTVars tmpl_tvs dc_tvs subst + = let (univ_tvs, raw_eqs, kind_subst) = mkGADTVars tc_tvs dc_tvs subst raw_ex_tvs = dc_tvs `minusList` univ_tvs (arg_subst, substed_ex_tvs) = substTyVarBndrs kind_subst raw_ex_tvs @@ -3590,11 +3686,11 @@ rejigConRes tmpl_bndrs res_tmpl dc_tvbndrs res_ty -- we must do *something*, not just crash. So we do something simple -- albeit bogus, relying on checkValidDataCon to check the -- bad-result-type error before seeing that the other fields look odd - -- See Note [Checking GADT return types] - = (tmpl_tvs, dc_tvs `minusList` tmpl_tvs, dc_tvbndrs, [], emptyTCvSubst) + -- See Note [rejigConRes] + = (tc_tvs, dc_tvs `minusList` tc_tvs, dc_tvbndrs, [], emptyTCvSubst) where - dc_tvs = binderVars dc_tvbndrs - tmpl_tvs = binderVars tmpl_bndrs + dc_tvs = binderVars dc_tvbndrs + tc_tvs = binderVars tc_tvbndrs {- Note [mkGADTVars] ~~~~~~~~~~~~~~~~~~~~ @@ -3634,7 +3730,7 @@ becomes We start off by matching (T k1 k2 a b) with (T x1 * (Proxy x1 y, z) z). We know this match will succeed because of the validity check (actually done -later, but laziness saves us -- see Note [Checking GADT return types]). +later, but laziness saves us -- see Note [rejigConRes]). Thus, we get subst := { k1 |-> x1, k2 |-> *, a |-> (Proxy x1 y, z), b |-> z } @@ -4081,15 +4177,9 @@ checkFieldCompat fld con1 con2 res1 res2 fty1 fty2 ------------------------------- checkValidDataCon :: DynFlags -> Bool -> TyCon -> DataCon -> TcM () checkValidDataCon dflags existential_ok tc con - = setSrcSpan (getSrcSpan con) $ - addErrCtxt (dataConCtxt con) $ - do { -- Check that the return type of the data constructor - -- matches the type constructor; eg reject this: - -- data T a where { MkT :: Bogus a } - -- It's important to do this first: - -- see Note [Checking GADT return types] - -- and c.f. Note [Check role annotations in a second pass] - let tc_tvs = tyConTyVars tc + = setSrcSpan con_loc $ + addErrCtxt (dataConCtxt [L con_loc con_name]) $ + do { let tc_tvs = tyConTyVars tc res_ty_tmpl = mkFamilyTyConApp tc (mkTyVarTys tc_tvs) orig_res_ty = dataConOrigResTy con ; traceTc "checkValidDataCon" (vcat @@ -4098,6 +4188,18 @@ checkValidDataCon dflags existential_ok tc con , ppr orig_res_ty <+> dcolon <+> ppr (tcTypeKind orig_res_ty)]) + -- Check that the return type of the data constructor + -- matches the type constructor; eg reject this: + -- data T a where { MkT :: Bogus a } + -- It's important to do this first: + -- see Note [rejigCon + -- and c.f. Note [Check role annotations in a second pass] + + -- Check that the return type of the data constructor is an instance + -- of the header of the header of data decl. This checks for + -- data T a where { MkT :: S a } + -- data instance D [a] where { MkD :: D (Maybe b) } + -- see Note [GADT return types] ; checkTc (isJust (tcMatchTyKi res_ty_tmpl orig_res_ty)) (badDataConTyCon con res_ty_tmpl) -- Note that checkTc aborts if it finds an error. This is @@ -4205,7 +4307,9 @@ checkValidDataCon dflags existential_ok tc con Just (f, _) -> ppr (tyConBinders f) ] } where - ctxt = ConArgCtxt (dataConName con) + con_name = dataConName con + con_loc = nameSrcSpan con_name + ctxt = ConArgCtxt con_name is_strict = \case NoSrcStrict -> xopt LangExt.StrictData dflags bang -> isSrcStrict bang @@ -4869,14 +4973,17 @@ fieldTypeMisMatch field_name con1 con2 = sep [text "Constructors" <+> ppr con1 <+> text "and" <+> ppr con2, text "give different types for field", quotes (ppr field_name)] -dataConCtxtName :: [Located Name] -> SDoc -dataConCtxtName [con] - = text "In the definition of data constructor" <+> quotes (ppr con) -dataConCtxtName con - = text "In the definition of data constructors" <+> interpp'SP con +dataConCtxt :: [Located Name] -> SDoc +dataConCtxt cons = text "In the definition of data constructor" <> plural cons + <+> ppr_cons cons + +dataConResCtxt :: [Located Name] -> SDoc +dataConResCtxt cons = text "In the result type of data constructor" <> plural cons + <+> ppr_cons cons -dataConCtxt :: Outputable a => a -> SDoc -dataConCtxt con = text "In the definition of data constructor" <+> quotes (ppr con) +ppr_cons :: [Located Name] -> SDoc +ppr_cons [con] = quotes (ppr con) +ppr_cons cons = interpp'SP cons classOpCtxt :: Var -> Type -> SDoc classOpCtxt sel_id tau = sep [text "When checking the class method:", ===================================== compiler/GHC/Tc/TyCl/Instance.hs ===================================== @@ -688,9 +688,8 @@ tcDataFamInstDecl mb_clsinfo tv_skol_env -- Do /not/ check that the number of patterns = tyConArity fam_tc -- See [Arity of data families] in GHC.Core.FamInstEnv ; (qtvs, pats, res_kind, stupid_theta) - <- tcDataFamInstHeader mb_clsinfo fam_tc outer_bndrs - fixity hs_ctxt hs_pats m_ksig hs_cons - new_or_data + <- tcDataFamInstHeader mb_clsinfo fam_tc outer_bndrs fixity + hs_ctxt hs_pats m_ksig new_or_data -- Eta-reduce the axiom if possible -- Quite tricky: see Note [Implementing eta reduction for data families] @@ -740,8 +739,9 @@ tcDataFamInstDecl mb_clsinfo tv_skol_env do { data_cons <- tcExtendTyVarEnv qtvs $ -- For H98 decls, the tyvars scope -- over the data constructors - tcConDecls rec_rep_tc new_or_data ty_binders final_res_kind - orig_res_ty hs_cons + tcConDecls new_or_data (DDataInstance orig_res_ty) + rec_rep_tc ty_binders final_res_kind + hs_cons ; rep_tc_name <- newFamInstTyConName lfam_name pats ; axiom_name <- newFamInstAxiomName lfam_name [pats] @@ -857,7 +857,7 @@ TyVarEnv will simply be empty, and there is nothing to worry about. tcDataFamInstHeader :: AssocInstInfo -> TyCon -> HsOuterFamEqnTyVarBndrs GhcRn -> LexicalFixity -> LHsContext GhcRn - -> HsTyPats GhcRn -> Maybe (LHsKind GhcRn) -> [LConDecl GhcRn] + -> HsTyPats GhcRn -> Maybe (LHsKind GhcRn) -> NewOrData -> TcM ([TyVar], [Type], Kind, ThetaType) -- The "header" of a data family instance is the part other than @@ -865,7 +865,7 @@ tcDataFamInstHeader -- e.g. data instance D [a] :: * -> * where ... -- Here the "header" is the bit before the "where" tcDataFamInstHeader mb_clsinfo fam_tc outer_bndrs fixity - hs_ctxt hs_pats m_ksig hs_cons new_or_data + hs_ctxt hs_pats m_ksig new_or_data = do { traceTc "tcDataFamInstHeader {" (ppr fam_tc <+> ppr hs_pats) ; (tclvl, wanted, (scoped_tvs, (stupid_theta, lhs_ty, master_res_kind, instance_res_kind))) <- pushLevelAndSolveEqualitiesX "tcDataFamInstHeader" $ @@ -884,8 +884,8 @@ tcDataFamInstHeader mb_clsinfo fam_tc outer_bndrs fixity -- Add constraints from the result signature ; res_kind <- tc_kind_sig m_ksig - -- Add constraints from the data constructors - ; kcConDecls new_or_data res_kind hs_cons + -- Do not add constraints from the data constructors + -- See Note [Kind inference for data family instances] -- Check that the result kind of the TyCon applied to its args -- is compatible with the explicit signature (or Type, if there @@ -1049,6 +1049,86 @@ however, so this Note aims to describe these subtleties: themselves. Heavy sigh. But not truly hard; that's what tcbVisibilities does. +Note [Kind inference for data family instances] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider this GADT-style data type declaration, where I have used +fresh variables in the data constructor's type, to stress that c,d are +quite distinct from a,b. + data T a b where + MkT :: forall c d. c d -> T c d + +Following Note [Inferring kinds for type declarations] in GHC.Tc.TyCl, +to infer T's kind, we initially give T :: kappa, a monomorpic kind, +gather constraints from the header and data constructors, and conclude + T :: (kappa1 -> type) -> kappa1 -> Type +Then we generalise, giving + T :: forall k. (k->Type) -> k -> Type + +Now what about a data /instance/ decl + data family T :: forall k. (k->Type) -> k -> Type + + data instance T p Int where ... + +No doubt here! The poly-kinded T is instantiated with k=Type, so the +header really looks like + data instance T @Type (p :: Type->Type) Int where ... + +But what about this? + data instance T p q where + MkT :: forall r. r Int -> T r Int + +So what kind do 'p' and 'q' have? No clues from the header, but from +the data constructor we can clearly see that (r :: Type->Type). Does +that mean that the the /entire data instance/ is instantiated at Type, +like this? + data instance T @Type (p :: Type->Type) (q :: Type) where + ... + +Not at all! This is a /GADT/-style decl, so the kind argument might +be specialised in this particular data constructor, thus: + data instance T @k (p :: k->Type) (q :: k) where + MkT :: forall (r :: Type -> Type). + r Int -> T @Type r Int +(and perhaps specialised differently in some other data +constructor MkT2). + +The key difference in this case and 'data T' at the top of this Note +is that we have no known kind for 'data T'. We thus forbid different +specialisations of T in its constructors, in an attempt to avoid +inferring polymorphic recursion. In data family T, however, there is +no problem with polymorphic recursion: we already /fully know/ T's +kind -- that came from the family declaration, and is not influenced +by the data instances -- and hence we /can/ specialise T's kind +differently in different GADT data constructors. + +SHORT SUMMARY: in a data instance decl, it's not clear whether kind +constraints arising from the data constructors should be considered +local to the (GADT) data /constructor/ or should apply to the entire +data instance. + +DESIGN CHOICE: in data/newtype family instance declarations, we ignore +the /data constructor/ declarations altogether, looking only at the +data instance /header/. + +Observations: +* This choice is simple to describe, as well as simple to implment. + For a data/newtype instance decl, the instance kinds are influenced + /only/ by the header. + +* We could treat Haskell-98 style data-instance decls differently, by + taking the data constructors into account, since there are no GADT + issues. But we don't, for simplicity, and because it means you can + understand the data type instance by looking only at the header. + +* Newtypes can be declared in GADT syntax, but they can't do GADT-style + specialisation, so like Haskell-98 definitions we could take the + data constructors into account. Again we don't, for the same reason. + +So for now at least, we keep the simplest choice. See #18891 and !4419 +for more discussion of this issue. + +Kind inference for data types (Xie et al) https://arxiv.org/abs/1911.06153 +takes a slightly different approach. -} ===================================== docs/users_guide/9.2.1-notes.rst ===================================== @@ -14,6 +14,11 @@ Language (Serrano et al, ICFP 2020). More information here: :ref:`impredicative-polymorphism`. This replaces the old (undefined, flaky) behaviour of the :extension:`ImpredicativeTypes` extension. +* Kind inference for data/newtype instance declarations is slightly + more restrictive than before. See the user manual :ref:`kind-inference-data-family-instances`. + This is a breaking change, albeit a fairly obscure one that corrects a specification bug. + + Compiler ~~~~~~~~ ===================================== docs/users_guide/exts/poly_kinds.rst ===================================== @@ -130,8 +130,45 @@ This rule has occasionally-surprising consequences (see The kind-polymorphism from the class declaration makes ``D1`` kind-polymorphic, but not so ``D2``; and similarly ``F1``, ``F2``. +Kind inference in type signatures +--------------------------------- + +When kind-checking a type, GHC considers only what is written in that +type when figuring out how to generalise the type's kind. + +For example, +consider these definitions (with :extension:`ScopedTypeVariables`): :: + + data Proxy a -- Proxy :: forall k. k -> Type + p :: forall a. Proxy a + p = Proxy :: Proxy (a :: Type) + +GHC reports an error, saying that the kind of ``a`` should be a kind variable +``k``, not ``Type``. This is because, by looking at the type signature +``forall a. Proxy a``, GHC assumes ``a``'s kind should be generalised, not +restricted to be ``Type``. The function definition is then rejected for being +more specific than its type signature. + +.. _explicit-kind-quantification: + +Explicit kind quantification +---------------------------- + +Enabled by :extension:`PolyKinds`, GHC supports explicit kind quantification, +as in these examples: :: + + data Proxy :: forall k. k -> Type + f :: (forall k (a :: k). Proxy a -> ()) -> Int + +Note that the second example has a ``forall`` that binds both a kind ``k`` and +a type variable ``a`` of kind ``k``. In general, there is no limit to how +deeply nested this sort of dependency can work. However, the dependency must +be well-scoped: ``forall (a :: k) k. ...`` is an error. + + .. _inferring-variable-order: + Inferring the order of variables in a type/class declaration ------------------------------------------------------------ @@ -490,41 +527,92 @@ This also applies to GADT-style data instances: :: -- • In the data instance declaration for ‘T’ -Kind inference in closed type families --------------------------------------- +Kind inference in data type declarations +---------------------------------------- -Although all open type families are considered to have a complete -user-supplied kind signature, we can relax this condition for closed -type families, where we have equations on which to perform kind -inference. GHC will infer kinds for the arguments and result types of a -closed type family. +Consider the declaration :: -GHC supports *kind-indexed* type families, where the family matches both -on the kind and type. GHC will *not* infer this behaviour without a -complete user-supplied kind signature, as doing so would sometimes infer -non-principal types. Indeed, we can see kind-indexing as a form -of polymorphic recursion, where a type is used at a kind other than -its most general in its own definition. + data T1 f a = MkT1 (f a) + data T2 f a where + MkT2 :: f a -> T f a -For example: :: +In both cases GHC looks at the data constructor declarations to +give constraints on the kind of ``T``, yielding :: - type family F1 a where - F1 True = False - F1 False = True - F1 x = x - -- F1 fails to compile: kind-indexing is not inferred + T1, T2 :: forall k. (k -> Type) -> k -> Type - type family F2 (a :: k) where - F2 True = False - F2 False = True - F2 x = x - -- F2 fails to compile: no complete signature +Consider the type :: + + type G :: forall k. k -> Type + data G (a :: k) where + GInt :: G Int + GMaybe :: G Maybe + +This datatype ``G`` is GADT-like in both its kind and its type. Suppose you +have ``g :: G a``, where ``a :: k``. Then pattern matching to discover that +``g`` is in fact ``GMaybe`` tells you both that ``k ~ (Type -> Type)`` and +``a ~ Maybe``. The definition for ``G`` requires that :extension:`PolyKinds` +be in effect, but pattern-matching on ``G`` requires no extension beyond +:extension:`GADTs`. That this works is actually a straightforward extension +of regular GADTs and a consequence of the fact that kinds and types are the +same. + +Note that the datatype ``G`` is used at different kinds in its body, and +therefore that kind-indexed GADTs use a form of polymorphic recursion. +It is thus only possible to use this feature if you have provided a +complete user-supplied kind signature (CUSK) +for the datatype (:ref:`complete-kind-signatures`), or a standalone +kind signature (:ref:`standalone-kind-signatures`); +in the case of ``G`` we both. +If you wish to see the kind indexing explicitly, you can do so by enabling :ghc-flag:`-fprint-explicit-kinds` and querying ``G`` with GHCi's :ghci-cmd:`:info` command: :: + + > :set -fprint-explicit-kinds + > :info G + type role G nominal nominal + type G :: forall k. k -> Type + data G @k a where + GInt :: G @Type Int + GMaybe :: G @(Type -> Type) Maybe + +where you can see the GADT-like nature of the two constructors. + +.. _kind-inference-data-family-instances: + +Kind inference for data/newtype instance declarations +----------------------------------------------------- + +Consider these declarations :: + + data family T :: forall k. (k->Type) -> k -> Type + + data instance T p q where + MkT :: forall r. r Int -> T r Int + +Here ``T`` has an invisible kind argument; and perhaps it is instantiated +to ``Type`` in the instance, thus:: + + data instance T @Type (p :: Type->Type) (q :: Type) where + MkT :: forall r. r Int -> T r Int + +Or perhaps we intended the specialisation to be in the GADT data +constructor, thus:: + + data instance T @k (p :: k->Type) (q :: k) where + MkT :: forall r. r Int -> T @Type r Int + +It gets more complicated if there are multiple constructors. In +general, there is no principled way to tell which type specialisation +comes from the data instance, and which from the individual GADT data +constructors. + +So GHC implements this rule: in data/newtype instance declararations +(unlike ordinary data/newtype declarations) we do *not* look at the +constructor declarations when inferring the shape of the instance +header. The principle is that *the instantiation of the data instance +should be apparent from the header alone*. This principle makes the +program easier to understand, and avoids the swamp of complexity +indicated above. - type family F3 (a :: k) :: k where - F3 True = False - F3 False = True - F3 x = x - -- OK Kind inference in class instance declarations --------------------------------------------- @@ -555,43 +643,8 @@ infrastructure, and it's not clear the payoff is worth it. If you want to restrict ``b``\ 's kind in the instance above, just use a kind signature in the instance head. -Kind inference in type signatures ---------------------------------- - -When kind-checking a type, GHC considers only what is written in that -type when figuring out how to generalise the type's kind. - -For example, -consider these definitions (with :extension:`ScopedTypeVariables`): :: - - data Proxy a -- Proxy :: forall k. k -> Type - p :: forall a. Proxy a - p = Proxy :: Proxy (a :: Type) - -GHC reports an error, saying that the kind of ``a`` should be a kind variable -``k``, not ``Type``. This is because, by looking at the type signature -``forall a. Proxy a``, GHC assumes ``a``'s kind should be generalised, not -restricted to be ``Type``. The function definition is then rejected for being -more specific than its type signature. - -.. _explicit-kind-quantification: - -Explicit kind quantification ----------------------------- - -Enabled by :extension:`PolyKinds`, GHC supports explicit kind quantification, -as in these examples: :: - - data Proxy :: forall k. k -> Type - f :: (forall k (a :: k). Proxy a -> ()) -> Int - -Note that the second example has a ``forall`` that binds both a kind ``k`` and -a type variable ``a`` of kind ``k``. In general, there is no limit to how -deeply nested this sort of dependency can work. However, the dependency must -be well-scoped: ``forall (a :: k) k. ...`` is an error. - -Implicit quantification in type synonyms and type family instances ------------------------------------------------------------------- +Kind inference in type synonyms and type family instances +--------------------------------------------------------- Consider the scoping rules for type synonyms and type family instances, such as these:: @@ -706,29 +759,44 @@ kinds. Consequently, visible dependent quantifiers are rejected in any context that is unambiguously the type of a term. They are also rejected in the types of data constructors. -Kind-indexed GADTs ------------------- +Kind inference in closed type families +-------------------------------------- -Consider the type :: +Although all open type families are considered to have a complete +user-supplied kind signature (:ref:`complete-kind-signatures`), +we can relax this condition for closed +type families, where we have equations on which to perform kind +inference. GHC will infer kinds for the arguments and result types of a +closed type family. - data G (a :: k) where - GInt :: G Int - GMaybe :: G Maybe +GHC supports *kind-indexed* type families, where the family matches both +on the kind and type. GHC will *not* infer this behaviour without a +complete user-supplied kind signature or standalone kind +signature (see :ref:`standalone-kind-signatures`), +because doing so would sometimes infer +non-principal types. Indeed, we can see kind-indexing as a form +of polymorphic recursion, where a type is used at a kind other than +its most general in its own definition. -This datatype ``G`` is GADT-like in both its kind and its type. Suppose you -have ``g :: G a``, where ``a :: k``. Then pattern matching to discover that -``g`` is in fact ``GMaybe`` tells you both that ``k ~ (Type -> Type)`` and -``a ~ Maybe``. The definition for ``G`` requires that :extension:`PolyKinds` -be in effect, but pattern-matching on ``G`` requires no extension beyond -:extension:`GADTs`. That this works is actually a straightforward extension -of regular GADTs and a consequence of the fact that kinds and types are the -same. +For example: :: -Note that the datatype ``G`` is used at different kinds in its body, and -therefore that kind-indexed GADTs use a form of polymorphic recursion. -It is thus only possible to use this feature if you have provided a -complete user-supplied kind signature -for the datatype (:ref:`complete-kind-signatures`). + type family F1 a where + F1 True = False + F1 False = True + F1 x = x + -- F1 fails to compile: kind-indexing is not inferred + + type family F2 (a :: k) where + F2 True = False + F2 False = True + F2 x = x + -- F2 fails to compile: no complete signature + + type family F3 (a :: k) :: k where + F3 True = False + F3 False = True + F3 x = x + -- OK Higher-rank kinds ----------------- ===================================== testsuite/tests/dependent/should_fail/T13780a.stderr ===================================== @@ -3,7 +3,7 @@ T13780a.hs:9:40: error: • Couldn't match kind ‘a’ with ‘Bool’ Expected kind ‘Foo a’, but ‘MkFoo’ has kind ‘Foo Bool’ ‘a’ is a rigid type variable bound by - a family instance declaration + the data constructor ‘SMkFoo’ at T13780a.hs:9:20-31 • In the second argument of ‘(~)’, namely ‘MkFoo’ In the definition of data constructor ‘SMkFoo’ ===================================== testsuite/tests/deriving/should_compile/T11416.hs ===================================== @@ -12,9 +12,11 @@ newtype T f (a :: ConstantT Type f) = T (f a) deriving Functor data family TFam1 (f :: k1) (a :: k2) -newtype instance TFam1 f (ConstantT a f) = TFam1 (f a) +newtype instance TFam1 (f :: k -> Type) (ConstantT (a :: k) f) + = TFam1 (f a) deriving Functor data family TFam2 (f :: k1) (a :: k2) -newtype instance TFam2 f (a :: ConstantT Type f) = TFam2 (f a) +newtype instance TFam2 (f :: Type -> Type) (a :: ConstantT Type f) + = TFam2 (f a) deriving Functor ===================================== testsuite/tests/deriving/should_compile/T9359.hs ===================================== @@ -9,6 +9,5 @@ data Cmp a where deriving (Show, Eq) data family CmpInterval (a :: Cmp k) (b :: Cmp k) :: Type -data instance CmpInterval (V c) Sup = Starting c +data instance CmpInterval (V (c :: Type)) Sup = Starting c deriving( Show ) - ===================================== testsuite/tests/indexed-types/should_compile/T14111.hs ===================================== @@ -0,0 +1,24 @@ +{-# LANGUAGE MagicHash, UnboxedSums, NoImplicitPrelude #-} +{-# LANGUAGE TypeFamilies #-} +-- {-# LANGUAGE PolyKinds #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE GADTs ,ExplicitNamespaces#-} +{-# LANGUAGE UnboxedTuples #-} + +module T14111 where + +import GHC.Exts +import GHC.Types +import Prelude (undefined) +import Data.Kind +import Data.Void + +data family Maybe(x :: TYPE (r :: RuntimeRep)) + +data instance Maybe (a :: Type ) where + MaybeSum :: (# a | (# #) #) -> Maybe a + +data instance Maybe (x :: TYPE 'UnliftedRep) where + MaybeSumU :: (# x | (# #) #) -> Maybe x ===================================== testsuite/tests/indexed-types/should_compile/T8707.hs ===================================== @@ -0,0 +1,11 @@ +{-# LANGUAGE TypeFamilies, PolyKinds, DataKinds, GADTs #-} + +module T8707 where + +import Data.Kind + +data family SingDF (a :: (k, k2 -> Type)) +data Ctor :: k -> Type + +data instance SingDF (a :: (Bool, Bool -> Type)) where + SFalse :: SingDF '(False, Ctor) ===================================== testsuite/tests/indexed-types/should_compile/all.T ===================================== @@ -300,3 +300,5 @@ test('T18809', normal, compile, ['-O']) test('CEqCanOccursCheck', normal, compile, ['']) test('GivenLoop', normal, compile, ['']) test('T18875', normal, compile, ['']) +test('T8707', normal, compile, ['-O']) +test('T14111', normal, compile, ['-O']) ===================================== testsuite/tests/indexed-types/should_fail/T8368.stderr ===================================== @@ -1,6 +1,5 @@ -T8368.hs:9:3: - Data constructor ‘MkFam’ returns type ‘Foo’ - instead of an instance of its parent type ‘Fam a’ - In the definition of data constructor ‘MkFam’ - In the data instance declaration for ‘Fam’ +T8368.hs:9:3: error: + • Couldn't match expected type ‘Fam a0’ with actual type ‘Foo’ + • In the result type of data constructor ‘MkFam’ + In the data instance declaration for ‘Fam’ ===================================== testsuite/tests/indexed-types/should_fail/T8368a.stderr ===================================== @@ -1,6 +1,7 @@ -T8368a.hs:7:3: - Data constructor ‘MkFam’ returns type ‘Fam Bool b’ - instead of an instance of its parent type ‘Fam Int b’ - In the definition of data constructor ‘MkFam’ - In the data instance declaration for ‘Fam’ +T8368a.hs:7:3: error: + • Couldn't match type ‘Bool’ with ‘Int’ + Expected: Fam Int b + Actual: Fam Bool b + • In the result type of data constructor ‘MkFam’ + In the data instance declaration for ‘Fam’ ===================================== testsuite/tests/patsyn/should_fail/T15685.stderr ===================================== @@ -1,13 +1,13 @@ T15685.hs:13:24: error: - • Could not deduce: a ~ [k0] - from the context: as ~ (a1 : as1) + • Could not deduce: k ~ [k0] + from the context: as ~ (a : as1) bound by a pattern with constructor: - Here :: forall {a1} (f :: a1 -> *) (a2 :: a1) (as :: [a1]). - f a2 -> NS f (a2 : as), + Here :: forall {k} (f :: k -> *) (a :: k) (as :: [k]). + f a -> NS f (a : as), in a pattern synonym declaration at T15685.hs:13:19-26 - ‘a’ is a rigid type variable bound by + ‘k’ is a rigid type variable bound by the inferred type of HereNil :: NS f as at T15685.hs:13:9-15 Possible fix: add a type signature for ‘HereNil’ ===================================== testsuite/tests/polykinds/T13659.stderr ===================================== @@ -1,6 +1,6 @@ -T13659.hs:14:27: error: - • Expected a type, but ‘a’ has kind ‘[*]’ - • In the first argument of ‘Format’, namely ‘'[Int, a]’ - In the type ‘Format '[Int, a]’ +T13659.hs:14:15: error: + • Expected kind ‘[*]’, but ‘a’ has kind ‘*’ + • In the first argument of ‘Format’, namely ‘a’ + In the type ‘Format a’ In the definition of data constructor ‘I’ ===================================== testsuite/tests/polykinds/T16221a.stderr ===================================== @@ -1,7 +1,7 @@ T16221a.hs:6:49: error: - • Expected kind ‘k’, but ‘b’ has kind ‘k1’ - ‘k1’ is a rigid type variable bound by + • Expected kind ‘k’, but ‘b’ has kind ‘k2’ + ‘k2’ is a rigid type variable bound by an explicit forall k (b :: k) at T16221a.hs:6:20 ‘k’ is a rigid type variable bound by ===================================== testsuite/tests/th/T11145.stderr ===================================== @@ -1,8 +1,7 @@ T11145.hs:8:1: error: - • Data constructor ‘MkFuggle’ returns type ‘Fuggle - Int (Maybe Bool)’ - instead of an instance of its parent type ‘Fuggle - Int (Maybe (a, b))’ - • In the definition of data constructor ‘MkFuggle’ + • Couldn't match type ‘Bool’ with ‘(a0, b0)’ + Expected: Fuggle Int (Maybe (a0, b0)) + Actual: Fuggle Int (Maybe Bool) + • In the result type of data constructor ‘MkFuggle’ In the data instance declaration for ‘Fuggle’ ===================================== testsuite/tests/th/T9692.hs ===================================== @@ -12,7 +12,7 @@ class C a where data F a (b :: k) :: Type instance C Int where - data F Int x = FInt x + data F Int (x :: Type) = FInt x $( do info <- qReify (mkName "F") runIO $ putStrLn $ pprint info ===================================== testsuite/tests/typecheck/should_compile/T18891.hs ===================================== @@ -0,0 +1,16 @@ +{-# LANGUAGE GADTs, UnliftedNewtypes, StandaloneKindSignatures, RankNTypes, TypeFamilies, PolyKinds #-} + +module T18891 where + +import GHC.Exts( TYPE ) + +data family T2 (a :: k) +data instance T2 a where + MkT2 :: T2 Maybe + +newtype N3 :: forall k -> TYPE k where + MkN3 :: N3 m -> N3 m + +type N4 :: forall k -> TYPE k +newtype N4 :: forall k -> TYPE k where + MkN4 :: N4 m -> N4 m ===================================== testsuite/tests/typecheck/should_compile/UnliftedNewtypesUnassociatedFamily.hs ===================================== @@ -4,6 +4,8 @@ {-# LANGUAGE PolyKinds #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TypeApplications #-} module UnliftedNewtypesUnassociatedFamily where @@ -20,7 +22,16 @@ newtype instance DFT ('TupleRep '[ 'IntRep, 'WordRep]) data instance DFT 'LiftedRep = MkDFT4 | MkDFT5 data family DF :: TYPE (r :: RuntimeRep) -newtype instance DF = MkDF1 Int# -newtype instance DF = MkDF2 Word# -newtype instance DF = MkDF3 (# Int#, Word# #) + +-- Use a type application +newtype instance DF @IntRep = MkDF1 Int# + +-- Use a kind signature +newtype instance DF :: TYPE 'WordRep where + MkDF2 :: Word# -> DF + +-- Also uses a kind signature +newtype instance DF :: TYPE ('TupleRep '[ 'IntRep, 'WordRep ]) where + MkDF3 :: (# Int#, Word# #) -> DF + data instance DF = MkDF4 | MkDF5 ===================================== testsuite/tests/typecheck/should_compile/UnliftedNewtypesUnifySig.hs ===================================== @@ -10,14 +10,14 @@ module UnliftedNewtypesUnassociatedFamily where import GHC.Int (Int(I#)) -import GHC.Exts (Int#,Word#,RuntimeRep(IntRep)) +import GHC.Exts (Int#,Word#,RuntimeRep(IntRep,WordRep)) import GHC.Exts (TYPE) type KindOf (a :: TYPE k) = k data family D (a :: TYPE r) :: TYPE r -newtype instance D a = MkWordD Word# +newtype instance D (a :: TYPE 'WordRep) = MkWordD Word# -newtype instance D a :: TYPE (KindOf a) where - MkIntD :: forall a. Int# -> D a +newtype instance D (a :: TYPE 'IntRep) :: TYPE (KindOf a) where + MkIntD :: forall (b :: TYPE 'IntRep). Int# -> D b ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -736,3 +736,4 @@ test('InstanceGivenOverlap', normal, compile, ['']) test('InstanceGivenOverlap2', normal, compile, ['']) test('LocalGivenEqs', normal, compile, ['']) test('LocalGivenEqs2', normal, compile, ['']) +test('T18891', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_fail/T18891a.hs ===================================== @@ -0,0 +1,13 @@ +{-# LANGUAGE GADTs, UnliftedNewtypes, StandaloneKindSignatures, RankNTypes, TypeFamilies, PolyKinds #-} + +module T18891 where + +import GHC.Exts( TYPE ) + +newtype N1 :: forall k. TYPE k where + MkN1 :: N1 -> N1 + +type N2 :: forall k. TYPE k +newtype N2 :: forall k. TYPE k where + MkN2 :: N2 -> N2 + ===================================== testsuite/tests/typecheck/should_fail/T18891a.stderr ===================================== @@ -0,0 +1,12 @@ + +T18891a.hs:8:4: error: + • A newtype constructor must have a return type of form T a1 ... an + MkN1 :: N1 -> N1 + • In the definition of data constructor ‘MkN1’ + In the newtype declaration for ‘N1’ + +T18891a.hs:12:3: error: + • A newtype constructor must have a return type of form T a1 ... an + MkN2 :: N2 -> N2 + • In the definition of data constructor ‘MkN2’ + In the newtype declaration for ‘N2’ ===================================== testsuite/tests/typecheck/should_fail/UnliftedNewtypesFamilyKindFail2.stderr ===================================== @@ -1,11 +1,5 @@ -UnliftedNewtypesFamilyKindFail2.hs:12:20: - Expected a type, but ‘5’ has kind ‘GHC.Num.Natural.Natural’ - In the first argument of ‘F’, namely ‘5’ - In the newtype instance declaration for ‘F’ - -UnliftedNewtypesFamilyKindFail2.hs:12:31: - Expected a type, but ‘5’ has kind ‘GHC.Num.Natural.Natural’ - In the first argument of ‘F’, namely ‘5’ - In the type ‘(F 5)’ - In the definition of data constructor ‘MkF’ +UnliftedNewtypesFamilyKindFail2.hs:12:20: error: + • Expected a type, but ‘5’ has kind ‘GHC.Num.Natural.Natural’ + • In the first argument of ‘F’, namely ‘5’ + In the newtype instance declaration for ‘F’ ===================================== testsuite/tests/typecheck/should_fail/UnliftedNewtypesUnassociatedFamilyFail.hs ===================================== @@ -0,0 +1,23 @@ +{-# LANGUAGE UnliftedNewtypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE GADTs #-} + +module UnliftedNewtypesUnassociatedFamily where + +import GHC.Int (Int(I#)) +import GHC.Word (Word(W#)) +import GHC.Exts (Int#,Word#) +import GHC.Exts (TYPE,RuntimeRep(LiftedRep,IntRep,WordRep,TupleRep)) + +data family DF :: TYPE (r :: RuntimeRep) + +-- All these fail: see #18891 and !4419 +-- See Note [Kind inference for data family instances] +-- in GHC.Tc.TyCl.Instance +newtype instance DF = MkDF1a Int# +newtype instance DF = MkDF2a Word# +newtype instance DF = MkDF3a (# Int#, Word# #) ===================================== testsuite/tests/typecheck/should_fail/UnliftedNewtypesUnassociatedFamilyFail.stderr ===================================== @@ -0,0 +1,18 @@ + +UnliftedNewtypesUnassociatedFamilyFail.hs:21:30: error: + • Expecting a lifted type, but ‘Int#’ is unlifted + • In the type ‘Int#’ + In the definition of data constructor ‘MkDF1a’ + In the newtype instance declaration for ‘DF’ + +UnliftedNewtypesUnassociatedFamilyFail.hs:22:30: error: + • Expecting a lifted type, but ‘Word#’ is unlifted + • In the type ‘Word#’ + In the definition of data constructor ‘MkDF2a’ + In the newtype instance declaration for ‘DF’ + +UnliftedNewtypesUnassociatedFamilyFail.hs:23:30: error: + • Expecting a lifted type, but ‘(# Int#, Word# #)’ is unlifted + • In the type ‘(# Int#, Word# #)’ + In the definition of data constructor ‘MkDF3a’ + In the newtype instance declaration for ‘DF’ ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -546,6 +546,7 @@ test('UnliftedNewtypesConstraintFamily', normal, compile_fail, ['']) test('UnliftedNewtypesMismatchedKind', normal, compile_fail, ['']) test('UnliftedNewtypesMismatchedKindRecord', normal, compile_fail, ['']) test('UnliftedNewtypesMultiFieldGadt', normal, compile_fail, ['']) +test('UnliftedNewtypesUnassociatedFamilyFail', normal, compile_fail, ['']) test('T13834', normal, compile_fail, ['']) test('T17077', normal, compile_fail, ['']) test('T16512a', normal, compile_fail, ['']) @@ -591,3 +592,4 @@ test('T18640c', normal, compile_fail, ['']) test('T10709', normal, compile_fail, ['']) test('T10709b', normal, compile_fail, ['']) test('GivenForallLoop', normal, compile_fail, ['']) +test('T18891a', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e96712f9a96fcefb8c8390631b4893bcb2b30cef -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e96712f9a96fcefb8c8390631b4893bcb2b30cef You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 4 12:44:30 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Fri, 04 Dec 2020 07:44:30 -0500 Subject: [Git][ghc/ghc][wip/T18891] Fix kind inference for data types. Again. Message-ID: <5fca2f2ea4da3_6b21421cd839077@gitlab.mail> Simon Peyton Jones pushed to branch wip/T18891 at Glasgow Haskell Compiler / GHC Commits: 727264bd by Simon Peyton Jones at 2020-12-04T12:43:10+00:00 Fix kind inference for data types. Again. This patch fixes several aspects of kind inference for data type declarations, especially data /instance/ declarations Specifically 1. In kcConDecls/kcConDecl make it clear that the tc_res_kind argument is only used in the H98 case; and in that case there is no result kind signature; and hence no need for the disgusting splitPiTys in kcConDecls (now thankfully gone). The GADT case is a bit different to before, and much nicer. This is what fixes #18891. See Note [kcConDecls: kind-checking data type decls] 2. Do not look at the constructor decls of a data/newtype instance in tcDataFamInstanceHeader. See GHC.Tc.TyCl.Instance Note [Kind inference for data family instances]. This was a new realisation that arose when doing (1) This causes a few knock-on effects in the tests suite, because we require more information than before in the instance /header/. New user-manual material about this in "Kind inference in data type declarations" and "Kind inference for data/newtype instance declarations". 3. Minor improvement in kcTyClDecl, combining GADT and H98 cases 4. Fix #14111 and #8707 by allowing the header of a data instance to affect kind inferece for the the data constructor signatures; as described at length in Note [GADT return types] in GHC.Tc.TyCl This led to a modest refactoring of the arguments (and argument order) of tcConDecl/tcConDecls. 5. Fix #19000 by inverting the sense of the test in new_locs in GHC.Tc.Solver.Canonical.canDecomposableTyConAppOK. - - - - - 30 changed files: - compiler/GHC/Hs/Extension.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Instance.hs - docs/users_guide/9.2.1-notes.rst - docs/users_guide/exts/poly_kinds.rst - testsuite/tests/dependent/should_fail/T13780a.stderr - testsuite/tests/deriving/should_compile/T11416.hs - testsuite/tests/deriving/should_compile/T9359.hs - + testsuite/tests/indexed-types/should_compile/T14111.hs - + testsuite/tests/indexed-types/should_compile/T8707.hs - testsuite/tests/indexed-types/should_compile/all.T - testsuite/tests/indexed-types/should_fail/T8368.stderr - testsuite/tests/indexed-types/should_fail/T8368a.stderr - testsuite/tests/patsyn/should_fail/T15685.stderr - testsuite/tests/polykinds/T13659.stderr - testsuite/tests/polykinds/T16221a.stderr - testsuite/tests/th/T11145.stderr - testsuite/tests/th/T9692.hs - + testsuite/tests/typecheck/should_compile/T18891.hs - testsuite/tests/typecheck/should_compile/UnliftedNewtypesUnassociatedFamily.hs - testsuite/tests/typecheck/should_compile/UnliftedNewtypesUnifySig.hs - testsuite/tests/typecheck/should_compile/all.T - + testsuite/tests/typecheck/should_fail/T18891a.hs - + testsuite/tests/typecheck/should_fail/T18891a.stderr - testsuite/tests/typecheck/should_fail/UnliftedNewtypesFamilyKindFail2.stderr - + testsuite/tests/typecheck/should_fail/UnliftedNewtypesUnassociatedFamilyFail.hs - + testsuite/tests/typecheck/should_fail/UnliftedNewtypesUnassociatedFamilyFail.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/Hs/Extension.hs ===================================== @@ -253,9 +253,9 @@ sure that any uses of it as a field are strict. -- | Used as a data type index for the hsSyn AST; also serves -- as a singleton type for Pass data GhcPass (c :: Pass) where - GhcPs :: GhcPs - GhcRn :: GhcRn - GhcTc :: GhcTc + GhcPs :: GhcPass 'Parsed + GhcRn :: GhcPass 'Renamed + GhcTc :: GhcPass 'Typechecked -- This really should never be entered, but the data-deriving machinery -- needs the instance to exist. ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -2986,7 +2986,7 @@ bindOuterSigTKBndrs_Tv_M :: TcTyMode -> TcM a -> TcM (HsOuterSigTyVarBndrs GhcTc, a) -- Do not push level; do not make implication constraint; use Tvs -- Two major clients of this "bind-only" path are: --- Note [Kind-checking for GADTs] in TyCl +-- Note [Using TyVarTvs for kind-checking GADTs] in GHC.Tc.TyCl -- Note [Checking partial type signatures] bindOuterSigTKBndrs_Tv_M mode = bindOuterTKBndrsX (smVanilla { sm_clone = True, sm_tvtv = True @@ -3299,8 +3299,8 @@ When we /must/ clone. When kind-checking T, we give (a :: kappa1). Then: - In kcConDecl we make a TyVarTv unification variable kappa2 for k2 - (as described in Note [Kind-checking for GADTs], even though this - example is an existential) + (as described in Note [Using TyVarTvs for kind-checking GADTs], + even though this example is an existential) - So we get (b :: kappa2) via bindExplicitTKBndrs_Tv - We end up unifying kappa1 := kappa2, because of the (SameKind a b) ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -1885,7 +1885,7 @@ canDecomposableTyConAppOK ev eq_rel tc tys1 tys2 | bndr <- tyConBinders tc , let new_loc0 | isNamedTyConBinder bndr = toKindLoc loc | otherwise = loc - new_loc | isVisibleTyConBinder bndr + new_loc | isInvisibleTyConBinder bndr = updateCtLocOrigin new_loc0 toInvisibleOrigin | otherwise = new_loc0 ] ===================================== compiler/GHC/Tc/TyCl.hs ===================================== @@ -17,7 +17,8 @@ module GHC.Tc.TyCl ( -- Functions used by GHC.Tc.TyCl.Instance to check -- data/type family instance declarations - kcConDecls, tcConDecls, dataDeclChecks, checkValidTyCon, + kcConDecls, tcConDecls, DataDeclInfo(..), + dataDeclChecks, checkValidTyCon, tcFamTyPats, tcTyFamInstEqn, tcAddTyFamInstCtxt, tcMkDataFamInstCtxt, tcAddDataFamInstCtxt, unravelFamInstPats, addConsistencyConstraints, @@ -38,7 +39,7 @@ import GHC.Tc.Solver( pushLevelAndSolveEqualities, pushLevelAndSolveEqualitiesX , reportUnsolvedEqualities ) import GHC.Tc.Utils.Monad import GHC.Tc.Utils.Env -import GHC.Tc.Utils.Unify( emitResidualTvConstraint ) +import GHC.Tc.Utils.Unify( unifyType, emitResidualTvConstraint ) import GHC.Tc.Types.Constraint( emptyWC ) import GHC.Tc.Validity import GHC.Tc.Utils.Zonk @@ -130,7 +131,7 @@ Note [Check role annotations in a second pass] Role inference potentially depends on the types of all of the datacons declared in a mutually recursive group. The validity of a role annotation, in turn, depends on the result of role inference. Because the types of datacons might -be ill-formed (see #7175 and Note [Checking GADT return types]) we must check +be ill-formed (see #7175 and Note [rejigConRes]) we must check *all* the tycons in a group for validity before checking *any* of the roles. Thus, we take two passes over the resulting tycons, first checking for general validity and then checking for valid role annotations. @@ -1529,27 +1530,16 @@ kcTyClDecl :: TyClDecl GhcRn -> TcTyCon -> TcM () -- result kind signature have already been dealt with -- by inferInitialKind, so we can ignore them here. -kcTyClDecl (DataDecl { tcdLName = (L _ name) - , tcdDataDefn = defn }) tyCon - | HsDataDefn { dd_cons = cons@((L _ (ConDeclGADT {})) : _) - , dd_ctxt = (L _ []) - , dd_ND = new_or_data } <- defn - = -- See Note [Implementation of UnliftedNewtypes] STEP 2 - kcConDecls new_or_data (tyConResKind tyCon) cons - - -- hs_tvs and dd_kindSig already dealt with in inferInitialKind - -- This must be a GADT-style decl, - -- (see invariants of DataDefn declaration) - -- so (a) we don't need to bring the hs_tvs into scope, because the - -- ConDecls bind all their own variables - -- (b) dd_ctxt is not allowed for GADT-style decls, so we can ignore it - - | HsDataDefn { dd_ctxt = ctxt - , dd_cons = cons - , dd_ND = new_or_data } <- defn +kcTyClDecl (DataDecl { tcdLName = (L _ name), tcdDataDefn = defn }) tycon + | HsDataDefn { dd_ctxt = ctxt, dd_cons = cons, dd_ND = new_or_data } <- defn = bindTyClTyVars name $ \ _ _ _ -> - do { _ <- tcHsContext ctxt - ; kcConDecls new_or_data (tyConResKind tyCon) cons + -- NB: binding these tyvars isn't necessary for GADTs, but it does no + -- harm. For GADTs, each data con brings its own tyvars into scope, + -- and the ones from this bindTyClTyVars are either not mentioned or + -- (conceivably) shadowed. + do { traceTc "kcTyClDecl" (ppr tycon $$ ppr (tyConTyVars tycon) $$ ppr (tyConResKind tycon)) + ; _ <- tcHsContext ctxt + ; kcConDecls new_or_data (tyConResKind tycon) cons } kcTyClDecl (SynDecl { tcdLName = L _ name, tcdRhs = rhs }) _tycon @@ -1585,7 +1575,6 @@ kcConArgTys new_or_data res_kind arg_tys = do { let exp_kind = getArgExpKind new_or_data res_kind ; forM_ arg_tys (\(HsScaled mult ty) -> do _ <- tcCheckLHsType (getBangType ty) exp_kind tcMult mult) - -- See Note [Implementation of UnliftedNewtypes], STEP 2 } @@ -1606,13 +1595,12 @@ kcConGADTArgs new_or_data res_kind con_args = case con_args of kcConDecls :: NewOrData -> Kind -- The result kind signature + -- Used only in H98 case -> [LConDecl GhcRn] -- The data constructors -> TcM () -kcConDecls new_or_data res_kind cons - = mapM_ (wrapLocM_ (kcConDecl new_or_data final_res_kind)) cons - where - (_, final_res_kind) = splitPiTys res_kind - -- See Note [kcConDecls result kind] +-- See Note [kcConDecls: kind-checking data type decls] +kcConDecls new_or_data tc_res_kind cons + = mapM_ (wrapLocM_ (kcConDecl new_or_data tc_res_kind)) cons -- Kind check a data constructor. In additional to the data constructor, -- we also need to know about whether or not its corresponding type was @@ -1623,82 +1611,77 @@ kcConDecl :: NewOrData -> Kind -- Result kind of the type constructor -- Usually Type but can be TYPE UnliftedRep -- or even TYPE r, in the case of unlifted newtype + -- Used only in H98 case -> ConDecl GhcRn -> TcM () -kcConDecl new_or_data res_kind (ConDeclH98 +kcConDecl new_or_data tc_res_kind (ConDeclH98 { con_name = name, con_ex_tvs = ex_tvs , con_mb_cxt = ex_ctxt, con_args = args }) - = addErrCtxt (dataConCtxtName [name]) $ + = addErrCtxt (dataConCtxt [name]) $ discardResult $ bindExplicitTKBndrs_Tv ex_tvs $ do { _ <- tcHsMbContext ex_ctxt - ; kcConH98Args new_or_data res_kind args + ; kcConH98Args new_or_data tc_res_kind args -- We don't need to check the telescope here, -- because that's done in tcConDecl } -kcConDecl new_or_data res_kind (ConDeclGADT +kcConDecl new_or_data + _tc_res_kind -- Not used in GADT case (and doesn't make sense) + (ConDeclGADT { con_names = names, con_bndrs = L _ outer_bndrs, con_mb_cxt = cxt , con_g_args = args, con_res_ty = res_ty }) - = -- Even though the GADT-style data constructor's type is closed, - -- we must still kind-check the type, because that may influence - -- the inferred kind of the /type/ constructor. Example: - -- data T f a where - -- MkT :: f a -> T f a - -- If we don't look at MkT we won't get the correct kind - -- for the type constructor T - addErrCtxt (dataConCtxtName names) $ + = -- See Note [kcConDecls: kind-checking data type decls] + addErrCtxt (dataConCtxt names) $ discardResult $ bindOuterSigTKBndrs_Tv outer_bndrs $ - -- Why "_Tv"? See Note [Kind-checking for GADTs] + -- Why "_Tv"? See Note [Using TyVarTvs for kind-checking GADTs] do { _ <- tcHsMbContext cxt - ; kcConGADTArgs new_or_data res_kind args - ; _ <- tcHsOpenType res_ty + ; traceTc "kcConDecl:GADT {" (ppr names $$ ppr res_ty) + ; con_res_kind <- newOpenTypeKind + ; _ <- tcCheckLHsType res_ty (TheKind con_res_kind) + ; kcConGADTArgs new_or_data con_res_kind args + ; traceTc "kcConDecl:GADT }" (ppr names $$ ppr con_res_kind) ; return () } -{- Note [kcConDecls result kind] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We might have e.g. - data T a :: Type -> Type where ... -or - newtype instance N a :: Type -> Type where .. -in which case, the 'res_kind' passed to kcConDecls will be - Type->Type - -We must look past those arrows, or even foralls, to the Type in the -corner, to pass to kcConDecl c.f. #16828. Hence the splitPiTys here. - -I am a bit concerned about tycons with a declaration like - data T a :: Type -> forall k. k -> Type where ... - -It does not have a CUSK, so kcInferDeclHeader will make a TcTyCon -with tyConResKind of Type -> forall k. k -> Type. Even that is fine: -the splitPiTys will look past the forall. But I'm bothered about -what if the type "in the corner" mentions k? This is incredibly -obscure but something like this could be bad: - data T a :: Type -> foral k. k -> TYPE (F k) where ... - -I bet we are not quite right here, but my brain suffered a buffer -overflow and I thought it best to nail the common cases right now. - -Note [Recursion and promoting data constructors] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We don't want to allow promotion in a strongly connected component -when kind checking. - -Consider: - data T f = K (f (K Any)) - -When kind checking the `data T' declaration the local env contains the -mappings: - T -> ATcTyCon - K -> APromotionErr - -APromotionErr is only used for DataCons, and only used during type checking -in tcTyClGroup. - -Note [Kind-checking for GADTs] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [kcConDecls: kind-checking data type decls] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +kcConDecls is used when we are inferring the kind of the type +constructor in a data type declaration. E.g. + data T f a = MkT (f a) +we want to infer the kind of 'f' and 'a'. The basic plan is described +in Note [Inferring kinds for type declarations]; here we are doing Step 2. + +In the GADT case we may have this: + data T f a where + MkT :: forall g b. g b -> T g b + +Notice that the variables f,a, and g,b are quite distinct. +Nevertheless, the type signature for MkT must still influence the kind +T which is (remember Step 1) something like + T :: kappa1 -> kappa2 -> Type +Otherwise we'd infer the bogus kind + T :: forall k1 k2. k1 -> k2 -> Type. + +The type signature for MkT influences the kind of T simply by +kind-checking the result type (T g b), which will force 'f' and 'g' to +have the same kinds. This is the call to + tcCheckLHsType res_ty (TheKind con_res_kind) +Because this is the result type of an arrow, we know the kind must be +of form (TYPE rr), and we get better error messages if we enforce that +here (e.g. test gadt10). + +For unlifted newtypes only, we must ensure that the argument kind +and result kind are the same: +* In the H98 case, we need the result kind of the TyCon, to unify with + the argument kind. + +* In GADT syntax, this unification happens via the result kind passed + to kcConGADTArgs. The tycon's result kind is not used at all in the + GADT case. + +Note [Using TyVarTvs for kind-checking GADTs] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider data Proxy a where @@ -1708,26 +1691,27 @@ Consider It seems reasonable that this should be accepted. But something very strange is going on here: when we're kind-checking this declaration, we need to unify the kind of `a` with k and j -- even though k and j's scopes are local to the type of -MkProxy{1,2}. The best approach we've come up with is to use TyVarTvs during -the kind-checking pass. First off, note that it's OK if the kind-checking pass -is too permissive: we'll snag the problems in the type-checking pass later. -(This extra permissiveness might happen with something like +MkProxy{1,2}. + +In effect, we are simply gathering constraints on the shape of Proxy's +kind, with no skolemisation or implication constraints involved at all. + +The best approach we've come up with is to use TyVarTvs during the +kind-checking pass, rather than ordinary skolems. This is why we use +the "_Tv" variant, bindOuterSigTKBndrs_Tv. + +Our only goal is to gather constraints on the kind of the type constructor; +we do not certify that the data declaration is well-kinded. For example: data SameKind :: k -> k -> Type data Bad a where MkBad :: forall k1 k2 (a :: k1) (b :: k2). Bad (SameKind a b) -which would be accepted if k1 and k2 were TyVarTvs. This is correctly rejected -in the second pass, though. Test case: polykinds/TyVarTvKinds3) -Recall that the kind-checking pass exists solely to collect constraints -on the kinds and to power unification. - -To achieve the use of TyVarTvs, we must be careful to use specialized functions -that produce TyVarTvs, not ordinary skolems. This is why we need -kcExplicitTKBndrs and kcImplicitTKBndrs in GHC.Tc.Gen.HsType, separate from their -tc... variants. +which would be accepted by kcConDecl because k1 and k2 are +TyVarTvs. It is correctly rejected in the second pass, tcConDecl. +(Test case: polykinds/TyVarTvKinds3) -The drawback of this approach is sometimes it will accept a definition that +One drawback of this approach is sometimes it will accept a definition that a (hypothetical) declarative specification would likely reject. As a general rule, we don't want to allow polymorphic recursion without a CUSK. Indeed, the whole point of CUSKs is to allow polymorphic recursion. Yet, the TyVarTvs @@ -1746,6 +1730,23 @@ be rejected (without a CUSK). However, the accepted definitions are indeed well-kinded and any rejected definitions would be accepted with a CUSK, and so this wrinkle need not cause anyone to lose sleep. +Note [Recursion and promoting data constructors] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We don't want to allow promotion in a strongly connected component +when kind checking. + +Consider: + data T f = K (f (K Any)) + +When kind checking the `data T' declaration the local env contains the +mappings: + T -> ATcTyCon + K -> APromotionErr + +APromotionErr is only used for DataCons, and only used during type checking +in tcTyClGroup. + + ************************************************************************ * * \subsection{Type checking} @@ -2782,18 +2783,14 @@ tcDataDefn err_ctxt roles_info tc_name ; when (isJust mb_ksig) $ checkTc (kind_signatures) (badSigTyDecl tc_name) - ; tycon <- fixM $ \ tycon -> do + ; tycon <- fixM $ \ rec_tycon -> do { let final_bndrs = tycon_binders `chkAppend` extra_bndrs - res_ty = mkTyConApp tycon (mkTyVarTys (binderVars final_bndrs)) roles = roles_info tc_name ; data_cons <- tcConDecls - tycon - new_or_data - final_bndrs - final_res_kind - res_ty + new_or_data DDataType + rec_tycon final_bndrs final_res_kind cons - ; tc_rhs <- mk_tc_rhs hsc_src tycon data_cons + ; tc_rhs <- mk_tc_rhs hsc_src rec_tycon data_cons ; tc_rep_nm <- newTyConRepName tc_name ; return (mkAlgTyCon tc_name final_bndrs @@ -3195,36 +3192,51 @@ consUseGadtSyntax _ = False -- All constructors have same shape ----------------------------------- -tcConDecls :: KnotTied TyCon -> NewOrData - -> [TyConBinder] -> TcKind -- binders and result kind of tycon - -> KnotTied Type -> [LConDecl GhcRn] -> TcM [DataCon] -tcConDecls rep_tycon new_or_data tmpl_bndrs res_kind res_tmpl +data DataDeclInfo + = DDataType -- data T a b = T1 a | T2 b + | DDataInstance -- data instance D [a] = D1 a | D2 + Type -- The header D [a] + +mkDDHeaderTy :: DataDeclInfo -> TyCon -> [TyConBinder] -> Type +mkDDHeaderTy dd_info rep_tycon tc_bndrs + = case dd_info of + DDataType -> mkTyConApp rep_tycon $ + mkTyVarTys (binderVars tc_bndrs) + DDataInstance header_ty -> header_ty + +tcConDecls :: NewOrData + -> DataDeclInfo + -> KnotTied TyCon -- Representation TyCon + -> [TyConBinder] -- Binders of representation TyCon + -> TcKind -- Result kind + -> [LConDecl GhcRn] -> TcM [DataCon] +tcConDecls new_or_data dd_info rep_tycon tmpl_bndrs res_kind = concatMapM $ addLocM $ - tcConDecl rep_tycon (mkTyConTagMap rep_tycon) - tmpl_bndrs res_kind res_tmpl new_or_data - -- It's important that we pay for tag allocation here, once per TyCon, - -- See Note [Constructor tag allocation], fixes #14657 - -tcConDecl :: KnotTied TyCon -- Representation tycon. Knot-tied! + tcConDecl new_or_data dd_info rep_tycon tmpl_bndrs res_kind + (mkTyConTagMap rep_tycon) + -- mkTyConTagMap: it's important that we pay for tag allocation here, + -- once per TyCon. See Note [Constructor tag allocation], fixes #14657 + +tcConDecl :: NewOrData + -> DataDeclInfo + -> KnotTied TyCon -- Representation tycon. Knot-tied! + -> [TyConBinder] -- Binders of representation TyCon + -> TcKind -- Result kind -> NameEnv ConTag - -> [TyConBinder] -> TcKind -- tycon binders and result kind - -> KnotTied Type - -- Return type template (T tys), where T is the family TyCon - -> NewOrData -> ConDecl GhcRn -> TcM [DataCon] -tcConDecl rep_tycon tag_map tmpl_bndrs res_kind res_tmpl new_or_data +tcConDecl new_or_data dd_info rep_tycon tc_bndrs res_kind tag_map (ConDeclH98 { con_name = lname@(L _ name) , con_ex_tvs = explicit_tkv_nms , con_mb_cxt = hs_ctxt , con_args = hs_args }) - = addErrCtxt (dataConCtxtName [lname]) $ + = addErrCtxt (dataConCtxt [lname]) $ do { -- NB: the tyvars from the declaration header are in scope -- Get hold of the existential type variables -- e.g. data T a = forall k (b::k) f. MkT a (f b) - -- Here tmpl_bndrs = {a} + -- Here tc_bndrs = {a} -- hs_qvars = HsQTvs { hsq_implicit = {k} -- , hsq_explicit = {f,b} } @@ -3242,29 +3254,35 @@ tcConDecl rep_tycon tag_map tmpl_bndrs res_kind res_tmpl new_or_data } - ; let tmpl_tvs = binderVars tmpl_bndrs - ; let fake_ty = mkSpecForAllTys tmpl_tvs $ + ; let tc_tvs = binderVars tc_bndrs + fake_ty = mkSpecForAllTys tc_tvs $ mkInvisForAllTys exp_tvbndrs $ mkPhiTy ctxt $ mkVisFunTys arg_tys $ unitTy -- That type is a lie, of course. (It shouldn't end in ()!) -- And we could construct a proper result type from the info - -- at hand. But the result would mention only the tmpl_tvs, + -- at hand. But the result would mention only the univ_tvs, -- and so it just creates more work to do it right. Really, -- we're only doing this to find the right kind variables to -- quantify over, and this type is fine for that purpose. - -- exp_tvs have explicit, user-written binding sites + -- exp_tvbndrs have explicit, user-written binding sites -- the kvs below are those kind variables entirely unmentioned by the user -- and discovered only by generalization ; kvs <- kindGeneralizeAll fake_ty - ; let skol_tvs = kvs ++ tmpl_tvs + ; let skol_tvs = tc_tvs ++ kvs ++ binderVars exp_tvbndrs ; reportUnsolvedEqualities skol_info skol_tvs tclvl wanted - - -- Zonk to Types + -- The skol_info claims that all the variables are bound + -- by the data constructor decl, whereas actually the + -- univ_tvs are bound by the data type decl itself. It + -- would be better to have a doubly-nested implication. + -- But that just doesn't seem worth it. + -- See test dependent/should_fail/T13780a + + -- Zonk to Types ; (ze, qkvs) <- zonkTyBndrs kvs ; (ze, user_qtvbndrs) <- zonkTyVarBindersX ze exp_tvbndrs ; arg_tys <- zonkScaledTcTypesToTypesX ze arg_tys @@ -3272,15 +3290,14 @@ tcConDecl rep_tycon tag_map tmpl_bndrs res_kind res_tmpl new_or_data -- Can't print univ_tvs, arg_tys etc, because we are inside the knot here ; traceTc "tcConDecl 2" (ppr name $$ ppr field_lbls) - ; let - univ_tvbs = tyConInvisTVBinders tmpl_bndrs - univ_tvs = binderVars univ_tvbs - ex_tvbs = mkTyVarBinders InferredSpec qkvs ++ user_qtvbndrs - ex_tvs = binderVars ex_tvbs - -- For H98 datatypes, the user-written tyvar binders are precisely - -- the universals followed by the existentials. - -- See Note [DataCon user type variable binders] in GHC.Core.DataCon. - user_tvbs = univ_tvbs ++ ex_tvbs + ; let univ_tvbs = tyConInvisTVBinders tc_bndrs + ex_tvbs = mkTyVarBinders InferredSpec qkvs ++ user_qtvbndrs + ex_tvs = binderVars ex_tvbs + -- For H98 datatypes, the user-written tyvar binders are precisely + -- the universals followed by the existentials. + -- See Note [DataCon user type variable binders] in GHC.Core.DataCon. + user_tvbs = univ_tvbs ++ ex_tvbs + user_res_ty = mkDDHeaderTy dd_info rep_tycon tc_bndrs ; traceTc "tcConDecl 2" (ppr name) ; is_infix <- tcConIsInfixH98 name hs_args @@ -3288,9 +3305,9 @@ tcConDecl rep_tycon tag_map tmpl_bndrs res_kind res_tmpl new_or_data ; fam_envs <- tcGetFamInstEnvs ; dc <- buildDataCon fam_envs name is_infix rep_nm stricts Nothing field_lbls - univ_tvs ex_tvs user_tvbs + tc_tvs ex_tvs user_tvbs [{- no eq_preds -}] ctxt arg_tys - res_tmpl rep_tycon tag_map + user_res_ty rep_tycon tag_map -- NB: we put data_tc, the type constructor gotten from the -- constructor type signature into the data constructor; -- that way checkValidDataCon can complain if it's wrong. @@ -3299,14 +3316,14 @@ tcConDecl rep_tycon tag_map tmpl_bndrs res_kind res_tmpl new_or_data where skol_info = DataConSkol name -tcConDecl rep_tycon tag_map tmpl_bndrs _res_kind res_tmpl new_or_data +tcConDecl new_or_data dd_info rep_tycon tc_bndrs _res_kind tag_map -- NB: don't use res_kind here, as it's ill-scoped. Instead, -- we get the res_kind by typechecking the result type. (ConDeclGADT { con_names = names , con_bndrs = L _ outer_hs_bndrs , con_mb_cxt = cxt, con_g_args = hs_args , con_res_ty = hs_res_ty }) - = addErrCtxt (dataConCtxtName names) $ + = addErrCtxt (dataConCtxt names) $ do { traceTc "tcConDecl 1 gadt" (ppr names) ; let (L _ name : _) = names @@ -3317,10 +3334,23 @@ tcConDecl rep_tycon tag_map tmpl_bndrs _res_kind res_tmpl new_or_data ; (res_ty, res_kind) <- tcInferLHsTypeKind hs_res_ty -- See Note [GADT return kinds] + -- For data instances (only), ensure that the return type, + -- res_ty, is a substitution instance of the header. + -- See Note [GADT return types] + ; case dd_info of + DDataType -> return () + DDataInstance hdr_ty -> + do { (subst, _meta_tvs) <- newMetaTyVars (binderVars tc_bndrs) + ; let head_shape = substTy subst hdr_ty + ; discardResult $ + popErrCtxt $ -- Drop dataConCtxt + addErrCtxt (dataConResCtxt names) $ + unifyType Nothing res_ty head_shape } + -- See Note [Datatype return kinds] ; let exp_kind = getArgExpKind new_or_data res_kind - ; btys <- tcConGADTArgs exp_kind hs_args + ; let (arg_tys, stricts) = unzip btys ; field_lbls <- lookupConstructorFields name ; return (ctxt, arg_tys, res_ty, field_lbls, stricts) @@ -3343,9 +3373,10 @@ tcConDecl rep_tycon tag_map tmpl_bndrs _res_kind res_tmpl new_or_data ; ctxt <- zonkTcTypesToTypesX ze ctxt ; res_ty <- zonkTcTypeToTypeX ze res_ty - ; let (univ_tvs, ex_tvs, tvbndrs', eq_preds, arg_subst) - = rejigConRes tmpl_bndrs res_tmpl tvbndrs res_ty - -- See Note [Checking GADT return types] + ; let res_tmpl = mkDDHeaderTy dd_info rep_tycon tc_bndrs + (univ_tvs, ex_tvs, tvbndrs', eq_preds, arg_subst) + = rejigConRes tc_bndrs res_tmpl tvbndrs res_ty + -- See Note [rejigConRes] ctxt' = substTys arg_subst ctxt arg_tys' = substScaledTys arg_subst arg_tys @@ -3372,8 +3403,73 @@ tcConDecl rep_tycon tag_map tmpl_bndrs _res_kind res_tmpl new_or_data where skol_info = DataConSkol (unLoc (head names)) -{- Note [GADT return kinds] +{- Note [GADT return types] ~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + data family T :: forall k. k -> Type + data instance T (a :: Type) where + MkT :: forall b. T b + +What kind does `b` have in the signature for MkT? +Since the return type must be an instance of the type in the header, +we must have (b :: Type), but you can't tell that by looking only at +the type of the data constructor; you have to look at the header too. +If you wrote it out fully, it'd look like + data instance T @Type (a :: Type) where + MkT :: forall (b::Type). T @Type b + +We could reject the program, and expect the user to add kind +annotations to `MkT` to restrict the signature. But an easy and +helpful alternative is this: simply instantiate the type from the +header with fresh unification variables, and unify with the return +type of `MkT`. That will force `b` to have kind `Type`. See #8707 +and #14111. + +Wrikles +* At first sight it looks as though this would completely subsume the + return-type check in checkValidDataCon. But it does not. Suppose we + have + data instance T [a] where + MkT :: T (F (Maybe a)) + + where F is a type function. Then maybe (F (Maybe a)) evaluates to + [a], so unifyType will succeed. But we discard the coercion + returned by unifyType; and we really don't want to accept this + program. The check in checkValidDataCon will, however, reject it. + TL;DR: keep the check in checkValidDataCon. + +* Consider a data type, rather than a data instance, declaration + data S a where { MkS :: b -> S [b] } + In tcConDecl, S is knot-tied, so we don't want to unify (S alpha) + with (S [b]). To put it another way, unifyType should never see a + TcTycon. Simple solution: do *not* do the extra unifyType for + data types (DDataType) only for data instances (DDataInstance); in + the latter the family constructor is not knot-tied so there is no + problem. + +* Consider this (from an earlier form of GHC itself): + + data Pass = Parsed | ... + data GhcPass (c :: Pass) where + GhcPs :: GhcPs + ... + type GhcPs = GhcPass 'Parsed + + Now GhcPs and GhcPass are mutually recursive. If we did unifyType + for datatypes like GhcPass, we would not be able to expand the type + synonym (it'd still be a TcTyCon). So again, we don't do unifyType + for data types; we leave it to checkValidDataCon. + + We /do/ perform the unifyType for data /instances/, but a data + instance doesn't declare a new (user-visible) type constructor, so + there is no mutual recursion with type synonyms to worry about. + All good. + + TL;DR we do support mutual recursion between type synonyms and + data type/instance declarations, as above. + +Note [GADT return kinds] +~~~~~~~~~~~~~~~~~~~~~~~~ Consider type family Star where Star = Type data T :: Type where @@ -3496,8 +3592,8 @@ For example: (:--:) :: t1 -> t2 -> T Int -Note [Checking GADT return types] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [rejigConRes] +~~~~~~~~~~~~~~~~~~ There is a delicacy around checking the return types of a datacon. The central problem is dealing with a declaration like @@ -3532,9 +3628,9 @@ errors reported in one pass. See #7175, and #10836. -- TI :: forall b1 c1. (b1 ~ c1) => b1 -> :R7T b1 c1 -- In this case orig_res_ty = T (e,e) -rejigConRes :: [KnotTied TyConBinder] -> KnotTied Type -- Template for result type; e.g. - -- data instance T [a] b c ... - -- gives template ([a,b,c], T [a] b c) +rejigConRes :: [KnotTied TyConBinder] -- Template for result type; e.g. + -> KnotTied Type -- data instance T [a] b c ... + -- gives template ([a,b,c], T [a] b c) -> [InvisTVBinder] -- The constructor's type variables (both inferred and user-written) -> KnotTied Type -- res_ty -> ([TyVar], -- Universal @@ -3546,10 +3642,10 @@ rejigConRes :: [KnotTied TyConBinder] -> KnotTied Type -- Template for result -- We don't check that the TyCon given in the ResTy is -- the same as the parent tycon, because checkValidDataCon will do it -- NB: All arguments may potentially be knot-tied -rejigConRes tmpl_bndrs res_tmpl dc_tvbndrs res_ty +rejigConRes tc_tvbndrs res_tmpl dc_tvbndrs res_ty -- E.g. data T [a] b c where -- MkT :: forall x y z. T [(x,y)] z z - -- The {a,b,c} are the tmpl_tvs, and the {x,y,z} are the dc_tvs + -- The {a,b,c} are the tc_tvs, and the {x,y,z} are the dc_tvs -- (NB: unlike the H98 case, the dc_tvs are not all existential) -- Then we generate -- Univ tyvars Eq-spec @@ -3564,7 +3660,7 @@ rejigConRes tmpl_bndrs res_tmpl dc_tvbndrs res_ty -- , [], [x,y,z] -- , [a~(x,y),b~z], ) | Just subst <- tcMatchTy res_tmpl res_ty - = let (univ_tvs, raw_eqs, kind_subst) = mkGADTVars tmpl_tvs dc_tvs subst + = let (univ_tvs, raw_eqs, kind_subst) = mkGADTVars tc_tvs dc_tvs subst raw_ex_tvs = dc_tvs `minusList` univ_tvs (arg_subst, substed_ex_tvs) = substTyVarBndrs kind_subst raw_ex_tvs @@ -3590,11 +3686,11 @@ rejigConRes tmpl_bndrs res_tmpl dc_tvbndrs res_ty -- we must do *something*, not just crash. So we do something simple -- albeit bogus, relying on checkValidDataCon to check the -- bad-result-type error before seeing that the other fields look odd - -- See Note [Checking GADT return types] - = (tmpl_tvs, dc_tvs `minusList` tmpl_tvs, dc_tvbndrs, [], emptyTCvSubst) + -- See Note [rejigConRes] + = (tc_tvs, dc_tvs `minusList` tc_tvs, dc_tvbndrs, [], emptyTCvSubst) where - dc_tvs = binderVars dc_tvbndrs - tmpl_tvs = binderVars tmpl_bndrs + dc_tvs = binderVars dc_tvbndrs + tc_tvs = binderVars tc_tvbndrs {- Note [mkGADTVars] ~~~~~~~~~~~~~~~~~~~~ @@ -3634,7 +3730,7 @@ becomes We start off by matching (T k1 k2 a b) with (T x1 * (Proxy x1 y, z) z). We know this match will succeed because of the validity check (actually done -later, but laziness saves us -- see Note [Checking GADT return types]). +later, but laziness saves us -- see Note [rejigConRes]). Thus, we get subst := { k1 |-> x1, k2 |-> *, a |-> (Proxy x1 y, z), b |-> z } @@ -4081,15 +4177,9 @@ checkFieldCompat fld con1 con2 res1 res2 fty1 fty2 ------------------------------- checkValidDataCon :: DynFlags -> Bool -> TyCon -> DataCon -> TcM () checkValidDataCon dflags existential_ok tc con - = setSrcSpan (getSrcSpan con) $ - addErrCtxt (dataConCtxt con) $ - do { -- Check that the return type of the data constructor - -- matches the type constructor; eg reject this: - -- data T a where { MkT :: Bogus a } - -- It's important to do this first: - -- see Note [Checking GADT return types] - -- and c.f. Note [Check role annotations in a second pass] - let tc_tvs = tyConTyVars tc + = setSrcSpan con_loc $ + addErrCtxt (dataConCtxt [L con_loc con_name]) $ + do { let tc_tvs = tyConTyVars tc res_ty_tmpl = mkFamilyTyConApp tc (mkTyVarTys tc_tvs) orig_res_ty = dataConOrigResTy con ; traceTc "checkValidDataCon" (vcat @@ -4098,6 +4188,18 @@ checkValidDataCon dflags existential_ok tc con , ppr orig_res_ty <+> dcolon <+> ppr (tcTypeKind orig_res_ty)]) + -- Check that the return type of the data constructor + -- matches the type constructor; eg reject this: + -- data T a where { MkT :: Bogus a } + -- It's important to do this first: + -- see Note [rejigCon + -- and c.f. Note [Check role annotations in a second pass] + + -- Check that the return type of the data constructor is an instance + -- of the header of the header of data decl. This checks for + -- data T a where { MkT :: S a } + -- data instance D [a] where { MkD :: D (Maybe b) } + -- see Note [GADT return types] ; checkTc (isJust (tcMatchTyKi res_ty_tmpl orig_res_ty)) (badDataConTyCon con res_ty_tmpl) -- Note that checkTc aborts if it finds an error. This is @@ -4205,7 +4307,9 @@ checkValidDataCon dflags existential_ok tc con Just (f, _) -> ppr (tyConBinders f) ] } where - ctxt = ConArgCtxt (dataConName con) + con_name = dataConName con + con_loc = nameSrcSpan con_name + ctxt = ConArgCtxt con_name is_strict = \case NoSrcStrict -> xopt LangExt.StrictData dflags bang -> isSrcStrict bang @@ -4869,14 +4973,17 @@ fieldTypeMisMatch field_name con1 con2 = sep [text "Constructors" <+> ppr con1 <+> text "and" <+> ppr con2, text "give different types for field", quotes (ppr field_name)] -dataConCtxtName :: [Located Name] -> SDoc -dataConCtxtName [con] - = text "In the definition of data constructor" <+> quotes (ppr con) -dataConCtxtName con - = text "In the definition of data constructors" <+> interpp'SP con +dataConCtxt :: [Located Name] -> SDoc +dataConCtxt cons = text "In the definition of data constructor" <> plural cons + <+> ppr_cons cons + +dataConResCtxt :: [Located Name] -> SDoc +dataConResCtxt cons = text "In the result type of data constructor" <> plural cons + <+> ppr_cons cons -dataConCtxt :: Outputable a => a -> SDoc -dataConCtxt con = text "In the definition of data constructor" <+> quotes (ppr con) +ppr_cons :: [Located Name] -> SDoc +ppr_cons [con] = quotes (ppr con) +ppr_cons cons = interpp'SP cons classOpCtxt :: Var -> Type -> SDoc classOpCtxt sel_id tau = sep [text "When checking the class method:", ===================================== compiler/GHC/Tc/TyCl/Instance.hs ===================================== @@ -688,9 +688,8 @@ tcDataFamInstDecl mb_clsinfo tv_skol_env -- Do /not/ check that the number of patterns = tyConArity fam_tc -- See [Arity of data families] in GHC.Core.FamInstEnv ; (qtvs, pats, res_kind, stupid_theta) - <- tcDataFamInstHeader mb_clsinfo fam_tc outer_bndrs - fixity hs_ctxt hs_pats m_ksig hs_cons - new_or_data + <- tcDataFamInstHeader mb_clsinfo fam_tc outer_bndrs fixity + hs_ctxt hs_pats m_ksig new_or_data -- Eta-reduce the axiom if possible -- Quite tricky: see Note [Implementing eta reduction for data families] @@ -740,8 +739,9 @@ tcDataFamInstDecl mb_clsinfo tv_skol_env do { data_cons <- tcExtendTyVarEnv qtvs $ -- For H98 decls, the tyvars scope -- over the data constructors - tcConDecls rec_rep_tc new_or_data ty_binders final_res_kind - orig_res_ty hs_cons + tcConDecls new_or_data (DDataInstance orig_res_ty) + rec_rep_tc ty_binders final_res_kind + hs_cons ; rep_tc_name <- newFamInstTyConName lfam_name pats ; axiom_name <- newFamInstAxiomName lfam_name [pats] @@ -857,7 +857,7 @@ TyVarEnv will simply be empty, and there is nothing to worry about. tcDataFamInstHeader :: AssocInstInfo -> TyCon -> HsOuterFamEqnTyVarBndrs GhcRn -> LexicalFixity -> LHsContext GhcRn - -> HsTyPats GhcRn -> Maybe (LHsKind GhcRn) -> [LConDecl GhcRn] + -> HsTyPats GhcRn -> Maybe (LHsKind GhcRn) -> NewOrData -> TcM ([TyVar], [Type], Kind, ThetaType) -- The "header" of a data family instance is the part other than @@ -865,7 +865,7 @@ tcDataFamInstHeader -- e.g. data instance D [a] :: * -> * where ... -- Here the "header" is the bit before the "where" tcDataFamInstHeader mb_clsinfo fam_tc outer_bndrs fixity - hs_ctxt hs_pats m_ksig hs_cons new_or_data + hs_ctxt hs_pats m_ksig new_or_data = do { traceTc "tcDataFamInstHeader {" (ppr fam_tc <+> ppr hs_pats) ; (tclvl, wanted, (scoped_tvs, (stupid_theta, lhs_ty, master_res_kind, instance_res_kind))) <- pushLevelAndSolveEqualitiesX "tcDataFamInstHeader" $ @@ -884,8 +884,8 @@ tcDataFamInstHeader mb_clsinfo fam_tc outer_bndrs fixity -- Add constraints from the result signature ; res_kind <- tc_kind_sig m_ksig - -- Add constraints from the data constructors - ; kcConDecls new_or_data res_kind hs_cons + -- Do not add constraints from the data constructors + -- See Note [Kind inference for data family instances] -- Check that the result kind of the TyCon applied to its args -- is compatible with the explicit signature (or Type, if there @@ -1049,6 +1049,86 @@ however, so this Note aims to describe these subtleties: themselves. Heavy sigh. But not truly hard; that's what tcbVisibilities does. +Note [Kind inference for data family instances] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider this GADT-style data type declaration, where I have used +fresh variables in the data constructor's type, to stress that c,d are +quite distinct from a,b. + data T a b where + MkT :: forall c d. c d -> T c d + +Following Note [Inferring kinds for type declarations] in GHC.Tc.TyCl, +to infer T's kind, we initially give T :: kappa, a monomorpic kind, +gather constraints from the header and data constructors, and conclude + T :: (kappa1 -> type) -> kappa1 -> Type +Then we generalise, giving + T :: forall k. (k->Type) -> k -> Type + +Now what about a data /instance/ decl + data family T :: forall k. (k->Type) -> k -> Type + + data instance T p Int where ... + +No doubt here! The poly-kinded T is instantiated with k=Type, so the +header really looks like + data instance T @Type (p :: Type->Type) Int where ... + +But what about this? + data instance T p q where + MkT :: forall r. r Int -> T r Int + +So what kind do 'p' and 'q' have? No clues from the header, but from +the data constructor we can clearly see that (r :: Type->Type). Does +that mean that the the /entire data instance/ is instantiated at Type, +like this? + data instance T @Type (p :: Type->Type) (q :: Type) where + ... + +Not at all! This is a /GADT/-style decl, so the kind argument might +be specialised in this particular data constructor, thus: + data instance T @k (p :: k->Type) (q :: k) where + MkT :: forall (r :: Type -> Type). + r Int -> T @Type r Int +(and perhaps specialised differently in some other data +constructor MkT2). + +The key difference in this case and 'data T' at the top of this Note +is that we have no known kind for 'data T'. We thus forbid different +specialisations of T in its constructors, in an attempt to avoid +inferring polymorphic recursion. In data family T, however, there is +no problem with polymorphic recursion: we already /fully know/ T's +kind -- that came from the family declaration, and is not influenced +by the data instances -- and hence we /can/ specialise T's kind +differently in different GADT data constructors. + +SHORT SUMMARY: in a data instance decl, it's not clear whether kind +constraints arising from the data constructors should be considered +local to the (GADT) data /constructor/ or should apply to the entire +data instance. + +DESIGN CHOICE: in data/newtype family instance declarations, we ignore +the /data constructor/ declarations altogether, looking only at the +data instance /header/. + +Observations: +* This choice is simple to describe, as well as simple to implment. + For a data/newtype instance decl, the instance kinds are influenced + /only/ by the header. + +* We could treat Haskell-98 style data-instance decls differently, by + taking the data constructors into account, since there are no GADT + issues. But we don't, for simplicity, and because it means you can + understand the data type instance by looking only at the header. + +* Newtypes can be declared in GADT syntax, but they can't do GADT-style + specialisation, so like Haskell-98 definitions we could take the + data constructors into account. Again we don't, for the same reason. + +So for now at least, we keep the simplest choice. See #18891 and !4419 +for more discussion of this issue. + +Kind inference for data types (Xie et al) https://arxiv.org/abs/1911.06153 +takes a slightly different approach. -} ===================================== docs/users_guide/9.2.1-notes.rst ===================================== @@ -14,6 +14,11 @@ Language (Serrano et al, ICFP 2020). More information here: :ref:`impredicative-polymorphism`. This replaces the old (undefined, flaky) behaviour of the :extension:`ImpredicativeTypes` extension. +* Kind inference for data/newtype instance declarations is slightly + more restrictive than before. See the user manual :ref:`kind-inference-data-family-instances`. + This is a breaking change, albeit a fairly obscure one that corrects a specification bug. + + Compiler ~~~~~~~~ ===================================== docs/users_guide/exts/poly_kinds.rst ===================================== @@ -130,8 +130,45 @@ This rule has occasionally-surprising consequences (see The kind-polymorphism from the class declaration makes ``D1`` kind-polymorphic, but not so ``D2``; and similarly ``F1``, ``F2``. +Kind inference in type signatures +--------------------------------- + +When kind-checking a type, GHC considers only what is written in that +type when figuring out how to generalise the type's kind. + +For example, +consider these definitions (with :extension:`ScopedTypeVariables`): :: + + data Proxy a -- Proxy :: forall k. k -> Type + p :: forall a. Proxy a + p = Proxy :: Proxy (a :: Type) + +GHC reports an error, saying that the kind of ``a`` should be a kind variable +``k``, not ``Type``. This is because, by looking at the type signature +``forall a. Proxy a``, GHC assumes ``a``'s kind should be generalised, not +restricted to be ``Type``. The function definition is then rejected for being +more specific than its type signature. + +.. _explicit-kind-quantification: + +Explicit kind quantification +---------------------------- + +Enabled by :extension:`PolyKinds`, GHC supports explicit kind quantification, +as in these examples: :: + + data Proxy :: forall k. k -> Type + f :: (forall k (a :: k). Proxy a -> ()) -> Int + +Note that the second example has a ``forall`` that binds both a kind ``k`` and +a type variable ``a`` of kind ``k``. In general, there is no limit to how +deeply nested this sort of dependency can work. However, the dependency must +be well-scoped: ``forall (a :: k) k. ...`` is an error. + + .. _inferring-variable-order: + Inferring the order of variables in a type/class declaration ------------------------------------------------------------ @@ -490,41 +527,92 @@ This also applies to GADT-style data instances: :: -- • In the data instance declaration for ‘T’ -Kind inference in closed type families --------------------------------------- +Kind inference in data type declarations +---------------------------------------- -Although all open type families are considered to have a complete -user-supplied kind signature, we can relax this condition for closed -type families, where we have equations on which to perform kind -inference. GHC will infer kinds for the arguments and result types of a -closed type family. +Consider the declaration :: -GHC supports *kind-indexed* type families, where the family matches both -on the kind and type. GHC will *not* infer this behaviour without a -complete user-supplied kind signature, as doing so would sometimes infer -non-principal types. Indeed, we can see kind-indexing as a form -of polymorphic recursion, where a type is used at a kind other than -its most general in its own definition. + data T1 f a = MkT1 (f a) + data T2 f a where + MkT2 :: f a -> T f a -For example: :: +In both cases GHC looks at the data constructor declarations to +give constraints on the kind of ``T``, yielding :: - type family F1 a where - F1 True = False - F1 False = True - F1 x = x - -- F1 fails to compile: kind-indexing is not inferred + T1, T2 :: forall k. (k -> Type) -> k -> Type - type family F2 (a :: k) where - F2 True = False - F2 False = True - F2 x = x - -- F2 fails to compile: no complete signature +Consider the type :: + + type G :: forall k. k -> Type + data G (a :: k) where + GInt :: G Int + GMaybe :: G Maybe + +This datatype ``G`` is GADT-like in both its kind and its type. Suppose you +have ``g :: G a``, where ``a :: k``. Then pattern matching to discover that +``g`` is in fact ``GMaybe`` tells you both that ``k ~ (Type -> Type)`` and +``a ~ Maybe``. The definition for ``G`` requires that :extension:`PolyKinds` +be in effect, but pattern-matching on ``G`` requires no extension beyond +:extension:`GADTs`. That this works is actually a straightforward extension +of regular GADTs and a consequence of the fact that kinds and types are the +same. + +Note that the datatype ``G`` is used at different kinds in its body, and +therefore that kind-indexed GADTs use a form of polymorphic recursion. +It is thus only possible to use this feature if you have provided a +complete user-supplied kind signature (CUSK) +for the datatype (:ref:`complete-kind-signatures`), or a standalone +kind signature (:ref:`standalone-kind-signatures`); +in the case of ``G`` we both. +If you wish to see the kind indexing explicitly, you can do so by enabling :ghc-flag:`-fprint-explicit-kinds` and querying ``G`` with GHCi's :ghci-cmd:`:info` command: :: + + > :set -fprint-explicit-kinds + > :info G + type role G nominal nominal + type G :: forall k. k -> Type + data G @k a where + GInt :: G @Type Int + GMaybe :: G @(Type -> Type) Maybe + +where you can see the GADT-like nature of the two constructors. + +.. _kind-inference-data-family-instances: + +Kind inference for data/newtype instance declarations +----------------------------------------------------- + +Consider these declarations :: + + data family T :: forall k. (k->Type) -> k -> Type + + data instance T p q where + MkT :: forall r. r Int -> T r Int + +Here ``T`` has an invisible kind argument; and perhaps it is instantiated +to ``Type`` in the instance, thus:: + + data instance T @Type (p :: Type->Type) (q :: Type) where + MkT :: forall r. r Int -> T r Int + +Or perhaps we intended the specialisation to be in the GADT data +constructor, thus:: + + data instance T @k (p :: k->Type) (q :: k) where + MkT :: forall r. r Int -> T @Type r Int + +It gets more complicated if there are multiple constructors. In +general, there is no principled way to tell which type specialisation +comes from the data instance, and which from the individual GADT data +constructors. + +So GHC implements this rule: in data/newtype instance declararations +(unlike ordinary data/newtype declarations) we do *not* look at the +constructor declarations when inferring the shape of the instance +header. The principle is that *the instantiation of the data instance +should be apparent from the header alone*. This principle makes the +program easier to understand, and avoids the swamp of complexity +indicated above. - type family F3 (a :: k) :: k where - F3 True = False - F3 False = True - F3 x = x - -- OK Kind inference in class instance declarations --------------------------------------------- @@ -555,43 +643,8 @@ infrastructure, and it's not clear the payoff is worth it. If you want to restrict ``b``\ 's kind in the instance above, just use a kind signature in the instance head. -Kind inference in type signatures ---------------------------------- - -When kind-checking a type, GHC considers only what is written in that -type when figuring out how to generalise the type's kind. - -For example, -consider these definitions (with :extension:`ScopedTypeVariables`): :: - - data Proxy a -- Proxy :: forall k. k -> Type - p :: forall a. Proxy a - p = Proxy :: Proxy (a :: Type) - -GHC reports an error, saying that the kind of ``a`` should be a kind variable -``k``, not ``Type``. This is because, by looking at the type signature -``forall a. Proxy a``, GHC assumes ``a``'s kind should be generalised, not -restricted to be ``Type``. The function definition is then rejected for being -more specific than its type signature. - -.. _explicit-kind-quantification: - -Explicit kind quantification ----------------------------- - -Enabled by :extension:`PolyKinds`, GHC supports explicit kind quantification, -as in these examples: :: - - data Proxy :: forall k. k -> Type - f :: (forall k (a :: k). Proxy a -> ()) -> Int - -Note that the second example has a ``forall`` that binds both a kind ``k`` and -a type variable ``a`` of kind ``k``. In general, there is no limit to how -deeply nested this sort of dependency can work. However, the dependency must -be well-scoped: ``forall (a :: k) k. ...`` is an error. - -Implicit quantification in type synonyms and type family instances ------------------------------------------------------------------- +Kind inference in type synonyms and type family instances +--------------------------------------------------------- Consider the scoping rules for type synonyms and type family instances, such as these:: @@ -706,29 +759,44 @@ kinds. Consequently, visible dependent quantifiers are rejected in any context that is unambiguously the type of a term. They are also rejected in the types of data constructors. -Kind-indexed GADTs ------------------- +Kind inference in closed type families +-------------------------------------- -Consider the type :: +Although all open type families are considered to have a complete +user-supplied kind signature (:ref:`complete-kind-signatures`), +we can relax this condition for closed +type families, where we have equations on which to perform kind +inference. GHC will infer kinds for the arguments and result types of a +closed type family. - data G (a :: k) where - GInt :: G Int - GMaybe :: G Maybe +GHC supports *kind-indexed* type families, where the family matches both +on the kind and type. GHC will *not* infer this behaviour without a +complete user-supplied kind signature or standalone kind +signature (see :ref:`standalone-kind-signatures`), +because doing so would sometimes infer +non-principal types. Indeed, we can see kind-indexing as a form +of polymorphic recursion, where a type is used at a kind other than +its most general in its own definition. -This datatype ``G`` is GADT-like in both its kind and its type. Suppose you -have ``g :: G a``, where ``a :: k``. Then pattern matching to discover that -``g`` is in fact ``GMaybe`` tells you both that ``k ~ (Type -> Type)`` and -``a ~ Maybe``. The definition for ``G`` requires that :extension:`PolyKinds` -be in effect, but pattern-matching on ``G`` requires no extension beyond -:extension:`GADTs`. That this works is actually a straightforward extension -of regular GADTs and a consequence of the fact that kinds and types are the -same. +For example: :: -Note that the datatype ``G`` is used at different kinds in its body, and -therefore that kind-indexed GADTs use a form of polymorphic recursion. -It is thus only possible to use this feature if you have provided a -complete user-supplied kind signature -for the datatype (:ref:`complete-kind-signatures`). + type family F1 a where + F1 True = False + F1 False = True + F1 x = x + -- F1 fails to compile: kind-indexing is not inferred + + type family F2 (a :: k) where + F2 True = False + F2 False = True + F2 x = x + -- F2 fails to compile: no complete signature + + type family F3 (a :: k) :: k where + F3 True = False + F3 False = True + F3 x = x + -- OK Higher-rank kinds ----------------- ===================================== testsuite/tests/dependent/should_fail/T13780a.stderr ===================================== @@ -3,7 +3,7 @@ T13780a.hs:9:40: error: • Couldn't match kind ‘a’ with ‘Bool’ Expected kind ‘Foo a’, but ‘MkFoo’ has kind ‘Foo Bool’ ‘a’ is a rigid type variable bound by - a family instance declaration + the data constructor ‘SMkFoo’ at T13780a.hs:9:20-31 • In the second argument of ‘(~)’, namely ‘MkFoo’ In the definition of data constructor ‘SMkFoo’ ===================================== testsuite/tests/deriving/should_compile/T11416.hs ===================================== @@ -12,9 +12,11 @@ newtype T f (a :: ConstantT Type f) = T (f a) deriving Functor data family TFam1 (f :: k1) (a :: k2) -newtype instance TFam1 f (ConstantT a f) = TFam1 (f a) +newtype instance TFam1 (f :: k -> Type) (ConstantT (a :: k) f) + = TFam1 (f a) deriving Functor data family TFam2 (f :: k1) (a :: k2) -newtype instance TFam2 f (a :: ConstantT Type f) = TFam2 (f a) +newtype instance TFam2 (f :: Type -> Type) (a :: ConstantT Type f) + = TFam2 (f a) deriving Functor ===================================== testsuite/tests/deriving/should_compile/T9359.hs ===================================== @@ -9,6 +9,5 @@ data Cmp a where deriving (Show, Eq) data family CmpInterval (a :: Cmp k) (b :: Cmp k) :: Type -data instance CmpInterval (V c) Sup = Starting c +data instance CmpInterval (V (c :: Type)) Sup = Starting c deriving( Show ) - ===================================== testsuite/tests/indexed-types/should_compile/T14111.hs ===================================== @@ -0,0 +1,24 @@ +{-# LANGUAGE MagicHash, UnboxedSums, NoImplicitPrelude #-} +{-# LANGUAGE TypeFamilies #-} +-- {-# LANGUAGE PolyKinds #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE GADTs ,ExplicitNamespaces#-} +{-# LANGUAGE UnboxedTuples #-} + +module T14111 where + +import GHC.Exts +import GHC.Types +import Prelude (undefined) +import Data.Kind +import Data.Void + +data family Maybe(x :: TYPE (r :: RuntimeRep)) + +data instance Maybe (a :: Type ) where + MaybeSum :: (# a | (# #) #) -> Maybe a + +data instance Maybe (x :: TYPE 'UnliftedRep) where + MaybeSumU :: (# x | (# #) #) -> Maybe x ===================================== testsuite/tests/indexed-types/should_compile/T8707.hs ===================================== @@ -0,0 +1,11 @@ +{-# LANGUAGE TypeFamilies, PolyKinds, DataKinds, GADTs #-} + +module T8707 where + +import Data.Kind + +data family SingDF (a :: (k, k2 -> Type)) +data Ctor :: k -> Type + +data instance SingDF (a :: (Bool, Bool -> Type)) where + SFalse :: SingDF '(False, Ctor) ===================================== testsuite/tests/indexed-types/should_compile/all.T ===================================== @@ -300,3 +300,5 @@ test('T18809', normal, compile, ['-O']) test('CEqCanOccursCheck', normal, compile, ['']) test('GivenLoop', normal, compile, ['']) test('T18875', normal, compile, ['']) +test('T8707', normal, compile, ['-O']) +test('T14111', normal, compile, ['-O']) ===================================== testsuite/tests/indexed-types/should_fail/T8368.stderr ===================================== @@ -1,6 +1,5 @@ -T8368.hs:9:3: - Data constructor ‘MkFam’ returns type ‘Foo’ - instead of an instance of its parent type ‘Fam a’ - In the definition of data constructor ‘MkFam’ - In the data instance declaration for ‘Fam’ +T8368.hs:9:3: error: + • Couldn't match expected type ‘Fam a0’ with actual type ‘Foo’ + • In the result type of data constructor ‘MkFam’ + In the data instance declaration for ‘Fam’ ===================================== testsuite/tests/indexed-types/should_fail/T8368a.stderr ===================================== @@ -1,6 +1,7 @@ -T8368a.hs:7:3: - Data constructor ‘MkFam’ returns type ‘Fam Bool b’ - instead of an instance of its parent type ‘Fam Int b’ - In the definition of data constructor ‘MkFam’ - In the data instance declaration for ‘Fam’ +T8368a.hs:7:3: error: + • Couldn't match type ‘Bool’ with ‘Int’ + Expected: Fam Int b + Actual: Fam Bool b + • In the result type of data constructor ‘MkFam’ + In the data instance declaration for ‘Fam’ ===================================== testsuite/tests/patsyn/should_fail/T15685.stderr ===================================== @@ -1,13 +1,13 @@ T15685.hs:13:24: error: - • Could not deduce: a ~ [k0] - from the context: as ~ (a1 : as1) + • Could not deduce: k ~ [k0] + from the context: as ~ (a : as1) bound by a pattern with constructor: - Here :: forall {a1} (f :: a1 -> *) (a2 :: a1) (as :: [a1]). - f a2 -> NS f (a2 : as), + Here :: forall {k} (f :: k -> *) (a :: k) (as :: [k]). + f a -> NS f (a : as), in a pattern synonym declaration at T15685.hs:13:19-26 - ‘a’ is a rigid type variable bound by + ‘k’ is a rigid type variable bound by the inferred type of HereNil :: NS f as at T15685.hs:13:9-15 Possible fix: add a type signature for ‘HereNil’ ===================================== testsuite/tests/polykinds/T13659.stderr ===================================== @@ -1,6 +1,6 @@ -T13659.hs:14:27: error: - • Expected a type, but ‘a’ has kind ‘[*]’ - • In the first argument of ‘Format’, namely ‘'[Int, a]’ - In the type ‘Format '[Int, a]’ +T13659.hs:14:15: error: + • Expected kind ‘[*]’, but ‘a’ has kind ‘*’ + • In the first argument of ‘Format’, namely ‘a’ + In the type ‘Format a’ In the definition of data constructor ‘I’ ===================================== testsuite/tests/polykinds/T16221a.stderr ===================================== @@ -1,7 +1,7 @@ T16221a.hs:6:49: error: - • Expected kind ‘k’, but ‘b’ has kind ‘k1’ - ‘k1’ is a rigid type variable bound by + • Expected kind ‘k’, but ‘b’ has kind ‘k2’ + ‘k2’ is a rigid type variable bound by an explicit forall k (b :: k) at T16221a.hs:6:20 ‘k’ is a rigid type variable bound by ===================================== testsuite/tests/th/T11145.stderr ===================================== @@ -1,8 +1,7 @@ T11145.hs:8:1: error: - • Data constructor ‘MkFuggle’ returns type ‘Fuggle - Int (Maybe Bool)’ - instead of an instance of its parent type ‘Fuggle - Int (Maybe (a, b))’ - • In the definition of data constructor ‘MkFuggle’ + • Couldn't match type ‘Bool’ with ‘(a0, b0)’ + Expected: Fuggle Int (Maybe (a0, b0)) + Actual: Fuggle Int (Maybe Bool) + • In the result type of data constructor ‘MkFuggle’ In the data instance declaration for ‘Fuggle’ ===================================== testsuite/tests/th/T9692.hs ===================================== @@ -12,7 +12,7 @@ class C a where data F a (b :: k) :: Type instance C Int where - data F Int x = FInt x + data F Int (x :: Type) = FInt x $( do info <- qReify (mkName "F") runIO $ putStrLn $ pprint info ===================================== testsuite/tests/typecheck/should_compile/T18891.hs ===================================== @@ -0,0 +1,16 @@ +{-# LANGUAGE GADTs, UnliftedNewtypes, StandaloneKindSignatures, RankNTypes, TypeFamilies, PolyKinds #-} + +module T18891 where + +import GHC.Exts( TYPE ) + +data family T2 (a :: k) +data instance T2 a where + MkT2 :: T2 Maybe + +newtype N3 :: forall k -> TYPE k where + MkN3 :: N3 m -> N3 m + +type N4 :: forall k -> TYPE k +newtype N4 :: forall k -> TYPE k where + MkN4 :: N4 m -> N4 m ===================================== testsuite/tests/typecheck/should_compile/UnliftedNewtypesUnassociatedFamily.hs ===================================== @@ -4,6 +4,8 @@ {-# LANGUAGE PolyKinds #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TypeApplications #-} module UnliftedNewtypesUnassociatedFamily where @@ -20,7 +22,16 @@ newtype instance DFT ('TupleRep '[ 'IntRep, 'WordRep]) data instance DFT 'LiftedRep = MkDFT4 | MkDFT5 data family DF :: TYPE (r :: RuntimeRep) -newtype instance DF = MkDF1 Int# -newtype instance DF = MkDF2 Word# -newtype instance DF = MkDF3 (# Int#, Word# #) + +-- Use a type application +newtype instance DF @IntRep = MkDF1 Int# + +-- Use a kind signature +newtype instance DF :: TYPE 'WordRep where + MkDF2 :: Word# -> DF + +-- Also uses a kind signature +newtype instance DF :: TYPE ('TupleRep '[ 'IntRep, 'WordRep ]) where + MkDF3 :: (# Int#, Word# #) -> DF + data instance DF = MkDF4 | MkDF5 ===================================== testsuite/tests/typecheck/should_compile/UnliftedNewtypesUnifySig.hs ===================================== @@ -10,14 +10,14 @@ module UnliftedNewtypesUnassociatedFamily where import GHC.Int (Int(I#)) -import GHC.Exts (Int#,Word#,RuntimeRep(IntRep)) +import GHC.Exts (Int#,Word#,RuntimeRep(IntRep,WordRep)) import GHC.Exts (TYPE) type KindOf (a :: TYPE k) = k data family D (a :: TYPE r) :: TYPE r -newtype instance D a = MkWordD Word# +newtype instance D (a :: TYPE 'WordRep) = MkWordD Word# -newtype instance D a :: TYPE (KindOf a) where - MkIntD :: forall a. Int# -> D a +newtype instance D (a :: TYPE 'IntRep) :: TYPE (KindOf a) where + MkIntD :: forall (b :: TYPE 'IntRep). Int# -> D b ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -736,3 +736,4 @@ test('InstanceGivenOverlap', normal, compile, ['']) test('InstanceGivenOverlap2', normal, compile, ['']) test('LocalGivenEqs', normal, compile, ['']) test('LocalGivenEqs2', normal, compile, ['']) +test('T18891', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_fail/T18891a.hs ===================================== @@ -0,0 +1,13 @@ +{-# LANGUAGE GADTs, UnliftedNewtypes, StandaloneKindSignatures, RankNTypes, TypeFamilies, PolyKinds #-} + +module T18891 where + +import GHC.Exts( TYPE ) + +newtype N1 :: forall k. TYPE k where + MkN1 :: N1 -> N1 + +type N2 :: forall k. TYPE k +newtype N2 :: forall k. TYPE k where + MkN2 :: N2 -> N2 + ===================================== testsuite/tests/typecheck/should_fail/T18891a.stderr ===================================== @@ -0,0 +1,12 @@ + +T18891a.hs:8:4: error: + • A newtype constructor must have a return type of form T a1 ... an + MkN1 :: N1 -> N1 + • In the definition of data constructor ‘MkN1’ + In the newtype declaration for ‘N1’ + +T18891a.hs:12:3: error: + • A newtype constructor must have a return type of form T a1 ... an + MkN2 :: N2 -> N2 + • In the definition of data constructor ‘MkN2’ + In the newtype declaration for ‘N2’ ===================================== testsuite/tests/typecheck/should_fail/UnliftedNewtypesFamilyKindFail2.stderr ===================================== @@ -1,11 +1,5 @@ -UnliftedNewtypesFamilyKindFail2.hs:12:20: - Expected a type, but ‘5’ has kind ‘GHC.Num.Natural.Natural’ - In the first argument of ‘F’, namely ‘5’ - In the newtype instance declaration for ‘F’ - -UnliftedNewtypesFamilyKindFail2.hs:12:31: - Expected a type, but ‘5’ has kind ‘GHC.Num.Natural.Natural’ - In the first argument of ‘F’, namely ‘5’ - In the type ‘(F 5)’ - In the definition of data constructor ‘MkF’ +UnliftedNewtypesFamilyKindFail2.hs:12:20: error: + • Expected a type, but ‘5’ has kind ‘GHC.Num.Natural.Natural’ + • In the first argument of ‘F’, namely ‘5’ + In the newtype instance declaration for ‘F’ ===================================== testsuite/tests/typecheck/should_fail/UnliftedNewtypesUnassociatedFamilyFail.hs ===================================== @@ -0,0 +1,23 @@ +{-# LANGUAGE UnliftedNewtypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE GADTs #-} + +module UnliftedNewtypesUnassociatedFamily where + +import GHC.Int (Int(I#)) +import GHC.Word (Word(W#)) +import GHC.Exts (Int#,Word#) +import GHC.Exts (TYPE,RuntimeRep(LiftedRep,IntRep,WordRep,TupleRep)) + +data family DF :: TYPE (r :: RuntimeRep) + +-- All these fail: see #18891 and !4419 +-- See Note [Kind inference for data family instances] +-- in GHC.Tc.TyCl.Instance +newtype instance DF = MkDF1a Int# +newtype instance DF = MkDF2a Word# +newtype instance DF = MkDF3a (# Int#, Word# #) ===================================== testsuite/tests/typecheck/should_fail/UnliftedNewtypesUnassociatedFamilyFail.stderr ===================================== @@ -0,0 +1,18 @@ + +UnliftedNewtypesUnassociatedFamilyFail.hs:21:30: error: + • Expecting a lifted type, but ‘Int#’ is unlifted + • In the type ‘Int#’ + In the definition of data constructor ‘MkDF1a’ + In the newtype instance declaration for ‘DF’ + +UnliftedNewtypesUnassociatedFamilyFail.hs:22:30: error: + • Expecting a lifted type, but ‘Word#’ is unlifted + • In the type ‘Word#’ + In the definition of data constructor ‘MkDF2a’ + In the newtype instance declaration for ‘DF’ + +UnliftedNewtypesUnassociatedFamilyFail.hs:23:30: error: + • Expecting a lifted type, but ‘(# Int#, Word# #)’ is unlifted + • In the type ‘(# Int#, Word# #)’ + In the definition of data constructor ‘MkDF3a’ + In the newtype instance declaration for ‘DF’ ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -546,6 +546,7 @@ test('UnliftedNewtypesConstraintFamily', normal, compile_fail, ['']) test('UnliftedNewtypesMismatchedKind', normal, compile_fail, ['']) test('UnliftedNewtypesMismatchedKindRecord', normal, compile_fail, ['']) test('UnliftedNewtypesMultiFieldGadt', normal, compile_fail, ['']) +test('UnliftedNewtypesUnassociatedFamilyFail', normal, compile_fail, ['']) test('T13834', normal, compile_fail, ['']) test('T17077', normal, compile_fail, ['']) test('T16512a', normal, compile_fail, ['']) @@ -591,3 +592,4 @@ test('T18640c', normal, compile_fail, ['']) test('T10709', normal, compile_fail, ['']) test('T10709b', normal, compile_fail, ['']) test('GivenForallLoop', normal, compile_fail, ['']) +test('T18891a', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/727264bde42c7c14e5452c68463051005ef5cfb4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/727264bde42c7c14e5452c68463051005ef5cfb4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 4 13:21:44 2020 From: gitlab at gitlab.haskell.org (Andrew Martin) Date: Fri, 04 Dec 2020 08:21:44 -0500 Subject: [Git][ghc/ghc][wip/boxed-rep] [skip ci] Update some notes Message-ID: <5fca37e8de765_6b212a30284539f@gitlab.mail> Andrew Martin pushed to branch wip/boxed-rep at Glasgow Haskell Compiler / GHC Commits: 185a01b0 by Andrew Martin at 2020-12-04T08:21:29-05:00 [skip ci] Update some notes - - - - - 3 changed files: - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Types/RepType.hs - libraries/ghc-prim/GHC/Types.hs Changes: ===================================== compiler/GHC/Builtin/Types/Prim.hs ===================================== @@ -451,26 +451,28 @@ Note [TYPE and RuntimeRep] All types that classify values have a kind of the form (TYPE rr), where data RuntimeRep -- Defined in ghc-prim:GHC.Types - = LiftedRep - | UnliftedRep + = BoxedRep Levity | IntRep | FloatRep .. etc .. + data Levity = Lifted | Unlifted + rr :: RuntimeRep TYPE :: RuntimeRep -> TYPE 'LiftedRep -- Built in So for example: - Int :: TYPE 'LiftedRep - Array# Int :: TYPE 'UnliftedRep + Int :: TYPE ('BoxedRep 'Lifted) + Array# Int :: TYPE ('BoxedRep 'Unlifted) Int# :: TYPE 'IntRep Float# :: TYPE 'FloatRep - Maybe :: TYPE 'LiftedRep -> TYPE 'LiftedRep + Maybe :: TYPE ('BoxedRep 'Lifted) -> TYPE ('BoxedRep 'Lifted) (# , #) :: TYPE r1 -> TYPE r2 -> TYPE (TupleRep [r1, r2]) We abbreviate '*' specially: - type * = TYPE 'LiftedRep + type LiftedRep = 'BoxedRep 'Lifted + type * = TYPE LiftedRep The 'rr' parameter tells us how the value is represented at runtime. ===================================== compiler/GHC/Types/RepType.hs ===================================== @@ -361,10 +361,11 @@ but RuntimeRep has some extra cases: data RuntimeRep = VecRep VecCount VecElem -- ^ a SIMD vector type | TupleRep [RuntimeRep] -- ^ An unboxed tuple of the given reps | SumRep [RuntimeRep] -- ^ An unboxed sum of the given reps - | LiftedRep -- ^ lifted; represented by a pointer - | UnliftedRep -- ^ unlifted; represented by a pointer + | BoxedRep Levity -- ^ boxed; represented by a pointer | IntRep -- ^ signed, word-sized value ...etc... +data Levity = Lifted + | Unlifted It's all in 1-1 correspondence with PrimRep except for TupleRep and SumRep, which describe unboxed products and sums respectively. RuntimeRep is defined @@ -374,6 +375,13 @@ program, so that every variable has a type that has a PrimRep. For example, unarisation transforms our utup function above, to take two Int arguments instead of one (# Int, Int #) argument. +Also, note that boxed types are represented slightly differently in RuntimeRep +and PrimRep. PrimRep just has the nullary LiftedRep and UnliftedRep data +constructors. RuntimeRep has a BoxedRep data constructor, which accepts a +Levity. The subtle distinction is that since BoxedRep can accept a variable +argument, RuntimeRep can talk about levity polymorphic types. PrimRep, by +contrast, cannot. + See also Note [Getting from RuntimeRep to PrimRep] and Note [VoidRep]. Note [VoidRep] ===================================== libraries/ghc-prim/GHC/Types.hs ===================================== @@ -448,6 +448,7 @@ data RuntimeRep = VecRep VecCount VecElem -- ^ a SIMD vector type -- RuntimeRep is intimately tied to TyCon.RuntimeRep (in GHC proper). See -- Note [RuntimeRep and PrimRep] in RepType. -- See also Note [Wiring in RuntimeRep] in GHC.Builtin.Types +-- See also Note [TYPE and RuntimeRep] in GHC.Builtin.Type.Prim -- | Length of a SIMD vector type data VecCount = Vec2 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/185a01b0a2522b8197710e339b21179267d4245a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/185a01b0a2522b8197710e339b21179267d4245a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 4 14:17:47 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Fri, 04 Dec 2020 09:17:47 -0500 Subject: [Git][ghc/ghc][wip/sgraf-dmdanal-stuff] WorkWrap: Unbox constructors with existentials (#18982) Message-ID: <5fca450bd2b9a_6b21408f9451750@gitlab.mail> Sebastian Graf pushed to branch wip/sgraf-dmdanal-stuff at Glasgow Haskell Compiler / GHC Commits: eda02f1e by Sebastian Graf at 2020-12-04T15:17:36+01:00 WorkWrap: Unbox constructors with existentials (#18982) I found that by relaxing the "no existential" checks in `isDataProductType_maybe` and `isDataSumType_maybe`, the former becomes identical to `tyConSingleAlgDataCon_maybe`. So I deleted both and introduced a new function, `tyConAlgDataCons_maybe` for the sum case. I cleaned up a couple of call sites, some of which weren't very explicit about whether they cared for existentials or not. Most of the new stuff happens in worker/wrapper, where handling of existentials means a bit of substitution work carried out by `GHC.Core.Utils.dataConRepFSInstPat`. The test output of `T18013` changed, because we now unbox the `Rule` data type. Its constructor carries existential state and will be w/w'd now. In the particular example, the worker functions inlines right back into the wrapper, which then unnecessarily has a (quite big) stable unfolding. I think this kind of fallout is inevitable; see also Note [Don't w/w inline small non-loop-breaker things]. There's a new regression test case `T18982`. Fixes #18982. - - - - - 14 changed files: - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Opt/CprAnal.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/HsToCore/Foreign/Call.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Tc/Deriv/Utils.hs - testsuite/tests/simplCore/should_compile/T18013.stderr - + testsuite/tests/stranal/should_compile/T18982.hs - + testsuite/tests/stranal/should_compile/T18982.stderr - testsuite/tests/stranal/should_compile/all.T Changes: ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -1564,15 +1564,13 @@ promoteDataCon (MkData { dcPromoted = tc }) = tc -- | Extract the type constructor, type argument, data constructor and it's -- /representation/ argument types from a type if it is a product type. -- --- Precisely, we return @Just@ for any type that is all of: +-- Precisely, we return @Just@ for any data type that is all of: -- -- * Concrete (i.e. constructors visible) --- -- * Single-constructor +-- * ... which has no existentials -- --- * Not existentially quantified --- --- Whether the type is a @data@ type or a @newtype@ +-- Whether the type is a @data@ type or a @newtype at . splitDataProductType_maybe :: Type -- ^ A product type, perhaps -> Maybe (TyCon, -- The type constructor @@ -1580,13 +1578,14 @@ splitDataProductType_maybe DataCon, -- The data constructor [Scaled Type]) -- Its /representation/ arg types - -- Rejecting existentials is conservative. Maybe some things - -- could be made to work with them, but I'm not going to sweat - -- it through till someone finds it's important. + -- Rejecting existentials means we don't have to worry about + -- freshening and substituting type variables + -- (See "GHC.Type.Id.Make.dataConArgUnpack") splitDataProductType_maybe ty | Just (tycon, ty_args) <- splitTyConApp_maybe ty - , Just con <- isDataProductTyCon_maybe tycon + , Just con <- tyConSingleDataCon_maybe tycon + , null (dataConExTyCoVars con) -- no existentials! See above = Just (tycon, ty_args, con, dataConInstArgTys con ty_args) | otherwise = Nothing ===================================== compiler/GHC/Core/Opt/CprAnal.hs ===================================== @@ -446,14 +446,13 @@ extendEnvForDataAlt env scrut case_bndr dc bndrs ids_w_strs = filter isId bndrs `zip` dataConRepStrictness dc - tycon = dataConTyCon dc - is_product = isJust (isDataProductTyCon_maybe tycon) - is_sum = isJust (isDataSumTyCon_maybe tycon) + is_algebraic = isJust (tyConAlgDataCons_maybe (dataConTyCon dc)) + no_exs = null (dataConExTyCoVars dc) case_bndr_ty - | is_product || is_sum = conCprType (dataConTag dc) - -- Any of the constructors had existentials. This is a little too - -- conservative (after all, we only care about the particular data con), - -- but there is no easy way to write is_sum and this won't happen much. + | is_algebraic, no_exs = conCprType (dataConTag dc) + -- The tycon wasn't algebraic or the datacon had existentials. + -- CPR'ing existentials would need first class existentials/dependent sums + -- to exploit, so we return topCprType here. | otherwise = topCprType -- We could have much deeper CPR info here with Nested CPR, which could ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -400,8 +400,8 @@ dmdAnal' env dmd (Lam var body) dmdAnal' env dmd (Case scrut case_bndr ty [(alt, bndrs, rhs)]) -- Only one alternative. - -- If it's a DataAlt, it should be a product constructor. - | is_non_sum_alt alt + -- If it's a DataAlt, it should be the only constructor of the type. + | is_single_data_alt alt = let (rhs_ty, rhs') = dmdAnal env dmd rhs (alt_ty1, dmds) = findBndrsDmds env rhs_ty bndrs @@ -440,8 +440,8 @@ dmdAnal' env dmd (Case scrut case_bndr ty [(alt, bndrs, rhs)]) -- , text "res_ty" <+> ppr res_ty ]) $ (res_ty, Case scrut' case_bndr' ty [(alt, bndrs', rhs')]) where - is_non_sum_alt (DataAlt dc) = isJust $ isDataProductTyCon_maybe $ dataConTyCon dc - is_non_sum_alt _ = True + is_single_data_alt (DataAlt dc) = isJust $ tyConSingleAlgDataCon_maybe $ dataConTyCon dc + is_single_data_alt _ = True dmdAnal' env dmd (Case scrut case_bndr ty alts) = let -- Case expression with multiple alternatives @@ -501,10 +501,11 @@ forcesRealWorld :: FamInstEnvs -> Type -> Bool forcesRealWorld fam_envs ty | ty `eqType` realWorldStatePrimTy = True - | Just DataConAppContext{ dcac_dc = dc, dcac_arg_tys = field_tys } + | Just DataConAppContext{ dcac_dc = dc, dcac_tc_args = tc_args } <- deepSplitProductType_maybe fam_envs ty , isUnboxedTupleDataCon dc - = any (\(ty,_) -> scaledThing ty `eqType` realWorldStatePrimTy) field_tys + , let field_tys = dataConInstArgTys dc tc_args + = any (eqType realWorldStatePrimTy . scaledThing) field_tys | otherwise = False ===================================== compiler/GHC/Core/Opt/WorkWrap/Utils.hs ===================================== @@ -19,7 +19,8 @@ where import GHC.Prelude import GHC.Core -import GHC.Core.Utils ( exprType, mkCast, mkDefaultCase, mkSingleAltCase ) +import GHC.Core.Utils ( exprType, mkCast, mkDefaultCase, mkSingleAltCase + , dataConRepFSInstPat ) import GHC.Types.Id import GHC.Types.Id.Info ( JoinArity ) import GHC.Core.DataCon @@ -43,9 +44,11 @@ import GHC.Core.TyCon import GHC.Core.TyCon.RecWalk import GHC.Types.Unique.Supply import GHC.Types.Unique +import GHC.Types.Name ( getOccFS ) import GHC.Data.Maybe import GHC.Utils.Misc import GHC.Utils.Outputable +import GHC.Utils.Panic import GHC.Driver.Session import GHC.Driver.Ppr import GHC.Data.FastString @@ -609,50 +612,61 @@ mkWWstr_one dflags fam_envs has_inlineable_prag arg wantToUnbox :: FamInstEnvs -> Bool -> Type -> Demand -> Maybe ([Demand], DataConAppContext) wantToUnbox fam_envs has_inlineable_prag ty dmd = case deepSplitProductType_maybe fam_envs ty of - Just dcac at DataConAppContext{ dcac_arg_tys = con_arg_tys } + Just dcac at DataConAppContext{ dcac_dc = dc } | isStrUsedDmd dmd + , let arity = dataConRepArity dc -- See Note [Unpacking arguments with product and polymorphic demands] - , Just cs <- split_prod_dmd_arity dmd (length con_arg_tys) + , Just cs <- split_prod_dmd_arity dmd arity -- See Note [Do not unpack class dictionaries] , not (has_inlineable_prag && isClassPred ty) -- See Note [mkWWstr and unsafeCoerce] - , cs `equalLength` con_arg_tys + , cs `lengthIs` arity -> Just (cs, dcac) _ -> Nothing where - split_prod_dmd_arity dmd arty + split_prod_dmd_arity dmd arity -- For seqDmd, it should behave like , for some -- suitable arity - | isSeqDmd dmd = Just (replicate arty absDmd) + | isSeqDmd dmd = Just (replicate arity absDmd) | _ :* Prod ds <- dmd = Just ds | otherwise = Nothing +-- | Exactly 'dataConInstArgTys', but lacks the (ASSERT'ed) precondition that +-- the 'DataCon' may not have existentials. The lack of cloning the existentials +-- compared to 'dataConInstExAndArgVars' makes this function \"dubious\"; +-- only use it where type variables aren't substituted! +dubiousDataConInstArgTys :: DataCon -> [Type] -> [Scaled Type] +dubiousDataConInstArgTys dc tc_args = arg_tys + where + univ_tvs = dataConUnivTyVars dc + ex_tvs = dataConExTyCoVars dc + subst = extendTCvInScopeList (zipTvSubst univ_tvs tc_args) ex_tvs + arg_tys = mapScaledType (substTy subst) <$> dataConRepArgTys dc + unbox_one :: DynFlags -> FamInstEnvs -> Var -> [Demand] -> DataConAppContext -> UniqSM (Bool, [Var], CoreExpr -> CoreExpr, CoreExpr -> CoreExpr) unbox_one dflags fam_envs arg cs - DataConAppContext { dcac_dc = data_con, dcac_tys = inst_tys - , dcac_arg_tys = inst_con_arg_tys + DataConAppContext { dcac_dc = dc, dcac_tc_args = tc_args , dcac_co = co } - = do { (uniq1:uniqs) <- getUniquesM - ; let scale = scaleScaled (idMult arg) - scaled_inst_con_arg_tys = map (\(t,s) -> (scale t, s)) inst_con_arg_tys - -- See Note [Add demands for strict constructors] - cs' = addDataConStrictness data_con cs - unpk_args = zipWith3 mk_ww_arg uniqs scaled_inst_con_arg_tys cs' - unbox_fn = mkUnpackCase (Var arg) co (idMult arg) uniq1 - data_con unpk_args - arg_no_unf = zapStableUnfolding arg - -- See Note [Zap unfolding when beta-reducing] - -- in GHC.Core.Opt.Simplify; and see #13890 - rebox_fn = Let (NonRec arg_no_unf con_app) - con_app = mkConApp2 data_con inst_tys unpk_args `mkCast` mkSymCo co - ; (_, worker_args, wrap_fn, work_fn) <- mkWWstr dflags fam_envs False unpk_args - ; return (True, worker_args, unbox_fn . wrap_fn, work_fn . rebox_fn) } - -- Don't pass the arg, rebox instead - where - mk_ww_arg uniq ty sub_dmd = setIdDemandInfo (mk_ww_local uniq ty) sub_dmd + = do { (case_bndr_uniq:pat_bndrs_uniqs) <- getUniquesM + ; let ex_name_fss = map getOccFS $ dataConExTyCoVars dc + (ex_tvs', arg_ids) = + dataConRepFSInstPat (ex_name_fss ++ repeat ww_prefix) pat_bndrs_uniqs (idMult arg) dc tc_args + -- See Note [Add demands for strict constructors] + cs' = addDataConStrictness dc cs + arg_ids' = zipWithEqual "unbox_one" setIdDemandInfo arg_ids cs' + unbox_fn = mkUnpackCase (Var arg) co (idMult arg) case_bndr_uniq + dc (ex_tvs' ++ arg_ids') + arg_no_unf = zapStableUnfolding arg + -- See Note [Zap unfolding when beta-reducing] + -- in GHC.Core.Opt.Simplify; and see #13890 + rebox_fn = Let (NonRec arg_no_unf con_app) + con_app = mkConApp2 dc tc_args (ex_tvs' ++ arg_ids') `mkCast` mkSymCo co + ; (_, worker_args, wrap_fn, work_fn) <- mkWWstr dflags fam_envs False (ex_tvs' ++ arg_ids') + ; return (True, worker_args, unbox_fn . wrap_fn, work_fn . rebox_fn) } + -- Don't pass the arg, rebox instead ---------------------- nop_fn :: CoreExpr -> CoreExpr @@ -932,72 +946,67 @@ off the unpacking in mkWWstr_one (see the isClassPred test). Historical note: #14955 describes how I got this fix wrong the first time. -} --- | Context for a 'DataCon' application with a hole for every field, including --- surrounding coercions. +-- | Context for a 'DataCon' application wrapped in a cast, where we know the +-- type arguments of the 'TyCon' but not any of the arguments to the 'DataCon' +-- (type or term). +-- -- The result of 'deepSplitProductType_maybe' and 'deepSplitCprType_maybe'. -- -- Example: -- --- > DataConAppContext Just [Int] [(Lazy, Int)] (co :: Maybe Int ~ First Int) +-- > DataConAppContext Just [Int] (co :: Maybe Int ~ First Int) -- -- represents -- --- > Just @Int (_1 :: Int) |> co :: First Int +-- > (Just @_1 _2 :: Maybe Int) |> co :: First Int -- --- where _1 is a hole for the first argument. The number of arguments is --- determined by the length of @arg_tys at . data DataConAppContext = DataConAppContext - { dcac_dc :: !DataCon - , dcac_tys :: ![Type] - , dcac_arg_tys :: ![(Scaled Type, StrictnessMark)] - , dcac_co :: !Coercion + { dcac_dc :: !DataCon + , dcac_tc_args :: ![Type] + , dcac_co :: !Coercion } +-- | If @deepSplitProductType_maybe ty = Just (dc, tys, co)@ +-- then @dc \@tys \@_ex_tys (_args::_arg_tys) :: tc tys@ +-- and @co :: ty ~ tc tys@ +-- where underscore prefixes are holes, e.g. yet unspecified. deepSplitProductType_maybe :: FamInstEnvs -> Type -> Maybe DataConAppContext --- If deepSplitProductType_maybe ty = Just (dc, tys, arg_tys, co) --- then dc @ tys (args::arg_tys) :: rep_ty --- co :: ty ~ rep_ty --- Why do we return the strictness of the data-con arguments? --- Answer: see Note [Record evaluated-ness in worker/wrapper] deepSplitProductType_maybe fam_envs ty | let (co, ty1) = topNormaliseType_maybe fam_envs ty `orElse` (mkRepReflCo ty, ty) , Just (tc, tc_args) <- splitTyConApp_maybe ty1 - , Just con <- isDataProductTyCon_maybe tc - , let arg_tys = dataConInstArgTys con tc_args - strict_marks = dataConRepStrictness con - = Just DataConAppContext { dcac_dc = con - , dcac_tys = tc_args - , dcac_arg_tys = zipEqual "dspt" arg_tys strict_marks - , dcac_co = co } + , Just con <- tyConSingleAlgDataCon_maybe tc + = Just DataConAppContext { dcac_dc = con + , dcac_tc_args = tc_args + , dcac_co = co } deepSplitProductType_maybe _ _ = Nothing -deepSplitCprType_maybe - :: FamInstEnvs -> ConTag -> Type -> Maybe DataConAppContext --- If deepSplitCprType_maybe n ty = Just (dc, tys, arg_tys, co) --- then dc @ tys (args::arg_tys) :: rep_ty --- co :: ty ~ rep_ty --- Why do we return the strictness of the data-con arguments? --- Answer: see Note [Record evaluated-ness in worker/wrapper] +-- | If @deepSplitCprType_maybe n ty = Just (dc, tys, co)@ +-- then @dc \@tys \@_ex_tys (_args::_arg_tys) :: tc tys@ +-- and @co :: ty ~ tc tys@ +-- where underscore prefixes are holes, e.g. yet unspecified. +-- @dc@ is the @n at th data constructor of @tc at . +deepSplitCprType_maybe :: FamInstEnvs -> ConTag -> Type -> Maybe DataConAppContext deepSplitCprType_maybe fam_envs con_tag ty | let (co, ty1) = topNormaliseType_maybe fam_envs ty `orElse` (mkRepReflCo ty, ty) , Just (tc, tc_args) <- splitTyConApp_maybe ty1 - , isDataTyCon tc + , isDataTyCon tc -- NB: rules out unboxed sums and pairs! , let cons = tyConDataCons tc , cons `lengthAtLeast` con_tag -- This might not be true if we import the - -- type constructor via a .hs-bool file (#8743) + -- type constructor via a .hs-boot file (#8743) , let con = cons `getNth` (con_tag - fIRST_TAG) - arg_tys = dataConInstArgTys con tc_args - strict_marks = dataConRepStrictness con - , all isLinear arg_tys + , null (dataConExTyCoVars con) -- no existentials; + -- See Note [Product types] in "GHC.Core.TyCon" + -- and GHC.Core.Opt.CprAnal.extendEnvForDataAlt + -- where we also check this. + , all isLinear (dataConInstArgTys con tc_args) -- Deactivates CPR worker/wrapper splits on constructors with non-linear -- arguments, for the moment, because they require unboxed tuple with variable -- multiplicity fields. = Just DataConAppContext { dcac_dc = con - , dcac_tys = tc_args - , dcac_arg_tys = zipEqual "dspt" arg_tys strict_marks + , dcac_tc_args = tc_args , dcac_co = co } deepSplitCprType_maybe _ _ _ = Nothing @@ -1035,13 +1044,15 @@ findTypeShape fam_envs ty | Just (_, rhs, _) <- topReduceTyFamApp_maybe fam_envs tc tc_args = go rec_tc rhs - | Just con <- isDataProductTyCon_maybe tc + | Just con <- tyConSingleAlgDataCon_maybe tc , Just rec_tc <- if isTupleTyCon tc then Just rec_tc else checkRecTc rec_tc tc -- We treat tuples specially because they can't cause loops. -- Maybe we should do so in checkRecTc. - = TsProd (map (go rec_tc . scaledThing) (dataConInstArgTys con tc_args)) + -- The use of 'dubiousDataConInstArgTys' is OK, since this + -- function performs no substitution at all. + = TsProd (map (go rec_tc . scaledThing) (dubiousDataConInstArgTys con tc_args)) | Just (ty', _) <- instNewTyCon_maybe tc tc_args , Just rec_tc <- checkRecTc rec_tc tc @@ -1093,25 +1104,26 @@ mkWWcpr opt_CprAnal fam_envs body_ty cpr mkWWcpr_help :: DataConAppContext -> UniqSM (Bool, CoreExpr -> CoreExpr, CoreExpr -> CoreExpr, Type) -mkWWcpr_help (DataConAppContext { dcac_dc = data_con, dcac_tys = inst_tys - , dcac_arg_tys = arg_tys, dcac_co = co }) - | [arg1@(arg_ty1, _)] <- arg_tys - , isUnliftedType (scaledThing arg_ty1) - , isLinear arg_ty1 +mkWWcpr_help (DataConAppContext { dcac_dc = dc, dcac_tc_args = tc_args + , dcac_co = co }) + | [arg_ty] <- arg_tys + , [str_mark] <- str_marks + , isUnliftedType (scaledThing arg_ty) + , isLinear arg_ty -- Special case when there is a single result of unlifted, linear, type -- -- Wrapper: case (..call worker..) of x -> C x -- Worker: case ( ..body.. ) of C x -> x = do { (work_uniq : arg_uniq : _) <- getUniquesM - ; let arg = mk_ww_local arg_uniq arg1 - con_app = mkConApp2 data_con inst_tys [arg] `mkCast` mkSymCo co + ; let arg_id = mk_ww_local arg_uniq str_mark arg_ty + con_app = mkConApp2 dc tc_args [arg_id] `mkCast` mkSymCo co ; return ( True - , \ wkr_call -> mkDefaultCase wkr_call arg con_app - , \ body -> mkUnpackCase body co One work_uniq data_con [arg] (varToCoreExpr arg) + , \ wkr_call -> mkDefaultCase wkr_call arg_id con_app + , \ body -> mkUnpackCase body co One work_uniq dc [arg_id] (varToCoreExpr arg_id) -- varToCoreExpr important here: arg can be a coercion -- Lacking this caused #10658 - , scaledThing arg_ty1 ) } + , scaledThing arg_ty ) } | otherwise -- The general case -- Wrapper: case (..call worker..) of (# a, b #) -> C a b @@ -1123,19 +1135,26 @@ mkWWcpr_help (DataConAppContext { dcac_dc = data_con, dcac_tys = inst_tys -- parametrised by the multiplicity of its fields. Specifically, in this -- instance, the multiplicity of the fields of (#,#) is chosen to be the -- same as those of C. - = do { (work_uniq : wild_uniq : uniqs) <- getUniquesM - ; let wrap_wild = mk_ww_local wild_uniq (linear ubx_tup_ty,MarkedStrict) - args = zipWith mk_ww_local uniqs arg_tys - ubx_tup_ty = exprType ubx_tup_app - ubx_tup_app = mkCoreUbxTup (map (scaledThing . fst) arg_tys) (map varToCoreExpr args) - con_app = mkConApp2 data_con inst_tys args `mkCast` mkSymCo co - tup_con = tupleDataCon Unboxed (length arg_tys) + = do { (work_uniq : wild_uniq : pat_bndrs_uniqs) <- getUniquesM + ; let case_mult = One -- see above + (_exs, arg_ids) = + dataConRepFSInstPat (repeat ww_prefix) pat_bndrs_uniqs case_mult dc tc_args + wrap_wild = mk_ww_local wild_uniq MarkedStrict (Scaled case_mult ubx_tup_ty) + ubx_tup_ty = exprType ubx_tup_app + ubx_tup_app = mkCoreUbxTup (map scaledThing arg_tys) (map varToCoreExpr arg_ids) + con_app = mkConApp2 dc tc_args arg_ids `mkCast` mkSymCo co + tup_con = tupleDataCon Unboxed (length arg_tys) + + ; MASSERT( null _exs ) -- Should have been caught by deepSplitCprType_maybe ; return (True , \ wkr_call -> mkSingleAltCase wkr_call wrap_wild - (DataAlt tup_con) args con_app - , \ body -> mkUnpackCase body co One work_uniq data_con args ubx_tup_app + (DataAlt tup_con) arg_ids con_app + , \ body -> mkUnpackCase body co case_mult work_uniq dc arg_ids ubx_tup_app , ubx_tup_ty ) } + where + arg_tys = dataConInstArgTys dc tc_args -- NB: No existentials! + str_marks = dataConRepStrictness dc mkUnpackCase :: CoreExpr -> Coercion -> Mult -> Unique -> DataCon -> [Id] -> CoreExpr -> CoreExpr -- (mkUnpackCase e co uniq Con args body) @@ -1149,7 +1168,7 @@ mkUnpackCase scrut co mult uniq boxing_con unpk_args body (DataAlt boxing_con) unpk_args body where casted_scrut = scrut `mkCast` co - bndr = mk_ww_local uniq (Scaled mult (exprType casted_scrut), MarkedStrict) + bndr = mk_ww_local uniq MarkedStrict (Scaled mult (exprType casted_scrut)) -- An unpacking case can always be chosen linear, because the variables -- are always passed to a constructor. This limits the {- @@ -1291,10 +1310,13 @@ mk_absent_let dflags fam_envs arg -- See also Note [Unique Determinism] in GHC.Types.Unique unlifted_rhs = mkTyApps (Lit rubbishLit) [arg_ty] -mk_ww_local :: Unique -> (Scaled Type, StrictnessMark) -> Id +ww_prefix :: FastString +ww_prefix = fsLit "ww" + +mk_ww_local :: Unique -> StrictnessMark -> Scaled Type -> Id -- The StrictnessMark comes form the data constructor and says -- whether this field is strict -- See Note [Record evaluated-ness in worker/wrapper] -mk_ww_local uniq (Scaled w ty,str) +mk_ww_local uniq str (Scaled w ty) = setCaseBndrEvald str $ - mkSysLocalOrCoVar (fsLit "ww") uniq w ty + mkSysLocalOrCoVar ww_prefix uniq w ty ===================================== compiler/GHC/Core/TyCon.hs ===================================== @@ -58,8 +58,7 @@ module GHC.Core.TyCon( isKindTyCon, isLiftedTypeKindTyConName, isTauTyCon, isFamFreeTyCon, - isDataTyCon, isProductTyCon, isDataProductTyCon_maybe, - isDataSumTyCon_maybe, + isDataTyCon, isEnumerationTyCon, isNewTyCon, isAbstractTyCon, isFamilyTyCon, isOpenFamilyTyCon, @@ -84,6 +83,7 @@ module GHC.Core.TyCon( tyConCType, tyConCType_maybe, tyConDataCons, tyConDataCons_maybe, tyConSingleDataCon_maybe, tyConSingleDataCon, + tyConAlgDataCons_maybe, tyConSingleAlgDataCon_maybe, tyConFamilySize, tyConStupidTheta, @@ -143,7 +143,7 @@ import {-# SOURCE #-} GHC.Builtin.Types , multiplicityTyCon , vecCountTyCon, vecElemTyCon, liftedTypeKind ) import {-# SOURCE #-} GHC.Core.DataCon - ( DataCon, dataConExTyCoVars, dataConFieldLabels + ( DataCon, dataConFieldLabels , dataConTyCon, dataConFullSig , isUnboxedSumDataCon ) import GHC.Builtin.Uniques @@ -1970,72 +1970,6 @@ unwrapNewTyConEtad_maybe (AlgTyCon { algTcRhs = NewTyCon { nt_co = co, = Just (tvs, rhs, co) unwrapNewTyConEtad_maybe _ = Nothing -isProductTyCon :: TyCon -> Bool --- True of datatypes or newtypes that have --- one, non-existential, data constructor --- See Note [Product types] -isProductTyCon tc@(AlgTyCon {}) - = case algTcRhs tc of - TupleTyCon {} -> True - DataTyCon{ data_cons = [data_con] } - -> null (dataConExTyCoVars data_con) - NewTyCon {} -> True - _ -> False -isProductTyCon _ = False - -isDataProductTyCon_maybe :: TyCon -> Maybe DataCon --- True of datatypes (not newtypes) with --- one, vanilla, data constructor --- See Note [Product types] -isDataProductTyCon_maybe (AlgTyCon { algTcRhs = rhs }) - = case rhs of - DataTyCon { data_cons = [con] } - | null (dataConExTyCoVars con) -- non-existential - -> Just con - TupleTyCon { data_con = con } - -> Just con - _ -> Nothing -isDataProductTyCon_maybe _ = Nothing - -isDataSumTyCon_maybe :: TyCon -> Maybe [DataCon] -isDataSumTyCon_maybe (AlgTyCon { algTcRhs = rhs }) - = case rhs of - DataTyCon { data_cons = cons } - | cons `lengthExceeds` 1 - , all (null . dataConExTyCoVars) cons -- FIXME(osa): Why do we need this? - -> Just cons - SumTyCon { data_cons = cons } - | all (null . dataConExTyCoVars) cons -- FIXME(osa): Why do we need this? - -> Just cons - _ -> Nothing -isDataSumTyCon_maybe _ = Nothing - -{- Note [Product types] -~~~~~~~~~~~~~~~~~~~~~~~ -A product type is - * A data type (not a newtype) - * With one, boxed data constructor - * That binds no existential type variables - -The main point is that product types are amenable to unboxing for - * Strict function calls; we can transform - f (D a b) = e - to - fw a b = e - via the worker/wrapper transformation. (Question: couldn't this - work for existentials too?) - - * CPR for function results; we can transform - f x y = let ... in D a b - to - fw x y = let ... in (# a, b #) - -Note that the data constructor /can/ have evidence arguments: equality -constraints, type classes etc. So it can be GADT. These evidence -arguments are simply value arguments, and should not get in the way. --} - - -- | Is this a 'TyCon' representing a regular H98 type synonym (@type@)? {-# INLINE isTypeSynonymTyCon #-} -- See Note [Inlining coreView] in GHC.Core.Type isTypeSynonymTyCon :: TyCon -> Bool @@ -2363,8 +2297,7 @@ tyConDataCons_maybe _ = Nothing -- | If the given 'TyCon' has a /single/ data constructor, i.e. it is a @data@ -- type with one alternative, a tuple type or a @newtype@ then that constructor -- is returned. If the 'TyCon' has more than one constructor, or represents a --- primitive or function type constructor then @Nothing@ is returned. In any --- other case, the function panics +-- primitive or function type constructor then @Nothing@ is returned. tyConSingleDataCon_maybe :: TyCon -> Maybe DataCon tyConSingleDataCon_maybe (AlgTyCon { algTcRhs = rhs }) = case rhs of @@ -2374,21 +2307,31 @@ tyConSingleDataCon_maybe (AlgTyCon { algTcRhs = rhs }) _ -> Nothing tyConSingleDataCon_maybe _ = Nothing +-- | Like 'tyConSingleDataCon_maybe', but panics if 'Nothing'. tyConSingleDataCon :: TyCon -> DataCon tyConSingleDataCon tc = case tyConSingleDataCon_maybe tc of Just c -> c Nothing -> pprPanic "tyConDataCon" (ppr tc) +-- | Like 'tyConSingleDataCon_maybe', but returns 'Nothing' for newtypes. +-- +-- These are the 'TyCon's we want to unbox. See Note [Product types]. tyConSingleAlgDataCon_maybe :: TyCon -> Maybe DataCon --- Returns (Just con) for single-constructor --- *algebraic* data types *not* newtypes -tyConSingleAlgDataCon_maybe (AlgTyCon { algTcRhs = rhs }) - = case rhs of - DataTyCon { data_cons = [c] } -> Just c - TupleTyCon { data_con = c } -> Just c - _ -> Nothing -tyConSingleAlgDataCon_maybe _ = Nothing +tyConSingleAlgDataCon_maybe tycon + | isNewTyCon tycon = Nothing + | otherwise = tyConSingleDataCon_maybe tycon + +-- | Returns @Just dcs@ if the given 'TyCon' is a @data@ type, a tuple type +-- or a sum type with data constructors dcs. If the 'TyCon' has more than one +-- constructor, or represents a primitive or function type constructor then +-- @Nothing@ is returned. +-- +-- Like 'tyConDataCons_maybe', but returns 'Nothing' for newtypes. +tyConAlgDataCons_maybe :: TyCon -> Maybe [DataCon] +tyConAlgDataCons_maybe tycon + | isNewTyCon tycon = Nothing + | otherwise = tyConDataCons_maybe tycon -- | Determine the number of value constructors a 'TyCon' has. Panics if the -- 'TyCon' is not algebraic or a tuple @@ -2408,6 +2351,31 @@ algTyConRhs :: TyCon -> AlgTyConRhs algTyConRhs (AlgTyCon {algTcRhs = rhs}) = rhs algTyConRhs other = pprPanic "algTyConRhs" (ppr other) +{- Note [Product types] +~~~~~~~~~~~~~~~~~~~~~~~ +A product type is + * A data type (not a newtype) + * With one data constructor + +The main point is that product types are amenable to unboxing for + * Strict function calls; we can transform + f (D @ex a b) = e + to + fw @ex a b = e + via the worker/wrapper transformation. + + * CPR for function results (if the data con has no existentials); we can + transform + f x y = let ... in D a b + to + fw x y = let ... in (# a, b #) + +Note that the data constructor /can/ have evidence arguments: equality +constraints, type classes etc. So it can be GADT. These evidence +arguments are simply value arguments, and should not get in the way. +-} + + -- | Extract type variable naming the result of injective type family tyConFamilyResVar_maybe :: TyCon -> Maybe Name tyConFamilyResVar_maybe (FamilyTyCon {famTcResVar = res}) = res ===================================== compiler/GHC/CoreToIface.hs ===================================== @@ -245,7 +245,7 @@ toIfaceTyCon tc , Just tsort <- tupleSort tc' = tsort | isUnboxedSumTyCon tc - , Just cons <- isDataSumTyCon_maybe tc = IfaceSumTyCon (length cons) + , Just cons <- tyConDataCons_maybe tc = IfaceSumTyCon (length cons) | otherwise = IfaceNormalTyCon ===================================== compiler/GHC/Hs/Pat.hs ===================================== @@ -771,8 +771,6 @@ isIrrefutableHsPat L _ (PatSynCon _pat) -> False -- Conservative L _ (RealDataCon con) -> isJust (tyConSingleDataCon_maybe (dataConTyCon con)) - -- NB: tyConSingleDataCon_maybe, *not* isProductTyCon, because - -- the latter is false of existentials. See #4439 && all goL (hsConPatArgs details) go (LitPat {}) = False go (NPat {}) = False ===================================== compiler/GHC/HsToCore/Foreign/Call.hs ===================================== @@ -353,7 +353,8 @@ resultWrapper result_ty -- Data types with a single constructor, which has a single arg -- This includes types like Ptr and ForeignPtr | Just (tycon, tycon_arg_tys) <- maybe_tc_app - , Just data_con <- isDataProductTyCon_maybe tycon -- One constructor, no existentials + , Just data_con <- tyConSingleAlgDataCon_maybe tycon -- One constructor + , null (dataConExTyCoVars data_con) -- no existentials , [Scaled _ unwrapped_res_ty] <- dataConInstOrigArgTys data_con tycon_arg_tys -- One argument = do { dflags <- getDynFlags ; let platform = targetPlatform dflags ===================================== compiler/GHC/HsToCore/Utils.hs ===================================== @@ -737,7 +737,7 @@ is_flat_prod_pat (TuplePat _ ps Boxed) = all is_triv_lpat ps is_flat_prod_pat (ConPat { pat_con = L _ pcon , pat_args = ps}) | RealDataCon con <- pcon - , isProductTyCon (dataConTyCon con) + , Just _ <- tyConSingleDataCon_maybe (dataConTyCon con) = all is_triv_lpat (hsConPatArgs ps) is_flat_prod_pat _ = False ===================================== compiler/GHC/Tc/Deriv/Utils.hs ===================================== @@ -928,8 +928,8 @@ cond_isEnumeration _ _ rep_tc cond_isProduct :: Condition cond_isProduct _ _ rep_tc - | isProductTyCon rep_tc = IsValid - | otherwise = NotValid why + | Just _ <- tyConSingleDataCon_maybe rep_tc = IsValid + | otherwise = NotValid why where why = quotes (pprSourceTyCon rep_tc) <+> text "must have precisely one constructor" ===================================== testsuite/tests/simplCore/should_compile/T18013.stderr ===================================== @@ -132,33 +132,58 @@ Result size of Tidy Core = {terms: 52, types: 106, coercions: 17, joins: 0/1} -- RHS size: {terms: 37, types: 87, coercions: 17, joins: 0/1} -mapMaybeRule +mapMaybeRule [InlPrag=[2]] :: forall a b. Rule IO a b -> Rule IO (Maybe a) (Maybe b) [GblId, Arity=1, - Str=, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 150 10}] + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (@a) (@b) (w [Occ=Once1!] :: Rule IO a b) -> + case w of { Rule @s ww1 ww2 [Occ=OnceL1!] -> + T18013a.Rule + @IO + @(Maybe a) + @(Maybe b) + @s + ww1 + ((\ (s2 [Occ=Once1] :: s) + (a1 [Occ=Once1!] :: Maybe a) + (s1 [Occ=Once2] :: GHC.Prim.State# GHC.Prim.RealWorld) -> + case a1 of { + Nothing -> + (# s1, T18013a.Result @s @(Maybe b) ww1 (GHC.Maybe.Nothing @b) #); + Just x [Occ=Once1] -> + case ((ww2 s2 x) `cast` ) s1 of + { (# ipv [Occ=Once1], ipv1 [Occ=Once1!] #) -> + case ipv1 of { Result t2 [Occ=Once1] c1 [Occ=Once1] -> + (# ipv, T18013a.Result @s @(Maybe b) t2 (GHC.Maybe.Just @b c1) #) + } + } + }) + `cast` ) + }}] mapMaybeRule - = \ (@a) (@b) (f :: Rule IO a b) -> - case f of { Rule @s t0 g -> + = \ (@a) (@b) (w :: Rule IO a b) -> + case w of { Rule @s ww1 ww2 -> let { lvl :: Result s (Maybe b) [LclId, Unf=OtherCon []] - lvl = T18013a.Result @s @(Maybe b) t0 (GHC.Maybe.Nothing @b) } in + lvl = T18013a.Result @s @(Maybe b) ww1 (GHC.Maybe.Nothing @b) } in T18013a.Rule @IO @(Maybe a) @(Maybe b) @s - t0 + ww1 ((\ (s2 :: s) (a1 :: Maybe a) (s1 :: GHC.Prim.State# GHC.Prim.RealWorld) -> case a1 of { Nothing -> (# s1, lvl #); Just x -> - case ((g s2 x) `cast` ) s1 of { (# ipv, ipv1 #) -> + case ((ww2 s2 x) `cast` ) s1 of { (# ipv, ipv1 #) -> case ipv1 of { Result t2 c1 -> (# ipv, T18013a.Result @s @(Maybe b) t2 (GHC.Maybe.Just @b c1) #) } ===================================== testsuite/tests/stranal/should_compile/T18982.hs ===================================== @@ -0,0 +1,33 @@ +{-# OPTIONS_GHC -O -fforce-recomp #-} +{-# LANGUAGE GADTs #-} + +module T18982 where + +data Box a where + Box :: a -> Box a + +data Ex a where + Ex :: e -> a -> Ex a + +data GADT a where + GADT :: Int -> GADT Int + +data ExGADT a where + ExGADT :: (e ~ Int) => e -> Int -> ExGADT Int + +f :: Box Int -> Int +f (Box n) = n + 1 +{-# NOINLINE f #-} + +g :: Ex Int -> Int +g (Ex e n) = e `seq` n + 1 +{-# NOINLINE g #-} + +h :: GADT a -> Int +h (GADT n) = n + 1 +{-# NOINLINE h #-} + +i :: ExGADT a -> Int +i (ExGADT e n) = e `seq` n + 1 +{-# NOINLINE i #-} + ===================================== testsuite/tests/stranal/should_compile/T18982.stderr ===================================== @@ -0,0 +1,246 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core = {terms: 311, types: 249, coercions: 4, joins: 0/0} + +-- RHS size: {terms: 8, types: 11, coercions: 1, joins: 0/0} +T18982.$WExGADT :: forall e. (e ~ Int) => e %1 -> Int %1 -> ExGADT Int +T18982.$WExGADT = \ (@e) (dt :: e ~ Int) (dt :: e) (dt :: Int) -> T18982.ExGADT @Int @e @~(_N :: Int GHC.Prim.~# Int) dt dt dt + +-- RHS size: {terms: 3, types: 2, coercions: 1, joins: 0/0} +T18982.$WGADT :: Int %1 -> GADT Int +T18982.$WGADT = \ (dt :: Int) -> T18982.GADT @Int @~(_N :: Int GHC.Prim.~# Int) dt + +-- RHS size: {terms: 7, types: 8, coercions: 0, joins: 0/0} +T18982.$WEx :: forall e a. e %1 -> a %1 -> Ex a +T18982.$WEx = \ (@e) (@a) (dt :: e) (dt :: a) -> T18982.Ex @a @e dt dt + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$trModule4 :: GHC.Prim.Addr# +T18982.$trModule4 = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$trModule3 :: GHC.Types.TrName +T18982.$trModule3 = GHC.Types.TrNameS T18982.$trModule4 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$trModule2 :: GHC.Prim.Addr# +T18982.$trModule2 = "T18982"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$trModule1 :: GHC.Types.TrName +T18982.$trModule1 = GHC.Types.TrNameS T18982.$trModule2 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18982.$trModule :: GHC.Types.Module +T18982.$trModule = GHC.Types.Module T18982.$trModule3 T18982.$trModule1 + +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} +$krep :: GHC.Types.KindRep +$krep = GHC.Types.KindRepTyConApp GHC.Types.$tcInt (GHC.Types.[] @GHC.Types.KindRep) + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$krep1 :: GHC.Types.KindRep +$krep1 = GHC.Types.KindRepVar 1# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$krep2 :: GHC.Types.KindRep +$krep2 = GHC.Types.KindRepVar 0# + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +$krep3 :: [GHC.Types.KindRep] +$krep3 = GHC.Types.: @GHC.Types.KindRep $krep (GHC.Types.[] @GHC.Types.KindRep) + +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} +$krep4 :: [GHC.Types.KindRep] +$krep4 = GHC.Types.: @GHC.Types.KindRep $krep2 $krep3 + +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} +$krep5 :: [GHC.Types.KindRep] +$krep5 = GHC.Types.: @GHC.Types.KindRep GHC.Types.krep$* $krep4 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep6 :: GHC.Types.KindRep +$krep6 = GHC.Types.KindRepTyConApp GHC.Types.$tc~ $krep5 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tcBox2 :: GHC.Prim.Addr# +T18982.$tcBox2 = "Box"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tcBox1 :: GHC.Types.TrName +T18982.$tcBox1 = GHC.Types.TrNameS T18982.$tcBox2 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tcBox :: GHC.Types.TyCon +T18982.$tcBox = GHC.Types.TyCon 16948648223906549518## 2491460178135962649## T18982.$trModule T18982.$tcBox1 0# GHC.Types.krep$*Arr* + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +$krep7 :: [GHC.Types.KindRep] +$krep7 = GHC.Types.: @GHC.Types.KindRep $krep2 (GHC.Types.[] @GHC.Types.KindRep) + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep8 :: GHC.Types.KindRep +$krep8 = GHC.Types.KindRepTyConApp T18982.$tcBox $krep7 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Box1 :: GHC.Types.KindRep +T18982.$tc'Box1 = GHC.Types.KindRepFun $krep2 $krep8 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Box3 :: GHC.Prim.Addr# +T18982.$tc'Box3 = "'Box"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Box2 :: GHC.Types.TrName +T18982.$tc'Box2 = GHC.Types.TrNameS T18982.$tc'Box3 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Box :: GHC.Types.TyCon +T18982.$tc'Box = GHC.Types.TyCon 1412068769125067428## 8727214667407894081## T18982.$trModule T18982.$tc'Box2 1# T18982.$tc'Box1 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tcEx2 :: GHC.Prim.Addr# +T18982.$tcEx2 = "Ex"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tcEx1 :: GHC.Types.TrName +T18982.$tcEx1 = GHC.Types.TrNameS T18982.$tcEx2 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tcEx :: GHC.Types.TyCon +T18982.$tcEx = GHC.Types.TyCon 4376661818164435927## 18005417598910668817## T18982.$trModule T18982.$tcEx1 0# GHC.Types.krep$*Arr* + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +$krep9 :: [GHC.Types.KindRep] +$krep9 = GHC.Types.: @GHC.Types.KindRep $krep1 (GHC.Types.[] @GHC.Types.KindRep) + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep10 :: GHC.Types.KindRep +$krep10 = GHC.Types.KindRepTyConApp T18982.$tcEx $krep9 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep11 :: GHC.Types.KindRep +$krep11 = GHC.Types.KindRepFun $krep1 $krep10 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Ex1 :: GHC.Types.KindRep +T18982.$tc'Ex1 = GHC.Types.KindRepFun $krep2 $krep11 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Ex3 :: GHC.Prim.Addr# +T18982.$tc'Ex3 = "'Ex"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Ex2 :: GHC.Types.TrName +T18982.$tc'Ex2 = GHC.Types.TrNameS T18982.$tc'Ex3 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Ex :: GHC.Types.TyCon +T18982.$tc'Ex = GHC.Types.TyCon 14609381081172201359## 3077219645053200509## T18982.$trModule T18982.$tc'Ex2 2# T18982.$tc'Ex1 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tcGADT2 :: GHC.Prim.Addr# +T18982.$tcGADT2 = "GADT"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tcGADT1 :: GHC.Types.TrName +T18982.$tcGADT1 = GHC.Types.TrNameS T18982.$tcGADT2 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tcGADT :: GHC.Types.TyCon +T18982.$tcGADT = GHC.Types.TyCon 9243924476135839950## 5096619276488416461## T18982.$trModule T18982.$tcGADT1 0# GHC.Types.krep$*Arr* + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep12 :: GHC.Types.KindRep +$krep12 = GHC.Types.KindRepTyConApp T18982.$tcGADT $krep3 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'GADT1 :: GHC.Types.KindRep +T18982.$tc'GADT1 = GHC.Types.KindRepFun $krep $krep12 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'GADT3 :: GHC.Prim.Addr# +T18982.$tc'GADT3 = "'GADT"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'GADT2 :: GHC.Types.TrName +T18982.$tc'GADT2 = GHC.Types.TrNameS T18982.$tc'GADT3 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'GADT :: GHC.Types.TyCon +T18982.$tc'GADT = GHC.Types.TyCon 2077850259354179864## 16731205864486799217## T18982.$trModule T18982.$tc'GADT2 0# T18982.$tc'GADT1 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tcExGADT2 :: GHC.Prim.Addr# +T18982.$tcExGADT2 = "ExGADT"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tcExGADT1 :: GHC.Types.TrName +T18982.$tcExGADT1 = GHC.Types.TrNameS T18982.$tcExGADT2 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tcExGADT :: GHC.Types.TyCon +T18982.$tcExGADT = GHC.Types.TyCon 6470898418160489500## 10361108917441214060## T18982.$trModule T18982.$tcExGADT1 0# GHC.Types.krep$*Arr* + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep13 :: GHC.Types.KindRep +$krep13 = GHC.Types.KindRepTyConApp T18982.$tcExGADT $krep3 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep14 :: GHC.Types.KindRep +$krep14 = GHC.Types.KindRepFun $krep $krep13 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep15 :: GHC.Types.KindRep +$krep15 = GHC.Types.KindRepFun $krep2 $krep14 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'ExGADT1 :: GHC.Types.KindRep +T18982.$tc'ExGADT1 = GHC.Types.KindRepFun $krep6 $krep15 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'ExGADT3 :: GHC.Prim.Addr# +T18982.$tc'ExGADT3 = "'ExGADT"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'ExGADT2 :: GHC.Types.TrName +T18982.$tc'ExGADT2 = GHC.Types.TrNameS T18982.$tc'ExGADT3 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'ExGADT :: GHC.Types.TyCon +T18982.$tc'ExGADT = GHC.Types.TyCon 8468257409157161049## 5503123603717080600## T18982.$trModule T18982.$tc'ExGADT2 1# T18982.$tc'ExGADT1 + +-- RHS size: {terms: 11, types: 14, coercions: 0, joins: 0/0} +T18982.$wi :: forall {a} {e}. (a GHC.Prim.~# Int) -> e -> GHC.Prim.Int# -> GHC.Prim.Int# +T18982.$wi = \ (@a) (@e) (ww :: a GHC.Prim.~# Int) (ww1 :: e) (ww2 :: GHC.Prim.Int#) -> case ww1 of { __DEFAULT -> GHC.Prim.+# ww2 1# } + +-- RHS size: {terms: 15, types: 27, coercions: 1, joins: 0/0} +i :: forall a. ExGADT a -> Int +i = \ (@a) (w :: ExGADT a) -> case w of { ExGADT @e ww1 ww2 ww3 ww4 -> case ww4 of { GHC.Types.I# ww6 -> case T18982.$wi @a @e @~(ww1 :: a GHC.Prim.~# Int) ww3 ww6 of ww7 { __DEFAULT -> GHC.Types.I# ww7 } } } + +-- RHS size: {terms: 6, types: 10, coercions: 0, joins: 0/0} +T18982.$wh :: forall {a}. (a GHC.Prim.~# Int) -> GHC.Prim.Int# -> GHC.Prim.Int# +T18982.$wh = \ (@a) (ww :: a GHC.Prim.~# Int) (ww1 :: GHC.Prim.Int#) -> GHC.Prim.+# ww1 1# + +-- RHS size: {terms: 14, types: 18, coercions: 1, joins: 0/0} +h :: forall a. GADT a -> Int +h = \ (@a) (w :: GADT a) -> case w of { GADT ww1 ww2 -> case ww2 of { GHC.Types.I# ww4 -> case T18982.$wh @a @~(ww1 :: a GHC.Prim.~# Int) ww4 of ww5 { __DEFAULT -> GHC.Types.I# ww5 } } } + +-- RHS size: {terms: 9, types: 5, coercions: 0, joins: 0/0} +T18982.$wg :: forall {e}. e -> GHC.Prim.Int# -> GHC.Prim.Int# +T18982.$wg = \ (@e) (ww :: e) (ww1 :: GHC.Prim.Int#) -> case ww of { __DEFAULT -> GHC.Prim.+# ww1 1# } + +-- RHS size: {terms: 14, types: 12, coercions: 0, joins: 0/0} +g :: Ex Int -> Int +g = \ (w :: Ex Int) -> case w of { Ex @e ww1 ww2 -> case ww2 of { GHC.Types.I# ww4 -> case T18982.$wg @e ww1 ww4 of ww5 { __DEFAULT -> GHC.Types.I# ww5 } } } + +-- RHS size: {terms: 4, types: 1, coercions: 0, joins: 0/0} +T18982.$wf :: GHC.Prim.Int# -> GHC.Prim.Int# +T18982.$wf = \ (ww :: GHC.Prim.Int#) -> GHC.Prim.+# ww 1# + +-- RHS size: {terms: 13, types: 8, coercions: 0, joins: 0/0} +f :: Box Int -> Int +f = \ (w :: Box Int) -> case w of { Box ww1 -> case ww1 of { GHC.Types.I# ww3 -> case T18982.$wf ww3 of ww4 { __DEFAULT -> GHC.Types.I# ww4 } } } + + + ===================================== testsuite/tests/stranal/should_compile/all.T ===================================== @@ -62,3 +62,5 @@ test('T18903', [ grep_errmsg(r'Dmd=\S+C\S+') ], compile, ['-ddump-simpl -dsuppr test('T18894', [ grep_errmsg(r'Dmd=\S+C\S+') ], compile, ['-ddump-stranal -dsuppress-uniques']) # We care about the Arity 2 on eta, as a result of the annotated Dmd test('T18894b', [ grep_errmsg(r'Arity=2') ], compile, ['-ddump-stranal -dsuppress-uniques -fno-call-arity -dppr-cols=200']) +# We care about the workers of f,g,h,i: +test('T18982', [ grep_errmsg(r'\$w. .*Int#$') ], compile, ['-dppr-cols=1000 -ddump-simpl -dsuppress-idinfo -dsuppress-uniques']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eda02f1eb2d90464cd09551ea2bb6e6cc98e7e98 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eda02f1eb2d90464cd09551ea2bb6e6cc98e7e98 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 4 14:52:34 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Fri, 04 Dec 2020 09:52:34 -0500 Subject: [Git][ghc/ghc][wip/T18894] 2 commits: DmdAnal: Annotate top-level function bindings with demands (#18894) Message-ID: <5fca4d324be01_6b2122cc845494a@gitlab.mail> Sebastian Graf pushed to branch wip/T18894 at Glasgow Haskell Compiler / GHC Commits: a5fe3ee4 by Sebastian Graf at 2020-12-04T15:52:24+01:00 DmdAnal: Annotate top-level function bindings with demands (#18894) It's useful to annotate a non-exported top-level function like `g` in ```hs module Lib (h) where g :: Int -> Int -> (Int,Int) g m 1 = (m, 0) g m n = (2 * m, 2 `div` n) {-# NOINLINE g #-} h :: Int -> Int h 1 = 0 h m | odd m = snd (g m 2) | otherwise = uncurry (+) (g 2 m) ``` with its demand `UCU(CS(P(1P(U),SP(U))`, which tells us that whenever `g` was called, the second component of the returned pair was evaluated strictly. Since #18903 we do so for local functions, where we can see all calls. For top-level functions, we can assume that all *exported* functions are demanded according to `topDmd` and thus get sound demands for non-exported top-level functions. The demand on `g` is crucial information for Nested CPR, which may the go on and unbox `g` for the second pair component. That is true even if that pair component may diverge, as is the case for the call site `g 13 0`, which throws a div-by-zero exception. In `T18894b`, you can even see the new demand annotation enabling us to eta-expand a function that we wouldn't be able to eta-expand without Call Arity. We only track bindings of function type in order not to risk huge compile-time regressions, see `isInterestingTopLevelFn`. There was a CoreLint check that rejected strict demand annotations on recursive or top-level bindings, which seems completely unjustified. All the cases I investigated were fine, so I removed it. Fixes #18894. - - - - - eb30d28f by Sebastian Graf at 2020-12-04T15:52:24+01:00 Demand: Simplify `CU(U)` to `U` (#19005) Both sub-demands encode the same information. This is a trivial change and already affects a few regression tests (e.g. `T5075`), so no separate regression test is necessary. - - - - - 18 changed files: - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Types/Demand.hs - compiler/GHC/Types/Id/Info.hs - testsuite/tests/arityanal/should_compile/Arity11.stderr - testsuite/tests/arityanal/should_compile/Arity16.stderr - + testsuite/tests/stranal/should_compile/T18894.hs - + testsuite/tests/stranal/should_compile/T18894.stderr - + testsuite/tests/stranal/should_compile/T18894b.hs - + testsuite/tests/stranal/should_compile/T18894b.stderr - testsuite/tests/stranal/should_compile/all.T - testsuite/tests/stranal/sigs/T5075.stderr Changes: ===================================== compiler/GHC/Core/FVs.hs ===================================== @@ -525,12 +525,11 @@ ruleLhsFVIds (Rule { ru_bndrs = bndrs, ru_args = args }) = filterFV isLocalId $ addBndrs bndrs (exprs_fvs args) ruleRhsFreeIds :: CoreRule -> VarSet --- ^ This finds all locally-defined free Ids on the left hand side of a rule +-- ^ This finds all locally-defined free Ids on the right hand side of a rule -- and returns them as a non-deterministic set ruleRhsFreeIds (BuiltinRule {}) = emptyVarSet -ruleRhsFreeIds (Rule { ru_bndrs = bndrs, ru_args = args }) - = fvVarSet $ filterFV isLocalId $ - addBndrs bndrs $ exprs_fvs args +ruleRhsFreeIds (Rule { ru_bndrs = bndrs, ru_rhs = rhs }) + = fvVarSet $ filterFV isLocalId $ addBndrs bndrs $ expr_fvs rhs {- Note [Rule free var hack] (Not a hack any more) ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -623,14 +623,6 @@ lintLetBind top_lvl rec_flag binder rhs rhs_ty || exprIsTickedString rhs) (badBndrTyMsg binder (text "unlifted")) - -- Check that if the binder is top-level or recursive, it's not - -- demanded. Primitive string literals are exempt as there is no - -- computation to perform, see Note [Core top-level string literals]. - ; checkL (not (isStrictId binder) - || (isNonRec rec_flag && not (isTopLevel top_lvl)) - || exprIsTickedString rhs) - (mkStrictMsg binder) - -- Check that if the binder is at the top level and has type Addr#, -- that it is a string literal, see -- Note [Core top-level string literals]. @@ -3119,13 +3111,6 @@ badBndrTyMsg binder what = vcat [ text "The type of this binder is" <+> what <> colon <+> ppr binder , text "Binder's type:" <+> ppr (idType binder) ] -mkStrictMsg :: Id -> MsgDoc -mkStrictMsg binder - = vcat [hsep [text "Recursive or top-level binder has strict demand info:", - ppr binder], - hsep [text "Binder's demand info:", ppr (idDemandInfo binder)] - ] - mkNonTopExportedMsg :: Id -> MsgDoc mkNonTopExportedMsg binder = hsep [text "Non-top-level binder is marked as exported:", ppr binder] ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -37,6 +37,7 @@ import GHC.Core.Type import GHC.Core.FVs ( exprFreeIds, ruleRhsFreeIds ) import GHC.Core.Coercion ( Coercion, coVarsOfCo ) import GHC.Core.FamInstEnv +import GHC.Core.Opt.Arity ( typeArity ) import GHC.Utils.Misc import GHC.Utils.Panic import GHC.Data.Maybe ( isJust ) @@ -64,28 +65,55 @@ data DmdAnalOpts = DmdAnalOpts -- -- Note: use `seqBinds` on the result to avoid leaks due to lazyness (cf Note -- [Stamp out space leaks in demand analysis]) -dmdAnalProgram :: DmdAnalOpts -> FamInstEnvs -> CoreProgram -> CoreProgram -dmdAnalProgram opts fam_envs binds = binds_plus_dmds - where - env = emptyAnalEnv opts fam_envs - binds_plus_dmds = snd $ mapAccumL dmdAnalTopBind env binds - --- Analyse a (group of) top-level binding(s) -dmdAnalTopBind :: AnalEnv - -> CoreBind - -> (AnalEnv, CoreBind) -dmdAnalTopBind env (NonRec id rhs) - = ( extendAnalEnv TopLevel env id sig - , NonRec (setIdStrictness id sig) rhs') +dmdAnalProgram :: DmdAnalOpts -> FamInstEnvs -> [CoreRule] -> CoreProgram -> CoreProgram +dmdAnalProgram opts fam_envs rules binds + = snd $ go (emptyAnalEnv opts fam_envs) binds where - ( _, sig, rhs') = dmdAnalRhsLetDown Nothing env topSubDmd id rhs - -dmdAnalTopBind env (Rec pairs) - = (env', Rec pairs') - where - (env', _, pairs') = dmdFix TopLevel env topSubDmd pairs - -- We get two iterations automatically - -- c.f. the NonRec case above + -- See Note [Analysing top-level bindings] + -- TLDR; We analyse them like + -- let ex1 = ... in (ex1, let nex1 = ... in let ex2 = ... in (ex2, ...))) + -- where ex* are exported (or RULE mentions) and nex* are not. + go _ [] = (nopDmdType, []) + go env (b:bs) = cons_up $ dmdAnalBind TopLevel env topSubDmd b anal_body + where + anal_body env' + | (body_ty, bs') <- go env' bs + = (add_exported_uses env' body_ty (bindersOf b), bs') + + cons_up :: (a, b, [b]) -> (a, [b]) + cons_up (dmd_ty, b', bs') = (dmd_ty, b':bs') + + add_exported_uses :: AnalEnv -> DmdType -> [Id] -> DmdType + add_exported_uses env = foldl' (add_exported_use env) + + -- | If @e@ is denoted by @dmd_ty@, then @add_exported_use _ dmd_ty id@ + -- corresponds to the demand type of @(id, e)@, but is a lot more direct. + -- See Note [Analysing top-level bindings]. + add_exported_use :: AnalEnv -> DmdType -> Id -> DmdType + add_exported_use env dmd_ty id + -- See Note [Absence analysis for stable unfoldings and RULES] + | isExportedId id || elemVarSet id rule_fvs + , Just (sig, _) <- lookupSigEnv env id + = dmd_ty `plusDmdType` toPlusDmdArg (dmdTransformSig sig topSubDmd) + | otherwise = dmd_ty + + rule_fvs :: IdSet + rule_fvs = foldr (unionVarSet . ruleRhsFreeIds) emptyVarSet rules + +-- | Whether we want to store demands on a top-level Id or just default +-- to 'topDmd'. +-- +-- Basically, we want to now how top-level *functions* are *used* +-- (e.g. called), but aren't interested in whether they were called strictly +-- or not. Other top-level bindings are boring. +isInterestingTopLevelFn :: Id -> Bool +-- SG tried to set this to True and got a +2% ghc/alloc regression in T5642 +-- (which is dominated by the Simplifier) at no gain in analysis precision. +-- If there was a gain, that regression might be acceptable. +-- Plus, we could use LetUp for thunks and share some code with local let +-- bindings. +isInterestingTopLevelFn id = + typeArity (idType id) `lengthExceeds` 0 {- Note [Stamp out space leaks in demand analysis] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -105,8 +133,56 @@ generation would hold on to an extra copy of the Core program, via unforced thunks in demand or strictness information; and it is the most memory-intensive part of the compilation process, so this added seqBinds makes a big difference in peak memory usage. --} +Note [Analysing top-level bindings] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider a CoreProgram like + e1 = ... + n1 = ... + e2 = \a b -> ... fst (n1 a b) ... + n2 = \c d -> ... snd (e2 c d) ... + ... +where e* are exported, but n* are not. +Intuitively, we can see that @n1@ is only ever called with two arguments +and in every call site, the first component of the result of the call +is evaluated. Thus, we'd like it to have idDemandInfo @UCU(C1(P(SU,A))@. + +(This can be exploited by a Nested CPR pass which may then unbox the +first component of the pair returned from @n1 at . Or if @n1@ had arity +1 before, we may now eta-expand to arity 2.) + +NB: We may *not* give e2 a similar annotation, because it is exported and +external callers might use it in arbitrary ways, expressed by 'topDmd'. + +How do we get this result? Answer: By analysing the program as if it was a let +expression of this form: + let e1 = ... in + (e1, let n1 = ... in + ( let e2 = ... in + (e2, let n2 = ... in + ( ...)))) +E.g. putting all bindings in nested lets, where whenever it binds an exported +binding, the body is a *pair* of an occurrence of the exported binder and +the other nested lets. Of course, we will not actually build that CoreExpr! +Instead we faithfully simulate analysis of said expression by adding the +free variable 'DmdEnv' of @e*@'s strictness signatures to the 'DmdType' we +get from analysing the nested bindings. + +You might also wonder why we didn't analyse in terms of the simpler + let e1 = ... in + let n1 = ... in + let e2 = ... in + let n2 = ... in + (e1,e2, ...) +The reason is analysis performance: If @e1@ uses many free variables, we'll +unnecessarily carry their demands around with us from the moment we analyse +the pair to the moment we bubble back up to the binding for @e1 at . +This blows up e.g. @T10370 at . + +A final note about variables occuring free in RULE RHSs: They are to be handled +pretty much like exported Ids. +See also Note [Absence analysis for stable unfoldings and RULES] +-} {- ************************************************************************ @@ -114,7 +190,103 @@ seqBinds makes a big difference in peak memory usage. \subsection{The analyser itself} * * ************************************************************************ +-} + +-- | Analyse a binding group and its \"body\", e.g. where it is in scope. +-- +-- It calls a function that knows how to analyse this \"body\" given +-- an 'AnalEnv' with updated demand signatures for the binding group +-- (reflecting their 'idStrictnessInfo') and expects to receive a +-- 'DmdType' in return, which it uses to annotate the binding group with their +-- 'idDemandInfo'. +dmdAnalBind + :: TopLevelFlag + -> AnalEnv + -> SubDemand -- ^ Demand put on the "body" + -- (important for join points) + -> CoreBind + -> (AnalEnv -> (DmdType, a)) -- ^ How to analyse the "body", e.g. + -- where the binding is in scope + -> (DmdType, CoreBind, a) +dmdAnalBind top_lvl env dmd bind anal_body = case bind of + NonRec id rhs + | useLetUp top_lvl id + -> dmdAnalBindLetUp top_lvl env id rhs anal_body + _ -> dmdAnalBindLetDown top_lvl env dmd bind anal_body + +-- | Annotates uninteresting top level functions ('isInterestingTopLevelFn') +-- with 'topDmd', the rest with the given demand. +setBindIdDemandInfo :: TopLevelFlag -> Id -> Demand -> Id +setBindIdDemandInfo top_lvl id dmd = setIdDemandInfo id $ case top_lvl of + TopLevel | not (isInterestingTopLevelFn id) -> topDmd + _ -> dmd + +-- | Let bindings can be processed in two ways: +-- Down (RHS before body) or Up (body before RHS). +-- This function handles the up variant. +-- +-- It is very simple. For let x = rhs in body +-- * Demand-analyse 'body' in the current environment +-- * Find the demand, 'rhs_dmd' placed on 'x' by 'body' +-- * Demand-analyse 'rhs' in 'rhs_dmd' +-- +-- This is used for a non-recursive local let without manifest lambdas (see +-- 'useLetUp'). +-- +-- This is the LetUp rule in the paper “Higher-Order Cardinality Analysis”. +dmdAnalBindLetUp :: TopLevelFlag -> AnalEnv -> Id -> CoreExpr -> (AnalEnv -> (DmdType, a)) -> (DmdType, CoreBind, a) +dmdAnalBindLetUp top_lvl env id rhs anal_body = (final_ty, NonRec id' rhs', body') + where + (body_ty, body') = anal_body env + (body_ty', id_dmd) = findBndrDmd env notArgOfDfun body_ty id + id' = setBindIdDemandInfo top_lvl id id_dmd + (rhs_ty, rhs') = dmdAnalStar env (dmdTransformThunkDmd rhs id_dmd) rhs + final_ty = body_ty' `plusDmdType` rhs_ty + +-- | Let bindings can be processed in two ways: +-- Down (RHS before body) or Up (body before RHS). +-- This function handles the down variant. +-- +-- It computes a demand signature (by means of 'dmdAnalRhsSig') and uses +-- that at call sites in the body. +-- +-- It is used for toplevel definitions, recursive definitions and local +-- non-recursive definitions that have manifest lambdas (cf. 'useLetUp'). +-- Local non-recursive definitions without a lambda are handled with LetUp. +-- +-- This is the LetDown rule in the paper “Higher-Order Cardinality Analysis”. +dmdAnalBindLetDown :: TopLevelFlag -> AnalEnv -> SubDemand -> CoreBind -> (AnalEnv -> (DmdType, a)) -> (DmdType, CoreBind, a) +dmdAnalBindLetDown top_lvl env dmd bind anal_body = case bind of + NonRec id rhs + | (env', lazy_fv, id1, rhs1) <- + dmdAnalRhsSig top_lvl NonRecursive env dmd id rhs + -> do_rest env' lazy_fv [(id1, rhs1)] (uncurry NonRec . only) + Rec pairs + | (env', lazy_fv, pairs') <- dmdFix top_lvl env dmd pairs + -> do_rest env' lazy_fv pairs' Rec + where + do_rest env' lazy_fv pairs1 build_bind = (final_ty, build_bind pairs2, body') + where + (body_ty, body') = anal_body env' + -- see Note [Lazy and unleashable free variables] + dmd_ty = addLazyFVs body_ty lazy_fv + (!final_ty, id_dmds) = findBndrsDmds env' dmd_ty (map fst pairs1) + pairs2 = zipWith do_one pairs1 id_dmds + do_one (id', rhs') dmd = (setBindIdDemandInfo top_lvl id' dmd, rhs') + -- If the actual demand is better than the vanilla call + -- demand, you might think that we might do better to re-analyse + -- the RHS with the stronger demand. + -- But (a) That seldom happens, because it means that *every* path in + -- the body of the let has to use that stronger demand + -- (b) It often happens temporarily in when fixpointing, because + -- the recursive function at first seems to place a massive demand. + -- But we don't want to go to extra work when the function will + -- probably iterate to something less demanding. + -- In practice, all the times the actual demand on id2 is more than + -- the vanilla call demand seem to be due to (b). So we don't + -- bother to re-analyse the RHS. +{- Note [Ensure demand is strict] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ It's important not to analyse e with a lazy demand because @@ -194,7 +366,7 @@ dmdAnal' env dmd (App fun arg) -- Crucially, coercions /are/ handled here, because they are -- value arguments (#10288) let - call_dmd = mkCallDmd dmd + call_dmd = mkCalledOnceDmd dmd (fun_ty, fun') = dmdAnal env call_dmd fun (arg_dmd, res_ty) = splitDmdTy fun_ty (arg_ty, arg') = dmdAnalStar env (dmdTransformThunkDmd arg arg_dmd) arg @@ -295,60 +467,11 @@ dmdAnal' env dmd (Case scrut case_bndr ty alts) -- , text "res_ty" <+> ppr res_ty ]) $ (res_ty, Case scrut' case_bndr' ty alts') --- Let bindings can be processed in two ways: --- Down (RHS before body) or Up (body before RHS). --- The following case handle the up variant. --- --- It is very simple. For let x = rhs in body --- * Demand-analyse 'body' in the current environment --- * Find the demand, 'rhs_dmd' placed on 'x' by 'body' --- * Demand-analyse 'rhs' in 'rhs_dmd' --- --- This is used for a non-recursive local let without manifest lambdas. --- This is the LetUp rule in the paper “Higher-Order Cardinality Analysis”. -dmdAnal' env dmd (Let (NonRec id rhs) body) - | useLetUp id - = (final_ty, Let (NonRec id' rhs') body') +dmdAnal' env dmd (Let bind body) + = (final_ty, Let bind' body') where - (body_ty, body') = dmdAnal env dmd body - (body_ty', id_dmd) = findBndrDmd env notArgOfDfun body_ty id - id' = setIdDemandInfo id id_dmd - - (rhs_ty, rhs') = dmdAnalStar env (dmdTransformThunkDmd rhs id_dmd) rhs - final_ty = body_ty' `plusDmdType` rhs_ty - -dmdAnal' env dmd (Let (NonRec id rhs) body) - = (body_ty2, Let (NonRec id2 rhs') body') - where - (lazy_fv, sig, rhs') = dmdAnalRhsLetDown Nothing env dmd id rhs - id1 = setIdStrictness id sig - env1 = extendAnalEnv NotTopLevel env id sig - (body_ty, body') = dmdAnal env1 dmd body - (body_ty1, id2) = annotateBndr env body_ty id1 - body_ty2 = addLazyFVs body_ty1 lazy_fv -- see Note [Lazy and unleashable free variables] - - -- If the actual demand is better than the vanilla call - -- demand, you might think that we might do better to re-analyse - -- the RHS with the stronger demand. - -- But (a) That seldom happens, because it means that *every* path in - -- the body of the let has to use that stronger demand - -- (b) It often happens temporarily in when fixpointing, because - -- the recursive function at first seems to place a massive demand. - -- But we don't want to go to extra work when the function will - -- probably iterate to something less demanding. - -- In practice, all the times the actual demand on id2 is more than - -- the vanilla call demand seem to be due to (b). So we don't - -- bother to re-analyse the RHS. - -dmdAnal' env dmd (Let (Rec pairs) body) - = let - (env', lazy_fv, pairs') = dmdFix NotTopLevel env dmd pairs - (body_ty, body') = dmdAnal env' dmd body - body_ty1 = deleteFVs body_ty (map fst pairs) - body_ty2 = addLazyFVs body_ty1 lazy_fv -- see Note [Lazy and unleashable free variables] - in - body_ty2 `seq` - (body_ty2, Let (Rec pairs') body') + (final_ty, bind', body') = dmdAnalBind NotTopLevel env dmd bind go' + go' env' = dmdAnal env' dmd body -- | A simple, syntactic analysis of whether an expression MAY throw a precise -- exception when evaluated. It's always sound to return 'True'. @@ -582,9 +705,13 @@ dmdTransform env var dmd | Just (sig, top_lvl) <- lookupSigEnv env var , let fn_ty = dmdTransformSig sig dmd = -- pprTrace "dmdTransform:LetDown" (vcat [ppr var, ppr sig, ppr dmd, ppr fn_ty]) $ - if isTopLevel top_lvl - then fn_ty -- Don't record demand on top-level things - else addVarDmd fn_ty var (C_11 :* dmd) + case top_lvl of + NotTopLevel -> addVarDmd fn_ty var (C_11 :* dmd) + TopLevel + | isInterestingTopLevelFn var + -> addVarDmd fn_ty var (C_0N `multDmd` (C_11 :* dmd)) -- discard strictness + | otherwise + -> fn_ty -- don't bother tracking; just annotate with 'topDmd' later -- Everything else: -- * Local let binders for which we use LetUp (cf. 'useLetUp') -- * Lambda binders @@ -599,46 +726,46 @@ dmdTransform env var dmd * * ********************************************************************* -} --- Let bindings can be processed in two ways: --- Down (RHS before body) or Up (body before RHS). --- dmdAnalRhsLetDown implements the Down variant: --- * assuming a demand of +-- | @dmdAnalRhsSig@ analyses the given RHS to compute a demand signature +-- for the LetDown rule. It works as follows: +-- +-- * assuming a demand of -- * looking at the definition -- * determining a strictness signature -- --- It is used for toplevel definition, recursive definitions and local --- non-recursive definitions that have manifest lambdas. --- Local non-recursive definitions without a lambda are handled with LetUp. --- --- This is the LetDown rule in the paper “Higher-Order Cardinality Analysis”. -dmdAnalRhsLetDown - :: Maybe [Id] -- Just bs <=> recursive, Nothing <=> non-recursive +-- Since it assumed a demand of , the resulting signature is applicable at +-- any call site. +dmdAnalRhsSig + :: TopLevelFlag + -> RecFlag -> AnalEnv -> SubDemand -> Id -> CoreExpr - -> (DmdEnv, StrictSig, CoreExpr) + -> (AnalEnv, DmdEnv, Id, CoreExpr) -- Process the RHS of the binding, add the strictness signature -- to the Id, and augment the environment with the signature as well. -- See Note [NOINLINE and strictness] -dmdAnalRhsLetDown rec_flag env let_dmd id rhs - = -- pprTrace "dmdAnalRhsLetDown" (ppr id $$ ppr let_dmd $$ ppr sig $$ ppr lazy_fv) $ - (lazy_fv, sig, rhs') +dmdAnalRhsSig top_lvl rec_flag env let_dmd id rhs + = -- pprTrace "dmdAnalRhsSig" (ppr id $$ ppr let_dmd $$ ppr sig $$ ppr lazy_fv) $ + (env', lazy_fv, id', rhs') where rhs_arity = idArity id + -- See Note [Demand signatures are computed for a threshold demand based on idArity] rhs_dmd -- See Note [Demand analysis for join points] -- See Note [Invariants on join points] invariant 2b, in GHC.Core -- rhs_arity matches the join arity of the join point | isJoinId id - = mkCallDmds rhs_arity let_dmd + = mkCalledOnceDmds rhs_arity let_dmd | otherwise - -- NB: rhs_arity - -- See Note [Demand signatures are computed for a threshold demand based on idArity] - = mkRhsDmd env rhs_arity rhs + = mkCalledOnceDmds rhs_arity topSubDmd (rhs_dmd_ty, rhs') = dmdAnal env rhs_dmd rhs DmdType rhs_fv rhs_dmds rhs_div = rhs_dmd_ty sig = mkStrictSigForArity rhs_arity (DmdType sig_fv rhs_dmds rhs_div) + id' = id `setIdStrictness` sig + env' = extendAnalEnv top_lvl env id' sig + -- See Note [Aggregated demand for cardinality] -- FIXME: That Note doesn't explain the following lines at all. The reason -- is really much different: When we have a recursive function, we'd @@ -651,8 +778,8 @@ dmdAnalRhsLetDown rec_flag env let_dmd id rhs -- we'd have to do an additional iteration. reuseEnv makes sure that -- we never get used-once info for FVs of recursive functions. rhs_fv1 = case rec_flag of - Just bs -> reuseEnv (delVarEnvList rhs_fv bs) - Nothing -> rhs_fv + Recursive -> reuseEnv rhs_fv + NonRecursive -> rhs_fv rhs_fv2 = rhs_fv1 `keepAliveDmdEnv` extra_fvs -- Find the RHS free vars of the unfoldings and RULES @@ -669,13 +796,6 @@ dmdAnalRhsLetDown rec_flag env let_dmd id rhs = exprFreeIds unf_body | otherwise = emptyVarSet --- | @mkRhsDmd env rhs_arity rhs@ creates a 'SubDemand' for --- unleashing on the given function's @rhs@, by creating --- a call demand of @rhs_arity@ --- See Historical Note [Product demands for function body] -mkRhsDmd :: AnalEnv -> Arity -> CoreExpr -> SubDemand -mkRhsDmd _env rhs_arity _rhs = mkCallDmds rhs_arity topSubDmd - -- | If given the (local, non-recursive) let-bound 'Id', 'useLetUp' determines -- whether we should process the binding up (body before rhs) or down (rhs -- before body). @@ -720,8 +840,8 @@ mkRhsDmd _env rhs_arity _rhs = mkCallDmds rhs_arity topSubDmd -- * For a more convincing example with join points, see Note [Demand analysis -- for join points]. -- -useLetUp :: Var -> Bool -useLetUp f = idArity f == 0 && not (isJoinId f) +useLetUp :: TopLevelFlag -> Var -> Bool +useLetUp top_lvl f = isNotTopLevel top_lvl && idArity f == 0 && not (isJoinId f) {- Note [Demand analysis for join points] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -939,8 +1059,6 @@ dmdFix :: TopLevelFlag dmdFix top_lvl env let_dmd orig_pairs = loop 1 initial_pairs where - bndrs = map fst orig_pairs - -- See Note [Initialising strictness] initial_pairs | ae_virgin env = [(setIdStrictness id botSig, rhs) | (id, rhs) <- orig_pairs ] | otherwise = orig_pairs @@ -990,10 +1108,8 @@ dmdFix top_lvl env let_dmd orig_pairs = -- pprTrace "my_downRhs" (ppr id $$ ppr (idStrictness id) $$ ppr sig) $ ((env', lazy_fv'), (id', rhs')) where - (lazy_fv1, sig, rhs') = dmdAnalRhsLetDown (Just bndrs) env let_dmd id rhs - lazy_fv' = plusVarEnv_C plusDmd lazy_fv lazy_fv1 - env' = extendAnalEnv top_lvl env id sig - id' = setIdStrictness id sig + (env', lazy_fv1, id', rhs') = dmdAnalRhsSig top_lvl Recursive env let_dmd id rhs + lazy_fv' = plusVarEnv_C plusDmd lazy_fv lazy_fv1 zapIdStrictness :: [(Id, CoreExpr)] -> [(Id, CoreExpr)] zapIdStrictness pairs = [(setIdStrictness id nopSig, rhs) | (id, rhs) <- pairs ] @@ -1090,7 +1206,7 @@ addLazyFVs dmd_ty lazy_fvs -- demand with the bottom coming up from 'error' -- -- I got a loop in the fixpointer without this, due to an interaction - -- with the lazy_fv filtering in dmdAnalRhsLetDown. Roughly, it was + -- with the lazy_fv filtering in dmdAnalRhsSig. Roughly, it was -- letrec f n x -- = letrec g y = x `fatbar` -- letrec h z = z + ...g... @@ -1156,10 +1272,6 @@ annotateLamIdBndr env arg_of_dfun dmd_ty id main_ty = addDemand dmd dmd_ty' (dmd_ty', dmd) = findBndrDmd env arg_of_dfun dmd_ty id -deleteFVs :: DmdType -> [Var] -> DmdType -deleteFVs (DmdType fvs dmds res) bndrs - = DmdType (delVarEnvList fvs bndrs) dmds res - {- Note [NOINLINE and strictness] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Core/Opt/Pipeline.hs ===================================== @@ -65,6 +65,7 @@ import GHC.Types.SrcLoc import GHC.Types.Id import GHC.Types.Id.Info import GHC.Types.Basic +import GHC.Types.Demand ( zapDmdEnvSig ) import GHC.Types.Var.Set import GHC.Types.Var.Env import GHC.Types.Unique.Supply ( UniqSupply, mkSplitUniqSupply, splitUniqSupply ) @@ -495,7 +496,7 @@ doCorePass CoreDoExitify = {-# SCC "Exitify" #-} doPass exitifyProgram doCorePass CoreDoDemand = {-# SCC "DmdAnal" #-} - doPassDFM dmdAnal + doPassDFRM dmdAnal doCorePass CoreDoCpr = {-# SCC "CprAnal" #-} doPassDFM cprAnalProgram @@ -575,6 +576,13 @@ doPassDFM do_pass guts = do let fam_envs = (p_fam_env, mg_fam_inst_env guts) doPassM (liftIO . do_pass dflags fam_envs) guts +doPassDFRM :: (DynFlags -> FamInstEnvs -> [CoreRule] -> CoreProgram -> IO CoreProgram) -> ModGuts -> CoreM ModGuts +doPassDFRM do_pass guts = do + dflags <- getDynFlags + p_fam_env <- getPackageFamInstEnv + let fam_envs = (p_fam_env, mg_fam_inst_env guts) + doPassM (liftIO . do_pass dflags fam_envs (mg_rules guts)) guts + doPassDFU :: (DynFlags -> FamInstEnvs -> UniqSupply -> CoreProgram -> CoreProgram) -> ModGuts -> CoreM ModGuts doPassDFU do_pass guts = do dflags <- getDynFlags @@ -1088,13 +1096,13 @@ transferIdInfo exported_id local_id -dmdAnal :: DynFlags -> FamInstEnvs -> CoreProgram -> IO CoreProgram -dmdAnal dflags fam_envs binds = do +dmdAnal :: DynFlags -> FamInstEnvs -> [CoreRule] -> CoreProgram -> IO CoreProgram +dmdAnal dflags fam_envs rules binds = do let opts = DmdAnalOpts { dmd_strict_dicts = gopt Opt_DictsStrict dflags } - binds_plus_dmds = dmdAnalProgram opts fam_envs binds + binds_plus_dmds = dmdAnalProgram opts fam_envs rules binds Err.dumpIfSet_dyn dflags Opt_D_dump_str_signatures "Strictness signatures" FormatText $ - dumpIdInfoOfProgram (ppr . strictnessInfo) binds_plus_dmds + dumpIdInfoOfProgram (ppr . zapDmdEnvSig . strictnessInfo) binds_plus_dmds -- See Note [Stamp out space leaks in demand analysis] in GHC.Core.Opt.DmdAnal seqBinds binds_plus_dmds `seq` return binds_plus_dmds ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -598,11 +598,10 @@ addJoinFlts = appOL mkRecFloats :: SimplFloats -> SimplFloats -- Flattens the floats into a single Rec group, -- They must either all be lifted LetFloats or all JoinFloats -mkRecFloats floats@(SimplFloats { sfLetFloats = LetFloats bs ff +mkRecFloats floats@(SimplFloats { sfLetFloats = LetFloats bs _ff , sfJoinFloats = jbs , sfInScope = in_scope }) - = ASSERT2( case ff of { FltLifted -> True; _ -> False }, ppr (fromOL bs) ) - ASSERT2( isNilOL bs || isNilOL jbs, ppr floats ) + = ASSERT2( isNilOL bs || isNilOL jbs, ppr floats ) SimplFloats { sfLetFloats = floats' , sfJoinFloats = jfloats' , sfInScope = in_scope } ===================================== compiler/GHC/Core/Opt/WorkWrap.hs ===================================== @@ -484,7 +484,7 @@ tryWW dflags fam_envs is_rec fn_id rhs | is_fun && is_eta_exp = splitFun dflags fam_envs new_fn_id fn_info wrap_dmds div cpr rhs - | is_thunk -- See Note [Thunk splitting] + | isNonRec is_rec, is_thunk -- See Note [Thunk splitting] = splitThunk dflags fam_envs is_rec new_fn_id rhs | otherwise ===================================== compiler/GHC/Core/Opt/WorkWrap/Utils.hs ===================================== @@ -1275,10 +1275,14 @@ mk_absent_let dflags fam_envs arg abs_rhs = mkAbsentErrorApp arg_ty msg msg = showSDoc (gopt_set dflags Opt_SuppressUniques) - (ppr arg <+> ppr (idType arg) <+> file_msg) + (vcat + [ text "Arg:" <+> ppr arg + , text "Type:" <+> ppr arg_ty + , file_msg + ]) file_msg = case outputFile dflags of Nothing -> empty - Just f -> text "in output file " <+> quotes (text f) + Just f -> text "In output file " <+> quotes (text f) -- We need to suppress uniques here because otherwise they'd -- end up in the generated code as strings. This is bad for -- determinism, because with different uniques the strings ===================================== compiler/GHC/Core/Tidy.hs ===================================== @@ -21,7 +21,7 @@ import GHC.Core import GHC.Core.Seq ( seqUnfolding ) import GHC.Types.Id import GHC.Types.Id.Info -import GHC.Types.Demand ( zapUsageEnvSig ) +import GHC.Types.Demand ( zapDmdEnvSig ) import GHC.Core.Type ( tidyType, tidyVarBndr ) import GHC.Core.Coercion ( tidyCo ) import GHC.Types.Var @@ -206,7 +206,7 @@ tidyLetBndr rec_tidy_env env@(tidy_env, var_env) id new_info = vanillaIdInfo `setOccInfo` occInfo old_info `setArityInfo` arityInfo old_info - `setStrictnessInfo` zapUsageEnvSig (strictnessInfo old_info) + `setStrictnessInfo` zapDmdEnvSig (strictnessInfo old_info) `setDemandInfo` demandInfo old_info `setInlinePragInfo` inlinePragInfo old_info `setUnfoldingInfo` new_unf ===================================== compiler/GHC/Types/Demand.hs ===================================== @@ -34,7 +34,7 @@ module GHC.Types.Demand ( lazyApply1Dmd, lazyApply2Dmd, strictOnceApply1Dmd, strictManyApply1Dmd, -- ** Other @Demand@ operations oneifyCard, oneifyDmd, strictifyDmd, strictifyDictDmd, mkWorkerDemand, - peelCallDmd, peelManyCalls, mkCallDmd, mkCallDmds, + peelCallDmd, peelManyCalls, mkCalledOnceDmd, mkCalledOnceDmds, addCaseBndrDmd, -- ** Extracting one-shot information argOneShots, argsOneShots, saturatedByOneShots, @@ -73,7 +73,7 @@ module GHC.Types.Demand ( seqDemand, seqDemandList, seqDmdType, seqStrictSig, -- * Zapping usage information - zapUsageDemand, zapUsageEnvSig, zapUsedOnceDemand, zapUsedOnceSig + zapUsageDemand, zapDmdEnvSig, zapUsedOnceDemand, zapUsedOnceSig ) where #include "HsVersions.h" @@ -278,7 +278,8 @@ data SubDemand -- ^ @Call n sd@ describes the evaluation context of @n@ function -- applications, where every individual result is evaluated according to @sd at . -- @sd@ is /relative/ to a single call, cf. Note [Call demands are relative]. - -- Used only for values of function type. + -- Used only for values of function type. Use the smart constructor 'mkCall' + -- whenever possible! | Prod ![Demand] -- ^ @Prod ds@ describes the evaluation context of a case scrutinisation -- on an expression of product type, where the product components are @@ -306,7 +307,7 @@ polyDmd C_1N = C_1N :* poly1N polyDmd C_10 = C_10 :* poly10 -- | A smart constructor for 'Prod', applying rewrite rules along the semantic --- equalities @Prod [polyDmd n, ...] === polyDmd n@, simplifying to 'Poly' +-- equality @Prod [polyDmd n, ...] === polyDmd n@, simplifying to 'Poly' -- 'SubDemand's when possible. Note that this degrades boxity information! E.g. a -- polymorphic demand will never unbox. mkProd :: [Demand] -> SubDemand @@ -335,6 +336,13 @@ viewProd _ _ = Nothing {-# INLINE viewProd #-} -- we want to fuse away the replicate and the allocation -- for Arity. Otherwise, #18304 bites us. +-- | A smart constructor for 'Call', applying rewrite rules along the semantic +-- equality @Call n (Poly n) === Poly n@, simplifying to 'Poly' 'SubDemand's +-- when possible. +mkCall :: Card -> SubDemand -> SubDemand +mkCall n cd@(Poly m) | n == m = cd +mkCall n cd = Call n cd + -- | @viewCall sd@ interprets @sd@ as a 'Call', expanding 'Poly' demands as -- necessary. viewCall :: SubDemand -> Maybe (Card, SubDemand) @@ -356,8 +364,8 @@ lubSubDmd (Prod ds1) (viewProd (length ds1) -> Just ds2) = -- Handle Call lubSubDmd (Call n1 d1) (viewCall -> Just (n2, d2)) -- See Note [Call demands are relative] - | isAbs n2 = Call (lubCard n1 n2) (lubSubDmd d1 botSubDmd) - | otherwise = Call (lubCard n1 n2) (lubSubDmd d1 d2) + | isAbs n2 = mkCall (lubCard n1 n2) (lubSubDmd d1 botSubDmd) + | otherwise = mkCall (lubCard n1 n2) (lubSubDmd d1 d2) -- Handle Poly lubSubDmd (Poly n1) (Poly n2) = Poly (lubCard n1 n2) -- Make use of reflexivity (so we'll match the Prod or Call cases again). @@ -377,8 +385,8 @@ plusSubDmd (Prod ds1) (viewProd (length ds1) -> Just ds2) = -- Handle Call plusSubDmd (Call n1 d1) (viewCall -> Just (n2, d2)) -- See Note [Call demands are relative] - | isAbs n2 = Call (plusCard n1 n2) (lubSubDmd d1 botSubDmd) - | otherwise = Call (plusCard n1 n2) (lubSubDmd d1 d2) + | isAbs n2 = mkCall (plusCard n1 n2) (lubSubDmd d1 botSubDmd) + | otherwise = mkCall (plusCard n1 n2) (lubSubDmd d1 d2) -- Handle Poly plusSubDmd (Poly n1) (Poly n2) = Poly (plusCard n1 n2) -- Make use of reflexivity (so we'll match the Prod or Call cases again). @@ -407,7 +415,7 @@ multSubDmd :: Card -> SubDemand -> SubDemand multSubDmd n sd | Just sd' <- multTrivial n seqSubDmd sd = sd' multSubDmd n (Poly n') = Poly (multCard n n') -multSubDmd n (Call n' sd) = Call (multCard n n') sd -- See Note [Call demands are relative] +multSubDmd n (Call n' sd) = mkCall (multCard n n') sd -- See Note [Call demands are relative] multSubDmd n (Prod ds) = Prod (map (multDmd n) ds) multDmd :: Card -> Demand -> Demand @@ -457,22 +465,22 @@ evalDmd = C_1N :* topSubDmd -- | First argument of 'GHC.Exts.maskAsyncExceptions#': @SCS(U)@. -- Called exactly once. strictOnceApply1Dmd :: Demand -strictOnceApply1Dmd = C_11 :* Call C_11 topSubDmd +strictOnceApply1Dmd = C_11 :* mkCall C_11 topSubDmd -- | First argument of 'GHC.Exts.atomically#': @MCM(U)@. -- Called at least once, possibly many times. strictManyApply1Dmd :: Demand -strictManyApply1Dmd = C_1N :* Call C_1N topSubDmd +strictManyApply1Dmd = C_1N :* mkCall C_1N topSubDmd -- | First argument of catch#: @1C1(U)@. -- Evaluates its arg lazily, but then applies it exactly once to one argument. lazyApply1Dmd :: Demand -lazyApply1Dmd = C_01 :* Call C_01 topSubDmd +lazyApply1Dmd = C_01 :* mkCall C_01 topSubDmd -- | Second argument of catch#: @1C1(CS(U))@. -- Calls its arg lazily, but then applies it exactly once to an additional argument. lazyApply2Dmd :: Demand -lazyApply2Dmd = C_01 :* Call C_01 (Call C_11 topSubDmd) +lazyApply2Dmd = C_01 :* mkCall C_01 (mkCall C_11 topSubDmd) -- | Make a 'Demand' evaluated at-most-once. oneifyDmd :: Demand -> Demand @@ -512,12 +520,12 @@ strictifyDictDmd ty (n :* Prod ds) strictifyDictDmd _ dmd = dmd -- | Wraps the 'SubDemand' with a one-shot call demand: @d@ -> @CS(d)@. -mkCallDmd :: SubDemand -> SubDemand -mkCallDmd sd = Call C_11 sd +mkCalledOnceDmd :: SubDemand -> SubDemand +mkCalledOnceDmd sd = mkCall C_11 sd --- | @mkCallDmds n d@ returns @CS(CS...(CS d))@ where there are @n@ @CS@'s. -mkCallDmds :: Arity -> SubDemand -> SubDemand -mkCallDmds arity sd = iterate mkCallDmd sd !! arity +-- | @mkCalledOnceDmds n d@ returns @CS(CS...(CS d))@ where there are @n@ @CS@'s. +mkCalledOnceDmds :: Arity -> SubDemand -> SubDemand +mkCalledOnceDmds arity sd = iterate mkCalledOnceDmd sd !! arity -- | Peels one call level from the sub-demand, and also returns how many -- times we entered the lambda body. @@ -669,7 +677,7 @@ This is needed even for non-product types, in case the case-binder is used but the components of the case alternative are not. Note [Don't optimise UP(U,U,...) to U] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ These two SubDemands: UP(U,U) (@Prod [topDmd, topDmd]@) and U (@topSubDmd@) are semantically equivalent, but we do not turn the former into @@ -1571,9 +1579,9 @@ This is weird, so I'm not worried about whether this optimises brilliantly; but it should not fall over. -} -zapUsageEnvSig :: StrictSig -> StrictSig --- Remove the usage environment from the demand -zapUsageEnvSig (StrictSig (DmdType _ ds r)) = mkClosedStrictSig ds r +-- | Remove the demand environment from the signature. +zapDmdEnvSig :: StrictSig -> StrictSig +zapDmdEnvSig (StrictSig (DmdType _ ds r)) = mkClosedStrictSig ds r zapUsageDemand :: Demand -> Demand -- Remove the usage info, but not the strictness info, from the demand @@ -1615,8 +1623,8 @@ kill_usage kfs (n :* sd) = kill_usage_card kfs n :* kill_usage_sd kfs sd kill_usage_sd :: KillFlags -> SubDemand -> SubDemand kill_usage_sd kfs (Call n sd) - | kf_called_once kfs = Call (lubCard C_1N n) (kill_usage_sd kfs sd) - | otherwise = Call n (kill_usage_sd kfs sd) + | kf_called_once kfs = mkCall (lubCard C_1N n) (kill_usage_sd kfs sd) + | otherwise = mkCall n (kill_usage_sd kfs sd) kill_usage_sd kfs (Prod ds) = Prod (map (kill_usage kfs) ds) kill_usage_sd _ sd = sd @@ -1640,7 +1648,7 @@ trimToType (n :* sd) ts where go (Prod ds) (TsProd tss) | equalLength ds tss = Prod (zipWith trimToType ds tss) - go (Call n sd) (TsFun ts) = Call n (go sd ts) + go (Call n sd) (TsFun ts) = mkCall n (go sd ts) go sd at Poly{} _ = sd go _ _ = topSubDmd @@ -1804,7 +1812,7 @@ instance Binary SubDemand where h <- getByte bh case h of 0 -> Poly <$> get bh - 1 -> Call <$> get bh <*> get bh + 1 -> mkCall <$> get bh <*> get bh 2 -> Prod <$> get bh _ -> pprPanic "Binary:SubDemand" (ppr (fromIntegral h :: Int)) ===================================== compiler/GHC/Types/Id/Info.hs ===================================== @@ -650,7 +650,7 @@ zapUsageInfo info = Just (info {demandInfo = zapUsageDemand (demandInfo info)}) zapUsageEnvInfo :: IdInfo -> Maybe IdInfo zapUsageEnvInfo info | hasDemandEnvSig (strictnessInfo info) - = Just (info {strictnessInfo = zapUsageEnvSig (strictnessInfo info)}) + = Just (info {strictnessInfo = zapDmdEnvSig (strictnessInfo info)}) | otherwise = Nothing ===================================== testsuite/tests/arityanal/should_compile/Arity11.stderr ===================================== @@ -35,7 +35,7 @@ end Rec } -- RHS size: {terms: 52, types: 28, coercions: 0, joins: 0/5} F11.$wfib [InlPrag=[2]] :: forall {a} {p}. (a -> a -> Bool) -> (Num a, Num p) => a -> p -[GblId, Arity=4, Str=, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 150 60 0] 460 0}] +[GblId, Arity=4, Str=, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 150 60 0] 460 0}] F11.$wfib = \ (@a) (@p) (ww :: a -> a -> Bool) (w :: Num a) (w1 :: Num p) (w2 :: a) -> let { @@ -73,7 +73,7 @@ F11.$wfib fib [InlPrag=[2]] :: forall {a} {p}. (Eq a, Num a, Num p) => a -> p [GblId, Arity=4, - Str=, + Str=, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=4,unsat_ok=True,boring_ok=False) Tmpl= \ (@a) (@p) (w [Occ=Once1!] :: Eq a) (w1 [Occ=Once1] :: Num a) (w2 [Occ=Once1] :: Num p) (w3 [Occ=Once1] :: a) -> case w of { GHC.Classes.C:Eq ww1 [Occ=Once1] _ [Occ=Dead] -> F11.$wfib @a @p ww1 w1 w2 w3 }}] fib = \ (@a) (@p) (w :: Eq a) (w1 :: Num a) (w2 :: Num p) (w3 :: a) -> case w of { GHC.Classes.C:Eq ww1 ww2 -> F11.$wfib @a @p ww1 w1 w2 w3 } ===================================== testsuite/tests/arityanal/should_compile/Arity16.stderr ===================================== @@ -5,7 +5,7 @@ Result size of Tidy Core = {terms: 52, types: 87, coercions: 0, joins: 0/0} Rec { -- RHS size: {terms: 15, types: 17, coercions: 0, joins: 0/0} map2 [Occ=LoopBreaker] :: forall {t} {a}. (t -> a) -> [t] -> [a] -[GblId, Arity=2, Str=, Unf=OtherCon []] +[GblId, Arity=2, Str=, Unf=OtherCon []] map2 = \ (@t) (@a) (f :: t -> a) (ds :: [t]) -> case ds of { ===================================== testsuite/tests/stranal/should_compile/T18894.hs ===================================== @@ -0,0 +1,28 @@ +{-# OPTIONS_GHC -O2 -fforce-recomp #-} + +-- | The point of this test is that @g*@ get's a demand that says +-- "whenever @g*@ is called, the second component of the pair is evaluated strictly". +module T18894 (h1, h2) where + +g1 :: Int -> (Int,Int) +g1 1 = (15, 0) +g1 n = (2 * n, 2 `div` n) +{-# NOINLINE g1 #-} + +h1 :: Int -> Int +h1 1 = 0 +-- Sadly, the @g1 2@ subexpression will be floated to top-level, where we +-- don't see the specific demand placed on it by @snd at . Tracked in #19001. +h1 2 = snd (g1 2) +h1 m = uncurry (+) (g1 m) + +g2 :: Int -> Int -> (Int,Int) +g2 m 1 = (m, 0) +g2 m n = (2 * m, 2 `div` n) +{-# NOINLINE g2 #-} + +h2 :: Int -> Int +h2 1 = 0 +h2 m + | odd m = snd (g2 m 2) + | otherwise = uncurry (+) (g2 2 m) ===================================== testsuite/tests/stranal/should_compile/T18894.stderr ===================================== @@ -0,0 +1,404 @@ + +==================== Demand analysis ==================== +Result size of Demand analysis + = {terms: 177, types: 97, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 36, types: 16, coercions: 0, joins: 0/0} +g2 [InlPrag=NOINLINE, Dmd=UCU(CS(P(1P(U),SP(U))))] + :: Int -> Int -> (Int, Int) +[LclId, + Arity=2, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20 20] 161 20}] +g2 + = \ (m [Dmd=UP(U)] :: Int) (ds [Dmd=SP(SU)] :: Int) -> + case ds of { GHC.Types.I# ds [Dmd=SU] -> + case ds of ds [Dmd=1U] { + __DEFAULT -> + (case m of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.*# 2# y) }, + case ds of wild { + __DEFAULT -> + case GHC.Classes.divInt# 2# wild of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> GHC.Types.I# -2#; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + }); + 1# -> (m, lvl) + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 36, types: 19, coercions: 0, joins: 0/0} +h2 :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 162 10}] +h2 + = \ (ds [Dmd=SP(MU)] :: Int) -> + case ds of wild [Dmd=UP(U)] { GHC.Types.I# ds [Dmd=MU] -> + case ds of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> + case g2 wild lvl of { (ds1 [Dmd=A], y [Dmd=SU]) -> y }; + 0# -> + case g2 lvl wild of { (x [Dmd=SP(U)], ds [Dmd=SP(U)]) -> + case x of { GHC.Types.I# x -> + case ds of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + } + }; + 1# -> lvl + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 15# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +lvl :: (Int, Int) +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = (lvl, lvl) + +-- RHS size: {terms: 30, types: 11, coercions: 0, joins: 0/0} +g1 [InlPrag=NOINLINE, Dmd=UCU(P(UP(U),UP(U)))] :: Int -> (Int, Int) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 141 10}] +g1 + = \ (ds [Dmd=SP(SU)] :: Int) -> + case ds of { GHC.Types.I# ds [Dmd=SU] -> + case ds of ds { + __DEFAULT -> + (GHC.Types.I# (GHC.Prim.*# 2# ds), + case ds of wild { + __DEFAULT -> + case GHC.Classes.divInt# 2# wild of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> GHC.Types.I# -2#; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + }); + 1# -> lvl + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +lvl :: (Int, Int) +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=False, ConLike=False, + WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 30 0}] +lvl = g1 (GHC.Types.I# 2#) + +-- RHS size: {terms: 28, types: 18, coercions: 0, joins: 0/0} +h1 :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 111 10}] +h1 + = \ (ds [Dmd=SP(MU)] :: Int) -> + case ds of wild [Dmd=1P(1U)] { GHC.Types.I# ds [Dmd=MU] -> + case ds of { + __DEFAULT -> + case g1 wild of { (x [Dmd=SP(U)], ds [Dmd=SP(U)]) -> + case x of { GHC.Types.I# x -> + case ds of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + }; + 1# -> lvl; + 2# -> case lvl of { (ds1 [Dmd=A], y [Dmd=SU]) -> y } + } + } + + + + +==================== Demand analysis ==================== +Result size of Demand analysis + = {terms: 171, types: 120, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# -2# + +-- RHS size: {terms: 32, types: 18, coercions: 0, joins: 0/0} +$wg2 [InlPrag=NOINLINE, Dmd=UCU(CS(P(1P(U),SP(U))))] + :: Int -> GHC.Prim.Int# -> (# Int, Int #) +[LclId, + Arity=2, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20 30] 121 20}] +$wg2 + = \ (w [Dmd=UP(U)] :: Int) (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + (# case w of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.*# 2# y) }, + case ds of { + __DEFAULT -> + case GHC.Classes.divInt# 2# ds of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> lvl; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + } #); + 1# -> (# w, lvl #) + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 34, types: 21, coercions: 0, joins: 0/0} +$wh2 [InlPrag=[2]] :: GHC.Prim.Int# -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 162 10}] +$wh2 + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> + case $wg2 (GHC.Types.I# ds) 2# of + { (# ww [Dmd=A], ww [Dmd=SU] #) -> + ww + }; + 0# -> + case $wg2 lvl ds of { (# ww [Dmd=SP(U)], ww [Dmd=SP(U)] #) -> + case ww of { GHC.Types.I# x -> + case ww of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + } + }; + 1# -> lvl + } + +-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} +h2 [InlPrag=[2]] :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (w [Occ=Once1!] :: Int) -> + case w of { GHC.Types.I# ww [Occ=Once1, Dmd=MU] -> $wh2 ww }}] +h2 + = \ (w [Dmd=SP(SU)] :: Int) -> + case w of { GHC.Types.I# ww [Dmd=SU] -> $wh2 ww } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 15# + +-- RHS size: {terms: 28, types: 15, coercions: 0, joins: 0/0} +$wg1 [InlPrag=NOINLINE, Dmd=UCU(P(UP(U),UP(U)))] + :: GHC.Prim.Int# -> (# Int, Int #) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 111 20}] +$wg1 + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + (# GHC.Types.I# (GHC.Prim.*# 2# ds), + case ds of { + __DEFAULT -> + case GHC.Classes.divInt# 2# ds of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> lvl; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + } #); + 1# -> (# lvl, lvl #) + } + +-- RHS size: {terms: 7, types: 9, coercions: 0, joins: 0/0} +lvl :: (Int, Int) +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=False, ConLike=False, + WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 40 10}] +lvl = case $wg1 2# of { (# ww, ww #) -> (ww, ww) } + +-- RHS size: {terms: 25, types: 18, coercions: 0, joins: 0/0} +$wh1 [InlPrag=[2]] :: GHC.Prim.Int# -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [50] 101 10}] +$wh1 + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds [Dmd=1U] { + __DEFAULT -> + case $wg1 ds of { (# ww [Dmd=SP(U)], ww [Dmd=SP(U)] #) -> + case ww of { GHC.Types.I# x -> + case ww of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + }; + 1# -> lvl; + 2# -> case lvl of { (ds1 [Dmd=A], y [Dmd=SU]) -> y } + } + +-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} +h1 [InlPrag=[2]] :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (w [Occ=Once1!] :: Int) -> + case w of { GHC.Types.I# ww [Occ=Once1, Dmd=MU] -> $wh1 ww }}] +h1 + = \ (w [Dmd=SP(SU)] :: Int) -> + case w of { GHC.Types.I# ww [Dmd=SU] -> $wh1 ww } + + + ===================================== testsuite/tests/stranal/should_compile/T18894b.hs ===================================== @@ -0,0 +1,20 @@ +{-# OPTIONS_GHC -O -fno-call-arity -fforce-recomp #-} + +module T18894 (f) where + +expensive :: Int -> (Int, Int) +expensive n = (n+1, n+2) +{-# NOINLINE expensive #-} + +-- arity 1 by itself, but not exported, thus can be eta-expanded based on usage +eta :: Int -> Int -> Int +eta x = if fst (expensive x) == 13 + then \y -> x + y + else \y -> x * y +{-# NOINLINE eta #-} + +f :: Int -> Int +f 1 = 0 +f m + | odd m = eta m 2 + | otherwise = eta 2 m ===================================== testsuite/tests/stranal/should_compile/T18894b.stderr ===================================== @@ -0,0 +1,187 @@ + +==================== Demand analysis ==================== +Result size of Demand analysis = {terms: 83, types: 40, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 16, types: 7, coercions: 0, joins: 0/0} +expensive [InlPrag=NOINLINE, Dmd=UCU(P(SP(SU),A))] :: Int -> (Int, Int) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [40] 52 10}] +expensive + = \ (n [Dmd=UP(U)] :: Int) -> + (case n of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 1#) }, case n of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 2#) }) + +-- RHS size: {terms: 20, types: 11, coercions: 0, joins: 0/0} +eta [InlPrag=NOINLINE, Dmd=UCU(CS(U))] :: Int -> Int -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [0] 140 120}] +eta + = \ (x [Dmd=UP(U)] :: Int) -> + case expensive x of { (x [Dmd=SP(SU)], ds1 [Dmd=A]) -> + case x of { GHC.Types.I# x [Dmd=SU] -> + case x of { + __DEFAULT -> \ (y [Dmd=SP(U)] :: Int) -> GHC.Num.$fNumInt_$c* x y; + 13# -> \ (y [Dmd=SP(U)] :: Int) -> GHC.Num.$fNumInt_$c+ x y + } + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 21, types: 5, coercions: 0, joins: 0/0} +f :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 111 0}] +f = \ (ds [Dmd=SP(MU)] :: Int) -> + case ds of wild [Dmd=UP(U)] { GHC.Types.I# ds [Dmd=MU] -> + case ds of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> eta wild lvl; + 0# -> eta lvl wild + }; + 1# -> lvl + } + } + + + + +==================== Demand analysis ==================== +Result size of Demand analysis = {terms: 85, types: 47, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 16, types: 9, coercions: 0, joins: 0/0} +$wexpensive [InlPrag=NOINLINE, Dmd=UCU(P(SP(SU),A))] :: Int -> (# Int, Int #) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [40] 42 10}] +$wexpensive + = \ (w [Dmd=UP(U)] :: Int) -> + (# case w of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 1#) }, + case w of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 2#) } #) + +-- RHS size: {terms: 19, types: 12, coercions: 0, joins: 0/0} +eta [InlPrag=NOINLINE, Dmd=UCU(CS(U))] :: Int -> Int -> Int +[LclId, + Arity=2, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [0 0] 120 0}] +eta + = \ (x [Dmd=MP(U)] :: Int) (eta [Dmd=SP(U), OS=OneShot] :: Int) -> + case $wexpensive x of { (# ww [Dmd=SP(SU)], ww [Dmd=A] #) -> + case ww of { GHC.Types.I# x [Dmd=SU] -> + case x of { + __DEFAULT -> GHC.Num.$fNumInt_$c* x eta; + 13# -> GHC.Num.$fNumInt_$c+ x eta + } + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 20, types: 3, coercions: 0, joins: 0/0} +$wf [InlPrag=[2]] :: GHC.Prim.Int# -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 121 0}] +$wf + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> eta (GHC.Types.I# ds) lvl; + 0# -> eta lvl (GHC.Types.I# ds) + }; + 1# -> lvl + } + +-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} +f [InlPrag=[2]] :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (w [Occ=Once1!] :: Int) -> case w of { GHC.Types.I# ww [Occ=Once1, Dmd=MU] -> $wf ww }}] +f = \ (w [Dmd=SP(SU)] :: Int) -> case w of { GHC.Types.I# ww [Dmd=SU] -> $wf ww } + + + ===================================== testsuite/tests/stranal/should_compile/all.T ===================================== @@ -58,3 +58,7 @@ test('T18122', [ grep_errmsg(r'wfoo =') ], compile, ['-ddump-simpl']) # We care about the call demand on $wg test('T18903', [ grep_errmsg(r'Dmd=\S+C\S+') ], compile, ['-ddump-simpl -dsuppress-uniques']) +# We care about the call demand on $wg1 and $wg2 +test('T18894', [ grep_errmsg(r'Dmd=\S+C\S+') ], compile, ['-ddump-stranal -dsuppress-uniques']) +# We care about the Arity 2 on eta, as a result of the annotated Dmd +test('T18894b', [ grep_errmsg(r'Arity=2') ], compile, ['-ddump-stranal -dsuppress-uniques -fno-call-arity -dppr-cols=200']) ===================================== testsuite/tests/stranal/sigs/T5075.stderr ===================================== @@ -1,7 +1,7 @@ ==================== Strictness signatures ==================== T5075.$trModule: -T5075.loop: +T5075.loop: @@ -13,6 +13,6 @@ T5075.loop: ==================== Strictness signatures ==================== T5075.$trModule: -T5075.loop: +T5075.loop: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/20d741fad5b3ac799f4a2aab3880831e73f9204e...eb30d28f6d985a7a222527021f1f6713f161879e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/20d741fad5b3ac799f4a2aab3880831e73f9204e...eb30d28f6d985a7a222527021f1f6713f161879e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 4 16:10:27 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Fri, 04 Dec 2020 11:10:27 -0500 Subject: [Git][ghc/ghc][wip/T18894] 2 commits: DmdAnal: Annotate top-level function bindings with demands (#18894) Message-ID: <5fca5f73d49f2_6b2147a61c6285d@gitlab.mail> Sebastian Graf pushed to branch wip/T18894 at Glasgow Haskell Compiler / GHC Commits: 21807b94 by Sebastian Graf at 2020-12-04T17:10:18+01:00 DmdAnal: Annotate top-level function bindings with demands (#18894) It's useful to annotate a non-exported top-level function like `g` in ```hs module Lib (h) where g :: Int -> Int -> (Int,Int) g m 1 = (m, 0) g m n = (2 * m, 2 `div` n) {-# NOINLINE g #-} h :: Int -> Int h 1 = 0 h m | odd m = snd (g m 2) | otherwise = uncurry (+) (g 2 m) ``` with its demand `UCU(CS(P(1P(U),SP(U))`, which tells us that whenever `g` was called, the second component of the returned pair was evaluated strictly. Since #18903 we do so for local functions, where we can see all calls. For top-level functions, we can assume that all *exported* functions are demanded according to `topDmd` and thus get sound demands for non-exported top-level functions. The demand on `g` is crucial information for Nested CPR, which may the go on and unbox `g` for the second pair component. That is true even if that pair component may diverge, as is the case for the call site `g 13 0`, which throws a div-by-zero exception. In `T18894b`, you can even see the new demand annotation enabling us to eta-expand a function that we wouldn't be able to eta-expand without Call Arity. We only track bindings of function type in order not to risk huge compile-time regressions, see `isInterestingTopLevelFn`. There was a CoreLint check that rejected strict demand annotations on recursive or top-level bindings, which seems completely unjustified. All the cases I investigated were fine, so I removed it. Fixes #18894. - - - - - 74613325 by Sebastian Graf at 2020-12-04T17:10:18+01:00 Demand: Simplify `CU(U)` to `U` (#19005) Both sub-demands encode the same information. This is a trivial change and already affects a few regression tests (e.g. `T5075`), so no separate regression test is necessary. - - - - - 18 changed files: - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Types/Demand.hs - compiler/GHC/Types/Id/Info.hs - testsuite/tests/arityanal/should_compile/Arity11.stderr - testsuite/tests/arityanal/should_compile/Arity16.stderr - + testsuite/tests/stranal/should_compile/T18894.hs - + testsuite/tests/stranal/should_compile/T18894.stderr - + testsuite/tests/stranal/should_compile/T18894b.hs - + testsuite/tests/stranal/should_compile/T18894b.stderr - testsuite/tests/stranal/should_compile/all.T - testsuite/tests/stranal/sigs/T5075.stderr Changes: ===================================== compiler/GHC/Core/FVs.hs ===================================== @@ -525,12 +525,11 @@ ruleLhsFVIds (Rule { ru_bndrs = bndrs, ru_args = args }) = filterFV isLocalId $ addBndrs bndrs (exprs_fvs args) ruleRhsFreeIds :: CoreRule -> VarSet --- ^ This finds all locally-defined free Ids on the left hand side of a rule +-- ^ This finds all locally-defined free Ids on the right hand side of a rule -- and returns them as a non-deterministic set ruleRhsFreeIds (BuiltinRule {}) = emptyVarSet -ruleRhsFreeIds (Rule { ru_bndrs = bndrs, ru_args = args }) - = fvVarSet $ filterFV isLocalId $ - addBndrs bndrs $ exprs_fvs args +ruleRhsFreeIds (Rule { ru_bndrs = bndrs, ru_rhs = rhs }) + = fvVarSet $ filterFV isLocalId $ addBndrs bndrs $ expr_fvs rhs {- Note [Rule free var hack] (Not a hack any more) ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -623,14 +623,6 @@ lintLetBind top_lvl rec_flag binder rhs rhs_ty || exprIsTickedString rhs) (badBndrTyMsg binder (text "unlifted")) - -- Check that if the binder is top-level or recursive, it's not - -- demanded. Primitive string literals are exempt as there is no - -- computation to perform, see Note [Core top-level string literals]. - ; checkL (not (isStrictId binder) - || (isNonRec rec_flag && not (isTopLevel top_lvl)) - || exprIsTickedString rhs) - (mkStrictMsg binder) - -- Check that if the binder is at the top level and has type Addr#, -- that it is a string literal, see -- Note [Core top-level string literals]. @@ -3119,13 +3111,6 @@ badBndrTyMsg binder what = vcat [ text "The type of this binder is" <+> what <> colon <+> ppr binder , text "Binder's type:" <+> ppr (idType binder) ] -mkStrictMsg :: Id -> MsgDoc -mkStrictMsg binder - = vcat [hsep [text "Recursive or top-level binder has strict demand info:", - ppr binder], - hsep [text "Binder's demand info:", ppr (idDemandInfo binder)] - ] - mkNonTopExportedMsg :: Id -> MsgDoc mkNonTopExportedMsg binder = hsep [text "Non-top-level binder is marked as exported:", ppr binder] ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -37,6 +37,7 @@ import GHC.Core.Type import GHC.Core.FVs ( exprFreeIds, ruleRhsFreeIds ) import GHC.Core.Coercion ( Coercion, coVarsOfCo ) import GHC.Core.FamInstEnv +import GHC.Core.Opt.Arity ( typeArity ) import GHC.Utils.Misc import GHC.Utils.Panic import GHC.Data.Maybe ( isJust ) @@ -64,28 +65,60 @@ data DmdAnalOpts = DmdAnalOpts -- -- Note: use `seqBinds` on the result to avoid leaks due to lazyness (cf Note -- [Stamp out space leaks in demand analysis]) -dmdAnalProgram :: DmdAnalOpts -> FamInstEnvs -> CoreProgram -> CoreProgram -dmdAnalProgram opts fam_envs binds = binds_plus_dmds - where - env = emptyAnalEnv opts fam_envs - binds_plus_dmds = snd $ mapAccumL dmdAnalTopBind env binds - --- Analyse a (group of) top-level binding(s) -dmdAnalTopBind :: AnalEnv - -> CoreBind - -> (AnalEnv, CoreBind) -dmdAnalTopBind env (NonRec id rhs) - = ( extendAnalEnv TopLevel env id sig - , NonRec (setIdStrictness id sig) rhs') +dmdAnalProgram :: DmdAnalOpts -> FamInstEnvs -> [CoreRule] -> CoreProgram -> CoreProgram +dmdAnalProgram opts fam_envs rules binds + = snd $ go (emptyAnalEnv opts fam_envs) binds where - ( _, sig, rhs') = dmdAnalRhsLetDown Nothing env topSubDmd id rhs + -- See Note [Analysing top-level bindings] + -- TLDR; We analyse them like + -- let ex1 = ... in (ex1, let nex1 = ... in let ex2 = ... in (ex2, ...))) + -- where ex* are exported (or RULE mentions) and nex* are not. + go _ [] = (nopDmdType, []) + go env (b:bs) = cons_up $ dmdAnalBind TopLevel env topSubDmd b anal_body + where + anal_body env' + | (body_ty, bs') <- go env' bs + = (add_exported_uses env' body_ty (bindersOf b), bs') + + cons_up :: (a, b, [b]) -> (a, [b]) + cons_up (dmd_ty, b', bs') = (dmd_ty, b':bs') + + add_exported_uses :: AnalEnv -> DmdType -> [Id] -> DmdType + add_exported_uses env = foldl' (add_exported_use env) + + -- | If @e@ is denoted by @dmd_ty@, then @add_exported_use _ dmd_ty id@ + -- corresponds to the demand type of @(id, e)@, but is a lot more direct. + -- See Note [Analysing top-level bindings]. + add_exported_use :: AnalEnv -> DmdType -> Id -> DmdType + add_exported_use env dmd_ty id + -- See Note [Absence analysis for stable unfoldings and RULES] + | isExportedId id || elemVarSet id rule_fvs + , Just (sig, _) <- lookupSigEnv env id + -- The following line should coincide with + -- @fst $ fst $ dmdAnalStar env topDmd (Var id)@, the denotation + -- of @id@ in @(id, e)@. + , let exported_use_env = multDmdEnv C_0N (strictSigDmdEnv sig) + = dmd_ty `plusDmdType` mkPlusDmdArg exported_use_env + | otherwise + = dmd_ty -dmdAnalTopBind env (Rec pairs) - = (env', Rec pairs') - where - (env', _, pairs') = dmdFix TopLevel env topSubDmd pairs - -- We get two iterations automatically - -- c.f. the NonRec case above + rule_fvs :: IdSet + rule_fvs = foldr (unionVarSet . ruleRhsFreeIds) emptyVarSet rules + +-- | Whether we want to store demands on a top-level Id or just default +-- to 'topDmd'. +-- +-- Basically, we want to now how top-level *functions* are *used* +-- (e.g. called), but aren't interested in whether they were called strictly +-- or not. Other top-level bindings are boring. +isInterestingTopLevelFn :: Id -> Bool +-- SG tried to set this to True and got a +2% ghc/alloc regression in T5642 +-- (which is dominated by the Simplifier) at no gain in analysis precision. +-- If there was a gain, that regression might be acceptable. +-- Plus, we could use LetUp for thunks and share some code with local let +-- bindings. +isInterestingTopLevelFn id = + typeArity (idType id) `lengthExceeds` 0 {- Note [Stamp out space leaks in demand analysis] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -105,8 +138,56 @@ generation would hold on to an extra copy of the Core program, via unforced thunks in demand or strictness information; and it is the most memory-intensive part of the compilation process, so this added seqBinds makes a big difference in peak memory usage. --} +Note [Analysing top-level bindings] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider a CoreProgram like + e1 = ... + n1 = ... + e2 = \a b -> ... fst (n1 a b) ... + n2 = \c d -> ... snd (e2 c d) ... + ... +where e* are exported, but n* are not. +Intuitively, we can see that @n1@ is only ever called with two arguments +and in every call site, the first component of the result of the call +is evaluated. Thus, we'd like it to have idDemandInfo @UCU(C1(P(SU,A))@. + +(This can be exploited by a Nested CPR pass which may then unbox the +first component of the pair returned from @n1 at . Or if @n1@ had arity +1 before, we may now eta-expand to arity 2.) + +NB: We may *not* give e2 a similar annotation, because it is exported and +external callers might use it in arbitrary ways, expressed by 'topDmd'. + +How do we get this result? Answer: By analysing the program as if it was a let +expression of this form: + let e1 = ... in + (e1, let n1 = ... in + ( let e2 = ... in + (e2, let n2 = ... in + ( ...)))) +E.g. putting all bindings in nested lets, where whenever it binds an exported +binding, the body is a *pair* of an occurrence of the exported binder and +the other nested lets. Of course, we will not actually build that CoreExpr! +Instead we faithfully simulate analysis of said expression by adding the +free variable 'DmdEnv' of @e*@'s strictness signatures to the 'DmdType' we +get from analysing the nested bindings. + +You might also wonder why we didn't analyse in terms of the simpler + let e1 = ... in + let n1 = ... in + let e2 = ... in + let n2 = ... in + (e1,e2, ...) +The reason is analysis performance: If @e1@ uses many free variables, we'll +unnecessarily carry their demands around with us from the moment we analyse +the pair to the moment we bubble back up to the binding for @e1 at . +This blows up e.g. @T10370 at . + +A final note about variables occuring free in RULE RHSs: They are to be handled +pretty much like exported Ids. +See also Note [Absence analysis for stable unfoldings and RULES] +-} {- ************************************************************************ @@ -114,7 +195,103 @@ seqBinds makes a big difference in peak memory usage. \subsection{The analyser itself} * * ************************************************************************ +-} +-- | Analyse a binding group and its \"body\", e.g. where it is in scope. +-- +-- It calls a function that knows how to analyse this \"body\" given +-- an 'AnalEnv' with updated demand signatures for the binding group +-- (reflecting their 'idStrictnessInfo') and expects to receive a +-- 'DmdType' in return, which it uses to annotate the binding group with their +-- 'idDemandInfo'. +dmdAnalBind + :: TopLevelFlag + -> AnalEnv + -> SubDemand -- ^ Demand put on the "body" + -- (important for join points) + -> CoreBind + -> (AnalEnv -> (DmdType, a)) -- ^ How to analyse the "body", e.g. + -- where the binding is in scope + -> (DmdType, CoreBind, a) +dmdAnalBind top_lvl env dmd bind anal_body = case bind of + NonRec id rhs + | useLetUp top_lvl id + -> dmdAnalBindLetUp top_lvl env id rhs anal_body + _ -> dmdAnalBindLetDown top_lvl env dmd bind anal_body + +-- | Annotates uninteresting top level functions ('isInterestingTopLevelFn') +-- with 'topDmd', the rest with the given demand. +setBindIdDemandInfo :: TopLevelFlag -> Id -> Demand -> Id +setBindIdDemandInfo top_lvl id dmd = setIdDemandInfo id $ case top_lvl of + TopLevel | not (isInterestingTopLevelFn id) -> topDmd + _ -> dmd + +-- | Let bindings can be processed in two ways: +-- Down (RHS before body) or Up (body before RHS). +-- This function handles the up variant. +-- +-- It is very simple. For let x = rhs in body +-- * Demand-analyse 'body' in the current environment +-- * Find the demand, 'rhs_dmd' placed on 'x' by 'body' +-- * Demand-analyse 'rhs' in 'rhs_dmd' +-- +-- This is used for a non-recursive local let without manifest lambdas (see +-- 'useLetUp'). +-- +-- This is the LetUp rule in the paper “Higher-Order Cardinality Analysis”. +dmdAnalBindLetUp :: TopLevelFlag -> AnalEnv -> Id -> CoreExpr -> (AnalEnv -> (DmdType, a)) -> (DmdType, CoreBind, a) +dmdAnalBindLetUp top_lvl env id rhs anal_body = (final_ty, NonRec id' rhs', body') + where + (body_ty, body') = anal_body env + (body_ty', id_dmd) = findBndrDmd env notArgOfDfun body_ty id + id' = setBindIdDemandInfo top_lvl id id_dmd + (rhs_ty, rhs') = dmdAnalStar env (dmdTransformThunkDmd rhs id_dmd) rhs + final_ty = body_ty' `plusDmdType` rhs_ty + +-- | Let bindings can be processed in two ways: +-- Down (RHS before body) or Up (body before RHS). +-- This function handles the down variant. +-- +-- It computes a demand signature (by means of 'dmdAnalRhsSig') and uses +-- that at call sites in the body. +-- +-- It is used for toplevel definitions, recursive definitions and local +-- non-recursive definitions that have manifest lambdas (cf. 'useLetUp'). +-- Local non-recursive definitions without a lambda are handled with LetUp. +-- +-- This is the LetDown rule in the paper “Higher-Order Cardinality Analysis”. +dmdAnalBindLetDown :: TopLevelFlag -> AnalEnv -> SubDemand -> CoreBind -> (AnalEnv -> (DmdType, a)) -> (DmdType, CoreBind, a) +dmdAnalBindLetDown top_lvl env dmd bind anal_body = case bind of + NonRec id rhs + | (env', lazy_fv, id1, rhs1) <- + dmdAnalRhsSig top_lvl NonRecursive env dmd id rhs + -> do_rest env' lazy_fv [(id1, rhs1)] (uncurry NonRec . only) + Rec pairs + | (env', lazy_fv, pairs') <- dmdFix top_lvl env dmd pairs + -> do_rest env' lazy_fv pairs' Rec + where + do_rest env' lazy_fv pairs1 build_bind = (final_ty, build_bind pairs2, body') + where + (body_ty, body') = anal_body env' + -- see Note [Lazy and unleashable free variables] + dmd_ty = addLazyFVs body_ty lazy_fv + (!final_ty, id_dmds) = findBndrsDmds env' dmd_ty (map fst pairs1) + pairs2 = zipWith do_one pairs1 id_dmds + do_one (id', rhs') dmd = (setBindIdDemandInfo top_lvl id' dmd, rhs') + -- If the actual demand is better than the vanilla call + -- demand, you might think that we might do better to re-analyse + -- the RHS with the stronger demand. + -- But (a) That seldom happens, because it means that *every* path in + -- the body of the let has to use that stronger demand + -- (b) It often happens temporarily in when fixpointing, because + -- the recursive function at first seems to place a massive demand. + -- But we don't want to go to extra work when the function will + -- probably iterate to something less demanding. + -- In practice, all the times the actual demand on id2 is more than + -- the vanilla call demand seem to be due to (b). So we don't + -- bother to re-analyse the RHS. + +{- Note [Ensure demand is strict] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ It's important not to analyse e with a lazy demand because @@ -194,7 +371,7 @@ dmdAnal' env dmd (App fun arg) -- Crucially, coercions /are/ handled here, because they are -- value arguments (#10288) let - call_dmd = mkCallDmd dmd + call_dmd = mkCalledOnceDmd dmd (fun_ty, fun') = dmdAnal env call_dmd fun (arg_dmd, res_ty) = splitDmdTy fun_ty (arg_ty, arg') = dmdAnalStar env (dmdTransformThunkDmd arg arg_dmd) arg @@ -295,60 +472,11 @@ dmdAnal' env dmd (Case scrut case_bndr ty alts) -- , text "res_ty" <+> ppr res_ty ]) $ (res_ty, Case scrut' case_bndr' ty alts') --- Let bindings can be processed in two ways: --- Down (RHS before body) or Up (body before RHS). --- The following case handle the up variant. --- --- It is very simple. For let x = rhs in body --- * Demand-analyse 'body' in the current environment --- * Find the demand, 'rhs_dmd' placed on 'x' by 'body' --- * Demand-analyse 'rhs' in 'rhs_dmd' --- --- This is used for a non-recursive local let without manifest lambdas. --- This is the LetUp rule in the paper “Higher-Order Cardinality Analysis”. -dmdAnal' env dmd (Let (NonRec id rhs) body) - | useLetUp id - = (final_ty, Let (NonRec id' rhs') body') +dmdAnal' env dmd (Let bind body) + = (final_ty, Let bind' body') where - (body_ty, body') = dmdAnal env dmd body - (body_ty', id_dmd) = findBndrDmd env notArgOfDfun body_ty id - id' = setIdDemandInfo id id_dmd - - (rhs_ty, rhs') = dmdAnalStar env (dmdTransformThunkDmd rhs id_dmd) rhs - final_ty = body_ty' `plusDmdType` rhs_ty - -dmdAnal' env dmd (Let (NonRec id rhs) body) - = (body_ty2, Let (NonRec id2 rhs') body') - where - (lazy_fv, sig, rhs') = dmdAnalRhsLetDown Nothing env dmd id rhs - id1 = setIdStrictness id sig - env1 = extendAnalEnv NotTopLevel env id sig - (body_ty, body') = dmdAnal env1 dmd body - (body_ty1, id2) = annotateBndr env body_ty id1 - body_ty2 = addLazyFVs body_ty1 lazy_fv -- see Note [Lazy and unleashable free variables] - - -- If the actual demand is better than the vanilla call - -- demand, you might think that we might do better to re-analyse - -- the RHS with the stronger demand. - -- But (a) That seldom happens, because it means that *every* path in - -- the body of the let has to use that stronger demand - -- (b) It often happens temporarily in when fixpointing, because - -- the recursive function at first seems to place a massive demand. - -- But we don't want to go to extra work when the function will - -- probably iterate to something less demanding. - -- In practice, all the times the actual demand on id2 is more than - -- the vanilla call demand seem to be due to (b). So we don't - -- bother to re-analyse the RHS. - -dmdAnal' env dmd (Let (Rec pairs) body) - = let - (env', lazy_fv, pairs') = dmdFix NotTopLevel env dmd pairs - (body_ty, body') = dmdAnal env' dmd body - body_ty1 = deleteFVs body_ty (map fst pairs) - body_ty2 = addLazyFVs body_ty1 lazy_fv -- see Note [Lazy and unleashable free variables] - in - body_ty2 `seq` - (body_ty2, Let (Rec pairs') body') + (final_ty, bind', body') = dmdAnalBind NotTopLevel env dmd bind go' + go' env' = dmdAnal env' dmd body -- | A simple, syntactic analysis of whether an expression MAY throw a precise -- exception when evaluated. It's always sound to return 'True'. @@ -582,9 +710,13 @@ dmdTransform env var dmd | Just (sig, top_lvl) <- lookupSigEnv env var , let fn_ty = dmdTransformSig sig dmd = -- pprTrace "dmdTransform:LetDown" (vcat [ppr var, ppr sig, ppr dmd, ppr fn_ty]) $ - if isTopLevel top_lvl - then fn_ty -- Don't record demand on top-level things - else addVarDmd fn_ty var (C_11 :* dmd) + case top_lvl of + NotTopLevel -> addVarDmd fn_ty var (C_11 :* dmd) + TopLevel + | isInterestingTopLevelFn var + -> addVarDmd fn_ty var (C_0N `multDmd` (C_11 :* dmd)) -- discard strictness + | otherwise + -> fn_ty -- don't bother tracking; just annotate with 'topDmd' later -- Everything else: -- * Local let binders for which we use LetUp (cf. 'useLetUp') -- * Lambda binders @@ -599,46 +731,46 @@ dmdTransform env var dmd * * ********************************************************************* -} --- Let bindings can be processed in two ways: --- Down (RHS before body) or Up (body before RHS). --- dmdAnalRhsLetDown implements the Down variant: --- * assuming a demand of +-- | @dmdAnalRhsSig@ analyses the given RHS to compute a demand signature +-- for the LetDown rule. It works as follows: +-- +-- * assuming a demand of -- * looking at the definition -- * determining a strictness signature -- --- It is used for toplevel definition, recursive definitions and local --- non-recursive definitions that have manifest lambdas. --- Local non-recursive definitions without a lambda are handled with LetUp. --- --- This is the LetDown rule in the paper “Higher-Order Cardinality Analysis”. -dmdAnalRhsLetDown - :: Maybe [Id] -- Just bs <=> recursive, Nothing <=> non-recursive +-- Since it assumed a demand of , the resulting signature is applicable at +-- any call site. +dmdAnalRhsSig + :: TopLevelFlag + -> RecFlag -> AnalEnv -> SubDemand -> Id -> CoreExpr - -> (DmdEnv, StrictSig, CoreExpr) + -> (AnalEnv, DmdEnv, Id, CoreExpr) -- Process the RHS of the binding, add the strictness signature -- to the Id, and augment the environment with the signature as well. -- See Note [NOINLINE and strictness] -dmdAnalRhsLetDown rec_flag env let_dmd id rhs - = -- pprTrace "dmdAnalRhsLetDown" (ppr id $$ ppr let_dmd $$ ppr sig $$ ppr lazy_fv) $ - (lazy_fv, sig, rhs') +dmdAnalRhsSig top_lvl rec_flag env let_dmd id rhs + = -- pprTrace "dmdAnalRhsSig" (ppr id $$ ppr let_dmd $$ ppr sig $$ ppr lazy_fv) $ + (env', lazy_fv, id', rhs') where rhs_arity = idArity id + -- See Note [Demand signatures are computed for a threshold demand based on idArity] rhs_dmd -- See Note [Demand analysis for join points] -- See Note [Invariants on join points] invariant 2b, in GHC.Core -- rhs_arity matches the join arity of the join point | isJoinId id - = mkCallDmds rhs_arity let_dmd + = mkCalledOnceDmds rhs_arity let_dmd | otherwise - -- NB: rhs_arity - -- See Note [Demand signatures are computed for a threshold demand based on idArity] - = mkRhsDmd env rhs_arity rhs + = mkCalledOnceDmds rhs_arity topSubDmd (rhs_dmd_ty, rhs') = dmdAnal env rhs_dmd rhs DmdType rhs_fv rhs_dmds rhs_div = rhs_dmd_ty sig = mkStrictSigForArity rhs_arity (DmdType sig_fv rhs_dmds rhs_div) + id' = id `setIdStrictness` sig + env' = extendAnalEnv top_lvl env id' sig + -- See Note [Aggregated demand for cardinality] -- FIXME: That Note doesn't explain the following lines at all. The reason -- is really much different: When we have a recursive function, we'd @@ -651,8 +783,8 @@ dmdAnalRhsLetDown rec_flag env let_dmd id rhs -- we'd have to do an additional iteration. reuseEnv makes sure that -- we never get used-once info for FVs of recursive functions. rhs_fv1 = case rec_flag of - Just bs -> reuseEnv (delVarEnvList rhs_fv bs) - Nothing -> rhs_fv + Recursive -> reuseEnv rhs_fv + NonRecursive -> rhs_fv rhs_fv2 = rhs_fv1 `keepAliveDmdEnv` extra_fvs -- Find the RHS free vars of the unfoldings and RULES @@ -669,13 +801,6 @@ dmdAnalRhsLetDown rec_flag env let_dmd id rhs = exprFreeIds unf_body | otherwise = emptyVarSet --- | @mkRhsDmd env rhs_arity rhs@ creates a 'SubDemand' for --- unleashing on the given function's @rhs@, by creating --- a call demand of @rhs_arity@ --- See Historical Note [Product demands for function body] -mkRhsDmd :: AnalEnv -> Arity -> CoreExpr -> SubDemand -mkRhsDmd _env rhs_arity _rhs = mkCallDmds rhs_arity topSubDmd - -- | If given the (local, non-recursive) let-bound 'Id', 'useLetUp' determines -- whether we should process the binding up (body before rhs) or down (rhs -- before body). @@ -720,8 +845,8 @@ mkRhsDmd _env rhs_arity _rhs = mkCallDmds rhs_arity topSubDmd -- * For a more convincing example with join points, see Note [Demand analysis -- for join points]. -- -useLetUp :: Var -> Bool -useLetUp f = idArity f == 0 && not (isJoinId f) +useLetUp :: TopLevelFlag -> Var -> Bool +useLetUp top_lvl f = isNotTopLevel top_lvl && idArity f == 0 && not (isJoinId f) {- Note [Demand analysis for join points] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -939,8 +1064,6 @@ dmdFix :: TopLevelFlag dmdFix top_lvl env let_dmd orig_pairs = loop 1 initial_pairs where - bndrs = map fst orig_pairs - -- See Note [Initialising strictness] initial_pairs | ae_virgin env = [(setIdStrictness id botSig, rhs) | (id, rhs) <- orig_pairs ] | otherwise = orig_pairs @@ -990,10 +1113,8 @@ dmdFix top_lvl env let_dmd orig_pairs = -- pprTrace "my_downRhs" (ppr id $$ ppr (idStrictness id) $$ ppr sig) $ ((env', lazy_fv'), (id', rhs')) where - (lazy_fv1, sig, rhs') = dmdAnalRhsLetDown (Just bndrs) env let_dmd id rhs - lazy_fv' = plusVarEnv_C plusDmd lazy_fv lazy_fv1 - env' = extendAnalEnv top_lvl env id sig - id' = setIdStrictness id sig + (env', lazy_fv1, id', rhs') = dmdAnalRhsSig top_lvl Recursive env let_dmd id rhs + lazy_fv' = plusVarEnv_C plusDmd lazy_fv lazy_fv1 zapIdStrictness :: [(Id, CoreExpr)] -> [(Id, CoreExpr)] zapIdStrictness pairs = [(setIdStrictness id nopSig, rhs) | (id, rhs) <- pairs ] @@ -1090,7 +1211,7 @@ addLazyFVs dmd_ty lazy_fvs -- demand with the bottom coming up from 'error' -- -- I got a loop in the fixpointer without this, due to an interaction - -- with the lazy_fv filtering in dmdAnalRhsLetDown. Roughly, it was + -- with the lazy_fv filtering in dmdAnalRhsSig. Roughly, it was -- letrec f n x -- = letrec g y = x `fatbar` -- letrec h z = z + ...g... @@ -1156,10 +1277,6 @@ annotateLamIdBndr env arg_of_dfun dmd_ty id main_ty = addDemand dmd dmd_ty' (dmd_ty', dmd) = findBndrDmd env arg_of_dfun dmd_ty id -deleteFVs :: DmdType -> [Var] -> DmdType -deleteFVs (DmdType fvs dmds res) bndrs - = DmdType (delVarEnvList fvs bndrs) dmds res - {- Note [NOINLINE and strictness] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Core/Opt/Pipeline.hs ===================================== @@ -65,6 +65,7 @@ import GHC.Types.SrcLoc import GHC.Types.Id import GHC.Types.Id.Info import GHC.Types.Basic +import GHC.Types.Demand ( zapDmdEnvSig ) import GHC.Types.Var.Set import GHC.Types.Var.Env import GHC.Types.Unique.Supply ( UniqSupply, mkSplitUniqSupply, splitUniqSupply ) @@ -495,7 +496,7 @@ doCorePass CoreDoExitify = {-# SCC "Exitify" #-} doPass exitifyProgram doCorePass CoreDoDemand = {-# SCC "DmdAnal" #-} - doPassDFM dmdAnal + doPassDFRM dmdAnal doCorePass CoreDoCpr = {-# SCC "CprAnal" #-} doPassDFM cprAnalProgram @@ -575,6 +576,13 @@ doPassDFM do_pass guts = do let fam_envs = (p_fam_env, mg_fam_inst_env guts) doPassM (liftIO . do_pass dflags fam_envs) guts +doPassDFRM :: (DynFlags -> FamInstEnvs -> [CoreRule] -> CoreProgram -> IO CoreProgram) -> ModGuts -> CoreM ModGuts +doPassDFRM do_pass guts = do + dflags <- getDynFlags + p_fam_env <- getPackageFamInstEnv + let fam_envs = (p_fam_env, mg_fam_inst_env guts) + doPassM (liftIO . do_pass dflags fam_envs (mg_rules guts)) guts + doPassDFU :: (DynFlags -> FamInstEnvs -> UniqSupply -> CoreProgram -> CoreProgram) -> ModGuts -> CoreM ModGuts doPassDFU do_pass guts = do dflags <- getDynFlags @@ -1088,13 +1096,13 @@ transferIdInfo exported_id local_id -dmdAnal :: DynFlags -> FamInstEnvs -> CoreProgram -> IO CoreProgram -dmdAnal dflags fam_envs binds = do +dmdAnal :: DynFlags -> FamInstEnvs -> [CoreRule] -> CoreProgram -> IO CoreProgram +dmdAnal dflags fam_envs rules binds = do let opts = DmdAnalOpts { dmd_strict_dicts = gopt Opt_DictsStrict dflags } - binds_plus_dmds = dmdAnalProgram opts fam_envs binds + binds_plus_dmds = dmdAnalProgram opts fam_envs rules binds Err.dumpIfSet_dyn dflags Opt_D_dump_str_signatures "Strictness signatures" FormatText $ - dumpIdInfoOfProgram (ppr . strictnessInfo) binds_plus_dmds + dumpIdInfoOfProgram (ppr . zapDmdEnvSig . strictnessInfo) binds_plus_dmds -- See Note [Stamp out space leaks in demand analysis] in GHC.Core.Opt.DmdAnal seqBinds binds_plus_dmds `seq` return binds_plus_dmds ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -598,11 +598,10 @@ addJoinFlts = appOL mkRecFloats :: SimplFloats -> SimplFloats -- Flattens the floats into a single Rec group, -- They must either all be lifted LetFloats or all JoinFloats -mkRecFloats floats@(SimplFloats { sfLetFloats = LetFloats bs ff +mkRecFloats floats@(SimplFloats { sfLetFloats = LetFloats bs _ff , sfJoinFloats = jbs , sfInScope = in_scope }) - = ASSERT2( case ff of { FltLifted -> True; _ -> False }, ppr (fromOL bs) ) - ASSERT2( isNilOL bs || isNilOL jbs, ppr floats ) + = ASSERT2( isNilOL bs || isNilOL jbs, ppr floats ) SimplFloats { sfLetFloats = floats' , sfJoinFloats = jfloats' , sfInScope = in_scope } ===================================== compiler/GHC/Core/Opt/WorkWrap.hs ===================================== @@ -484,7 +484,7 @@ tryWW dflags fam_envs is_rec fn_id rhs | is_fun && is_eta_exp = splitFun dflags fam_envs new_fn_id fn_info wrap_dmds div cpr rhs - | is_thunk -- See Note [Thunk splitting] + | isNonRec is_rec, is_thunk -- See Note [Thunk splitting] = splitThunk dflags fam_envs is_rec new_fn_id rhs | otherwise ===================================== compiler/GHC/Core/Opt/WorkWrap/Utils.hs ===================================== @@ -1275,10 +1275,14 @@ mk_absent_let dflags fam_envs arg abs_rhs = mkAbsentErrorApp arg_ty msg msg = showSDoc (gopt_set dflags Opt_SuppressUniques) - (ppr arg <+> ppr (idType arg) <+> file_msg) + (vcat + [ text "Arg:" <+> ppr arg + , text "Type:" <+> ppr arg_ty + , file_msg + ]) file_msg = case outputFile dflags of Nothing -> empty - Just f -> text "in output file " <+> quotes (text f) + Just f -> text "In output file " <+> quotes (text f) -- We need to suppress uniques here because otherwise they'd -- end up in the generated code as strings. This is bad for -- determinism, because with different uniques the strings ===================================== compiler/GHC/Core/Tidy.hs ===================================== @@ -21,7 +21,7 @@ import GHC.Core import GHC.Core.Seq ( seqUnfolding ) import GHC.Types.Id import GHC.Types.Id.Info -import GHC.Types.Demand ( zapUsageEnvSig ) +import GHC.Types.Demand ( zapDmdEnvSig ) import GHC.Core.Type ( tidyType, tidyVarBndr ) import GHC.Core.Coercion ( tidyCo ) import GHC.Types.Var @@ -206,7 +206,7 @@ tidyLetBndr rec_tidy_env env@(tidy_env, var_env) id new_info = vanillaIdInfo `setOccInfo` occInfo old_info `setArityInfo` arityInfo old_info - `setStrictnessInfo` zapUsageEnvSig (strictnessInfo old_info) + `setStrictnessInfo` zapDmdEnvSig (strictnessInfo old_info) `setDemandInfo` demandInfo old_info `setInlinePragInfo` inlinePragInfo old_info `setUnfoldingInfo` new_unf ===================================== compiler/GHC/Types/Demand.hs ===================================== @@ -34,14 +34,14 @@ module GHC.Types.Demand ( lazyApply1Dmd, lazyApply2Dmd, strictOnceApply1Dmd, strictManyApply1Dmd, -- ** Other @Demand@ operations oneifyCard, oneifyDmd, strictifyDmd, strictifyDictDmd, mkWorkerDemand, - peelCallDmd, peelManyCalls, mkCallDmd, mkCallDmds, + peelCallDmd, peelManyCalls, mkCalledOnceDmd, mkCalledOnceDmds, addCaseBndrDmd, -- ** Extracting one-shot information argOneShots, argsOneShots, saturatedByOneShots, -- * Demand environments DmdEnv, emptyDmdEnv, - keepAliveDmdEnv, reuseEnv, + keepAliveDmdEnv, reuseEnv, multDmdEnv, -- * Divergence Divergence(..), topDiv, botDiv, exnDiv, lubDivergence, isDeadEndDiv, @@ -73,7 +73,7 @@ module GHC.Types.Demand ( seqDemand, seqDemandList, seqDmdType, seqStrictSig, -- * Zapping usage information - zapUsageDemand, zapUsageEnvSig, zapUsedOnceDemand, zapUsedOnceSig + zapUsageDemand, zapDmdEnvSig, zapUsedOnceDemand, zapUsedOnceSig ) where #include "HsVersions.h" @@ -278,7 +278,8 @@ data SubDemand -- ^ @Call n sd@ describes the evaluation context of @n@ function -- applications, where every individual result is evaluated according to @sd at . -- @sd@ is /relative/ to a single call, cf. Note [Call demands are relative]. - -- Used only for values of function type. + -- Used only for values of function type. Use the smart constructor 'mkCall' + -- whenever possible! | Prod ![Demand] -- ^ @Prod ds@ describes the evaluation context of a case scrutinisation -- on an expression of product type, where the product components are @@ -306,7 +307,7 @@ polyDmd C_1N = C_1N :* poly1N polyDmd C_10 = C_10 :* poly10 -- | A smart constructor for 'Prod', applying rewrite rules along the semantic --- equalities @Prod [polyDmd n, ...] === polyDmd n@, simplifying to 'Poly' +-- equality @Prod [polyDmd n, ...] === polyDmd n@, simplifying to 'Poly' -- 'SubDemand's when possible. Note that this degrades boxity information! E.g. a -- polymorphic demand will never unbox. mkProd :: [Demand] -> SubDemand @@ -335,6 +336,13 @@ viewProd _ _ = Nothing {-# INLINE viewProd #-} -- we want to fuse away the replicate and the allocation -- for Arity. Otherwise, #18304 bites us. +-- | A smart constructor for 'Call', applying rewrite rules along the semantic +-- equality @Call n (Poly n) === Poly n@, simplifying to 'Poly' 'SubDemand's +-- when possible. +mkCall :: Card -> SubDemand -> SubDemand +mkCall n cd@(Poly m) | n == m = cd +mkCall n cd = Call n cd + -- | @viewCall sd@ interprets @sd@ as a 'Call', expanding 'Poly' demands as -- necessary. viewCall :: SubDemand -> Maybe (Card, SubDemand) @@ -356,8 +364,8 @@ lubSubDmd (Prod ds1) (viewProd (length ds1) -> Just ds2) = -- Handle Call lubSubDmd (Call n1 d1) (viewCall -> Just (n2, d2)) -- See Note [Call demands are relative] - | isAbs n2 = Call (lubCard n1 n2) (lubSubDmd d1 botSubDmd) - | otherwise = Call (lubCard n1 n2) (lubSubDmd d1 d2) + | isAbs n2 = mkCall (lubCard n1 n2) (lubSubDmd d1 botSubDmd) + | otherwise = mkCall (lubCard n1 n2) (lubSubDmd d1 d2) -- Handle Poly lubSubDmd (Poly n1) (Poly n2) = Poly (lubCard n1 n2) -- Make use of reflexivity (so we'll match the Prod or Call cases again). @@ -377,8 +385,8 @@ plusSubDmd (Prod ds1) (viewProd (length ds1) -> Just ds2) = -- Handle Call plusSubDmd (Call n1 d1) (viewCall -> Just (n2, d2)) -- See Note [Call demands are relative] - | isAbs n2 = Call (plusCard n1 n2) (lubSubDmd d1 botSubDmd) - | otherwise = Call (plusCard n1 n2) (lubSubDmd d1 d2) + | isAbs n2 = mkCall (plusCard n1 n2) (lubSubDmd d1 botSubDmd) + | otherwise = mkCall (plusCard n1 n2) (lubSubDmd d1 d2) -- Handle Poly plusSubDmd (Poly n1) (Poly n2) = Poly (plusCard n1 n2) -- Make use of reflexivity (so we'll match the Prod or Call cases again). @@ -407,7 +415,7 @@ multSubDmd :: Card -> SubDemand -> SubDemand multSubDmd n sd | Just sd' <- multTrivial n seqSubDmd sd = sd' multSubDmd n (Poly n') = Poly (multCard n n') -multSubDmd n (Call n' sd) = Call (multCard n n') sd -- See Note [Call demands are relative] +multSubDmd n (Call n' sd) = mkCall (multCard n n') sd -- See Note [Call demands are relative] multSubDmd n (Prod ds) = Prod (map (multDmd n) ds) multDmd :: Card -> Demand -> Demand @@ -457,22 +465,22 @@ evalDmd = C_1N :* topSubDmd -- | First argument of 'GHC.Exts.maskAsyncExceptions#': @SCS(U)@. -- Called exactly once. strictOnceApply1Dmd :: Demand -strictOnceApply1Dmd = C_11 :* Call C_11 topSubDmd +strictOnceApply1Dmd = C_11 :* mkCall C_11 topSubDmd -- | First argument of 'GHC.Exts.atomically#': @MCM(U)@. -- Called at least once, possibly many times. strictManyApply1Dmd :: Demand -strictManyApply1Dmd = C_1N :* Call C_1N topSubDmd +strictManyApply1Dmd = C_1N :* mkCall C_1N topSubDmd -- | First argument of catch#: @1C1(U)@. -- Evaluates its arg lazily, but then applies it exactly once to one argument. lazyApply1Dmd :: Demand -lazyApply1Dmd = C_01 :* Call C_01 topSubDmd +lazyApply1Dmd = C_01 :* mkCall C_01 topSubDmd -- | Second argument of catch#: @1C1(CS(U))@. -- Calls its arg lazily, but then applies it exactly once to an additional argument. lazyApply2Dmd :: Demand -lazyApply2Dmd = C_01 :* Call C_01 (Call C_11 topSubDmd) +lazyApply2Dmd = C_01 :* mkCall C_01 (mkCall C_11 topSubDmd) -- | Make a 'Demand' evaluated at-most-once. oneifyDmd :: Demand -> Demand @@ -512,12 +520,12 @@ strictifyDictDmd ty (n :* Prod ds) strictifyDictDmd _ dmd = dmd -- | Wraps the 'SubDemand' with a one-shot call demand: @d@ -> @CS(d)@. -mkCallDmd :: SubDemand -> SubDemand -mkCallDmd sd = Call C_11 sd +mkCalledOnceDmd :: SubDemand -> SubDemand +mkCalledOnceDmd sd = mkCall C_11 sd --- | @mkCallDmds n d@ returns @CS(CS...(CS d))@ where there are @n@ @CS@'s. -mkCallDmds :: Arity -> SubDemand -> SubDemand -mkCallDmds arity sd = iterate mkCallDmd sd !! arity +-- | @mkCalledOnceDmds n d@ returns @CS(CS...(CS d))@ where there are @n@ @CS@'s. +mkCalledOnceDmds :: Arity -> SubDemand -> SubDemand +mkCalledOnceDmds arity sd = iterate mkCalledOnceDmd sd !! arity -- | Peels one call level from the sub-demand, and also returns how many -- times we entered the lambda body. @@ -669,7 +677,7 @@ This is needed even for non-product types, in case the case-binder is used but the components of the case alternative are not. Note [Don't optimise UP(U,U,...) to U] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ These two SubDemands: UP(U,U) (@Prod [topDmd, topDmd]@) and U (@topSubDmd@) are semantically equivalent, but we do not turn the former into @@ -1571,9 +1579,9 @@ This is weird, so I'm not worried about whether this optimises brilliantly; but it should not fall over. -} -zapUsageEnvSig :: StrictSig -> StrictSig --- Remove the usage environment from the demand -zapUsageEnvSig (StrictSig (DmdType _ ds r)) = mkClosedStrictSig ds r +-- | Remove the demand environment from the signature. +zapDmdEnvSig :: StrictSig -> StrictSig +zapDmdEnvSig (StrictSig (DmdType _ ds r)) = mkClosedStrictSig ds r zapUsageDemand :: Demand -> Demand -- Remove the usage info, but not the strictness info, from the demand @@ -1615,8 +1623,8 @@ kill_usage kfs (n :* sd) = kill_usage_card kfs n :* kill_usage_sd kfs sd kill_usage_sd :: KillFlags -> SubDemand -> SubDemand kill_usage_sd kfs (Call n sd) - | kf_called_once kfs = Call (lubCard C_1N n) (kill_usage_sd kfs sd) - | otherwise = Call n (kill_usage_sd kfs sd) + | kf_called_once kfs = mkCall (lubCard C_1N n) (kill_usage_sd kfs sd) + | otherwise = mkCall n (kill_usage_sd kfs sd) kill_usage_sd kfs (Prod ds) = Prod (map (kill_usage kfs) ds) kill_usage_sd _ sd = sd @@ -1640,7 +1648,7 @@ trimToType (n :* sd) ts where go (Prod ds) (TsProd tss) | equalLength ds tss = Prod (zipWith trimToType ds tss) - go (Call n sd) (TsFun ts) = Call n (go sd ts) + go (Call n sd) (TsFun ts) = mkCall n (go sd ts) go sd at Poly{} _ = sd go _ _ = topSubDmd @@ -1804,7 +1812,7 @@ instance Binary SubDemand where h <- getByte bh case h of 0 -> Poly <$> get bh - 1 -> Call <$> get bh <*> get bh + 1 -> mkCall <$> get bh <*> get bh 2 -> Prod <$> get bh _ -> pprPanic "Binary:SubDemand" (ppr (fromIntegral h :: Int)) ===================================== compiler/GHC/Types/Id/Info.hs ===================================== @@ -650,7 +650,7 @@ zapUsageInfo info = Just (info {demandInfo = zapUsageDemand (demandInfo info)}) zapUsageEnvInfo :: IdInfo -> Maybe IdInfo zapUsageEnvInfo info | hasDemandEnvSig (strictnessInfo info) - = Just (info {strictnessInfo = zapUsageEnvSig (strictnessInfo info)}) + = Just (info {strictnessInfo = zapDmdEnvSig (strictnessInfo info)}) | otherwise = Nothing ===================================== testsuite/tests/arityanal/should_compile/Arity11.stderr ===================================== @@ -35,7 +35,7 @@ end Rec } -- RHS size: {terms: 52, types: 28, coercions: 0, joins: 0/5} F11.$wfib [InlPrag=[2]] :: forall {a} {p}. (a -> a -> Bool) -> (Num a, Num p) => a -> p -[GblId, Arity=4, Str=, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 150 60 0] 460 0}] +[GblId, Arity=4, Str=, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 150 60 0] 460 0}] F11.$wfib = \ (@a) (@p) (ww :: a -> a -> Bool) (w :: Num a) (w1 :: Num p) (w2 :: a) -> let { @@ -73,7 +73,7 @@ F11.$wfib fib [InlPrag=[2]] :: forall {a} {p}. (Eq a, Num a, Num p) => a -> p [GblId, Arity=4, - Str=, + Str=, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=4,unsat_ok=True,boring_ok=False) Tmpl= \ (@a) (@p) (w [Occ=Once1!] :: Eq a) (w1 [Occ=Once1] :: Num a) (w2 [Occ=Once1] :: Num p) (w3 [Occ=Once1] :: a) -> case w of { GHC.Classes.C:Eq ww1 [Occ=Once1] _ [Occ=Dead] -> F11.$wfib @a @p ww1 w1 w2 w3 }}] fib = \ (@a) (@p) (w :: Eq a) (w1 :: Num a) (w2 :: Num p) (w3 :: a) -> case w of { GHC.Classes.C:Eq ww1 ww2 -> F11.$wfib @a @p ww1 w1 w2 w3 } ===================================== testsuite/tests/arityanal/should_compile/Arity16.stderr ===================================== @@ -5,7 +5,7 @@ Result size of Tidy Core = {terms: 52, types: 87, coercions: 0, joins: 0/0} Rec { -- RHS size: {terms: 15, types: 17, coercions: 0, joins: 0/0} map2 [Occ=LoopBreaker] :: forall {t} {a}. (t -> a) -> [t] -> [a] -[GblId, Arity=2, Str=, Unf=OtherCon []] +[GblId, Arity=2, Str=, Unf=OtherCon []] map2 = \ (@t) (@a) (f :: t -> a) (ds :: [t]) -> case ds of { ===================================== testsuite/tests/stranal/should_compile/T18894.hs ===================================== @@ -0,0 +1,28 @@ +{-# OPTIONS_GHC -O2 -fforce-recomp #-} + +-- | The point of this test is that @g*@ get's a demand that says +-- "whenever @g*@ is called, the second component of the pair is evaluated strictly". +module T18894 (h1, h2) where + +g1 :: Int -> (Int,Int) +g1 1 = (15, 0) +g1 n = (2 * n, 2 `div` n) +{-# NOINLINE g1 #-} + +h1 :: Int -> Int +h1 1 = 0 +-- Sadly, the @g1 2@ subexpression will be floated to top-level, where we +-- don't see the specific demand placed on it by @snd at . Tracked in #19001. +h1 2 = snd (g1 2) +h1 m = uncurry (+) (g1 m) + +g2 :: Int -> Int -> (Int,Int) +g2 m 1 = (m, 0) +g2 m n = (2 * m, 2 `div` n) +{-# NOINLINE g2 #-} + +h2 :: Int -> Int +h2 1 = 0 +h2 m + | odd m = snd (g2 m 2) + | otherwise = uncurry (+) (g2 2 m) ===================================== testsuite/tests/stranal/should_compile/T18894.stderr ===================================== @@ -0,0 +1,404 @@ + +==================== Demand analysis ==================== +Result size of Demand analysis + = {terms: 177, types: 97, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 36, types: 16, coercions: 0, joins: 0/0} +g2 [InlPrag=NOINLINE, Dmd=UCU(CS(P(1P(U),SP(U))))] + :: Int -> Int -> (Int, Int) +[LclId, + Arity=2, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20 20] 161 20}] +g2 + = \ (m [Dmd=UP(U)] :: Int) (ds [Dmd=SP(SU)] :: Int) -> + case ds of { GHC.Types.I# ds [Dmd=SU] -> + case ds of ds [Dmd=1U] { + __DEFAULT -> + (case m of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.*# 2# y) }, + case ds of wild { + __DEFAULT -> + case GHC.Classes.divInt# 2# wild of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> GHC.Types.I# -2#; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + }); + 1# -> (m, lvl) + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 36, types: 19, coercions: 0, joins: 0/0} +h2 :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 162 10}] +h2 + = \ (ds [Dmd=SP(MU)] :: Int) -> + case ds of wild [Dmd=UP(U)] { GHC.Types.I# ds [Dmd=MU] -> + case ds of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> + case g2 wild lvl of { (ds1 [Dmd=A], y [Dmd=SU]) -> y }; + 0# -> + case g2 lvl wild of { (x [Dmd=SP(U)], ds [Dmd=SP(U)]) -> + case x of { GHC.Types.I# x -> + case ds of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + } + }; + 1# -> lvl + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 15# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +lvl :: (Int, Int) +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = (lvl, lvl) + +-- RHS size: {terms: 30, types: 11, coercions: 0, joins: 0/0} +g1 [InlPrag=NOINLINE, Dmd=UCU(P(UP(U),UP(U)))] :: Int -> (Int, Int) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 141 10}] +g1 + = \ (ds [Dmd=SP(SU)] :: Int) -> + case ds of { GHC.Types.I# ds [Dmd=SU] -> + case ds of ds { + __DEFAULT -> + (GHC.Types.I# (GHC.Prim.*# 2# ds), + case ds of wild { + __DEFAULT -> + case GHC.Classes.divInt# 2# wild of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> GHC.Types.I# -2#; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + }); + 1# -> lvl + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +lvl :: (Int, Int) +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=False, ConLike=False, + WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 30 0}] +lvl = g1 (GHC.Types.I# 2#) + +-- RHS size: {terms: 28, types: 18, coercions: 0, joins: 0/0} +h1 :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 111 10}] +h1 + = \ (ds [Dmd=SP(MU)] :: Int) -> + case ds of wild [Dmd=1P(1U)] { GHC.Types.I# ds [Dmd=MU] -> + case ds of { + __DEFAULT -> + case g1 wild of { (x [Dmd=SP(U)], ds [Dmd=SP(U)]) -> + case x of { GHC.Types.I# x -> + case ds of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + }; + 1# -> lvl; + 2# -> case lvl of { (ds1 [Dmd=A], y [Dmd=SU]) -> y } + } + } + + + + +==================== Demand analysis ==================== +Result size of Demand analysis + = {terms: 171, types: 120, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# -2# + +-- RHS size: {terms: 32, types: 18, coercions: 0, joins: 0/0} +$wg2 [InlPrag=NOINLINE, Dmd=UCU(CS(P(1P(U),SP(U))))] + :: Int -> GHC.Prim.Int# -> (# Int, Int #) +[LclId, + Arity=2, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20 30] 121 20}] +$wg2 + = \ (w [Dmd=UP(U)] :: Int) (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + (# case w of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.*# 2# y) }, + case ds of { + __DEFAULT -> + case GHC.Classes.divInt# 2# ds of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> lvl; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + } #); + 1# -> (# w, lvl #) + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 34, types: 21, coercions: 0, joins: 0/0} +$wh2 [InlPrag=[2]] :: GHC.Prim.Int# -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 162 10}] +$wh2 + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> + case $wg2 (GHC.Types.I# ds) 2# of + { (# ww [Dmd=A], ww [Dmd=SU] #) -> + ww + }; + 0# -> + case $wg2 lvl ds of { (# ww [Dmd=SP(U)], ww [Dmd=SP(U)] #) -> + case ww of { GHC.Types.I# x -> + case ww of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + } + }; + 1# -> lvl + } + +-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} +h2 [InlPrag=[2]] :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (w [Occ=Once1!] :: Int) -> + case w of { GHC.Types.I# ww [Occ=Once1, Dmd=MU] -> $wh2 ww }}] +h2 + = \ (w [Dmd=SP(SU)] :: Int) -> + case w of { GHC.Types.I# ww [Dmd=SU] -> $wh2 ww } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 15# + +-- RHS size: {terms: 28, types: 15, coercions: 0, joins: 0/0} +$wg1 [InlPrag=NOINLINE, Dmd=UCU(P(UP(U),UP(U)))] + :: GHC.Prim.Int# -> (# Int, Int #) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 111 20}] +$wg1 + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + (# GHC.Types.I# (GHC.Prim.*# 2# ds), + case ds of { + __DEFAULT -> + case GHC.Classes.divInt# 2# ds of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> lvl; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + } #); + 1# -> (# lvl, lvl #) + } + +-- RHS size: {terms: 7, types: 9, coercions: 0, joins: 0/0} +lvl :: (Int, Int) +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=False, ConLike=False, + WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 40 10}] +lvl = case $wg1 2# of { (# ww, ww #) -> (ww, ww) } + +-- RHS size: {terms: 25, types: 18, coercions: 0, joins: 0/0} +$wh1 [InlPrag=[2]] :: GHC.Prim.Int# -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [50] 101 10}] +$wh1 + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds [Dmd=1U] { + __DEFAULT -> + case $wg1 ds of { (# ww [Dmd=SP(U)], ww [Dmd=SP(U)] #) -> + case ww of { GHC.Types.I# x -> + case ww of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + }; + 1# -> lvl; + 2# -> case lvl of { (ds1 [Dmd=A], y [Dmd=SU]) -> y } + } + +-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} +h1 [InlPrag=[2]] :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (w [Occ=Once1!] :: Int) -> + case w of { GHC.Types.I# ww [Occ=Once1, Dmd=MU] -> $wh1 ww }}] +h1 + = \ (w [Dmd=SP(SU)] :: Int) -> + case w of { GHC.Types.I# ww [Dmd=SU] -> $wh1 ww } + + + ===================================== testsuite/tests/stranal/should_compile/T18894b.hs ===================================== @@ -0,0 +1,20 @@ +{-# OPTIONS_GHC -O -fno-call-arity -fforce-recomp #-} + +module T18894 (f) where + +expensive :: Int -> (Int, Int) +expensive n = (n+1, n+2) +{-# NOINLINE expensive #-} + +-- arity 1 by itself, but not exported, thus can be eta-expanded based on usage +eta :: Int -> Int -> Int +eta x = if fst (expensive x) == 13 + then \y -> x + y + else \y -> x * y +{-# NOINLINE eta #-} + +f :: Int -> Int +f 1 = 0 +f m + | odd m = eta m 2 + | otherwise = eta 2 m ===================================== testsuite/tests/stranal/should_compile/T18894b.stderr ===================================== @@ -0,0 +1,187 @@ + +==================== Demand analysis ==================== +Result size of Demand analysis = {terms: 83, types: 40, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 16, types: 7, coercions: 0, joins: 0/0} +expensive [InlPrag=NOINLINE, Dmd=UCU(P(SP(SU),A))] :: Int -> (Int, Int) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [40] 52 10}] +expensive + = \ (n [Dmd=UP(U)] :: Int) -> + (case n of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 1#) }, case n of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 2#) }) + +-- RHS size: {terms: 20, types: 11, coercions: 0, joins: 0/0} +eta [InlPrag=NOINLINE, Dmd=UCU(CS(U))] :: Int -> Int -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [0] 140 120}] +eta + = \ (x [Dmd=UP(U)] :: Int) -> + case expensive x of { (x [Dmd=SP(SU)], ds1 [Dmd=A]) -> + case x of { GHC.Types.I# x [Dmd=SU] -> + case x of { + __DEFAULT -> \ (y [Dmd=SP(U)] :: Int) -> GHC.Num.$fNumInt_$c* x y; + 13# -> \ (y [Dmd=SP(U)] :: Int) -> GHC.Num.$fNumInt_$c+ x y + } + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 21, types: 5, coercions: 0, joins: 0/0} +f :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 111 0}] +f = \ (ds [Dmd=SP(MU)] :: Int) -> + case ds of wild [Dmd=UP(U)] { GHC.Types.I# ds [Dmd=MU] -> + case ds of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> eta wild lvl; + 0# -> eta lvl wild + }; + 1# -> lvl + } + } + + + + +==================== Demand analysis ==================== +Result size of Demand analysis = {terms: 85, types: 47, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 16, types: 9, coercions: 0, joins: 0/0} +$wexpensive [InlPrag=NOINLINE, Dmd=UCU(P(SP(SU),A))] :: Int -> (# Int, Int #) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [40] 42 10}] +$wexpensive + = \ (w [Dmd=UP(U)] :: Int) -> + (# case w of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 1#) }, + case w of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 2#) } #) + +-- RHS size: {terms: 19, types: 12, coercions: 0, joins: 0/0} +eta [InlPrag=NOINLINE, Dmd=UCU(CS(U))] :: Int -> Int -> Int +[LclId, + Arity=2, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [0 0] 120 0}] +eta + = \ (x [Dmd=MP(U)] :: Int) (eta [Dmd=SP(U), OS=OneShot] :: Int) -> + case $wexpensive x of { (# ww [Dmd=SP(SU)], ww [Dmd=A] #) -> + case ww of { GHC.Types.I# x [Dmd=SU] -> + case x of { + __DEFAULT -> GHC.Num.$fNumInt_$c* x eta; + 13# -> GHC.Num.$fNumInt_$c+ x eta + } + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 20, types: 3, coercions: 0, joins: 0/0} +$wf [InlPrag=[2]] :: GHC.Prim.Int# -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 121 0}] +$wf + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> eta (GHC.Types.I# ds) lvl; + 0# -> eta lvl (GHC.Types.I# ds) + }; + 1# -> lvl + } + +-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} +f [InlPrag=[2]] :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (w [Occ=Once1!] :: Int) -> case w of { GHC.Types.I# ww [Occ=Once1, Dmd=MU] -> $wf ww }}] +f = \ (w [Dmd=SP(SU)] :: Int) -> case w of { GHC.Types.I# ww [Dmd=SU] -> $wf ww } + + + ===================================== testsuite/tests/stranal/should_compile/all.T ===================================== @@ -58,3 +58,7 @@ test('T18122', [ grep_errmsg(r'wfoo =') ], compile, ['-ddump-simpl']) # We care about the call demand on $wg test('T18903', [ grep_errmsg(r'Dmd=\S+C\S+') ], compile, ['-ddump-simpl -dsuppress-uniques']) +# We care about the call demand on $wg1 and $wg2 +test('T18894', [ grep_errmsg(r'Dmd=\S+C\S+') ], compile, ['-ddump-stranal -dsuppress-uniques']) +# We care about the Arity 2 on eta, as a result of the annotated Dmd +test('T18894b', [ grep_errmsg(r'Arity=2') ], compile, ['-ddump-stranal -dsuppress-uniques -fno-call-arity -dppr-cols=200']) ===================================== testsuite/tests/stranal/sigs/T5075.stderr ===================================== @@ -1,7 +1,7 @@ ==================== Strictness signatures ==================== T5075.$trModule: -T5075.loop: +T5075.loop: @@ -13,6 +13,6 @@ T5075.loop: ==================== Strictness signatures ==================== T5075.$trModule: -T5075.loop: +T5075.loop: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/eb30d28f6d985a7a222527021f1f6713f161879e...74613325e7f456a64c7c108dca7e93fc94577639 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/eb30d28f6d985a7a222527021f1f6713f161879e...74613325e7f456a64c7c108dca7e93fc94577639 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 4 17:14:37 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Fri, 04 Dec 2020 12:14:37 -0500 Subject: [Git][ghc/ghc][wip/T18894] 2 commits: DmdAnal: Annotate top-level function bindings with demands (#18894) Message-ID: <5fca6e7d90f6a_6b216c3c5c718f1@gitlab.mail> Sebastian Graf pushed to branch wip/T18894 at Glasgow Haskell Compiler / GHC Commits: 78808d87 by Sebastian Graf at 2020-12-04T18:14:26+01:00 DmdAnal: Annotate top-level function bindings with demands (#18894) It's useful to annotate a non-exported top-level function like `g` in ```hs module Lib (h) where g :: Int -> Int -> (Int,Int) g m 1 = (m, 0) g m n = (2 * m, 2 `div` n) {-# NOINLINE g #-} h :: Int -> Int h 1 = 0 h m | odd m = snd (g m 2) | otherwise = uncurry (+) (g 2 m) ``` with its demand `UCU(CS(P(1P(U),SP(U))`, which tells us that whenever `g` was called, the second component of the returned pair was evaluated strictly. Since #18903 we do so for local functions, where we can see all calls. For top-level functions, we can assume that all *exported* functions are demanded according to `topDmd` and thus get sound demands for non-exported top-level functions. The demand on `g` is crucial information for Nested CPR, which may the go on and unbox `g` for the second pair component. That is true even if that pair component may diverge, as is the case for the call site `g 13 0`, which throws a div-by-zero exception. In `T18894b`, you can even see the new demand annotation enabling us to eta-expand a function that we wouldn't be able to eta-expand without Call Arity. We only track bindings of function type in order not to risk huge compile-time regressions, see `isInterestingTopLevelFn`. There was a CoreLint check that rejected strict demand annotations on recursive or top-level bindings, which seems completely unjustified. All the cases I investigated were fine, so I removed it. Fixes #18894. - - - - - 46585fdb by Sebastian Graf at 2020-12-04T18:14:26+01:00 Demand: Simplify `CU(U)` to `U` (#19005) Both sub-demands encode the same information. This is a trivial change and already affects a few regression tests (e.g. `T5075`), so no separate regression test is necessary. - - - - - 18 changed files: - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Types/Demand.hs - compiler/GHC/Types/Id/Info.hs - testsuite/tests/arityanal/should_compile/Arity11.stderr - testsuite/tests/arityanal/should_compile/Arity16.stderr - + testsuite/tests/stranal/should_compile/T18894.hs - + testsuite/tests/stranal/should_compile/T18894.stderr - + testsuite/tests/stranal/should_compile/T18894b.hs - + testsuite/tests/stranal/should_compile/T18894b.stderr - testsuite/tests/stranal/should_compile/all.T - testsuite/tests/stranal/sigs/T5075.stderr Changes: ===================================== compiler/GHC/Core/FVs.hs ===================================== @@ -525,12 +525,11 @@ ruleLhsFVIds (Rule { ru_bndrs = bndrs, ru_args = args }) = filterFV isLocalId $ addBndrs bndrs (exprs_fvs args) ruleRhsFreeIds :: CoreRule -> VarSet --- ^ This finds all locally-defined free Ids on the left hand side of a rule +-- ^ This finds all locally-defined free Ids on the right hand side of a rule -- and returns them as a non-deterministic set ruleRhsFreeIds (BuiltinRule {}) = emptyVarSet -ruleRhsFreeIds (Rule { ru_bndrs = bndrs, ru_args = args }) - = fvVarSet $ filterFV isLocalId $ - addBndrs bndrs $ exprs_fvs args +ruleRhsFreeIds (Rule { ru_bndrs = bndrs, ru_rhs = rhs }) + = fvVarSet $ filterFV isLocalId $ addBndrs bndrs $ expr_fvs rhs {- Note [Rule free var hack] (Not a hack any more) ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -623,14 +623,6 @@ lintLetBind top_lvl rec_flag binder rhs rhs_ty || exprIsTickedString rhs) (badBndrTyMsg binder (text "unlifted")) - -- Check that if the binder is top-level or recursive, it's not - -- demanded. Primitive string literals are exempt as there is no - -- computation to perform, see Note [Core top-level string literals]. - ; checkL (not (isStrictId binder) - || (isNonRec rec_flag && not (isTopLevel top_lvl)) - || exprIsTickedString rhs) - (mkStrictMsg binder) - -- Check that if the binder is at the top level and has type Addr#, -- that it is a string literal, see -- Note [Core top-level string literals]. @@ -3119,13 +3111,6 @@ badBndrTyMsg binder what = vcat [ text "The type of this binder is" <+> what <> colon <+> ppr binder , text "Binder's type:" <+> ppr (idType binder) ] -mkStrictMsg :: Id -> MsgDoc -mkStrictMsg binder - = vcat [hsep [text "Recursive or top-level binder has strict demand info:", - ppr binder], - hsep [text "Binder's demand info:", ppr (idDemandInfo binder)] - ] - mkNonTopExportedMsg :: Id -> MsgDoc mkNonTopExportedMsg binder = hsep [text "Non-top-level binder is marked as exported:", ppr binder] ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -37,6 +37,7 @@ import GHC.Core.Type import GHC.Core.FVs ( exprFreeIds, ruleRhsFreeIds ) import GHC.Core.Coercion ( Coercion, coVarsOfCo ) import GHC.Core.FamInstEnv +import GHC.Core.Opt.Arity ( typeArity ) import GHC.Utils.Misc import GHC.Utils.Panic import GHC.Data.Maybe ( isJust ) @@ -64,28 +65,55 @@ data DmdAnalOpts = DmdAnalOpts -- -- Note: use `seqBinds` on the result to avoid leaks due to lazyness (cf Note -- [Stamp out space leaks in demand analysis]) -dmdAnalProgram :: DmdAnalOpts -> FamInstEnvs -> CoreProgram -> CoreProgram -dmdAnalProgram opts fam_envs binds = binds_plus_dmds - where - env = emptyAnalEnv opts fam_envs - binds_plus_dmds = snd $ mapAccumL dmdAnalTopBind env binds - --- Analyse a (group of) top-level binding(s) -dmdAnalTopBind :: AnalEnv - -> CoreBind - -> (AnalEnv, CoreBind) -dmdAnalTopBind env (NonRec id rhs) - = ( extendAnalEnv TopLevel env id sig - , NonRec (setIdStrictness id sig) rhs') +dmdAnalProgram :: DmdAnalOpts -> FamInstEnvs -> [CoreRule] -> CoreProgram -> CoreProgram +dmdAnalProgram opts fam_envs rules binds + = snd $ go (emptyAnalEnv opts fam_envs) binds where - ( _, sig, rhs') = dmdAnalRhsLetDown Nothing env topSubDmd id rhs + -- See Note [Analysing top-level bindings] + -- TLDR; We analyse them like + -- let ex1 = ... in (ex1, let nex1 = ... in let ex2 = ... in (ex2, ...))) + -- where ex* are exported (or RULE mentions) and nex* are not. + go _ [] = (nopDmdType, []) + go env (b:bs) = cons_up $ dmdAnalBind TopLevel env topSubDmd b anal_body + where + anal_body env' + | (body_ty, bs') <- go env' bs + = (add_exported_uses env' body_ty (bindersOf b), bs') + + cons_up :: (a, b, [b]) -> (a, [b]) + cons_up (dmd_ty, b', bs') = (dmd_ty, b':bs') + + add_exported_uses :: AnalEnv -> DmdType -> [Id] -> DmdType + add_exported_uses env = foldl' (add_exported_use env) + + -- | If @e@ is denoted by @dmd_ty@, then @add_exported_use _ dmd_ty id@ + -- corresponds to the demand type of @(id, e)@, but is a lot more direct. + -- See Note [Analysing top-level bindings]. + add_exported_use :: AnalEnv -> DmdType -> Id -> DmdType + add_exported_use env dmd_ty id + | isExportedId id || elemVarSet id rule_fvs + -- See Note [Absence analysis for stable unfoldings and RULES] + = dmd_ty `plusDmdType` fst (dmdAnalStar env topDmd (Var id)) + | otherwise + = dmd_ty -dmdAnalTopBind env (Rec pairs) - = (env', Rec pairs') - where - (env', _, pairs') = dmdFix TopLevel env topSubDmd pairs - -- We get two iterations automatically - -- c.f. the NonRec case above + rule_fvs :: IdSet + rule_fvs = foldr (unionVarSet . ruleRhsFreeIds) emptyVarSet rules + +-- | Whether we want to store demands on a top-level Id or just default +-- to 'topDmd'. +-- +-- Basically, we want to now how top-level *functions* are *used* +-- (e.g. called), but aren't interested in whether they were called strictly +-- or not. Other top-level bindings are boring. +isInterestingTopLevelFn :: Id -> Bool +-- SG tried to set this to True and got a +2% ghc/alloc regression in T5642 +-- (which is dominated by the Simplifier) at no gain in analysis precision. +-- If there was a gain, that regression might be acceptable. +-- Plus, we could use LetUp for thunks and share some code with local let +-- bindings. +isInterestingTopLevelFn id = + typeArity (idType id) `lengthExceeds` 0 {- Note [Stamp out space leaks in demand analysis] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -105,8 +133,56 @@ generation would hold on to an extra copy of the Core program, via unforced thunks in demand or strictness information; and it is the most memory-intensive part of the compilation process, so this added seqBinds makes a big difference in peak memory usage. --} +Note [Analysing top-level bindings] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider a CoreProgram like + e1 = ... + n1 = ... + e2 = \a b -> ... fst (n1 a b) ... + n2 = \c d -> ... snd (e2 c d) ... + ... +where e* are exported, but n* are not. +Intuitively, we can see that @n1@ is only ever called with two arguments +and in every call site, the first component of the result of the call +is evaluated. Thus, we'd like it to have idDemandInfo @UCU(C1(P(SU,A))@. + +(This can be exploited by a Nested CPR pass which may then unbox the +first component of the pair returned from @n1 at . Or if @n1@ had arity +1 before, we may now eta-expand to arity 2.) + +NB: We may *not* give e2 a similar annotation, because it is exported and +external callers might use it in arbitrary ways, expressed by 'topDmd'. + +How do we get this result? Answer: By analysing the program as if it was a let +expression of this form: + let e1 = ... in + (e1, let n1 = ... in + ( let e2 = ... in + (e2, let n2 = ... in + ( ...)))) +E.g. putting all bindings in nested lets, where whenever it binds an exported +binding, the body is a *pair* of an occurrence of the exported binder and +the other nested lets. Of course, we will not actually build that CoreExpr! +Instead we faithfully simulate analysis of said expression by adding the +free variable 'DmdEnv' of @e*@'s strictness signatures to the 'DmdType' we +get from analysing the nested bindings. + +You might also wonder why we didn't analyse in terms of the simpler + let e1 = ... in + let n1 = ... in + let e2 = ... in + let n2 = ... in + (e1,e2, ...) +The reason is analysis performance: If @e1@ uses many free variables, we'll +unnecessarily carry their demands around with us from the moment we analyse +the pair to the moment we bubble back up to the binding for @e1 at . +This blows up e.g. @T10370 at . + +A final note about variables occuring free in RULE RHSs: They are to be handled +pretty much like exported Ids. +See also Note [Absence analysis for stable unfoldings and RULES] +-} {- ************************************************************************ @@ -114,7 +190,103 @@ seqBinds makes a big difference in peak memory usage. \subsection{The analyser itself} * * ************************************************************************ +-} +-- | Analyse a binding group and its \"body\", e.g. where it is in scope. +-- +-- It calls a function that knows how to analyse this \"body\" given +-- an 'AnalEnv' with updated demand signatures for the binding group +-- (reflecting their 'idStrictnessInfo') and expects to receive a +-- 'DmdType' in return, which it uses to annotate the binding group with their +-- 'idDemandInfo'. +dmdAnalBind + :: TopLevelFlag + -> AnalEnv + -> SubDemand -- ^ Demand put on the "body" + -- (important for join points) + -> CoreBind + -> (AnalEnv -> (DmdType, a)) -- ^ How to analyse the "body", e.g. + -- where the binding is in scope + -> (DmdType, CoreBind, a) +dmdAnalBind top_lvl env dmd bind anal_body = case bind of + NonRec id rhs + | useLetUp top_lvl id + -> dmdAnalBindLetUp top_lvl env id rhs anal_body + _ -> dmdAnalBindLetDown top_lvl env dmd bind anal_body + +-- | Annotates uninteresting top level functions ('isInterestingTopLevelFn') +-- with 'topDmd', the rest with the given demand. +setBindIdDemandInfo :: TopLevelFlag -> Id -> Demand -> Id +setBindIdDemandInfo top_lvl id dmd = setIdDemandInfo id $ case top_lvl of + TopLevel | not (isInterestingTopLevelFn id) -> topDmd + _ -> dmd + +-- | Let bindings can be processed in two ways: +-- Down (RHS before body) or Up (body before RHS). +-- This function handles the up variant. +-- +-- It is very simple. For let x = rhs in body +-- * Demand-analyse 'body' in the current environment +-- * Find the demand, 'rhs_dmd' placed on 'x' by 'body' +-- * Demand-analyse 'rhs' in 'rhs_dmd' +-- +-- This is used for a non-recursive local let without manifest lambdas (see +-- 'useLetUp'). +-- +-- This is the LetUp rule in the paper “Higher-Order Cardinality Analysis”. +dmdAnalBindLetUp :: TopLevelFlag -> AnalEnv -> Id -> CoreExpr -> (AnalEnv -> (DmdType, a)) -> (DmdType, CoreBind, a) +dmdAnalBindLetUp top_lvl env id rhs anal_body = (final_ty, NonRec id' rhs', body') + where + (body_ty, body') = anal_body env + (body_ty', id_dmd) = findBndrDmd env notArgOfDfun body_ty id + id' = setBindIdDemandInfo top_lvl id id_dmd + (rhs_ty, rhs') = dmdAnalStar env (dmdTransformThunkDmd rhs id_dmd) rhs + final_ty = body_ty' `plusDmdType` rhs_ty + +-- | Let bindings can be processed in two ways: +-- Down (RHS before body) or Up (body before RHS). +-- This function handles the down variant. +-- +-- It computes a demand signature (by means of 'dmdAnalRhsSig') and uses +-- that at call sites in the body. +-- +-- It is used for toplevel definitions, recursive definitions and local +-- non-recursive definitions that have manifest lambdas (cf. 'useLetUp'). +-- Local non-recursive definitions without a lambda are handled with LetUp. +-- +-- This is the LetDown rule in the paper “Higher-Order Cardinality Analysis”. +dmdAnalBindLetDown :: TopLevelFlag -> AnalEnv -> SubDemand -> CoreBind -> (AnalEnv -> (DmdType, a)) -> (DmdType, CoreBind, a) +dmdAnalBindLetDown top_lvl env dmd bind anal_body = case bind of + NonRec id rhs + | (env', lazy_fv, id1, rhs1) <- + dmdAnalRhsSig top_lvl NonRecursive env dmd id rhs + -> do_rest env' lazy_fv [(id1, rhs1)] (uncurry NonRec . only) + Rec pairs + | (env', lazy_fv, pairs') <- dmdFix top_lvl env dmd pairs + -> do_rest env' lazy_fv pairs' Rec + where + do_rest env' lazy_fv pairs1 build_bind = (final_ty, build_bind pairs2, body') + where + (body_ty, body') = anal_body env' + -- see Note [Lazy and unleashable free variables] + dmd_ty = addLazyFVs body_ty lazy_fv + (!final_ty, id_dmds) = findBndrsDmds env' dmd_ty (map fst pairs1) + pairs2 = zipWith do_one pairs1 id_dmds + do_one (id', rhs') dmd = (setBindIdDemandInfo top_lvl id' dmd, rhs') + -- If the actual demand is better than the vanilla call + -- demand, you might think that we might do better to re-analyse + -- the RHS with the stronger demand. + -- But (a) That seldom happens, because it means that *every* path in + -- the body of the let has to use that stronger demand + -- (b) It often happens temporarily in when fixpointing, because + -- the recursive function at first seems to place a massive demand. + -- But we don't want to go to extra work when the function will + -- probably iterate to something less demanding. + -- In practice, all the times the actual demand on id2 is more than + -- the vanilla call demand seem to be due to (b). So we don't + -- bother to re-analyse the RHS. + +{- Note [Ensure demand is strict] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ It's important not to analyse e with a lazy demand because @@ -194,7 +366,7 @@ dmdAnal' env dmd (App fun arg) -- Crucially, coercions /are/ handled here, because they are -- value arguments (#10288) let - call_dmd = mkCallDmd dmd + call_dmd = mkCalledOnceDmd dmd (fun_ty, fun') = dmdAnal env call_dmd fun (arg_dmd, res_ty) = splitDmdTy fun_ty (arg_ty, arg') = dmdAnalStar env (dmdTransformThunkDmd arg arg_dmd) arg @@ -295,60 +467,11 @@ dmdAnal' env dmd (Case scrut case_bndr ty alts) -- , text "res_ty" <+> ppr res_ty ]) $ (res_ty, Case scrut' case_bndr' ty alts') --- Let bindings can be processed in two ways: --- Down (RHS before body) or Up (body before RHS). --- The following case handle the up variant. --- --- It is very simple. For let x = rhs in body --- * Demand-analyse 'body' in the current environment --- * Find the demand, 'rhs_dmd' placed on 'x' by 'body' --- * Demand-analyse 'rhs' in 'rhs_dmd' --- --- This is used for a non-recursive local let without manifest lambdas. --- This is the LetUp rule in the paper “Higher-Order Cardinality Analysis”. -dmdAnal' env dmd (Let (NonRec id rhs) body) - | useLetUp id - = (final_ty, Let (NonRec id' rhs') body') +dmdAnal' env dmd (Let bind body) + = (final_ty, Let bind' body') where - (body_ty, body') = dmdAnal env dmd body - (body_ty', id_dmd) = findBndrDmd env notArgOfDfun body_ty id - id' = setIdDemandInfo id id_dmd - - (rhs_ty, rhs') = dmdAnalStar env (dmdTransformThunkDmd rhs id_dmd) rhs - final_ty = body_ty' `plusDmdType` rhs_ty - -dmdAnal' env dmd (Let (NonRec id rhs) body) - = (body_ty2, Let (NonRec id2 rhs') body') - where - (lazy_fv, sig, rhs') = dmdAnalRhsLetDown Nothing env dmd id rhs - id1 = setIdStrictness id sig - env1 = extendAnalEnv NotTopLevel env id sig - (body_ty, body') = dmdAnal env1 dmd body - (body_ty1, id2) = annotateBndr env body_ty id1 - body_ty2 = addLazyFVs body_ty1 lazy_fv -- see Note [Lazy and unleashable free variables] - - -- If the actual demand is better than the vanilla call - -- demand, you might think that we might do better to re-analyse - -- the RHS with the stronger demand. - -- But (a) That seldom happens, because it means that *every* path in - -- the body of the let has to use that stronger demand - -- (b) It often happens temporarily in when fixpointing, because - -- the recursive function at first seems to place a massive demand. - -- But we don't want to go to extra work when the function will - -- probably iterate to something less demanding. - -- In practice, all the times the actual demand on id2 is more than - -- the vanilla call demand seem to be due to (b). So we don't - -- bother to re-analyse the RHS. - -dmdAnal' env dmd (Let (Rec pairs) body) - = let - (env', lazy_fv, pairs') = dmdFix NotTopLevel env dmd pairs - (body_ty, body') = dmdAnal env' dmd body - body_ty1 = deleteFVs body_ty (map fst pairs) - body_ty2 = addLazyFVs body_ty1 lazy_fv -- see Note [Lazy and unleashable free variables] - in - body_ty2 `seq` - (body_ty2, Let (Rec pairs') body') + (final_ty, bind', body') = dmdAnalBind NotTopLevel env dmd bind go' + go' env' = dmdAnal env' dmd body -- | A simple, syntactic analysis of whether an expression MAY throw a precise -- exception when evaluated. It's always sound to return 'True'. @@ -582,9 +705,13 @@ dmdTransform env var dmd | Just (sig, top_lvl) <- lookupSigEnv env var , let fn_ty = dmdTransformSig sig dmd = -- pprTrace "dmdTransform:LetDown" (vcat [ppr var, ppr sig, ppr dmd, ppr fn_ty]) $ - if isTopLevel top_lvl - then fn_ty -- Don't record demand on top-level things - else addVarDmd fn_ty var (C_11 :* dmd) + case top_lvl of + NotTopLevel -> addVarDmd fn_ty var (C_11 :* dmd) + TopLevel + | isInterestingTopLevelFn var + -> addVarDmd fn_ty var (C_0N `multDmd` (C_11 :* dmd)) -- discard strictness + | otherwise + -> fn_ty -- don't bother tracking; just annotate with 'topDmd' later -- Everything else: -- * Local let binders for which we use LetUp (cf. 'useLetUp') -- * Lambda binders @@ -599,46 +726,46 @@ dmdTransform env var dmd * * ********************************************************************* -} --- Let bindings can be processed in two ways: --- Down (RHS before body) or Up (body before RHS). --- dmdAnalRhsLetDown implements the Down variant: --- * assuming a demand of +-- | @dmdAnalRhsSig@ analyses the given RHS to compute a demand signature +-- for the LetDown rule. It works as follows: +-- +-- * assuming a demand of -- * looking at the definition -- * determining a strictness signature -- --- It is used for toplevel definition, recursive definitions and local --- non-recursive definitions that have manifest lambdas. --- Local non-recursive definitions without a lambda are handled with LetUp. --- --- This is the LetDown rule in the paper “Higher-Order Cardinality Analysis”. -dmdAnalRhsLetDown - :: Maybe [Id] -- Just bs <=> recursive, Nothing <=> non-recursive +-- Since it assumed a demand of , the resulting signature is applicable at +-- any call site. +dmdAnalRhsSig + :: TopLevelFlag + -> RecFlag -> AnalEnv -> SubDemand -> Id -> CoreExpr - -> (DmdEnv, StrictSig, CoreExpr) + -> (AnalEnv, DmdEnv, Id, CoreExpr) -- Process the RHS of the binding, add the strictness signature -- to the Id, and augment the environment with the signature as well. -- See Note [NOINLINE and strictness] -dmdAnalRhsLetDown rec_flag env let_dmd id rhs - = -- pprTrace "dmdAnalRhsLetDown" (ppr id $$ ppr let_dmd $$ ppr sig $$ ppr lazy_fv) $ - (lazy_fv, sig, rhs') +dmdAnalRhsSig top_lvl rec_flag env let_dmd id rhs + = -- pprTrace "dmdAnalRhsSig" (ppr id $$ ppr let_dmd $$ ppr sig $$ ppr lazy_fv) $ + (env', lazy_fv, id', rhs') where rhs_arity = idArity id + -- See Note [Demand signatures are computed for a threshold demand based on idArity] rhs_dmd -- See Note [Demand analysis for join points] -- See Note [Invariants on join points] invariant 2b, in GHC.Core -- rhs_arity matches the join arity of the join point | isJoinId id - = mkCallDmds rhs_arity let_dmd + = mkCalledOnceDmds rhs_arity let_dmd | otherwise - -- NB: rhs_arity - -- See Note [Demand signatures are computed for a threshold demand based on idArity] - = mkRhsDmd env rhs_arity rhs + = mkCalledOnceDmds rhs_arity topSubDmd (rhs_dmd_ty, rhs') = dmdAnal env rhs_dmd rhs DmdType rhs_fv rhs_dmds rhs_div = rhs_dmd_ty sig = mkStrictSigForArity rhs_arity (DmdType sig_fv rhs_dmds rhs_div) + id' = id `setIdStrictness` sig + env' = extendAnalEnv top_lvl env id' sig + -- See Note [Aggregated demand for cardinality] -- FIXME: That Note doesn't explain the following lines at all. The reason -- is really much different: When we have a recursive function, we'd @@ -651,8 +778,8 @@ dmdAnalRhsLetDown rec_flag env let_dmd id rhs -- we'd have to do an additional iteration. reuseEnv makes sure that -- we never get used-once info for FVs of recursive functions. rhs_fv1 = case rec_flag of - Just bs -> reuseEnv (delVarEnvList rhs_fv bs) - Nothing -> rhs_fv + Recursive -> reuseEnv rhs_fv + NonRecursive -> rhs_fv rhs_fv2 = rhs_fv1 `keepAliveDmdEnv` extra_fvs -- Find the RHS free vars of the unfoldings and RULES @@ -669,13 +796,6 @@ dmdAnalRhsLetDown rec_flag env let_dmd id rhs = exprFreeIds unf_body | otherwise = emptyVarSet --- | @mkRhsDmd env rhs_arity rhs@ creates a 'SubDemand' for --- unleashing on the given function's @rhs@, by creating --- a call demand of @rhs_arity@ --- See Historical Note [Product demands for function body] -mkRhsDmd :: AnalEnv -> Arity -> CoreExpr -> SubDemand -mkRhsDmd _env rhs_arity _rhs = mkCallDmds rhs_arity topSubDmd - -- | If given the (local, non-recursive) let-bound 'Id', 'useLetUp' determines -- whether we should process the binding up (body before rhs) or down (rhs -- before body). @@ -720,8 +840,8 @@ mkRhsDmd _env rhs_arity _rhs = mkCallDmds rhs_arity topSubDmd -- * For a more convincing example with join points, see Note [Demand analysis -- for join points]. -- -useLetUp :: Var -> Bool -useLetUp f = idArity f == 0 && not (isJoinId f) +useLetUp :: TopLevelFlag -> Var -> Bool +useLetUp top_lvl f = isNotTopLevel top_lvl && idArity f == 0 && not (isJoinId f) {- Note [Demand analysis for join points] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -939,8 +1059,6 @@ dmdFix :: TopLevelFlag dmdFix top_lvl env let_dmd orig_pairs = loop 1 initial_pairs where - bndrs = map fst orig_pairs - -- See Note [Initialising strictness] initial_pairs | ae_virgin env = [(setIdStrictness id botSig, rhs) | (id, rhs) <- orig_pairs ] | otherwise = orig_pairs @@ -990,10 +1108,8 @@ dmdFix top_lvl env let_dmd orig_pairs = -- pprTrace "my_downRhs" (ppr id $$ ppr (idStrictness id) $$ ppr sig) $ ((env', lazy_fv'), (id', rhs')) where - (lazy_fv1, sig, rhs') = dmdAnalRhsLetDown (Just bndrs) env let_dmd id rhs - lazy_fv' = plusVarEnv_C plusDmd lazy_fv lazy_fv1 - env' = extendAnalEnv top_lvl env id sig - id' = setIdStrictness id sig + (env', lazy_fv1, id', rhs') = dmdAnalRhsSig top_lvl Recursive env let_dmd id rhs + lazy_fv' = plusVarEnv_C plusDmd lazy_fv lazy_fv1 zapIdStrictness :: [(Id, CoreExpr)] -> [(Id, CoreExpr)] zapIdStrictness pairs = [(setIdStrictness id nopSig, rhs) | (id, rhs) <- pairs ] @@ -1090,7 +1206,7 @@ addLazyFVs dmd_ty lazy_fvs -- demand with the bottom coming up from 'error' -- -- I got a loop in the fixpointer without this, due to an interaction - -- with the lazy_fv filtering in dmdAnalRhsLetDown. Roughly, it was + -- with the lazy_fv filtering in dmdAnalRhsSig. Roughly, it was -- letrec f n x -- = letrec g y = x `fatbar` -- letrec h z = z + ...g... @@ -1156,10 +1272,6 @@ annotateLamIdBndr env arg_of_dfun dmd_ty id main_ty = addDemand dmd dmd_ty' (dmd_ty', dmd) = findBndrDmd env arg_of_dfun dmd_ty id -deleteFVs :: DmdType -> [Var] -> DmdType -deleteFVs (DmdType fvs dmds res) bndrs - = DmdType (delVarEnvList fvs bndrs) dmds res - {- Note [NOINLINE and strictness] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Core/Opt/Pipeline.hs ===================================== @@ -65,6 +65,7 @@ import GHC.Types.SrcLoc import GHC.Types.Id import GHC.Types.Id.Info import GHC.Types.Basic +import GHC.Types.Demand ( zapDmdEnvSig ) import GHC.Types.Var.Set import GHC.Types.Var.Env import GHC.Types.Unique.Supply ( UniqSupply, mkSplitUniqSupply, splitUniqSupply ) @@ -495,7 +496,7 @@ doCorePass CoreDoExitify = {-# SCC "Exitify" #-} doPass exitifyProgram doCorePass CoreDoDemand = {-# SCC "DmdAnal" #-} - doPassDFM dmdAnal + doPassDFRM dmdAnal doCorePass CoreDoCpr = {-# SCC "CprAnal" #-} doPassDFM cprAnalProgram @@ -575,6 +576,13 @@ doPassDFM do_pass guts = do let fam_envs = (p_fam_env, mg_fam_inst_env guts) doPassM (liftIO . do_pass dflags fam_envs) guts +doPassDFRM :: (DynFlags -> FamInstEnvs -> [CoreRule] -> CoreProgram -> IO CoreProgram) -> ModGuts -> CoreM ModGuts +doPassDFRM do_pass guts = do + dflags <- getDynFlags + p_fam_env <- getPackageFamInstEnv + let fam_envs = (p_fam_env, mg_fam_inst_env guts) + doPassM (liftIO . do_pass dflags fam_envs (mg_rules guts)) guts + doPassDFU :: (DynFlags -> FamInstEnvs -> UniqSupply -> CoreProgram -> CoreProgram) -> ModGuts -> CoreM ModGuts doPassDFU do_pass guts = do dflags <- getDynFlags @@ -1088,13 +1096,13 @@ transferIdInfo exported_id local_id -dmdAnal :: DynFlags -> FamInstEnvs -> CoreProgram -> IO CoreProgram -dmdAnal dflags fam_envs binds = do +dmdAnal :: DynFlags -> FamInstEnvs -> [CoreRule] -> CoreProgram -> IO CoreProgram +dmdAnal dflags fam_envs rules binds = do let opts = DmdAnalOpts { dmd_strict_dicts = gopt Opt_DictsStrict dflags } - binds_plus_dmds = dmdAnalProgram opts fam_envs binds + binds_plus_dmds = dmdAnalProgram opts fam_envs rules binds Err.dumpIfSet_dyn dflags Opt_D_dump_str_signatures "Strictness signatures" FormatText $ - dumpIdInfoOfProgram (ppr . strictnessInfo) binds_plus_dmds + dumpIdInfoOfProgram (ppr . zapDmdEnvSig . strictnessInfo) binds_plus_dmds -- See Note [Stamp out space leaks in demand analysis] in GHC.Core.Opt.DmdAnal seqBinds binds_plus_dmds `seq` return binds_plus_dmds ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -598,11 +598,10 @@ addJoinFlts = appOL mkRecFloats :: SimplFloats -> SimplFloats -- Flattens the floats into a single Rec group, -- They must either all be lifted LetFloats or all JoinFloats -mkRecFloats floats@(SimplFloats { sfLetFloats = LetFloats bs ff +mkRecFloats floats@(SimplFloats { sfLetFloats = LetFloats bs _ff , sfJoinFloats = jbs , sfInScope = in_scope }) - = ASSERT2( case ff of { FltLifted -> True; _ -> False }, ppr (fromOL bs) ) - ASSERT2( isNilOL bs || isNilOL jbs, ppr floats ) + = ASSERT2( isNilOL bs || isNilOL jbs, ppr floats ) SimplFloats { sfLetFloats = floats' , sfJoinFloats = jfloats' , sfInScope = in_scope } ===================================== compiler/GHC/Core/Opt/WorkWrap.hs ===================================== @@ -484,7 +484,7 @@ tryWW dflags fam_envs is_rec fn_id rhs | is_fun && is_eta_exp = splitFun dflags fam_envs new_fn_id fn_info wrap_dmds div cpr rhs - | is_thunk -- See Note [Thunk splitting] + | isNonRec is_rec, is_thunk -- See Note [Thunk splitting] = splitThunk dflags fam_envs is_rec new_fn_id rhs | otherwise ===================================== compiler/GHC/Core/Opt/WorkWrap/Utils.hs ===================================== @@ -1275,10 +1275,14 @@ mk_absent_let dflags fam_envs arg abs_rhs = mkAbsentErrorApp arg_ty msg msg = showSDoc (gopt_set dflags Opt_SuppressUniques) - (ppr arg <+> ppr (idType arg) <+> file_msg) + (vcat + [ text "Arg:" <+> ppr arg + , text "Type:" <+> ppr arg_ty + , file_msg + ]) file_msg = case outputFile dflags of Nothing -> empty - Just f -> text "in output file " <+> quotes (text f) + Just f -> text "In output file " <+> quotes (text f) -- We need to suppress uniques here because otherwise they'd -- end up in the generated code as strings. This is bad for -- determinism, because with different uniques the strings ===================================== compiler/GHC/Core/Tidy.hs ===================================== @@ -21,7 +21,7 @@ import GHC.Core import GHC.Core.Seq ( seqUnfolding ) import GHC.Types.Id import GHC.Types.Id.Info -import GHC.Types.Demand ( zapUsageEnvSig ) +import GHC.Types.Demand ( zapDmdEnvSig ) import GHC.Core.Type ( tidyType, tidyVarBndr ) import GHC.Core.Coercion ( tidyCo ) import GHC.Types.Var @@ -206,7 +206,7 @@ tidyLetBndr rec_tidy_env env@(tidy_env, var_env) id new_info = vanillaIdInfo `setOccInfo` occInfo old_info `setArityInfo` arityInfo old_info - `setStrictnessInfo` zapUsageEnvSig (strictnessInfo old_info) + `setStrictnessInfo` zapDmdEnvSig (strictnessInfo old_info) `setDemandInfo` demandInfo old_info `setInlinePragInfo` inlinePragInfo old_info `setUnfoldingInfo` new_unf ===================================== compiler/GHC/Types/Demand.hs ===================================== @@ -34,7 +34,7 @@ module GHC.Types.Demand ( lazyApply1Dmd, lazyApply2Dmd, strictOnceApply1Dmd, strictManyApply1Dmd, -- ** Other @Demand@ operations oneifyCard, oneifyDmd, strictifyDmd, strictifyDictDmd, mkWorkerDemand, - peelCallDmd, peelManyCalls, mkCallDmd, mkCallDmds, + peelCallDmd, peelManyCalls, mkCalledOnceDmd, mkCalledOnceDmds, addCaseBndrDmd, -- ** Extracting one-shot information argOneShots, argsOneShots, saturatedByOneShots, @@ -73,7 +73,7 @@ module GHC.Types.Demand ( seqDemand, seqDemandList, seqDmdType, seqStrictSig, -- * Zapping usage information - zapUsageDemand, zapUsageEnvSig, zapUsedOnceDemand, zapUsedOnceSig + zapUsageDemand, zapDmdEnvSig, zapUsedOnceDemand, zapUsedOnceSig ) where #include "HsVersions.h" @@ -278,7 +278,8 @@ data SubDemand -- ^ @Call n sd@ describes the evaluation context of @n@ function -- applications, where every individual result is evaluated according to @sd at . -- @sd@ is /relative/ to a single call, cf. Note [Call demands are relative]. - -- Used only for values of function type. + -- Used only for values of function type. Use the smart constructor 'mkCall' + -- whenever possible! | Prod ![Demand] -- ^ @Prod ds@ describes the evaluation context of a case scrutinisation -- on an expression of product type, where the product components are @@ -306,7 +307,7 @@ polyDmd C_1N = C_1N :* poly1N polyDmd C_10 = C_10 :* poly10 -- | A smart constructor for 'Prod', applying rewrite rules along the semantic --- equalities @Prod [polyDmd n, ...] === polyDmd n@, simplifying to 'Poly' +-- equality @Prod [polyDmd n, ...] === polyDmd n@, simplifying to 'Poly' -- 'SubDemand's when possible. Note that this degrades boxity information! E.g. a -- polymorphic demand will never unbox. mkProd :: [Demand] -> SubDemand @@ -335,6 +336,13 @@ viewProd _ _ = Nothing {-# INLINE viewProd #-} -- we want to fuse away the replicate and the allocation -- for Arity. Otherwise, #18304 bites us. +-- | A smart constructor for 'Call', applying rewrite rules along the semantic +-- equality @Call n (Poly n) === Poly n@, simplifying to 'Poly' 'SubDemand's +-- when possible. +mkCall :: Card -> SubDemand -> SubDemand +mkCall n cd@(Poly m) | n == m = cd +mkCall n cd = Call n cd + -- | @viewCall sd@ interprets @sd@ as a 'Call', expanding 'Poly' demands as -- necessary. viewCall :: SubDemand -> Maybe (Card, SubDemand) @@ -356,8 +364,8 @@ lubSubDmd (Prod ds1) (viewProd (length ds1) -> Just ds2) = -- Handle Call lubSubDmd (Call n1 d1) (viewCall -> Just (n2, d2)) -- See Note [Call demands are relative] - | isAbs n2 = Call (lubCard n1 n2) (lubSubDmd d1 botSubDmd) - | otherwise = Call (lubCard n1 n2) (lubSubDmd d1 d2) + | isAbs n2 = mkCall (lubCard n1 n2) (lubSubDmd d1 botSubDmd) + | otherwise = mkCall (lubCard n1 n2) (lubSubDmd d1 d2) -- Handle Poly lubSubDmd (Poly n1) (Poly n2) = Poly (lubCard n1 n2) -- Make use of reflexivity (so we'll match the Prod or Call cases again). @@ -377,8 +385,8 @@ plusSubDmd (Prod ds1) (viewProd (length ds1) -> Just ds2) = -- Handle Call plusSubDmd (Call n1 d1) (viewCall -> Just (n2, d2)) -- See Note [Call demands are relative] - | isAbs n2 = Call (plusCard n1 n2) (lubSubDmd d1 botSubDmd) - | otherwise = Call (plusCard n1 n2) (lubSubDmd d1 d2) + | isAbs n2 = mkCall (plusCard n1 n2) (lubSubDmd d1 botSubDmd) + | otherwise = mkCall (plusCard n1 n2) (lubSubDmd d1 d2) -- Handle Poly plusSubDmd (Poly n1) (Poly n2) = Poly (plusCard n1 n2) -- Make use of reflexivity (so we'll match the Prod or Call cases again). @@ -407,7 +415,7 @@ multSubDmd :: Card -> SubDemand -> SubDemand multSubDmd n sd | Just sd' <- multTrivial n seqSubDmd sd = sd' multSubDmd n (Poly n') = Poly (multCard n n') -multSubDmd n (Call n' sd) = Call (multCard n n') sd -- See Note [Call demands are relative] +multSubDmd n (Call n' sd) = mkCall (multCard n n') sd -- See Note [Call demands are relative] multSubDmd n (Prod ds) = Prod (map (multDmd n) ds) multDmd :: Card -> Demand -> Demand @@ -457,22 +465,22 @@ evalDmd = C_1N :* topSubDmd -- | First argument of 'GHC.Exts.maskAsyncExceptions#': @SCS(U)@. -- Called exactly once. strictOnceApply1Dmd :: Demand -strictOnceApply1Dmd = C_11 :* Call C_11 topSubDmd +strictOnceApply1Dmd = C_11 :* mkCall C_11 topSubDmd -- | First argument of 'GHC.Exts.atomically#': @MCM(U)@. -- Called at least once, possibly many times. strictManyApply1Dmd :: Demand -strictManyApply1Dmd = C_1N :* Call C_1N topSubDmd +strictManyApply1Dmd = C_1N :* mkCall C_1N topSubDmd -- | First argument of catch#: @1C1(U)@. -- Evaluates its arg lazily, but then applies it exactly once to one argument. lazyApply1Dmd :: Demand -lazyApply1Dmd = C_01 :* Call C_01 topSubDmd +lazyApply1Dmd = C_01 :* mkCall C_01 topSubDmd -- | Second argument of catch#: @1C1(CS(U))@. -- Calls its arg lazily, but then applies it exactly once to an additional argument. lazyApply2Dmd :: Demand -lazyApply2Dmd = C_01 :* Call C_01 (Call C_11 topSubDmd) +lazyApply2Dmd = C_01 :* mkCall C_01 (mkCall C_11 topSubDmd) -- | Make a 'Demand' evaluated at-most-once. oneifyDmd :: Demand -> Demand @@ -512,12 +520,12 @@ strictifyDictDmd ty (n :* Prod ds) strictifyDictDmd _ dmd = dmd -- | Wraps the 'SubDemand' with a one-shot call demand: @d@ -> @CS(d)@. -mkCallDmd :: SubDemand -> SubDemand -mkCallDmd sd = Call C_11 sd +mkCalledOnceDmd :: SubDemand -> SubDemand +mkCalledOnceDmd sd = mkCall C_11 sd --- | @mkCallDmds n d@ returns @CS(CS...(CS d))@ where there are @n@ @CS@'s. -mkCallDmds :: Arity -> SubDemand -> SubDemand -mkCallDmds arity sd = iterate mkCallDmd sd !! arity +-- | @mkCalledOnceDmds n d@ returns @CS(CS...(CS d))@ where there are @n@ @CS@'s. +mkCalledOnceDmds :: Arity -> SubDemand -> SubDemand +mkCalledOnceDmds arity sd = iterate mkCalledOnceDmd sd !! arity -- | Peels one call level from the sub-demand, and also returns how many -- times we entered the lambda body. @@ -669,7 +677,7 @@ This is needed even for non-product types, in case the case-binder is used but the components of the case alternative are not. Note [Don't optimise UP(U,U,...) to U] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ These two SubDemands: UP(U,U) (@Prod [topDmd, topDmd]@) and U (@topSubDmd@) are semantically equivalent, but we do not turn the former into @@ -1571,9 +1579,9 @@ This is weird, so I'm not worried about whether this optimises brilliantly; but it should not fall over. -} -zapUsageEnvSig :: StrictSig -> StrictSig --- Remove the usage environment from the demand -zapUsageEnvSig (StrictSig (DmdType _ ds r)) = mkClosedStrictSig ds r +-- | Remove the demand environment from the signature. +zapDmdEnvSig :: StrictSig -> StrictSig +zapDmdEnvSig (StrictSig (DmdType _ ds r)) = mkClosedStrictSig ds r zapUsageDemand :: Demand -> Demand -- Remove the usage info, but not the strictness info, from the demand @@ -1615,8 +1623,8 @@ kill_usage kfs (n :* sd) = kill_usage_card kfs n :* kill_usage_sd kfs sd kill_usage_sd :: KillFlags -> SubDemand -> SubDemand kill_usage_sd kfs (Call n sd) - | kf_called_once kfs = Call (lubCard C_1N n) (kill_usage_sd kfs sd) - | otherwise = Call n (kill_usage_sd kfs sd) + | kf_called_once kfs = mkCall (lubCard C_1N n) (kill_usage_sd kfs sd) + | otherwise = mkCall n (kill_usage_sd kfs sd) kill_usage_sd kfs (Prod ds) = Prod (map (kill_usage kfs) ds) kill_usage_sd _ sd = sd @@ -1640,7 +1648,7 @@ trimToType (n :* sd) ts where go (Prod ds) (TsProd tss) | equalLength ds tss = Prod (zipWith trimToType ds tss) - go (Call n sd) (TsFun ts) = Call n (go sd ts) + go (Call n sd) (TsFun ts) = mkCall n (go sd ts) go sd at Poly{} _ = sd go _ _ = topSubDmd @@ -1804,7 +1812,7 @@ instance Binary SubDemand where h <- getByte bh case h of 0 -> Poly <$> get bh - 1 -> Call <$> get bh <*> get bh + 1 -> mkCall <$> get bh <*> get bh 2 -> Prod <$> get bh _ -> pprPanic "Binary:SubDemand" (ppr (fromIntegral h :: Int)) ===================================== compiler/GHC/Types/Id/Info.hs ===================================== @@ -650,7 +650,7 @@ zapUsageInfo info = Just (info {demandInfo = zapUsageDemand (demandInfo info)}) zapUsageEnvInfo :: IdInfo -> Maybe IdInfo zapUsageEnvInfo info | hasDemandEnvSig (strictnessInfo info) - = Just (info {strictnessInfo = zapUsageEnvSig (strictnessInfo info)}) + = Just (info {strictnessInfo = zapDmdEnvSig (strictnessInfo info)}) | otherwise = Nothing ===================================== testsuite/tests/arityanal/should_compile/Arity11.stderr ===================================== @@ -35,7 +35,7 @@ end Rec } -- RHS size: {terms: 52, types: 28, coercions: 0, joins: 0/5} F11.$wfib [InlPrag=[2]] :: forall {a} {p}. (a -> a -> Bool) -> (Num a, Num p) => a -> p -[GblId, Arity=4, Str=, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 150 60 0] 460 0}] +[GblId, Arity=4, Str=, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 150 60 0] 460 0}] F11.$wfib = \ (@a) (@p) (ww :: a -> a -> Bool) (w :: Num a) (w1 :: Num p) (w2 :: a) -> let { @@ -73,7 +73,7 @@ F11.$wfib fib [InlPrag=[2]] :: forall {a} {p}. (Eq a, Num a, Num p) => a -> p [GblId, Arity=4, - Str=, + Str=, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=4,unsat_ok=True,boring_ok=False) Tmpl= \ (@a) (@p) (w [Occ=Once1!] :: Eq a) (w1 [Occ=Once1] :: Num a) (w2 [Occ=Once1] :: Num p) (w3 [Occ=Once1] :: a) -> case w of { GHC.Classes.C:Eq ww1 [Occ=Once1] _ [Occ=Dead] -> F11.$wfib @a @p ww1 w1 w2 w3 }}] fib = \ (@a) (@p) (w :: Eq a) (w1 :: Num a) (w2 :: Num p) (w3 :: a) -> case w of { GHC.Classes.C:Eq ww1 ww2 -> F11.$wfib @a @p ww1 w1 w2 w3 } ===================================== testsuite/tests/arityanal/should_compile/Arity16.stderr ===================================== @@ -5,7 +5,7 @@ Result size of Tidy Core = {terms: 52, types: 87, coercions: 0, joins: 0/0} Rec { -- RHS size: {terms: 15, types: 17, coercions: 0, joins: 0/0} map2 [Occ=LoopBreaker] :: forall {t} {a}. (t -> a) -> [t] -> [a] -[GblId, Arity=2, Str=, Unf=OtherCon []] +[GblId, Arity=2, Str=, Unf=OtherCon []] map2 = \ (@t) (@a) (f :: t -> a) (ds :: [t]) -> case ds of { ===================================== testsuite/tests/stranal/should_compile/T18894.hs ===================================== @@ -0,0 +1,28 @@ +{-# OPTIONS_GHC -O2 -fforce-recomp #-} + +-- | The point of this test is that @g*@ get's a demand that says +-- "whenever @g*@ is called, the second component of the pair is evaluated strictly". +module T18894 (h1, h2) where + +g1 :: Int -> (Int,Int) +g1 1 = (15, 0) +g1 n = (2 * n, 2 `div` n) +{-# NOINLINE g1 #-} + +h1 :: Int -> Int +h1 1 = 0 +-- Sadly, the @g1 2@ subexpression will be floated to top-level, where we +-- don't see the specific demand placed on it by @snd at . Tracked in #19001. +h1 2 = snd (g1 2) +h1 m = uncurry (+) (g1 m) + +g2 :: Int -> Int -> (Int,Int) +g2 m 1 = (m, 0) +g2 m n = (2 * m, 2 `div` n) +{-# NOINLINE g2 #-} + +h2 :: Int -> Int +h2 1 = 0 +h2 m + | odd m = snd (g2 m 2) + | otherwise = uncurry (+) (g2 2 m) ===================================== testsuite/tests/stranal/should_compile/T18894.stderr ===================================== @@ -0,0 +1,404 @@ + +==================== Demand analysis ==================== +Result size of Demand analysis + = {terms: 177, types: 97, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 36, types: 16, coercions: 0, joins: 0/0} +g2 [InlPrag=NOINLINE, Dmd=UCU(CS(P(1P(U),SP(U))))] + :: Int -> Int -> (Int, Int) +[LclId, + Arity=2, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20 20] 161 20}] +g2 + = \ (m [Dmd=UP(U)] :: Int) (ds [Dmd=SP(SU)] :: Int) -> + case ds of { GHC.Types.I# ds [Dmd=SU] -> + case ds of ds [Dmd=1U] { + __DEFAULT -> + (case m of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.*# 2# y) }, + case ds of wild { + __DEFAULT -> + case GHC.Classes.divInt# 2# wild of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> GHC.Types.I# -2#; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + }); + 1# -> (m, lvl) + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 36, types: 19, coercions: 0, joins: 0/0} +h2 :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 162 10}] +h2 + = \ (ds [Dmd=SP(MU)] :: Int) -> + case ds of wild [Dmd=UP(U)] { GHC.Types.I# ds [Dmd=MU] -> + case ds of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> + case g2 wild lvl of { (ds1 [Dmd=A], y [Dmd=SU]) -> y }; + 0# -> + case g2 lvl wild of { (x [Dmd=SP(U)], ds [Dmd=SP(U)]) -> + case x of { GHC.Types.I# x -> + case ds of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + } + }; + 1# -> lvl + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 15# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +lvl :: (Int, Int) +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = (lvl, lvl) + +-- RHS size: {terms: 30, types: 11, coercions: 0, joins: 0/0} +g1 [InlPrag=NOINLINE, Dmd=UCU(P(UP(U),UP(U)))] :: Int -> (Int, Int) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 141 10}] +g1 + = \ (ds [Dmd=SP(SU)] :: Int) -> + case ds of { GHC.Types.I# ds [Dmd=SU] -> + case ds of ds { + __DEFAULT -> + (GHC.Types.I# (GHC.Prim.*# 2# ds), + case ds of wild { + __DEFAULT -> + case GHC.Classes.divInt# 2# wild of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> GHC.Types.I# -2#; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + }); + 1# -> lvl + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +lvl :: (Int, Int) +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=False, ConLike=False, + WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 30 0}] +lvl = g1 (GHC.Types.I# 2#) + +-- RHS size: {terms: 28, types: 18, coercions: 0, joins: 0/0} +h1 :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 111 10}] +h1 + = \ (ds [Dmd=SP(MU)] :: Int) -> + case ds of wild [Dmd=1P(1U)] { GHC.Types.I# ds [Dmd=MU] -> + case ds of { + __DEFAULT -> + case g1 wild of { (x [Dmd=SP(U)], ds [Dmd=SP(U)]) -> + case x of { GHC.Types.I# x -> + case ds of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + }; + 1# -> lvl; + 2# -> case lvl of { (ds1 [Dmd=A], y [Dmd=SU]) -> y } + } + } + + + + +==================== Demand analysis ==================== +Result size of Demand analysis + = {terms: 171, types: 120, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# -2# + +-- RHS size: {terms: 32, types: 18, coercions: 0, joins: 0/0} +$wg2 [InlPrag=NOINLINE, Dmd=UCU(CS(P(1P(U),SP(U))))] + :: Int -> GHC.Prim.Int# -> (# Int, Int #) +[LclId, + Arity=2, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20 30] 121 20}] +$wg2 + = \ (w [Dmd=UP(U)] :: Int) (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + (# case w of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.*# 2# y) }, + case ds of { + __DEFAULT -> + case GHC.Classes.divInt# 2# ds of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> lvl; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + } #); + 1# -> (# w, lvl #) + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 34, types: 21, coercions: 0, joins: 0/0} +$wh2 [InlPrag=[2]] :: GHC.Prim.Int# -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 162 10}] +$wh2 + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> + case $wg2 (GHC.Types.I# ds) 2# of + { (# ww [Dmd=A], ww [Dmd=SU] #) -> + ww + }; + 0# -> + case $wg2 lvl ds of { (# ww [Dmd=SP(U)], ww [Dmd=SP(U)] #) -> + case ww of { GHC.Types.I# x -> + case ww of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + } + }; + 1# -> lvl + } + +-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} +h2 [InlPrag=[2]] :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (w [Occ=Once1!] :: Int) -> + case w of { GHC.Types.I# ww [Occ=Once1, Dmd=MU] -> $wh2 ww }}] +h2 + = \ (w [Dmd=SP(SU)] :: Int) -> + case w of { GHC.Types.I# ww [Dmd=SU] -> $wh2 ww } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 15# + +-- RHS size: {terms: 28, types: 15, coercions: 0, joins: 0/0} +$wg1 [InlPrag=NOINLINE, Dmd=UCU(P(UP(U),UP(U)))] + :: GHC.Prim.Int# -> (# Int, Int #) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 111 20}] +$wg1 + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + (# GHC.Types.I# (GHC.Prim.*# 2# ds), + case ds of { + __DEFAULT -> + case GHC.Classes.divInt# 2# ds of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> lvl; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + } #); + 1# -> (# lvl, lvl #) + } + +-- RHS size: {terms: 7, types: 9, coercions: 0, joins: 0/0} +lvl :: (Int, Int) +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=False, ConLike=False, + WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 40 10}] +lvl = case $wg1 2# of { (# ww, ww #) -> (ww, ww) } + +-- RHS size: {terms: 25, types: 18, coercions: 0, joins: 0/0} +$wh1 [InlPrag=[2]] :: GHC.Prim.Int# -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [50] 101 10}] +$wh1 + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds [Dmd=1U] { + __DEFAULT -> + case $wg1 ds of { (# ww [Dmd=SP(U)], ww [Dmd=SP(U)] #) -> + case ww of { GHC.Types.I# x -> + case ww of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + }; + 1# -> lvl; + 2# -> case lvl of { (ds1 [Dmd=A], y [Dmd=SU]) -> y } + } + +-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} +h1 [InlPrag=[2]] :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (w [Occ=Once1!] :: Int) -> + case w of { GHC.Types.I# ww [Occ=Once1, Dmd=MU] -> $wh1 ww }}] +h1 + = \ (w [Dmd=SP(SU)] :: Int) -> + case w of { GHC.Types.I# ww [Dmd=SU] -> $wh1 ww } + + + ===================================== testsuite/tests/stranal/should_compile/T18894b.hs ===================================== @@ -0,0 +1,20 @@ +{-# OPTIONS_GHC -O -fno-call-arity -fforce-recomp #-} + +module T18894 (f) where + +expensive :: Int -> (Int, Int) +expensive n = (n+1, n+2) +{-# NOINLINE expensive #-} + +-- arity 1 by itself, but not exported, thus can be eta-expanded based on usage +eta :: Int -> Int -> Int +eta x = if fst (expensive x) == 13 + then \y -> x + y + else \y -> x * y +{-# NOINLINE eta #-} + +f :: Int -> Int +f 1 = 0 +f m + | odd m = eta m 2 + | otherwise = eta 2 m ===================================== testsuite/tests/stranal/should_compile/T18894b.stderr ===================================== @@ -0,0 +1,187 @@ + +==================== Demand analysis ==================== +Result size of Demand analysis = {terms: 83, types: 40, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 16, types: 7, coercions: 0, joins: 0/0} +expensive [InlPrag=NOINLINE, Dmd=UCU(P(SP(SU),A))] :: Int -> (Int, Int) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [40] 52 10}] +expensive + = \ (n [Dmd=UP(U)] :: Int) -> + (case n of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 1#) }, case n of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 2#) }) + +-- RHS size: {terms: 20, types: 11, coercions: 0, joins: 0/0} +eta [InlPrag=NOINLINE, Dmd=UCU(CS(U))] :: Int -> Int -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [0] 140 120}] +eta + = \ (x [Dmd=UP(U)] :: Int) -> + case expensive x of { (x [Dmd=SP(SU)], ds1 [Dmd=A]) -> + case x of { GHC.Types.I# x [Dmd=SU] -> + case x of { + __DEFAULT -> \ (y [Dmd=SP(U)] :: Int) -> GHC.Num.$fNumInt_$c* x y; + 13# -> \ (y [Dmd=SP(U)] :: Int) -> GHC.Num.$fNumInt_$c+ x y + } + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 21, types: 5, coercions: 0, joins: 0/0} +f :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 111 0}] +f = \ (ds [Dmd=SP(MU)] :: Int) -> + case ds of wild [Dmd=UP(U)] { GHC.Types.I# ds [Dmd=MU] -> + case ds of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> eta wild lvl; + 0# -> eta lvl wild + }; + 1# -> lvl + } + } + + + + +==================== Demand analysis ==================== +Result size of Demand analysis = {terms: 85, types: 47, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 16, types: 9, coercions: 0, joins: 0/0} +$wexpensive [InlPrag=NOINLINE, Dmd=UCU(P(SP(SU),A))] :: Int -> (# Int, Int #) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [40] 42 10}] +$wexpensive + = \ (w [Dmd=UP(U)] :: Int) -> + (# case w of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 1#) }, + case w of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 2#) } #) + +-- RHS size: {terms: 19, types: 12, coercions: 0, joins: 0/0} +eta [InlPrag=NOINLINE, Dmd=UCU(CS(U))] :: Int -> Int -> Int +[LclId, + Arity=2, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [0 0] 120 0}] +eta + = \ (x [Dmd=MP(U)] :: Int) (eta [Dmd=SP(U), OS=OneShot] :: Int) -> + case $wexpensive x of { (# ww [Dmd=SP(SU)], ww [Dmd=A] #) -> + case ww of { GHC.Types.I# x [Dmd=SU] -> + case x of { + __DEFAULT -> GHC.Num.$fNumInt_$c* x eta; + 13# -> GHC.Num.$fNumInt_$c+ x eta + } + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 20, types: 3, coercions: 0, joins: 0/0} +$wf [InlPrag=[2]] :: GHC.Prim.Int# -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 121 0}] +$wf + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> eta (GHC.Types.I# ds) lvl; + 0# -> eta lvl (GHC.Types.I# ds) + }; + 1# -> lvl + } + +-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} +f [InlPrag=[2]] :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (w [Occ=Once1!] :: Int) -> case w of { GHC.Types.I# ww [Occ=Once1, Dmd=MU] -> $wf ww }}] +f = \ (w [Dmd=SP(SU)] :: Int) -> case w of { GHC.Types.I# ww [Dmd=SU] -> $wf ww } + + + ===================================== testsuite/tests/stranal/should_compile/all.T ===================================== @@ -58,3 +58,7 @@ test('T18122', [ grep_errmsg(r'wfoo =') ], compile, ['-ddump-simpl']) # We care about the call demand on $wg test('T18903', [ grep_errmsg(r'Dmd=\S+C\S+') ], compile, ['-ddump-simpl -dsuppress-uniques']) +# We care about the call demand on $wg1 and $wg2 +test('T18894', [ grep_errmsg(r'Dmd=\S+C\S+') ], compile, ['-ddump-stranal -dsuppress-uniques']) +# We care about the Arity 2 on eta, as a result of the annotated Dmd +test('T18894b', [ grep_errmsg(r'Arity=2') ], compile, ['-ddump-stranal -dsuppress-uniques -fno-call-arity -dppr-cols=200']) ===================================== testsuite/tests/stranal/sigs/T5075.stderr ===================================== @@ -1,7 +1,7 @@ ==================== Strictness signatures ==================== T5075.$trModule: -T5075.loop: +T5075.loop: @@ -13,6 +13,6 @@ T5075.loop: ==================== Strictness signatures ==================== T5075.$trModule: -T5075.loop: +T5075.loop: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/74613325e7f456a64c7c108dca7e93fc94577639...46585fdb4ea0f49649294391b1a2abb33d99d49e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/74613325e7f456a64c7c108dca7e93fc94577639...46585fdb4ea0f49649294391b1a2abb33d99d49e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 4 19:16:17 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 04 Dec 2020 14:16:17 -0500 Subject: [Git][ghc/ghc][wip/tyconapp-opts] Optimise nullary type constructor usage Message-ID: <5fca8b0142825_6b2147a61c8287d@gitlab.mail> Ben Gamari pushed to branch wip/tyconapp-opts at Glasgow Haskell Compiler / GHC Commits: 9e5a5f5d by Ben Gamari at 2020-12-04T14:16:06-05:00 Optimise nullary type constructor usage During the compilation of programs GHC very frequently deals with the `Type` type, which is a synonym of `TYPE 'LiftedRep`. This patch teaches GHC to avoid expanding the `Type` synonym (and other nullary type synonyms) during type comparisons, saving a good amount of work. This optimisation is described in `Note [Comparing nullary type synonyms]`. To maximize the impact of this optimisation, we introduce a few special-cases to reduce `TYPE 'LiftedRep` to `Type`. See `Note [Prefer Type over TYPE 'LiftedPtrRep]`. Closes #17958. Metric Decrease: T18698b T1969 T12227 T12545 T12707 T14683 T3064 T5631 T5642 T9020 T9630 T9872a T13035 haddock.Cabal haddock.base - - - - - 22 changed files: - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - + compiler/GHC/Builtin/Types/Prim.hs-boot - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/TcType.hs - testsuite/tests/deSugar/should_compile/T2431.stderr - testsuite/tests/deriving/should_compile/T14578.stderr - testsuite/tests/plugins/plugins09.stdout - testsuite/tests/plugins/plugins10.stdout - testsuite/tests/plugins/plugins11.stdout - testsuite/tests/plugins/static-plugins.stdout - testsuite/tests/printer/T18052a.stderr - testsuite/tests/simplCore/should_compile/T13143.stderr - testsuite/tests/simplCore/should_compile/T18013.stderr - testsuite/tests/simplCore/should_compile/T7360.stderr - testsuite/tests/typecheck/should_compile/T13032.stderr Changes: ===================================== compiler/GHC/Builtin/Types.hs ===================================== @@ -170,6 +170,7 @@ import GHC.Types.Var (VarBndr (Bndr)) import GHC.Settings.Constants ( mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE, mAX_SUM_SIZE ) import GHC.Unit.Module ( Module ) import GHC.Core.Type +import qualified GHC.Core.TyCo.Rep as TyCoRep (Type(TyConApp)) import GHC.Types.RepType import GHC.Core.DataCon import GHC.Core.ConLike @@ -689,7 +690,7 @@ constraintKindTyCon :: TyCon constraintKindTyCon = pcTyCon constraintKindTyConName Nothing [] [] liftedTypeKind, typeToTypeKind, constraintKind :: Kind -liftedTypeKind = tYPE liftedRepTy +liftedTypeKind = TyCoRep.TyConApp liftedTypeKindTyCon [] typeToTypeKind = liftedTypeKind `mkVisFunTyMany` liftedTypeKind constraintKind = mkTyConApp constraintKindTyCon [] @@ -1413,8 +1414,8 @@ runtimeRepTy = mkTyConTy runtimeRepTyCon -- type Type = tYPE 'LiftedRep liftedTypeKindTyCon :: TyCon liftedTypeKindTyCon = buildSynTyCon liftedTypeKindTyConName - [] liftedTypeKind [] - (tYPE liftedRepTy) + [] liftedTypeKind [] rhs + where rhs = TyCoRep.TyConApp tYPETyCon [liftedRepTy] runtimeRepTyCon :: TyCon runtimeRepTyCon = pcTyCon runtimeRepTyConName Nothing [] ===================================== compiler/GHC/Builtin/Types/Prim.hs ===================================== @@ -551,10 +551,6 @@ mkPrimTcName built_in_syntax occ key tycon = mkWiredInName gHC_PRIM (mkTcOccFS occ) key (mkATyCon tycon) built_in_syntax ----------------------------- --- | Given a RuntimeRep, applies TYPE to it. --- see Note [TYPE and RuntimeRep] -tYPE :: Type -> Type -tYPE rr = TyConApp tYPETyCon [rr] -- Given a Multiplicity, applies FUN to it. functionWithMultiplicity :: Type -> Type ===================================== compiler/GHC/Builtin/Types/Prim.hs-boot ===================================== @@ -0,0 +1,5 @@ +module GHC.Builtin.Types.Prim where + +import GHC.Core.TyCon + +tYPETyCon :: TyCon ===================================== compiler/GHC/Core/TyCo/Rep.hs ===================================== @@ -52,6 +52,7 @@ module GHC.Core.TyCo.Rep ( mkVisFunTyMany, mkVisFunTysMany, mkInvisFunTyMany, mkInvisFunTysMany, mkTyConApp, + tYPE, -- * Functions over binders TyCoBinder(..), TyCoVarBinder, TyBinder, @@ -90,8 +91,9 @@ import GHC.Core.TyCon import GHC.Core.Coercion.Axiom -- others -import GHC.Builtin.Names ( liftedTypeKindTyConKey, manyDataConKey ) -import {-# SOURCE #-} GHC.Builtin.Types ( liftedTypeKindTyCon, manyDataConTy ) +import GHC.Builtin.Names ( liftedTypeKindTyConKey, liftedRepDataConKey, manyDataConKey, tYPETyConKey ) +import {-# SOURCE #-} GHC.Builtin.Types ( liftedTypeKindTyCon, liftedTypeKind, manyDataConTy ) +import {-# SOURCE #-} GHC.Builtin.Types.Prim ( tYPETyCon ) import GHC.Types.Basic ( LeftOrRight(..), pickLR ) import GHC.Types.Unique ( hasKey, Uniquable(..) ) import GHC.Utils.Outputable @@ -1018,12 +1020,64 @@ mkTyConApp tycon tys -- avoid reboxing every time `mkTyConApp` is called. = ASSERT2( null tys, ppr tycon $$ ppr tys ) manyDataConTy + -- See Note [Prefer Type over TYPE 'LiftedRep]. + | tycon `hasKey` tYPETyConKey + , [rep] <- tys + = tYPE rep + -- The catch-all case | otherwise = TyConApp tycon tys +{- +Note [Prefer Type over TYPE 'LiftedRep] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The Core of nearly any program will have numerous occurrences of + at TYPE 'LiftedRep@ floating about. Consequently, we try hard to ensure +that operations on such types are efficient. Specifically, we strive to + + a. Avoid heap allocation of such types + b. Use a small (shallow in the tree-depth sense) representation + for such types + +Goal (b) is particularly useful as it makes traversals (e.g. free variable +traversal, substitution, and comparison) more efficient. +Comparison in particular takes special advantage of nullary type synonym +applications, Note [Comparing nullary type synonyms] in "GHC.Core.Type". + +To accomplish these we use a number of tricks: + + * Instead of representing the lifted kind as + @TyConApp tYPETyCon [liftedRepDataCon]@ we rather prefer to + use the 'GHC.Types.Type' type synonym. This serves goal (b) + since there are no applied type arguments to traverse, e.g., during + comparison. + + * We have a top-level binding to represent `TyConApp GHC.Types.Type []` + (namely 'GHC.Builtin.Types.Prim.liftedTypeKind'), ensuring that we + don't need to allocate such types (goal (a)). + + * To avoid allocating 'TyConApp' constructors + 'GHC.Builtin.Types.Prim.tYPE' catches the lifted case and returns + `liftedTypeKind` instead of building an application (goal (a)). + + * Similarly, 'Type.mkTyConApp' catches applications of `TYPE` and + handles them using 'GHC.Builtin.Types.Prim.tYPE', ensuring + that it benefits from the optimisation described above (goal (a)). + +See #17958. +-} + +-- | Given a RuntimeRep, applies TYPE to it. +-- See Note [TYPE and RuntimeRep] in GHC.Builtin.Types.Prim. +tYPE :: Type -> Type +tYPE (TyConApp tc []) + -- See Note [Prefer Type of TYPE 'LiftedRep] + | tc `hasKey` liftedRepDataConKey = liftedTypeKind -- TYPE 'LiftedRep +tYPE rr = TyConApp tYPETyCon [rr] + -- This is a single, global definition of the type `Type` -- Defined here so it is only allocated once. --- See Note [mkTyConApp and Type] +-- See Note [mkTyConApp and Type] in this module. liftedTypeKindTyConApp :: Type liftedTypeKindTyConApp = TyConApp liftedTypeKindTyCon [] ===================================== compiler/GHC/Core/TyCo/Subst.hs ===================================== @@ -424,6 +424,7 @@ zipTCvSubst tcvs tys -- | Generates the in-scope set for the 'TCvSubst' from the types in the -- incoming environment. No CoVars, please! mkTvSubstPrs :: [(TyVar, Type)] -> TCvSubst +mkTvSubstPrs [] = emptyTCvSubst mkTvSubstPrs prs = ASSERT2( onlyTyVarsAndNoCoercionTy, text "prs" <+> ppr prs ) mkTvSubst in_scope tenv ===================================== compiler/GHC/Core/TyCon.hs ===================================== @@ -2327,12 +2327,14 @@ expandSynTyCon_maybe -- ^ Expand a type synonym application, if any expandSynTyCon_maybe tc tys | SynonymTyCon { tyConTyVars = tvs, synTcRhs = rhs, tyConArity = arity } <- tc - = case tys `listLengthCmp` arity of - GT -> Just (tvs `zip` tys, rhs, drop arity tys) - EQ -> Just (tvs `zip` tys, rhs, []) - LT -> Nothing - | otherwise - = Nothing + = case tys of + [] -> Just ([], rhs, []) -- Avoid a bit of work in the case of nullary synonyms + _ -> case tys `listLengthCmp` arity of + GT -> Just (tvs `zip` tys, rhs, drop arity tys) + EQ -> Just (tvs `zip` tys, rhs, []) + LT -> Nothing + | otherwise + = Nothing ---------------- ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -383,15 +383,16 @@ how roles in kinds might work out. -} -- | Gives the typechecker view of a type. This unwraps synonyms but --- leaves 'Constraint' alone. c.f. coreView, which turns Constraint into --- TYPE LiftedRep. Returns Nothing if no unwrapping happens. +-- leaves 'Constraint' alone. c.f. 'coreView', which turns 'Constraint' into +-- @TYPE LiftedRep at . Returns 'Nothing' if no unwrapping happens. -- See also Note [coreView vs tcView] {-# INLINE tcView #-} tcView :: Type -> Maybe Type -tcView (TyConApp tc tys) | Just (tenv, rhs, tys') <- expandSynTyCon_maybe tc tys - = Just (mkAppTys (substTy (mkTvSubstPrs tenv) rhs) tys') +tcView (TyConApp tc tys) + | res@(Just _) <- expandSynTyConApp_maybe tc tys + = res -- The free vars of 'rhs' should all be bound by 'tenv', so it's - -- ok to use 'substTy' here. + -- ok to use 'substTy' here (which is what expandSynTyConApp_maybe does). -- See also Note [The substitution invariant] in GHC.Core.TyCo.Subst. -- Its important to use mkAppTys, rather than (foldl AppTy), -- because the function part might well return a @@ -400,17 +401,16 @@ tcView _ = Nothing {-# INLINE coreView #-} coreView :: Type -> Maybe Type --- ^ This function Strips off the /top layer only/ of a type synonym +-- ^ This function strips off the /top layer only/ of a type synonym -- application (if any) its underlying representation type. --- Returns Nothing if there is nothing to look through. +-- Returns 'Nothing' if there is nothing to look through. -- This function considers 'Constraint' to be a synonym of @TYPE LiftedRep at . -- -- By being non-recursive and inlined, this case analysis gets efficiently -- joined onto the case analysis that the caller is already doing coreView ty@(TyConApp tc tys) - | Just (tenv, rhs, tys') <- expandSynTyCon_maybe tc tys - = Just (mkAppTys (substTy (mkTvSubstPrs tenv) rhs) tys') - -- This equation is exactly like tcView + | res@(Just _) <- expandSynTyConApp_maybe tc tys + = res -- At the Core level, Constraint = Type -- See Note [coreView vs tcView] @@ -420,6 +420,30 @@ coreView ty@(TyConApp tc tys) coreView _ = Nothing +----------------------------------------------- +expandSynTyConApp_maybe :: TyCon -> [Type] -> Maybe Type +expandSynTyConApp_maybe tc tys + | Just (tvs, rhs) <- synTyConDefn_maybe tc + , n_tys >= arity + = Just (expand_syn arity tvs rhs n_tys tys) + | otherwise + = Nothing + where + n_tys = length tys + arity = tyConArity tc +-- Without this INLINE the call to expandSynTyConApp_maybe in coreView +-- will result in an avoidable allocation. +{-# INLINE expandSynTyConApp_maybe #-} + +-- | A helper for 'expandSynTyConApp_maybe' to avoid inlining this cold path +-- into call-sites. +expand_syn :: Int -> [TyVar] -> Type -> Int -> [Type] -> Type +expand_syn arity tvs rhs n_tys tys + | n_tys > arity = mkAppTys rhs' (drop arity tys) + | otherwise = rhs' + where + rhs' = substTy (mkTvSubstPrs (tvs `zip` tys)) rhs + {-# INLINE coreFullView #-} coreFullView :: Type -> Type -- ^ Iterates 'coreView' until there is no more to synonym to expand. @@ -2207,6 +2231,36 @@ But the left is an AppTy while the right is a TyConApp. The solution is to use repSplitAppTy_maybe to break up the TyConApp into its pieces and then continue. Easy to do, but also easy to forget to do. + +Note [Comparing nullary type synonyms] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider the task of testing equality between two 'Type's of the form + + TyConApp tc [] + +where @tc@ is a type synonym. A naive way to perform this comparison these +would first expand the synonym and then compare the resulting expansions. + +However, this is obviously wasteful and the RHS of @tc@ may be large; it is +much better to rather compare the TyCons directly. Consequently, before +expanding type synonyms in type comparisons we first look for a nullary +TyConApp and simply compare the TyCons if we find one. Of course, if we find +that the TyCons are *not* equal then we still need to perform the expansion as +their RHSs may still be equal. + +We perform this optimisation in a number of places: + + * GHC.Core.Types.eqType + * GHC.Core.Types.nonDetCmpType + * GHC.Core.Unify.unify_ty + * TcCanonical.can_eq_nc' + * TcUnify.uType + +This optimisation is especially helpful for the ubiquitous GHC.Types.Type, +since GHC prefers to use the type synonym over @TYPE 'LiftedRep@ applications +whenever possible. See [Prefer Type over TYPE 'LiftedRep] in +GHC.Core.TyCo.Rep for details. + -} eqType :: Type -> Type -> Bool @@ -2318,6 +2372,10 @@ nonDetCmpTypeX env orig_t1 orig_t2 = -- Returns both the resulting ordering relation between the two types -- and whether either contains a cast. go :: RnEnv2 -> Type -> Type -> TypeOrdering + -- See Note [Comparing nullary type synonyms]. + go _ (TyConApp tc1 []) (TyConApp tc2 []) + | tc1 == tc2 + = TEQ go env t1 t2 | Just t1' <- coreView t1 = go env t1' t2 | Just t2' <- coreView t2 = go env t1 t2' ===================================== compiler/GHC/Core/Unify.hs ===================================== @@ -957,7 +957,12 @@ unify_ty :: UMEnv -- Respects newtypes, PredTypes unify_ty env ty1 ty2 kco - -- Use tcView, not coreView. See Note [coreView vs tcView] in GHC.Core.Type. + -- See Note [Comparing nullary type synonyms] in GHC.Core.Type. + | TyConApp tc1 [] <- ty1 + , TyConApp tc2 [] <- ty2 + , tc1 == tc2 = return () + + -- TODO: More commentary needed here | Just ty1' <- tcView ty1 = unify_ty env ty1' ty2 kco | Just ty2' <- tcView ty2 = unify_ty env ty1 ty2' kco | CastTy ty1' co <- ty1 = if um_unif env ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -956,6 +956,11 @@ can_eq_nc' -> Type -> Type -- RHS, after and before type-synonym expansion, resp -> TcS (StopOrContinue Ct) +-- See Note [Comparing nullary type synonyms] in GHC.Core.Type. +can_eq_nc' _flat _rdr_env _envs ev eq_rel ty1@(TyConApp tc1 []) _ps_ty1 (TyConApp tc2 []) _ps_ty2 + | tc1 == tc2 + = canEqReflexive ev eq_rel ty1 + -- Expand synonyms first; see Note [Type synonyms and canonicalization] can_eq_nc' rewritten rdr_env envs ev eq_rel ty1 ps_ty1 ty2 ps_ty2 | Just ty1' <- tcView ty1 = can_eq_nc' rewritten rdr_env envs ev eq_rel ty1' ps_ty1 ty2 ps_ty2 ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -120,7 +120,6 @@ import GHC.Types.Id as Id import GHC.Types.Name import GHC.Types.Var.Set import GHC.Builtin.Types -import GHC.Builtin.Types.Prim import GHC.Types.Var.Env import GHC.Types.Name.Env import GHC.Utils.Misc ===================================== compiler/GHC/Tc/Utils/TcType.hs ===================================== @@ -1581,6 +1581,11 @@ tc_eq_type keep_syns vis_only orig_ty1 orig_ty2 = go orig_env orig_ty1 orig_ty2 where go :: RnEnv2 -> Type -> Type -> Bool + -- See Note [Comparing nullary type synonyms] in GHC.Core.Type. + go _ (TyConApp tc1 []) (TyConApp tc2 []) + | tc1 == tc2 + = True + go env t1 t2 | not keep_syns, Just t1' <- tcView t1 = go env t1' t2 go env t1 t2 | not keep_syns, Just t2' <- tcView t2 = go env t1 t2' ===================================== testsuite/tests/deSugar/should_compile/T2431.stderr ===================================== @@ -1,9 +1,9 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 63, types: 43, coercions: 1, joins: 0/0} + = {terms: 63, types: 39, coercions: 1, joins: 0/0} --- RHS size: {terms: 2, types: 4, coercions: 1, joins: 0/0} +-- RHS size: {terms: 2, types: 3, coercions: 1, joins: 0/0} T2431.$WRefl [InlPrag=INLINE[final] CONLIKE] :: forall a. a :~: a [GblId[DataConWrapper], Caf=NoCafRefs, @@ -15,7 +15,7 @@ T2431.$WRefl [InlPrag=INLINE[final] CONLIKE] :: forall a. a :~: a T2431.$WRefl = \ (@a) -> T2431.Refl @a @a @~(_N :: a GHC.Prim.~# a) --- RHS size: {terms: 4, types: 8, coercions: 0, joins: 0/0} +-- RHS size: {terms: 4, types: 7, coercions: 0, joins: 0/0} absurd :: forall a. (Int :~: Bool) -> a [GblId, Arity=1, Str=b, Cpr=b, Unf=OtherCon []] absurd = \ (@a) (x :: Int :~: Bool) -> case x of { } ===================================== testsuite/tests/deriving/should_compile/T14578.stderr ===================================== @@ -16,13 +16,12 @@ Derived class instances: = GHC.Prim.coerce @(T14578.App (Data.Functor.Compose.Compose f g) a -> T14578.App (Data.Functor.Compose.Compose f g) a - -> T14578.App (Data.Functor.Compose.Compose f g) a) + -> T14578.App (Data.Functor.Compose.Compose f g) a) @(T14578.Wat f g a -> T14578.Wat f g a -> T14578.Wat f g a) ((GHC.Base.<>) @(T14578.App (Data.Functor.Compose.Compose f g) a)) GHC.Base.sconcat = GHC.Prim.coerce - @(GHC.Base.NonEmpty - (T14578.App (Data.Functor.Compose.Compose f g) a) + @(GHC.Base.NonEmpty (T14578.App (Data.Functor.Compose.Compose f g) a) -> T14578.App (Data.Functor.Compose.Compose f g) a) @(GHC.Base.NonEmpty (T14578.Wat f g a) -> T14578.Wat f g a) (GHC.Base.sconcat @@ -31,7 +30,7 @@ Derived class instances: = GHC.Prim.coerce @(b -> T14578.App (Data.Functor.Compose.Compose f g) a - -> T14578.App (Data.Functor.Compose.Compose f g) a) + -> T14578.App (Data.Functor.Compose.Compose f g) a) @(b -> T14578.Wat f g a -> T14578.Wat f g a) (GHC.Base.stimes @(T14578.App (Data.Functor.Compose.Compose f g) a)) ===================================== testsuite/tests/plugins/plugins09.stdout ===================================== @@ -3,6 +3,5 @@ interfacePlugin: Prelude interfacePlugin: GHC.Float interfacePlugin: GHC.Base typeCheckPlugin (rn) -interfacePlugin: GHC.Types typeCheckPlugin (tc) interfacePlugin: GHC.Num.BigNat ===================================== testsuite/tests/plugins/plugins10.stdout ===================================== @@ -6,7 +6,6 @@ interfacePlugin: GHC.Float interfacePlugin: GHC.Base interfacePlugin: Language.Haskell.TH.Syntax typeCheckPlugin (rn) -interfacePlugin: GHC.Types typeCheckPlugin (tc) interfacePlugin: GHC.Num.BigNat parsePlugin(a) ===================================== testsuite/tests/plugins/plugins11.stdout ===================================== @@ -3,6 +3,5 @@ interfacePlugin: Prelude interfacePlugin: GHC.Float interfacePlugin: GHC.Base typeCheckPlugin (rn) -interfacePlugin: GHC.Types typeCheckPlugin (tc) interfacePlugin: GHC.Num.BigNat ===================================== testsuite/tests/plugins/static-plugins.stdout ===================================== @@ -5,11 +5,11 @@ interfacePlugin: GHC.Float interfacePlugin: GHC.Base interfacePlugin: System.IO typeCheckPlugin (rn) -interfacePlugin: GHC.Prim -interfacePlugin: GHC.Show interfacePlugin: GHC.Types +interfacePlugin: GHC.Show interfacePlugin: GHC.TopHandler typeCheckPlugin (tc) +interfacePlugin: GHC.Prim interfacePlugin: GHC.CString interfacePlugin: GHC.Num.BigNat ==pure.1 ===================================== testsuite/tests/printer/T18052a.stderr ===================================== @@ -10,9 +10,9 @@ Dependent packages: [base-4.16.0.0, ghc-bignum-1.0, ghc-prim-0.8.0] ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 24, types: 61, coercions: 0, joins: 0/0} + = {terms: 24, types: 52, coercions: 0, joins: 0/0} --- RHS size: {terms: 7, types: 8, coercions: 0, joins: 0/0} +-- RHS size: {terms: 7, types: 6, coercions: 0, joins: 0/0} T18052a.$b:||: :: forall {a} {b}. a -> b -> (a, b) [GblId, Arity=2, Unf=OtherCon []] T18052a.$b:||: = \ (@a) (@b) (x :: a) (y :: b) -> (x, y) @@ -22,7 +22,7 @@ T18052a.$b:||: = \ (@a) (@b) (x :: a) (y :: b) -> (x, y) [GblId] (+++) = ++ --- RHS size: {terms: 13, types: 20, coercions: 0, joins: 0/0} +-- RHS size: {terms: 13, types: 18, coercions: 0, joins: 0/0} T18052a.$m:||: :: forall {rep :: GHC.Types.RuntimeRep} {r :: TYPE rep} {a} {b}. (a, b) -> (a -> b -> r) -> ((# #) -> r) -> r ===================================== testsuite/tests/simplCore/should_compile/T13143.stderr ===================================== @@ -1,17 +1,17 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 71, types: 44, coercions: 0, joins: 0/0} + = {terms: 71, types: 40, coercions: 0, joins: 0/0} Rec { --- RHS size: {terms: 4, types: 4, coercions: 0, joins: 0/0} +-- RHS size: {terms: 4, types: 3, coercions: 0, joins: 0/0} T13143.$wf [InlPrag=NOINLINE, Occ=LoopBreaker] :: forall {a}. (# #) -> a [GblId, Arity=1, Str=b, Cpr=b, Unf=OtherCon []] T13143.$wf = \ (@a) _ [Occ=Dead] -> T13143.$wf @a GHC.Prim.(##) end Rec } --- RHS size: {terms: 4, types: 4, coercions: 0, joins: 0/0} +-- RHS size: {terms: 4, types: 3, coercions: 0, joins: 0/0} f [InlPrag=[final]] :: forall a. Int -> a [GblId, Arity=1, ===================================== testsuite/tests/simplCore/should_compile/T18013.stderr ===================================== @@ -129,9 +129,9 @@ Rule fired: Class op fmap (BUILTIN) ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 52, types: 106, coercions: 17, joins: 0/1} + = {terms: 52, types: 101, coercions: 17, joins: 0/1} --- RHS size: {terms: 37, types: 87, coercions: 17, joins: 0/1} +-- RHS size: {terms: 37, types: 84, coercions: 17, joins: 0/1} mapMaybeRule :: forall a b. Rule IO a b -> Rule IO (Maybe a) (Maybe b) [GblId, ===================================== testsuite/tests/simplCore/should_compile/T7360.stderr ===================================== @@ -1,7 +1,7 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 106, types: 47, coercions: 0, joins: 0/0} + = {terms: 106, types: 45, coercions: 0, joins: 0/0} -- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} T7360.$WFoo3 [InlPrag=INLINE[final] CONLIKE] :: Int %1 -> Foo @@ -31,7 +31,7 @@ T7360.fun4 :: () WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 20 0}] T7360.fun4 = fun1 T7360.Foo1 --- RHS size: {terms: 11, types: 8, coercions: 0, joins: 0/0} +-- RHS size: {terms: 11, types: 7, coercions: 0, joins: 0/0} fun2 :: forall {a}. [a] -> ((), Int) [GblId, Arity=1, ===================================== testsuite/tests/typecheck/should_compile/T13032.stderr ===================================== @@ -1,9 +1,9 @@ ==================== Desugar (after optimization) ==================== Result size of Desugar (after optimization) - = {terms: 13, types: 24, coercions: 0, joins: 0/0} + = {terms: 13, types: 18, coercions: 0, joins: 0/0} --- RHS size: {terms: 6, types: 11, coercions: 0, joins: 0/0} +-- RHS size: {terms: 6, types: 8, coercions: 0, joins: 0/0} f :: forall a b. (a ~ b) => a -> b -> Bool [LclIdX, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9e5a5f5d89509c27c8c4f74140c96bb2d863fe05 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9e5a5f5d89509c27c8c4f74140c96bb2d863fe05 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 4 19:18:38 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 04 Dec 2020 14:18:38 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/18923 Message-ID: <5fca8b8e9830_6b216a64f4837ce@gitlab.mail> Ben Gamari pushed new branch wip/18923 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/18923 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 4 20:04:09 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 04 Dec 2020 15:04:09 -0500 Subject: [Git][ghc/ghc][ghc-8.10] hadrian: Don't --export-dynamic on Darwin Message-ID: <5fca9639a0e72_6b2174471c992d7@gitlab.mail> Ben Gamari pushed to branch ghc-8.10 at Glasgow Haskell Compiler / GHC Commits: 391a3f6d by Ben Gamari at 2020-12-04T15:04:01-05:00 hadrian: Don't --export-dynamic on Darwin When fixing #17962 I neglected to consider that --export-dynamic is only supported on ELF platforms. (cherry picked from commit 35799dda07813e4c510237290a631d4d11fb92d2) - - - - - 2 changed files: - hadrian/src/Oracles/Setting.hs - hadrian/src/Settings/Packages.hs Changes: ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -11,6 +11,7 @@ module Oracles.Setting ( -- ** Target platform things anyTargetPlatform, anyTargetOs, anyTargetArch, anyHostOs, + isElfTarget, ArmVersion(..), targetArmVersion, ghcWithInterpreter, useLibFFIForAdjustors @@ -241,6 +242,13 @@ anyTargetArch = matchSetting TargetArch anyHostOs :: [String] -> Action Bool anyHostOs = matchSetting HostOs +-- | Check whether the target OS uses the ELF object format. +isElfTarget :: Action Bool +isElfTarget = anyTargetOs + [ "linux", "freebsd", "dragonfly", "openbsd", "netbsd", "solaris2", "kfreebsdgnu" + , "haiku", "linux-android" + ] + -- | Check whether the host OS supports the @-rpath@ linker option when -- using dynamic linking. -- ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -150,7 +150,12 @@ packageArgs = do -- 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 + -- + -- The Solaris linker does not support --export-dynamic option. It also + -- does not need it since it exports all dynamic symbols by default + , package iserv + ? expr isElfTarget + ? notM (expr $ anyTargetOs ["freebsd", "solaris2"])? mconcat [ builder (Ghc LinkHs) ? arg "-optl-Wl,--export-dynamic" ] -------------------------------- haddock ------------------------------- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/391a3f6d3776a069534a91e34e5915a0c8d0391b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/391a3f6d3776a069534a91e34e5915a0c8d0391b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 4 21:11:34 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 04 Dec 2020 16:11:34 -0500 Subject: [Git][ghc/ghc][wip/keepAlive-the-return-of-the-primop] testsuite fixes Message-ID: <5fcaa606377bc_6b2174471c14378c@gitlab.mail> Ben Gamari pushed to branch wip/keepAlive-the-return-of-the-primop at Glasgow Haskell Compiler / GHC Commits: 40e8fd86 by Ben Gamari at 2020-12-04T15:59:28-05:00 testsuite fixes Metric Increase: T10421 T13701 T14697 T12227 T12234 T12425 T13035 T5536 - - - - - 2 changed files: - testsuite/tests/ghci/should_run/T16012.script - testsuite/tests/ghci/should_run/T16012.stdout Changes: ===================================== testsuite/tests/ghci/should_run/T16012.script ===================================== @@ -3,4 +3,4 @@ -- should always return a reasonably low result. n <- System.Mem.getAllocationCounter -if (n < 0 && n >= -160000) then putStrLn "Alloction counter in expected range" else (putStrLn $ "Unexpected allocation counter result:" ++ show n) +if (n < 0 && n >= -200000) then putStrLn "Allocation counter in expected range" else (putStrLn $ "Unexpected allocation counter result:" ++ show n) ===================================== testsuite/tests/ghci/should_run/T16012.stdout ===================================== @@ -1 +1 @@ -Alloction counter in expected range +Allocation counter in expected range View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/40e8fd86a8cccd0a967a9a75aaf41c1eb53618b4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/40e8fd86a8cccd0a967a9a75aaf41c1eb53618b4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 4 22:08:10 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Fri, 04 Dec 2020 17:08:10 -0500 Subject: [Git][ghc/ghc][wip/T18891] Fix kind inference for data types. Again. Message-ID: <5fcab34a17dc1_6b21a31a381584e7@gitlab.mail> Simon Peyton Jones pushed to branch wip/T18891 at Glasgow Haskell Compiler / GHC Commits: 1a9e9996 by Simon Peyton Jones at 2020-12-04T22:06:53+00:00 Fix kind inference for data types. Again. This patch fixes several aspects of kind inference for data type declarations, especially data /instance/ declarations Specifically 1. In kcConDecls/kcConDecl make it clear that the tc_res_kind argument is only used in the H98 case; and in that case there is no result kind signature; and hence no need for the disgusting splitPiTys in kcConDecls (now thankfully gone). The GADT case is a bit different to before, and much nicer. This is what fixes #18891. See Note [kcConDecls: kind-checking data type decls] 2. Do not look at the constructor decls of a data/newtype instance in tcDataFamInstanceHeader. See GHC.Tc.TyCl.Instance Note [Kind inference for data family instances]. This was a new realisation that arose when doing (1) This causes a few knock-on effects in the tests suite, because we require more information than before in the instance /header/. New user-manual material about this in "Kind inference in data type declarations" and "Kind inference for data/newtype instance declarations". 3. Minor improvement in kcTyClDecl, combining GADT and H98 cases 4. Fix #14111 and #8707 by allowing the header of a data instance to affect kind inferece for the the data constructor signatures; as described at length in Note [GADT return types] in GHC.Tc.TyCl This led to a modest refactoring of the arguments (and argument order) of tcConDecl/tcConDecls. 5. Fix #19000 by inverting the sense of the test in new_locs in GHC.Tc.Solver.Canonical.canDecomposableTyConAppOK. - - - - - 30 changed files: - compiler/GHC/Hs/Extension.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Instance.hs - docs/users_guide/9.2.1-notes.rst - docs/users_guide/exts/poly_kinds.rst - testsuite/tests/dependent/should_fail/T13780a.stderr - testsuite/tests/deriving/should_compile/T11416.hs - testsuite/tests/deriving/should_compile/T9359.hs - + testsuite/tests/gadt/SynDataRec.hs - testsuite/tests/gadt/all.T - + testsuite/tests/indexed-types/should_compile/T14111.hs - + testsuite/tests/indexed-types/should_compile/T8707.hs - testsuite/tests/indexed-types/should_compile/all.T - testsuite/tests/indexed-types/should_fail/T8368.stderr - testsuite/tests/indexed-types/should_fail/T8368a.stderr - testsuite/tests/patsyn/should_fail/T15685.stderr - testsuite/tests/polykinds/T13659.stderr - testsuite/tests/polykinds/T16221a.stderr - testsuite/tests/th/T11145.stderr - testsuite/tests/th/T9692.hs - + testsuite/tests/typecheck/should_compile/T18891.hs - testsuite/tests/typecheck/should_compile/UnliftedNewtypesUnassociatedFamily.hs - testsuite/tests/typecheck/should_compile/UnliftedNewtypesUnifySig.hs - testsuite/tests/typecheck/should_compile/all.T - + testsuite/tests/typecheck/should_fail/T18891a.hs - + testsuite/tests/typecheck/should_fail/T18891a.stderr - testsuite/tests/typecheck/should_fail/UnliftedNewtypesFamilyKindFail2.stderr - + testsuite/tests/typecheck/should_fail/UnliftedNewtypesUnassociatedFamilyFail.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1a9e9996e17f73b40fcdfc18f0a3d4dd39c2f187 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1a9e9996e17f73b40fcdfc18f0a3d4dd39c2f187 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 4 22:57:33 2020 From: gitlab at gitlab.haskell.org (Ryan Scott) Date: Fri, 04 Dec 2020 17:57:33 -0500 Subject: [Git][ghc/ghc][wip/T18021] 42 commits: Hadrian: fix detection of ghc-pkg for cross-compilers Message-ID: <5fcabedd36c56_6b216c3c5c172780@gitlab.mail> Ryan Scott pushed to branch wip/T18021 at Glasgow Haskell Compiler / GHC Commits: 75fc1ed5 by Sylvain Henry at 2020-11-28T15:40:23-05:00 Hadrian: fix detection of ghc-pkg for cross-compilers - - - - - 7cb5df96 by Sylvain Henry at 2020-11-28T15:40:23-05:00 hadrian: fix ghc-pkg uses (#17601) Make sure ghc-pkg doesn't read the compiler "settings" file by passing --no-user-package-db. - - - - - e3fd4226 by Ben Gamari at 2020-11-28T15:40:23-05:00 gitlab-ci: Introduce a nightly cross-compilation job This adds a job to test cross-compilation from x86-64 to AArch64 with Hadrian. Fixes #18234 - - - - - 698d3d96 by Ben Gamari at 2020-11-28T15:41:00-05:00 gitlab-ci: Only deploy GitLab Pages in ghc/ghc> The deployments are quite large and yet are currently only served for the ghc/ghc> project. - - - - - 625726f9 by David Eichmann at 2020-11-28T15:41:37-05:00 ghc-heap: partial TSO/STACK decoding Co-authored-by: Sven Tennie <sven.tennie at gmail.com> Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> Co-authored-by: Ben Gamari <bgamari.foss at gmail.com> - - - - - 22ea9c29 by Andreas Klebinger at 2020-11-28T15:42:13-05:00 Small optimization to CmmSink. Inside `regsUsedIn` we can avoid some thunks by specializing the recursion. In particular we avoid the thunk for `(f e z)` in the MachOp/Load branches, where we know this will evaluate to z. Reduces allocations for T3294 by ~1%. - - - - - bba42c62 by John Ericson at 2020-11-28T15:42:49-05:00 Make primop handler indentation more consistent - - - - - c82bc8e9 by John Ericson at 2020-11-28T15:42:49-05:00 Cleanup some primop constructor names Harmonize the internal (big sum type) names of the native vs fixed-sized number primops a bit. (Mainly by renaming the former.) No user-facing names are changed. - - - - - ae14f160 by Ben Gamari at 2020-11-28T15:43:25-05:00 testsuite: Mark T14702 as fragile on Windows Due to #18953. - - - - - 1bc104b0 by Ben Gamari at 2020-11-29T15:33:18-05:00 withTimings: Emit allocations counter This will allow us to back out the allocations per compiler pass from the eventlog. Note that we dump the allocation counter rather than the difference since this will allow us to determine how much work is done *between* `withTiming` blocks. - - - - - e992ea84 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 ThreadPaused: Don't zero slop until free vars are pushed When threadPaused blackholes a thunk it calls `OVERWRITING_CLOSURE` to zero the slop for the benefit of the sanity checker. Previously this was done *before* pushing the thunk's free variables to the update remembered set. Consequently we would pull zero'd pointers to the update remembered set. - - - - - e82cd140 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Fix regression from TSAN work The TSAN rework (specifically aad1f803) introduced a subtle regression in GC.c, swapping `g0` in place of `gen`. Whoops! Fixes #18997. - - - - - 35a5207e by GHC GitLab CI at 2020-11-29T15:33:54-05:00 rts/Messages: Add missing write barrier in THROWTO message update After a THROWTO message has been handle the message closure is overwritten by a NULL message. We must ensure that the original closure's pointers continue to be visible to the nonmoving GC. - - - - - 0120829f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Add missing write barrier in shrinkSmallByteArray - - - - - 8a4d8fb6 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 Updates: Don't zero slop until closure has been pushed Ensure that the the free variables have been pushed to the update remembered set before we zero the slop. - - - - - 2793cfdc by GHC GitLab CI at 2020-11-29T15:33:54-05:00 OSThreads: Fix error code checking pthread_join returns its error code and apparently doesn't set errno. - - - - - e391a16f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Don't join to mark_thread on shutdown The mark thread is not joinable as we detach from it on creation. - - - - - 60d088ab by Ben Gamari at 2020-11-29T15:33:54-05:00 nonmoving: Add reference to Ueno 2016 - - - - - 3aa60362 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Ensure that evacuated large objects are marked See Note [Non-moving GC: Marking evacuated objects]. - - - - - 8d304a99 by Ben Gamari at 2020-11-30T10:15:22-05:00 rts/m32: Refactor handling of allocator seeding Previously, in an attempt to reduce fragmentation, each new allocator would map a region of M32_MAX_PAGES fresh pages to seed itself. However, this ends up being extremely wasteful since it turns out that we often use fewer than this. Consequently, these pages end up getting freed which, ends up fragmenting our address space more than than we would have if we had naively allocated pages on-demand. Here we refactor m32 to avoid this waste while achieving the fragmentation mitigation previously desired. In particular, we move all page allocation into the global m32_alloc_page, which will pull a page from the free page pool. If the free page pool is empty we then refill it by allocating a region of M32_MAP_PAGES and adding them to the pool. Furthermore, we do away with the initial seeding entirely. That is, the allocator starts with no active pages: pages are rather allocated on an as-needed basis. On the whole this ends up being a pleasingly simple change, simultaneously making m32 more efficient, more robust, and simpler. Fixes #18980. - - - - - b6629289 by Ben Gamari at 2020-11-30T10:15:58-05:00 rts: Use CHECK instead of assert Use the GHC wrappers instead of <assert.h>. - - - - - 9f4efa6a by Ben Gamari at 2020-11-30T10:15:58-05:00 rts/linker: Replace some ASSERTs with CHECK In the past some people have confused ASSERT, which is for checking internal invariants, which CHECK, which should be used when checking things that might fail due to bad input (and therefore should be enabled even in the release compiler). Change some of these cases in the linker to use CHECK. - - - - - 0f8a4655 by Ryan Scott at 2020-11-30T10:16:34-05:00 Allow deploy:pages job to fail See #18973. - - - - - 49ebe369 by chessai at 2020-11-30T19:47:40-05:00 Optimisations in Data.Foldable (T17867) This PR concerns the following functions from `Data.Foldable`: * minimum * maximum * sum * product * minimumBy * maximumBy - Default implementations of these functions now use `foldl'` or `foldMap'`. - All have been marked with INLINEABLE to make room for further optimisations. - - - - - 4d79ef65 by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - 6af074ce by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - ab334262 by Viktor Dukhovni at 2020-11-30T19:48:17-05:00 dirty MVAR after mutating TSO queue head While the original head and tail of the TSO queue may be in the same generation as the MVAR, interior elements of the queue could be younger after a GC run and may then be exposed by putMVar operation that updates the queue head. Resolves #18919 - - - - - 5eb163f3 by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Don't allow shared libraries to be loaded multiple times - - - - - 490aa14d by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Initialise CCSs from native shared objects - - - - - 6ac3db5f by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Move shared library loading logic into Elf.c - - - - - b6698d73 by GHC GitLab CI at 2020-11-30T19:48:53-05:00 rts/linker: Don't declare dynamic objects with image_mapped This previously resulted in warnings due to spurious unmap failures. - - - - - b94a65af by jneira at 2020-11-30T19:49:31-05:00 Include tried paths in findToolDir error - - - - - 72a87fbc by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Move core flattening algorithm to Core.Unify This sets the stage for a later change, where this algorithm will be needed from GHC.Core.InstEnv. This commit also splits GHC.Core.Map into GHC.Core.Map.Type and GHC.Core.Map.Expr, in order to avoid module import cycles with GHC.Core. - - - - - 0dd45d0a by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Bump the # of commits searched for perf baseline The previous value of 75 meant that a feature branch with more than 75 commits would get spurious CI passes. This affects #18692, but does not fix that ticket, because if a baseline cannot be found, we should fail, not succeed. - - - - - 8bb52d91 by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Remove flattening variables This patch redesigns the flattener to simplify type family applications directly instead of using flattening meta-variables and skolems. The key new innovation is the CanEqLHS type and the new CEqCan constraint (Ct). A CanEqLHS is either a type variable or exactly-saturated type family application; either can now be rewritten using a CEqCan constraint in the inert set. Because the flattener no longer reduces all type family applications to variables, there was some performance degradation if a lengthy type family application is now flattened over and over (not making progress). To compensate, this patch contains some extra optimizations in the flattener, leading to a number of performance improvements. Close #18875. Close #18910. There are many extra parts of the compiler that had to be affected in writing this patch: * The family-application cache (formerly the flat-cache) sometimes stores coercions built from Given inerts. When these inerts get kicked out, we must kick out from the cache as well. (This was, I believe, true previously, but somehow never caused trouble.) Kicking out from the cache requires adding a filterTM function to TrieMap. * This patch obviates the need to distinguish "blocking" coercion holes from non-blocking ones (which, previously, arose from CFunEqCans). There is thus some simplification around coercion holes. * Extra commentary throughout parts of the code I read through, to preserve the knowledge I gained while working. * A change in the pure unifier around unifying skolems with other types. Unifying a skolem now leads to SurelyApart, not MaybeApart, as documented in Note [Binding when looking up instances] in GHC.Core.InstEnv. * Some more use of MCoercion where appropriate. * Previously, class-instance lookup automatically noticed that e.g. C Int was a "unifier" to a target [W] C (F Bool), because the F Bool was flattened to a variable. Now, a little more care must be taken around checking for unifying instances. * Previously, tcSplitTyConApp_maybe would split (Eq a => a). This is silly, because (=>) is not a tycon in Haskell. Fixed now, but there are some knock-on changes in e.g. TrieMap code and in the canonicaliser. * New function anyFreeVarsOf{Type,Co} to check whether a free variable satisfies a certain predicate. * Type synonyms now remember whether or not they are "forgetful"; a forgetful synonym drops at least one argument. This is useful when flattening; see flattenView. * The pattern-match completeness checker invokes the solver. This invocation might need to look through newtypes when checking representational equality. Thus, the desugarer needs to keep track of the in-scope variables to know what newtype constructors are in scope. I bet this bug was around before but never noticed. * Extra-constraints wildcards are no longer simplified before printing. See Note [Do not simplify ConstraintHoles] in GHC.Tc.Solver. * Whether or not there are Given equalities has become slightly subtler. See the new HasGivenEqs datatype. * Note [Type variable cycles in Givens] in GHC.Tc.Solver.Canonical explains a significant new wrinkle in the new approach. * See Note [What might match later?] in GHC.Tc.Solver.Interact, which explains the fix to #18910. * The inert_count field of InertCans wasn't actually used, so I removed it. Though I (Richard) did the implementation, Simon PJ was very involved in design and review. This updates the Haddock submodule to avoid #18932 by adding a type signature. ------------------------- Metric Decrease: T12227 T5030 T9872a T9872b T9872c Metric Increase: T9872d ------------------------- - - - - - d66660ba by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Rename the flattener to become the rewriter. Now that flattening doesn't produce flattening variables, it's not really flattening anything: it's rewriting. This change also means that the rewriter can no longer be confused the core flattener (in GHC.Core.Unify), which is sometimes used during type-checking. - - - - - add0aeae by Ben Gamari at 2020-12-01T19:58:17-05:00 rts: Introduce mmapAnonForLinker Previously most of the uses of mmapForLinker were mapping anonymous memory, resulting in a great deal of unnecessary repetition. Factor this out into a new helper. Also fixes a few places where error checking was missing or suboptimal. - - - - - 97d71646 by Ben Gamari at 2020-12-01T19:58:17-05:00 rts/linker: Introduce munmapForLinker Consolidates munmap calls to ensure consistent error handling. - - - - - d8872af0 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/Linker: Introduce Windows implementations for mmapForLinker, et al. - - - - - c35d0e03 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/m32: Introduce NEEDS_M32 macro Instead of relying on RTS_LINKER_USE_MMAP - - - - - 41c64eb5 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/linker: Use m32 to allocate symbol extras in PEi386 - - - - - 86a700ec by Ryan Scott at 2020-12-04T17:54:42-05:00 Reject dodgy scoping in associated family instance RHSes Commit e63518f5d6a93be111f9108c0990a1162f88d615 tried to push all of the logic of detecting out-of-scope type variables on the RHSes of associated type family instances to `GHC.Tc.Validity` by deleting a similar check in the renamer. Unfortunately, this commit went a little too far, as there are some corner cases that `GHC.Tc.Validity` doesn't detect. Consider this example: ```hs class C a where data D a instance forall a. C Int where data instance D Int = MkD a ``` If this program isn't rejected by the time it reaches the typechecker, then GHC will believe the `a` in `MkD a` is existentially quantified and accept it. This is almost surely not what the user wants! The simplest way to reject programs like this is to restore the old validity check in the renamer (search for `improperly_scoped` in `rnFamEqn`). Note that this is technically a breaking change, since the program in the `polykinds/T9574` test case (which previously compiled) will now be rejected: ```hs instance Funct ('KProxy :: KProxy o) where type Codomain 'KProxy = NatTr (Proxy :: o -> *) ``` This is because the `o` on the RHS will now be rejected for being out of scope. Luckily, this is simple to repair: ```hs instance Funct ('KProxy :: KProxy o) where type Codomain ('KProxy @o) = NatTr (Proxy :: o -> *) ``` All of the discussion is now a part of the revamped `Note [Renaming associated types]` in `GHC.Rename.Module`. A different design would be to make associated type family instances have completely separate scoping from the parent instance declaration, much like how associated type family default declarations work today. See the discussion beginning at https://gitlab.haskell.org/ghc/ghc/-/issues/18021#note_265729 for more on this point. This, however, would break even more programs that are accepted today and likely warrants a GHC proposal before going forward. In the meantime, this patch fixes the issue described in #18021 in the least invasive way possible. There are programs that are accepted today that will no longer be accepted after this patch, but they are arguably pathological programs, and they are simple to repair. Fixes #18021. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Axiom.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FamInstEnv.hs - compiler/GHC/Core/InstEnv.hs - + compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Map.hs → compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/Opt/CSE.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/TyCon/Env.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/Maybe.hs - compiler/GHC/Data/TrieMap.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Pmc/Solver.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/13aafbac51162391116830240288d9706946a460...86a700ecd8ed2265535f5d39b20cd9938c2203d5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/13aafbac51162391116830240288d9706946a460...86a700ecd8ed2265535f5d39b20cd9938c2203d5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Dec 5 00:29:25 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 04 Dec 2020 19:29:25 -0500 Subject: [Git][ghc/ghc][wip/tyconapp-opts] Optimise nullary type constructor usage Message-ID: <5fcad465e8674_6b216b4c841750a9@gitlab.mail> Ben Gamari pushed to branch wip/tyconapp-opts at Glasgow Haskell Compiler / GHC Commits: 53c0b472 by Ben Gamari at 2020-12-04T19:28:33-05:00 Optimise nullary type constructor usage During the compilation of programs GHC very frequently deals with the `Type` type, which is a synonym of `TYPE 'LiftedRep`. This patch teaches GHC to avoid expanding the `Type` synonym (and other nullary type synonyms) during type comparisons, saving a good amount of work. This optimisation is described in `Note [Comparing nullary type synonyms]`. To maximize the impact of this optimisation, we introduce a few special-cases to reduce `TYPE 'LiftedRep` to `Type`. See `Note [Prefer Type over TYPE 'LiftedPtrRep]`. Closes #17958. Metric Decrease: T18698b T1969 T12227 T12545 T12707 T14683 T3064 T5631 T5642 T9020 T9630 T9872a T13035 haddock.Cabal haddock.base - - - - - 23 changed files: - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - + compiler/GHC/Builtin/Types/Prim.hs-boot - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/TcType.hs - testsuite/tests/deSugar/should_compile/T2431.stderr - testsuite/tests/deriving/should_compile/T14578.stderr - testsuite/tests/plugins/plugins09.stdout - testsuite/tests/plugins/plugins10.stdout - testsuite/tests/plugins/plugins11.stdout - testsuite/tests/plugins/static-plugins.stdout - testsuite/tests/printer/T18052a.stderr - testsuite/tests/simplCore/should_compile/T13143.stderr - testsuite/tests/simplCore/should_compile/T18013.stderr - testsuite/tests/simplCore/should_compile/T7360.stderr - testsuite/tests/typecheck/should_compile/T13032.stderr - utils/haddock Changes: ===================================== compiler/GHC/Builtin/Types.hs ===================================== @@ -170,6 +170,7 @@ import GHC.Types.Var (VarBndr (Bndr)) import GHC.Settings.Constants ( mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE, mAX_SUM_SIZE ) import GHC.Unit.Module ( Module ) import GHC.Core.Type +import qualified GHC.Core.TyCo.Rep as TyCoRep (Type(TyConApp)) import GHC.Types.RepType import GHC.Core.DataCon import GHC.Core.ConLike @@ -689,7 +690,7 @@ constraintKindTyCon :: TyCon constraintKindTyCon = pcTyCon constraintKindTyConName Nothing [] [] liftedTypeKind, typeToTypeKind, constraintKind :: Kind -liftedTypeKind = tYPE liftedRepTy +liftedTypeKind = TyCoRep.TyConApp liftedTypeKindTyCon [] typeToTypeKind = liftedTypeKind `mkVisFunTyMany` liftedTypeKind constraintKind = mkTyConApp constraintKindTyCon [] @@ -1413,8 +1414,8 @@ runtimeRepTy = mkTyConTy runtimeRepTyCon -- type Type = tYPE 'LiftedRep liftedTypeKindTyCon :: TyCon liftedTypeKindTyCon = buildSynTyCon liftedTypeKindTyConName - [] liftedTypeKind [] - (tYPE liftedRepTy) + [] liftedTypeKind [] rhs + where rhs = TyCoRep.TyConApp tYPETyCon [liftedRepTy] runtimeRepTyCon :: TyCon runtimeRepTyCon = pcTyCon runtimeRepTyConName Nothing [] ===================================== compiler/GHC/Builtin/Types/Prim.hs ===================================== @@ -551,10 +551,6 @@ mkPrimTcName built_in_syntax occ key tycon = mkWiredInName gHC_PRIM (mkTcOccFS occ) key (mkATyCon tycon) built_in_syntax ----------------------------- --- | Given a RuntimeRep, applies TYPE to it. --- see Note [TYPE and RuntimeRep] -tYPE :: Type -> Type -tYPE rr = TyConApp tYPETyCon [rr] -- Given a Multiplicity, applies FUN to it. functionWithMultiplicity :: Type -> Type ===================================== compiler/GHC/Builtin/Types/Prim.hs-boot ===================================== @@ -0,0 +1,5 @@ +module GHC.Builtin.Types.Prim where + +import GHC.Core.TyCon + +tYPETyCon :: TyCon ===================================== compiler/GHC/Core/TyCo/Rep.hs ===================================== @@ -52,6 +52,7 @@ module GHC.Core.TyCo.Rep ( mkVisFunTyMany, mkVisFunTysMany, mkInvisFunTyMany, mkInvisFunTysMany, mkTyConApp, + tYPE, -- * Functions over binders TyCoBinder(..), TyCoVarBinder, TyBinder, @@ -90,8 +91,9 @@ import GHC.Core.TyCon import GHC.Core.Coercion.Axiom -- others -import GHC.Builtin.Names ( liftedTypeKindTyConKey, manyDataConKey ) -import {-# SOURCE #-} GHC.Builtin.Types ( liftedTypeKindTyCon, manyDataConTy ) +import GHC.Builtin.Names ( liftedTypeKindTyConKey, liftedRepDataConKey, manyDataConKey, tYPETyConKey ) +import {-# SOURCE #-} GHC.Builtin.Types ( liftedTypeKindTyCon, liftedTypeKind, manyDataConTy ) +import {-# SOURCE #-} GHC.Builtin.Types.Prim ( tYPETyCon ) import GHC.Types.Basic ( LeftOrRight(..), pickLR ) import GHC.Types.Unique ( hasKey, Uniquable(..) ) import GHC.Utils.Outputable @@ -1018,12 +1020,64 @@ mkTyConApp tycon tys -- avoid reboxing every time `mkTyConApp` is called. = ASSERT2( null tys, ppr tycon $$ ppr tys ) manyDataConTy + -- See Note [Prefer Type over TYPE 'LiftedRep]. + | tycon `hasKey` tYPETyConKey + , [rep] <- tys + = tYPE rep + -- The catch-all case | otherwise = TyConApp tycon tys +{- +Note [Prefer Type over TYPE 'LiftedRep] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The Core of nearly any program will have numerous occurrences of + at TYPE 'LiftedRep@ floating about. Consequently, we try hard to ensure +that operations on such types are efficient. Specifically, we strive to + + a. Avoid heap allocation of such types + b. Use a small (shallow in the tree-depth sense) representation + for such types + +Goal (b) is particularly useful as it makes traversals (e.g. free variable +traversal, substitution, and comparison) more efficient. +Comparison in particular takes special advantage of nullary type synonym +applications, Note [Comparing nullary type synonyms] in "GHC.Core.Type". + +To accomplish these we use a number of tricks: + + * Instead of representing the lifted kind as + @TyConApp tYPETyCon [liftedRepDataCon]@ we rather prefer to + use the 'GHC.Types.Type' type synonym. This serves goal (b) + since there are no applied type arguments to traverse, e.g., during + comparison. + + * We have a top-level binding to represent `TyConApp GHC.Types.Type []` + (namely 'GHC.Builtin.Types.Prim.liftedTypeKind'), ensuring that we + don't need to allocate such types (goal (a)). + + * To avoid allocating 'TyConApp' constructors + 'GHC.Builtin.Types.Prim.tYPE' catches the lifted case and returns + `liftedTypeKind` instead of building an application (goal (a)). + + * Similarly, 'Type.mkTyConApp' catches applications of `TYPE` and + handles them using 'GHC.Builtin.Types.Prim.tYPE', ensuring + that it benefits from the optimisation described above (goal (a)). + +See #17958. +-} + +-- | Given a RuntimeRep, applies TYPE to it. +-- See Note [TYPE and RuntimeRep] in GHC.Builtin.Types.Prim. +tYPE :: Type -> Type +tYPE (TyConApp tc []) + -- See Note [Prefer Type of TYPE 'LiftedRep] + | tc `hasKey` liftedRepDataConKey = liftedTypeKind -- TYPE 'LiftedRep +tYPE rr = TyConApp tYPETyCon [rr] + -- This is a single, global definition of the type `Type` -- Defined here so it is only allocated once. --- See Note [mkTyConApp and Type] +-- See Note [mkTyConApp and Type] in this module. liftedTypeKindTyConApp :: Type liftedTypeKindTyConApp = TyConApp liftedTypeKindTyCon [] ===================================== compiler/GHC/Core/TyCo/Subst.hs ===================================== @@ -424,6 +424,7 @@ zipTCvSubst tcvs tys -- | Generates the in-scope set for the 'TCvSubst' from the types in the -- incoming environment. No CoVars, please! mkTvSubstPrs :: [(TyVar, Type)] -> TCvSubst +mkTvSubstPrs [] = emptyTCvSubst mkTvSubstPrs prs = ASSERT2( onlyTyVarsAndNoCoercionTy, text "prs" <+> ppr prs ) mkTvSubst in_scope tenv ===================================== compiler/GHC/Core/TyCon.hs ===================================== @@ -2327,12 +2327,14 @@ expandSynTyCon_maybe -- ^ Expand a type synonym application, if any expandSynTyCon_maybe tc tys | SynonymTyCon { tyConTyVars = tvs, synTcRhs = rhs, tyConArity = arity } <- tc - = case tys `listLengthCmp` arity of - GT -> Just (tvs `zip` tys, rhs, drop arity tys) - EQ -> Just (tvs `zip` tys, rhs, []) - LT -> Nothing - | otherwise - = Nothing + = case tys of + [] -> Just ([], rhs, []) -- Avoid a bit of work in the case of nullary synonyms + _ -> case tys `listLengthCmp` arity of + GT -> Just (tvs `zip` tys, rhs, drop arity tys) + EQ -> Just (tvs `zip` tys, rhs, []) + LT -> Nothing + | otherwise + = Nothing ---------------- ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -383,15 +383,16 @@ how roles in kinds might work out. -} -- | Gives the typechecker view of a type. This unwraps synonyms but --- leaves 'Constraint' alone. c.f. coreView, which turns Constraint into --- TYPE LiftedRep. Returns Nothing if no unwrapping happens. +-- leaves 'Constraint' alone. c.f. 'coreView', which turns 'Constraint' into +-- @TYPE LiftedRep at . Returns 'Nothing' if no unwrapping happens. -- See also Note [coreView vs tcView] {-# INLINE tcView #-} tcView :: Type -> Maybe Type -tcView (TyConApp tc tys) | Just (tenv, rhs, tys') <- expandSynTyCon_maybe tc tys - = Just (mkAppTys (substTy (mkTvSubstPrs tenv) rhs) tys') +tcView (TyConApp tc tys) + | res@(Just _) <- expandSynTyConApp_maybe tc tys + = res -- The free vars of 'rhs' should all be bound by 'tenv', so it's - -- ok to use 'substTy' here. + -- ok to use 'substTy' here (which is what expandSynTyConApp_maybe does). -- See also Note [The substitution invariant] in GHC.Core.TyCo.Subst. -- Its important to use mkAppTys, rather than (foldl AppTy), -- because the function part might well return a @@ -400,17 +401,16 @@ tcView _ = Nothing {-# INLINE coreView #-} coreView :: Type -> Maybe Type --- ^ This function Strips off the /top layer only/ of a type synonym +-- ^ This function strips off the /top layer only/ of a type synonym -- application (if any) its underlying representation type. --- Returns Nothing if there is nothing to look through. +-- Returns 'Nothing' if there is nothing to look through. -- This function considers 'Constraint' to be a synonym of @TYPE LiftedRep at . -- -- By being non-recursive and inlined, this case analysis gets efficiently -- joined onto the case analysis that the caller is already doing coreView ty@(TyConApp tc tys) - | Just (tenv, rhs, tys') <- expandSynTyCon_maybe tc tys - = Just (mkAppTys (substTy (mkTvSubstPrs tenv) rhs) tys') - -- This equation is exactly like tcView + | res@(Just _) <- expandSynTyConApp_maybe tc tys + = res -- At the Core level, Constraint = Type -- See Note [coreView vs tcView] @@ -420,6 +420,30 @@ coreView ty@(TyConApp tc tys) coreView _ = Nothing +----------------------------------------------- +expandSynTyConApp_maybe :: TyCon -> [Type] -> Maybe Type +expandSynTyConApp_maybe tc tys + | Just (tvs, rhs) <- synTyConDefn_maybe tc + , n_tys >= arity + = Just (expand_syn arity tvs rhs n_tys tys) + | otherwise + = Nothing + where + n_tys = length tys + arity = tyConArity tc +-- Without this INLINE the call to expandSynTyConApp_maybe in coreView +-- will result in an avoidable allocation. +{-# INLINE expandSynTyConApp_maybe #-} + +-- | A helper for 'expandSynTyConApp_maybe' to avoid inlining this cold path +-- into call-sites. +expand_syn :: Int -> [TyVar] -> Type -> Int -> [Type] -> Type +expand_syn arity tvs rhs n_tys tys + | n_tys > arity = mkAppTys rhs' (drop arity tys) + | otherwise = rhs' + where + rhs' = substTy (mkTvSubstPrs (tvs `zip` tys)) rhs + {-# INLINE coreFullView #-} coreFullView :: Type -> Type -- ^ Iterates 'coreView' until there is no more to synonym to expand. @@ -2207,6 +2231,36 @@ But the left is an AppTy while the right is a TyConApp. The solution is to use repSplitAppTy_maybe to break up the TyConApp into its pieces and then continue. Easy to do, but also easy to forget to do. + +Note [Comparing nullary type synonyms] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider the task of testing equality between two 'Type's of the form + + TyConApp tc [] + +where @tc@ is a type synonym. A naive way to perform this comparison these +would first expand the synonym and then compare the resulting expansions. + +However, this is obviously wasteful and the RHS of @tc@ may be large; it is +much better to rather compare the TyCons directly. Consequently, before +expanding type synonyms in type comparisons we first look for a nullary +TyConApp and simply compare the TyCons if we find one. Of course, if we find +that the TyCons are *not* equal then we still need to perform the expansion as +their RHSs may still be equal. + +We perform this optimisation in a number of places: + + * GHC.Core.Types.eqType + * GHC.Core.Types.nonDetCmpType + * GHC.Core.Unify.unify_ty + * TcCanonical.can_eq_nc' + * TcUnify.uType + +This optimisation is especially helpful for the ubiquitous GHC.Types.Type, +since GHC prefers to use the type synonym over @TYPE 'LiftedRep@ applications +whenever possible. See [Prefer Type over TYPE 'LiftedRep] in +GHC.Core.TyCo.Rep for details. + -} eqType :: Type -> Type -> Bool @@ -2318,6 +2372,10 @@ nonDetCmpTypeX env orig_t1 orig_t2 = -- Returns both the resulting ordering relation between the two types -- and whether either contains a cast. go :: RnEnv2 -> Type -> Type -> TypeOrdering + -- See Note [Comparing nullary type synonyms]. + go _ (TyConApp tc1 []) (TyConApp tc2 []) + | tc1 == tc2 + = TEQ go env t1 t2 | Just t1' <- coreView t1 = go env t1' t2 | Just t2' <- coreView t2 = go env t1 t2' ===================================== compiler/GHC/Core/Unify.hs ===================================== @@ -957,7 +957,12 @@ unify_ty :: UMEnv -- Respects newtypes, PredTypes unify_ty env ty1 ty2 kco - -- Use tcView, not coreView. See Note [coreView vs tcView] in GHC.Core.Type. + -- See Note [Comparing nullary type synonyms] in GHC.Core.Type. + | TyConApp tc1 [] <- ty1 + , TyConApp tc2 [] <- ty2 + , tc1 == tc2 = return () + + -- TODO: More commentary needed here | Just ty1' <- tcView ty1 = unify_ty env ty1' ty2 kco | Just ty2' <- tcView ty2 = unify_ty env ty1 ty2' kco | CastTy ty1' co <- ty1 = if um_unif env ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -956,6 +956,11 @@ can_eq_nc' -> Type -> Type -- RHS, after and before type-synonym expansion, resp -> TcS (StopOrContinue Ct) +-- See Note [Comparing nullary type synonyms] in GHC.Core.Type. +can_eq_nc' _flat _rdr_env _envs ev eq_rel ty1@(TyConApp tc1 []) _ps_ty1 (TyConApp tc2 []) _ps_ty2 + | tc1 == tc2 + = canEqReflexive ev eq_rel ty1 + -- Expand synonyms first; see Note [Type synonyms and canonicalization] can_eq_nc' rewritten rdr_env envs ev eq_rel ty1 ps_ty1 ty2 ps_ty2 | Just ty1' <- tcView ty1 = can_eq_nc' rewritten rdr_env envs ev eq_rel ty1' ps_ty1 ty2 ps_ty2 ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -120,7 +120,6 @@ import GHC.Types.Id as Id import GHC.Types.Name import GHC.Types.Var.Set import GHC.Builtin.Types -import GHC.Builtin.Types.Prim import GHC.Types.Var.Env import GHC.Types.Name.Env import GHC.Utils.Misc ===================================== compiler/GHC/Tc/Utils/TcType.hs ===================================== @@ -1581,6 +1581,11 @@ tc_eq_type keep_syns vis_only orig_ty1 orig_ty2 = go orig_env orig_ty1 orig_ty2 where go :: RnEnv2 -> Type -> Type -> Bool + -- See Note [Comparing nullary type synonyms] in GHC.Core.Type. + go _ (TyConApp tc1 []) (TyConApp tc2 []) + | tc1 == tc2 + = True + go env t1 t2 | not keep_syns, Just t1' <- tcView t1 = go env t1' t2 go env t1 t2 | not keep_syns, Just t2' <- tcView t2 = go env t1 t2' ===================================== testsuite/tests/deSugar/should_compile/T2431.stderr ===================================== @@ -1,9 +1,9 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 63, types: 43, coercions: 1, joins: 0/0} + = {terms: 63, types: 39, coercions: 1, joins: 0/0} --- RHS size: {terms: 2, types: 4, coercions: 1, joins: 0/0} +-- RHS size: {terms: 2, types: 3, coercions: 1, joins: 0/0} T2431.$WRefl [InlPrag=INLINE[final] CONLIKE] :: forall a. a :~: a [GblId[DataConWrapper], Caf=NoCafRefs, @@ -15,7 +15,7 @@ T2431.$WRefl [InlPrag=INLINE[final] CONLIKE] :: forall a. a :~: a T2431.$WRefl = \ (@a) -> T2431.Refl @a @a @~(_N :: a GHC.Prim.~# a) --- RHS size: {terms: 4, types: 8, coercions: 0, joins: 0/0} +-- RHS size: {terms: 4, types: 7, coercions: 0, joins: 0/0} absurd :: forall a. (Int :~: Bool) -> a [GblId, Arity=1, Str=b, Cpr=b, Unf=OtherCon []] absurd = \ (@a) (x :: Int :~: Bool) -> case x of { } ===================================== testsuite/tests/deriving/should_compile/T14578.stderr ===================================== @@ -16,13 +16,12 @@ Derived class instances: = GHC.Prim.coerce @(T14578.App (Data.Functor.Compose.Compose f g) a -> T14578.App (Data.Functor.Compose.Compose f g) a - -> T14578.App (Data.Functor.Compose.Compose f g) a) + -> T14578.App (Data.Functor.Compose.Compose f g) a) @(T14578.Wat f g a -> T14578.Wat f g a -> T14578.Wat f g a) ((GHC.Base.<>) @(T14578.App (Data.Functor.Compose.Compose f g) a)) GHC.Base.sconcat = GHC.Prim.coerce - @(GHC.Base.NonEmpty - (T14578.App (Data.Functor.Compose.Compose f g) a) + @(GHC.Base.NonEmpty (T14578.App (Data.Functor.Compose.Compose f g) a) -> T14578.App (Data.Functor.Compose.Compose f g) a) @(GHC.Base.NonEmpty (T14578.Wat f g a) -> T14578.Wat f g a) (GHC.Base.sconcat @@ -31,7 +30,7 @@ Derived class instances: = GHC.Prim.coerce @(b -> T14578.App (Data.Functor.Compose.Compose f g) a - -> T14578.App (Data.Functor.Compose.Compose f g) a) + -> T14578.App (Data.Functor.Compose.Compose f g) a) @(b -> T14578.Wat f g a -> T14578.Wat f g a) (GHC.Base.stimes @(T14578.App (Data.Functor.Compose.Compose f g) a)) ===================================== testsuite/tests/plugins/plugins09.stdout ===================================== @@ -3,6 +3,5 @@ interfacePlugin: Prelude interfacePlugin: GHC.Float interfacePlugin: GHC.Base typeCheckPlugin (rn) -interfacePlugin: GHC.Types typeCheckPlugin (tc) interfacePlugin: GHC.Num.BigNat ===================================== testsuite/tests/plugins/plugins10.stdout ===================================== @@ -6,7 +6,6 @@ interfacePlugin: GHC.Float interfacePlugin: GHC.Base interfacePlugin: Language.Haskell.TH.Syntax typeCheckPlugin (rn) -interfacePlugin: GHC.Types typeCheckPlugin (tc) interfacePlugin: GHC.Num.BigNat parsePlugin(a) ===================================== testsuite/tests/plugins/plugins11.stdout ===================================== @@ -3,6 +3,5 @@ interfacePlugin: Prelude interfacePlugin: GHC.Float interfacePlugin: GHC.Base typeCheckPlugin (rn) -interfacePlugin: GHC.Types typeCheckPlugin (tc) interfacePlugin: GHC.Num.BigNat ===================================== testsuite/tests/plugins/static-plugins.stdout ===================================== @@ -5,11 +5,11 @@ interfacePlugin: GHC.Float interfacePlugin: GHC.Base interfacePlugin: System.IO typeCheckPlugin (rn) -interfacePlugin: GHC.Prim -interfacePlugin: GHC.Show interfacePlugin: GHC.Types +interfacePlugin: GHC.Show interfacePlugin: GHC.TopHandler typeCheckPlugin (tc) +interfacePlugin: GHC.Prim interfacePlugin: GHC.CString interfacePlugin: GHC.Num.BigNat ==pure.1 ===================================== testsuite/tests/printer/T18052a.stderr ===================================== @@ -10,9 +10,9 @@ Dependent packages: [base-4.16.0.0, ghc-bignum-1.0, ghc-prim-0.8.0] ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 24, types: 61, coercions: 0, joins: 0/0} + = {terms: 24, types: 52, coercions: 0, joins: 0/0} --- RHS size: {terms: 7, types: 8, coercions: 0, joins: 0/0} +-- RHS size: {terms: 7, types: 6, coercions: 0, joins: 0/0} T18052a.$b:||: :: forall {a} {b}. a -> b -> (a, b) [GblId, Arity=2, Unf=OtherCon []] T18052a.$b:||: = \ (@a) (@b) (x :: a) (y :: b) -> (x, y) @@ -22,7 +22,7 @@ T18052a.$b:||: = \ (@a) (@b) (x :: a) (y :: b) -> (x, y) [GblId] (+++) = ++ --- RHS size: {terms: 13, types: 20, coercions: 0, joins: 0/0} +-- RHS size: {terms: 13, types: 18, coercions: 0, joins: 0/0} T18052a.$m:||: :: forall {rep :: GHC.Types.RuntimeRep} {r :: TYPE rep} {a} {b}. (a, b) -> (a -> b -> r) -> ((# #) -> r) -> r ===================================== testsuite/tests/simplCore/should_compile/T13143.stderr ===================================== @@ -1,17 +1,17 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 71, types: 44, coercions: 0, joins: 0/0} + = {terms: 71, types: 40, coercions: 0, joins: 0/0} Rec { --- RHS size: {terms: 4, types: 4, coercions: 0, joins: 0/0} +-- RHS size: {terms: 4, types: 3, coercions: 0, joins: 0/0} T13143.$wf [InlPrag=NOINLINE, Occ=LoopBreaker] :: forall {a}. (# #) -> a [GblId, Arity=1, Str=b, Cpr=b, Unf=OtherCon []] T13143.$wf = \ (@a) _ [Occ=Dead] -> T13143.$wf @a GHC.Prim.(##) end Rec } --- RHS size: {terms: 4, types: 4, coercions: 0, joins: 0/0} +-- RHS size: {terms: 4, types: 3, coercions: 0, joins: 0/0} f [InlPrag=[final]] :: forall a. Int -> a [GblId, Arity=1, ===================================== testsuite/tests/simplCore/should_compile/T18013.stderr ===================================== @@ -129,9 +129,9 @@ Rule fired: Class op fmap (BUILTIN) ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 52, types: 106, coercions: 17, joins: 0/1} + = {terms: 52, types: 101, coercions: 17, joins: 0/1} --- RHS size: {terms: 37, types: 87, coercions: 17, joins: 0/1} +-- RHS size: {terms: 37, types: 84, coercions: 17, joins: 0/1} mapMaybeRule :: forall a b. Rule IO a b -> Rule IO (Maybe a) (Maybe b) [GblId, ===================================== testsuite/tests/simplCore/should_compile/T7360.stderr ===================================== @@ -1,7 +1,7 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 106, types: 47, coercions: 0, joins: 0/0} + = {terms: 106, types: 45, coercions: 0, joins: 0/0} -- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} T7360.$WFoo3 [InlPrag=INLINE[final] CONLIKE] :: Int %1 -> Foo @@ -31,7 +31,7 @@ T7360.fun4 :: () WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 20 0}] T7360.fun4 = fun1 T7360.Foo1 --- RHS size: {terms: 11, types: 8, coercions: 0, joins: 0/0} +-- RHS size: {terms: 11, types: 7, coercions: 0, joins: 0/0} fun2 :: forall {a}. [a] -> ((), Int) [GblId, Arity=1, ===================================== testsuite/tests/typecheck/should_compile/T13032.stderr ===================================== @@ -1,9 +1,9 @@ ==================== Desugar (after optimization) ==================== Result size of Desugar (after optimization) - = {terms: 13, types: 24, coercions: 0, joins: 0/0} + = {terms: 13, types: 18, coercions: 0, joins: 0/0} --- RHS size: {terms: 6, types: 11, coercions: 0, joins: 0/0} +-- RHS size: {terms: 6, types: 8, coercions: 0, joins: 0/0} f :: forall a b. (a ~ b) => a -> b -> Bool [LclIdX, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 8d260690b53f2fb6b54ba78bd13d1400d9ebd395 +Subproject commit 5726d91cfe8ad40d3f32b1ee6957c1f42a1c4a01 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/53c0b472dbdddea7ca4eb366c982509866ee2665 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/53c0b472dbdddea7ca4eb366c982509866ee2665 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Dec 5 01:15:38 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 04 Dec 2020 20:15:38 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 12 commits: Move core flattening algorithm to Core.Unify Message-ID: <5fcadf3a81ebe_6b216b4c8418333@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 72a87fbc by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Move core flattening algorithm to Core.Unify This sets the stage for a later change, where this algorithm will be needed from GHC.Core.InstEnv. This commit also splits GHC.Core.Map into GHC.Core.Map.Type and GHC.Core.Map.Expr, in order to avoid module import cycles with GHC.Core. - - - - - 0dd45d0a by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Bump the # of commits searched for perf baseline The previous value of 75 meant that a feature branch with more than 75 commits would get spurious CI passes. This affects #18692, but does not fix that ticket, because if a baseline cannot be found, we should fail, not succeed. - - - - - 8bb52d91 by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Remove flattening variables This patch redesigns the flattener to simplify type family applications directly instead of using flattening meta-variables and skolems. The key new innovation is the CanEqLHS type and the new CEqCan constraint (Ct). A CanEqLHS is either a type variable or exactly-saturated type family application; either can now be rewritten using a CEqCan constraint in the inert set. Because the flattener no longer reduces all type family applications to variables, there was some performance degradation if a lengthy type family application is now flattened over and over (not making progress). To compensate, this patch contains some extra optimizations in the flattener, leading to a number of performance improvements. Close #18875. Close #18910. There are many extra parts of the compiler that had to be affected in writing this patch: * The family-application cache (formerly the flat-cache) sometimes stores coercions built from Given inerts. When these inerts get kicked out, we must kick out from the cache as well. (This was, I believe, true previously, but somehow never caused trouble.) Kicking out from the cache requires adding a filterTM function to TrieMap. * This patch obviates the need to distinguish "blocking" coercion holes from non-blocking ones (which, previously, arose from CFunEqCans). There is thus some simplification around coercion holes. * Extra commentary throughout parts of the code I read through, to preserve the knowledge I gained while working. * A change in the pure unifier around unifying skolems with other types. Unifying a skolem now leads to SurelyApart, not MaybeApart, as documented in Note [Binding when looking up instances] in GHC.Core.InstEnv. * Some more use of MCoercion where appropriate. * Previously, class-instance lookup automatically noticed that e.g. C Int was a "unifier" to a target [W] C (F Bool), because the F Bool was flattened to a variable. Now, a little more care must be taken around checking for unifying instances. * Previously, tcSplitTyConApp_maybe would split (Eq a => a). This is silly, because (=>) is not a tycon in Haskell. Fixed now, but there are some knock-on changes in e.g. TrieMap code and in the canonicaliser. * New function anyFreeVarsOf{Type,Co} to check whether a free variable satisfies a certain predicate. * Type synonyms now remember whether or not they are "forgetful"; a forgetful synonym drops at least one argument. This is useful when flattening; see flattenView. * The pattern-match completeness checker invokes the solver. This invocation might need to look through newtypes when checking representational equality. Thus, the desugarer needs to keep track of the in-scope variables to know what newtype constructors are in scope. I bet this bug was around before but never noticed. * Extra-constraints wildcards are no longer simplified before printing. See Note [Do not simplify ConstraintHoles] in GHC.Tc.Solver. * Whether or not there are Given equalities has become slightly subtler. See the new HasGivenEqs datatype. * Note [Type variable cycles in Givens] in GHC.Tc.Solver.Canonical explains a significant new wrinkle in the new approach. * See Note [What might match later?] in GHC.Tc.Solver.Interact, which explains the fix to #18910. * The inert_count field of InertCans wasn't actually used, so I removed it. Though I (Richard) did the implementation, Simon PJ was very involved in design and review. This updates the Haddock submodule to avoid #18932 by adding a type signature. ------------------------- Metric Decrease: T12227 T5030 T9872a T9872b T9872c Metric Increase: T9872d ------------------------- - - - - - d66660ba by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Rename the flattener to become the rewriter. Now that flattening doesn't produce flattening variables, it's not really flattening anything: it's rewriting. This change also means that the rewriter can no longer be confused the core flattener (in GHC.Core.Unify), which is sometimes used during type-checking. - - - - - add0aeae by Ben Gamari at 2020-12-01T19:58:17-05:00 rts: Introduce mmapAnonForLinker Previously most of the uses of mmapForLinker were mapping anonymous memory, resulting in a great deal of unnecessary repetition. Factor this out into a new helper. Also fixes a few places where error checking was missing or suboptimal. - - - - - 97d71646 by Ben Gamari at 2020-12-01T19:58:17-05:00 rts/linker: Introduce munmapForLinker Consolidates munmap calls to ensure consistent error handling. - - - - - d8872af0 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/Linker: Introduce Windows implementations for mmapForLinker, et al. - - - - - c35d0e03 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/m32: Introduce NEEDS_M32 macro Instead of relying on RTS_LINKER_USE_MMAP - - - - - 41c64eb5 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/linker: Use m32 to allocate symbol extras in PEi386 - - - - - e0b08c5f by Ben Gamari at 2020-12-03T13:01:47-05:00 gitlab-ci: Fix copy-paste error Also be more consistent in quoting. - - - - - 33ec3a06 by Ben Gamari at 2020-12-03T23:11:31-05:00 gitlab-ci: Run linters through ci.sh Ensuring that the right toolchain is used. - - - - - ad28aa13 by Shayne Fletcher at 2020-12-04T20:15:31-05:00 Fix bad span calculations of post qualified imports - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Axiom.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FamInstEnv.hs - compiler/GHC/Core/InstEnv.hs - + compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Map.hs → compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/Opt/CSE.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/TyCon/Env.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/Maybe.hs - compiler/GHC/Data/TrieMap.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - compiler/GHC/HsToCore/Types.hs - compiler/GHC/Iface/Ext/Utils.hs - compiler/GHC/Parser.y The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/aa1f4b6c450635e8a10ade33e019d60391ebec51...ad28aa1300301ad577ba32f0712d4ace6c880014 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/aa1f4b6c450635e8a10ade33e019d60391ebec51...ad28aa1300301ad577ba32f0712d4ace6c880014 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Dec 5 08:06:06 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sat, 05 Dec 2020 03:06:06 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 2 commits: Fix bad span calculations of post qualified imports Message-ID: <5fcb3f6e1f340_6b216b4c8419389a@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: ca4549e6 by Shayne Fletcher at 2020-12-05T03:05:56-05:00 Fix bad span calculations of post qualified imports - - - - - 8730d567 by Ben Gamari at 2020-12-05T03:05:56-05:00 testsuite: Add a test for #18923 - - - - - 6 changed files: - compiler/GHC/Parser.y - testsuite/tests/module/all.T - + testsuite/tests/module/mod185.hs - + testsuite/tests/module/mod185.stderr - + testsuite/tests/perf/compiler/T18923.hs - testsuite/tests/perf/compiler/all.T Changes: ===================================== compiler/GHC/Parser.y ===================================== @@ -1057,18 +1057,20 @@ importdecls_semi importdecl :: { LImportDecl GhcPs } : 'import' maybe_src maybe_safe optqualified maybe_pkg modid optqualified maybeas maybeimpspec {% do { - ; checkImportDecl $4 $7 - ; ams (L (comb4 $1 $6 (snd $8) $9) $ + ; let { ; mPreQual = unLoc $4 + ; mPostQual = unLoc $7 } + ; checkImportDecl mPreQual mPostQual + ; ams (L (comb5 $1 $6 $7 (snd $8) $9) $ ImportDecl { ideclExt = noExtField , ideclSourceSrc = snd $ fst $2 , ideclName = $6, ideclPkgQual = snd $5 , ideclSource = snd $2, ideclSafe = snd $3 - , ideclQualified = importDeclQualifiedStyle $4 $7 + , ideclQualified = importDeclQualifiedStyle mPreQual mPostQual , ideclImplicit = False , ideclAs = unLoc (snd $8) , ideclHiding = unLoc $9 }) - (mj AnnImport $1 : fst (fst $2) ++ fst $3 ++ fmap (mj AnnQualified) (maybeToList $4) - ++ fst $5 ++ fmap (mj AnnQualified) (maybeToList $7) ++ fst $8) + (mj AnnImport $1 : fst (fst $2) ++ fst $3 ++ fmap (mj AnnQualified) (maybeToList mPreQual) + ++ fst $5 ++ fmap (mj AnnQualified) (maybeToList mPostQual) ++ fst $8) } } @@ -1089,9 +1091,9 @@ maybe_pkg :: { ([AddAnn],Maybe StringLiteral) } ; return ([mj AnnPackageName $1], Just (StringLiteral (getSTRINGs $1) pkgFS)) } } | {- empty -} { ([],Nothing) } -optqualified :: { Maybe (Located Token) } - : 'qualified' { Just $1 } - | {- empty -} { Nothing } +optqualified :: { Located (Maybe (Located Token)) } + : 'qualified' { sL1 $1 (Just $1) } + | {- empty -} { noLoc Nothing } maybeas :: { ([AddAnn],Located (Maybe (Located ModuleName))) } : 'as' modid { ([mj AnnAs $1] @@ -3861,6 +3863,11 @@ comb4 a b c d = a `seq` b `seq` c `seq` d `seq` (combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $ combineSrcSpans (getLoc c) (getLoc d)) +comb5 :: Located a -> Located b -> Located c -> Located d -> Located e -> SrcSpan +comb5 a b c d e = a `seq` b `seq` c `seq` d `seq` e `seq` + (combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $ + combineSrcSpans (getLoc c) $ combineSrcSpans (getLoc d) (getLoc e)) + -- strict constructor version: {-# INLINE sL #-} sL :: SrcSpan -> a -> Located a ===================================== testsuite/tests/module/all.T ===================================== @@ -268,6 +268,7 @@ test('mod181', normal, compile, ['']) test('mod182', normal, compile_fail, ['']) test('mod183', normal, compile_fail, ['']) test('mod184', normal, compile, ['-Wprepositive-qualified-module']) +test('mod185', normal, compile, ['-ddump-parsed-ast']) test('T1148', normal, compile, ['']) test('T1074', normal, compile, ['']) ===================================== testsuite/tests/module/mod185.hs ===================================== @@ -0,0 +1,5 @@ +{-# LANGUAGE ImportQualifiedPost #-} +-- The span of the import decl should include the 'qualified' keyword. +import Prelude qualified + +main = Prelude.undefined ===================================== testsuite/tests/module/mod185.stderr ===================================== @@ -0,0 +1,62 @@ +==================== Parser AST ==================== + +({ mod185.hs:1:1 } + (HsModule + (VirtualBraces + (1)) + (Nothing) + (Nothing) + [({ mod185.hs:3:1-24 } + (ImportDecl + (NoExtField) + (NoSourceText) + ({ mod185.hs:3:8-14 } + {ModuleName: Prelude}) + (Nothing) + (NotBoot) + (False) + (QualifiedPost) + (False) + (Nothing) + (Nothing)))] + [({ mod185.hs:5:1-24 } + (ValD + (NoExtField) + (FunBind + (NoExtField) + ({ mod185.hs:5:1-4 } + (Unqual + {OccName: main})) + (MG + (NoExtField) + ({ mod185.hs:5:1-24 } + [({ mod185.hs:5:1-24 } + (Match + (NoExtField) + (FunRhs + ({ mod185.hs:5:1-4 } + (Unqual + {OccName: main})) + (Prefix) + (NoSrcStrict)) + [] + (GRHSs + (NoExtField) + [({ mod185.hs:5:6-24 } + (GRHS + (NoExtField) + [] + ({ mod185.hs:5:8-24 } + (HsVar + (NoExtField) + ({ mod185.hs:5:8-24 } + (Qual + {ModuleName: Prelude} + {OccName: undefined}))))))] + ({ } + (EmptyLocalBinds + (NoExtField))))))]) + (FromSource)) + [])))] + (Nothing) + (Nothing))) ===================================== testsuite/tests/perf/compiler/T18923.hs ===================================== @@ -0,0 +1,16 @@ +module T18923 (mergeRec, Rec) where + +mayMerge :: Maybe b -> Maybe b -> Maybe b +mayMerge Nothing y = y +mayMerge x Nothing = x +mayMerge (Just x) (Just y) = Just y + +data Rec = Rec { v0,v1,v2,v3,v4,v5,v6,v7 :: !(Maybe Bool) } + +mergeRec :: Rec -> Rec -> Rec +mergeRec + (Rec a0 a1 a2 a3 a4 a5 a6 a7) + (Rec b0 b1 b2 b3 b4 b5 b6 b7) = + Rec (mayMerge a0 b0) (mayMerge a1 b1) (mayMerge a2 b2) (mayMerge a3 b3) + (mayMerge a4 b4) (mayMerge a5 b5) (mayMerge a6 b6) (mayMerge a7 b7) + ===================================== testsuite/tests/perf/compiler/all.T ===================================== @@ -434,3 +434,7 @@ test ('T18223', ], compile, ['-v0 -O']) +test ('T18923', + [ collect_compiler_stats('bytes allocated',2) ], + compile, + ['-v0 -O']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ad28aa1300301ad577ba32f0712d4ace6c880014...8730d5679a4a2a09db1683a5b680a9a250282917 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ad28aa1300301ad577ba32f0712d4ace6c880014...8730d5679a4a2a09db1683a5b680a9a250282917 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Dec 5 14:06:09 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sat, 05 Dec 2020 09:06:09 -0500 Subject: [Git][ghc/ghc][master] 2 commits: gitlab-ci: Fix copy-paste error Message-ID: <5fcb93d18b3ac_6b216c0ae82047b8@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: e0b08c5f by Ben Gamari at 2020-12-03T13:01:47-05:00 gitlab-ci: Fix copy-paste error Also be more consistent in quoting. - - - - - 33ec3a06 by Ben Gamari at 2020-12-03T23:11:31-05:00 gitlab-ci: Run linters through ci.sh Ensuring that the right toolchain is used. - - - - - 2 changed files: - .gitlab-ci.yml - .gitlab/ci.sh Changes: ===================================== .gitlab-ci.yml ===================================== @@ -299,12 +299,11 @@ hadrian-ghc-in-ghci: tags: - x86_64-linux script: + - git clean -xdf && git submodule foreach git clean -xdf - .gitlab/ci.sh setup + - .gitlab/ci.sh configure - cabal update - cd hadrian; cabal new-build -j`../mk/detect-cpu-count.sh` --with-compiler=$GHC --project-file=ci.project; cd .. - - git clean -xdf && git submodule foreach git clean -xdf - - ./boot - - ./configure $CONFIGURE_ARGS # Load ghc-in-ghci then immediately exit and check the modules loaded - echo ":q" | hadrian/ghci -j`mk/detect-cpu-count.sh`| tail -n2 | grep "Ok," after_script: @@ -345,9 +344,13 @@ hadrian-ghc-in-ghci: lint-base: extends: .lint-params + variables: + BUILD_FLAVOUR: default script: - - hadrian/build -c -j stage1:lib:base - - hadrian/build -j lint:base + - .gitlab/ci.sh setup + - .gitlab/ci.sh configure + - .gitlab/ci.sh run_hadrian stage1:lib:base + - .gitlab/ci.sh run_hadrian lint:base ############################################################ # Validation via Pipelines (make) ===================================== .gitlab/ci.sh ===================================== @@ -168,13 +168,13 @@ function show_tool() { } function set_toolchain_paths() { - needs_toolchain=1 + needs_toolchain="1" case "$(uname)" in Linux) needs_toolchain="0" ;; *) ;; esac - if [[ "$needs_toolchain" = 1 ]]; then + if [[ "$needs_toolchain" = "1" ]]; then # These are populated by setup_toolchain GHC="$toolchain/bin/ghc$exe" CABAL="$toolchain/bin/cabal$exe" @@ -185,9 +185,9 @@ function set_toolchain_paths() { # we provide these handy fallbacks in case the # script isn't run from within a GHC CI docker image. if [ -z "$GHC" ]; then GHC="$(which ghc)"; fi - if [ -z "$CABAL" ]; then GHC="$(which cabal)"; fi - if [ -z "$HAPPY" ]; then GHC="$(which happy)"; fi - if [ -z "$ALEX" ]; then GHC="$(which alex)"; fi + if [ -z "$CABAL" ]; then CABAL="$(which cabal)"; fi + if [ -z "$HAPPY" ]; then HAPPY="$(which happy)"; fi + if [ -z "$ALEX" ]; then ALEX="$(which alex)"; fi fi export GHC @@ -204,7 +204,7 @@ function setup() { cp -Rf cabal-cache/* "$cabal_dir" fi - if [[ -n "$needs_toolchain" ]]; then + if [[ "$needs_toolchain" = "1" ]]; then setup_toolchain fi case "$(uname)" in @@ -442,9 +442,6 @@ function test_make() { } function build_hadrian() { - if [ -z "$BUILD_FLAVOUR" ]; then - fail "BUILD_FLAVOUR not set" - fi if [ -z "$BIN_DIST_NAME" ]; then fail "BIN_DIST_NAME not set" fi @@ -506,6 +503,9 @@ function clean() { } function run_hadrian() { + if [ -z "$BUILD_FLAVOUR" ]; then + fail "BUILD_FLAVOUR not set" + fi if [ -z "$BIGNUM_BACKEND" ]; then BIGNUM_BACKEND="gmp"; fi if [ -n "$VERBOSE" ]; then HADRIAN_ARGS="$HADRIAN_ARGS -V"; fi run hadrian/build-cabal \ @@ -575,7 +575,7 @@ case $1 in test_hadrian || res=$? push_perf_notes exit $res ;; - run_hadrian) run_hadrian $@ ;; + run_hadrian) shift; run_hadrian $@ ;; perf_test) run_perf_test ;; clean) clean ;; shell) shell $@ ;; View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/41c64eb5db50c80e110e47b7ab1c1ee18dada46b...33ec3a0600fe8c009ab8ed6d86941a8fd88fb033 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/41c64eb5db50c80e110e47b7ab1c1ee18dada46b...33ec3a0600fe8c009ab8ed6d86941a8fd88fb033 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Dec 5 14:06:45 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sat, 05 Dec 2020 09:06:45 -0500 Subject: [Git][ghc/ghc][master] Fix bad span calculations of post qualified imports Message-ID: <5fcb93f5669d0_6b2147a61c20761e@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 4a437bc1 by Shayne Fletcher at 2020-12-05T09:06:38-05:00 Fix bad span calculations of post qualified imports - - - - - 4 changed files: - compiler/GHC/Parser.y - testsuite/tests/module/all.T - + testsuite/tests/module/mod185.hs - + testsuite/tests/module/mod185.stderr Changes: ===================================== compiler/GHC/Parser.y ===================================== @@ -1057,18 +1057,20 @@ importdecls_semi importdecl :: { LImportDecl GhcPs } : 'import' maybe_src maybe_safe optqualified maybe_pkg modid optqualified maybeas maybeimpspec {% do { - ; checkImportDecl $4 $7 - ; ams (L (comb4 $1 $6 (snd $8) $9) $ + ; let { ; mPreQual = unLoc $4 + ; mPostQual = unLoc $7 } + ; checkImportDecl mPreQual mPostQual + ; ams (L (comb5 $1 $6 $7 (snd $8) $9) $ ImportDecl { ideclExt = noExtField , ideclSourceSrc = snd $ fst $2 , ideclName = $6, ideclPkgQual = snd $5 , ideclSource = snd $2, ideclSafe = snd $3 - , ideclQualified = importDeclQualifiedStyle $4 $7 + , ideclQualified = importDeclQualifiedStyle mPreQual mPostQual , ideclImplicit = False , ideclAs = unLoc (snd $8) , ideclHiding = unLoc $9 }) - (mj AnnImport $1 : fst (fst $2) ++ fst $3 ++ fmap (mj AnnQualified) (maybeToList $4) - ++ fst $5 ++ fmap (mj AnnQualified) (maybeToList $7) ++ fst $8) + (mj AnnImport $1 : fst (fst $2) ++ fst $3 ++ fmap (mj AnnQualified) (maybeToList mPreQual) + ++ fst $5 ++ fmap (mj AnnQualified) (maybeToList mPostQual) ++ fst $8) } } @@ -1089,9 +1091,9 @@ maybe_pkg :: { ([AddAnn],Maybe StringLiteral) } ; return ([mj AnnPackageName $1], Just (StringLiteral (getSTRINGs $1) pkgFS)) } } | {- empty -} { ([],Nothing) } -optqualified :: { Maybe (Located Token) } - : 'qualified' { Just $1 } - | {- empty -} { Nothing } +optqualified :: { Located (Maybe (Located Token)) } + : 'qualified' { sL1 $1 (Just $1) } + | {- empty -} { noLoc Nothing } maybeas :: { ([AddAnn],Located (Maybe (Located ModuleName))) } : 'as' modid { ([mj AnnAs $1] @@ -3861,6 +3863,11 @@ comb4 a b c d = a `seq` b `seq` c `seq` d `seq` (combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $ combineSrcSpans (getLoc c) (getLoc d)) +comb5 :: Located a -> Located b -> Located c -> Located d -> Located e -> SrcSpan +comb5 a b c d e = a `seq` b `seq` c `seq` d `seq` e `seq` + (combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $ + combineSrcSpans (getLoc c) $ combineSrcSpans (getLoc d) (getLoc e)) + -- strict constructor version: {-# INLINE sL #-} sL :: SrcSpan -> a -> Located a ===================================== testsuite/tests/module/all.T ===================================== @@ -268,6 +268,7 @@ test('mod181', normal, compile, ['']) test('mod182', normal, compile_fail, ['']) test('mod183', normal, compile_fail, ['']) test('mod184', normal, compile, ['-Wprepositive-qualified-module']) +test('mod185', normal, compile, ['-ddump-parsed-ast']) test('T1148', normal, compile, ['']) test('T1074', normal, compile, ['']) ===================================== testsuite/tests/module/mod185.hs ===================================== @@ -0,0 +1,5 @@ +{-# LANGUAGE ImportQualifiedPost #-} +-- The span of the import decl should include the 'qualified' keyword. +import Prelude qualified + +main = Prelude.undefined ===================================== testsuite/tests/module/mod185.stderr ===================================== @@ -0,0 +1,62 @@ +==================== Parser AST ==================== + +({ mod185.hs:1:1 } + (HsModule + (VirtualBraces + (1)) + (Nothing) + (Nothing) + [({ mod185.hs:3:1-24 } + (ImportDecl + (NoExtField) + (NoSourceText) + ({ mod185.hs:3:8-14 } + {ModuleName: Prelude}) + (Nothing) + (NotBoot) + (False) + (QualifiedPost) + (False) + (Nothing) + (Nothing)))] + [({ mod185.hs:5:1-24 } + (ValD + (NoExtField) + (FunBind + (NoExtField) + ({ mod185.hs:5:1-4 } + (Unqual + {OccName: main})) + (MG + (NoExtField) + ({ mod185.hs:5:1-24 } + [({ mod185.hs:5:1-24 } + (Match + (NoExtField) + (FunRhs + ({ mod185.hs:5:1-4 } + (Unqual + {OccName: main})) + (Prefix) + (NoSrcStrict)) + [] + (GRHSs + (NoExtField) + [({ mod185.hs:5:6-24 } + (GRHS + (NoExtField) + [] + ({ mod185.hs:5:8-24 } + (HsVar + (NoExtField) + ({ mod185.hs:5:8-24 } + (Qual + {ModuleName: Prelude} + {OccName: undefined}))))))] + ({ } + (EmptyLocalBinds + (NoExtField))))))]) + (FromSource)) + [])))] + (Nothing) + (Nothing))) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4a437bc19d2026845948356a932b2cac2417eb12 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4a437bc19d2026845948356a932b2cac2417eb12 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Dec 5 14:07:20 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sat, 05 Dec 2020 09:07:20 -0500 Subject: [Git][ghc/ghc][master] testsuite: Add a test for #18923 Message-ID: <5fcb9418789f5_6b216b4c84210374@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 8fac4b93 by Ben Gamari at 2020-12-05T09:07:13-05:00 testsuite: Add a test for #18923 - - - - - 2 changed files: - + testsuite/tests/perf/compiler/T18923.hs - testsuite/tests/perf/compiler/all.T Changes: ===================================== testsuite/tests/perf/compiler/T18923.hs ===================================== @@ -0,0 +1,16 @@ +module T18923 (mergeRec, Rec) where + +mayMerge :: Maybe b -> Maybe b -> Maybe b +mayMerge Nothing y = y +mayMerge x Nothing = x +mayMerge (Just x) (Just y) = Just y + +data Rec = Rec { v0,v1,v2,v3,v4,v5,v6,v7 :: !(Maybe Bool) } + +mergeRec :: Rec -> Rec -> Rec +mergeRec + (Rec a0 a1 a2 a3 a4 a5 a6 a7) + (Rec b0 b1 b2 b3 b4 b5 b6 b7) = + Rec (mayMerge a0 b0) (mayMerge a1 b1) (mayMerge a2 b2) (mayMerge a3 b3) + (mayMerge a4 b4) (mayMerge a5 b5) (mayMerge a6 b6) (mayMerge a7 b7) + ===================================== testsuite/tests/perf/compiler/all.T ===================================== @@ -434,3 +434,7 @@ test ('T18223', ], compile, ['-v0 -O']) +test ('T18923', + [ collect_compiler_stats('bytes allocated',2) ], + compile, + ['-v0 -O']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8fac4b9333ef3607e75b4520d847054316cb8c2d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8fac4b9333ef3607e75b4520d847054316cb8c2d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Dec 5 16:04:17 2020 From: gitlab at gitlab.haskell.org (Shayne Fletcher) Date: Sat, 05 Dec 2020 11:04:17 -0500 Subject: [Git][ghc/ghc] Deleted branch wip/19014 Message-ID: <5fcbaf8136e95_6b2147a61c216299@gitlab.mail> Shayne Fletcher deleted branch wip/19014 at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Dec 6 16:30:55 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sun, 06 Dec 2020 11:30:55 -0500 Subject: [Git][ghc/ghc][wip/tyconapp-opts] 5 commits: gitlab-ci: Fix copy-paste error Message-ID: <5fcd073f7a03c_6b216c0ae8243712@gitlab.mail> Ben Gamari pushed to branch wip/tyconapp-opts at Glasgow Haskell Compiler / GHC Commits: e0b08c5f by Ben Gamari at 2020-12-03T13:01:47-05:00 gitlab-ci: Fix copy-paste error Also be more consistent in quoting. - - - - - 33ec3a06 by Ben Gamari at 2020-12-03T23:11:31-05:00 gitlab-ci: Run linters through ci.sh Ensuring that the right toolchain is used. - - - - - 4a437bc1 by Shayne Fletcher at 2020-12-05T09:06:38-05:00 Fix bad span calculations of post qualified imports - - - - - 8fac4b93 by Ben Gamari at 2020-12-05T09:07:13-05:00 testsuite: Add a test for #18923 - - - - - 2eb43a46 by Ben Gamari at 2020-12-06T11:30:14-05:00 Optimise nullary type constructor usage During the compilation of programs GHC very frequently deals with the `Type` type, which is a synonym of `TYPE 'LiftedRep`. This patch teaches GHC to avoid expanding the `Type` synonym (and other nullary type synonyms) during type comparisons, saving a good amount of work. This optimisation is described in `Note [Comparing nullary type synonyms]`. To maximize the impact of this optimisation, we introduce a few special-cases to reduce `TYPE 'LiftedRep` to `Type`. See `Note [Prefer Type over TYPE 'LiftedPtrRep]`. Closes #17958. Metric Decrease: T18698b T1969 T12227 T12545 T12707 T14683 T3064 T5631 T5642 T9020 T9630 T9872a T13035 haddock.Cabal haddock.base - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - + compiler/GHC/Builtin/Types/Prim.hs-boot - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Parser.y - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/TcType.hs - testsuite/tests/deSugar/should_compile/T2431.stderr - testsuite/tests/deriving/should_compile/T14578.stderr - testsuite/tests/module/all.T - + testsuite/tests/module/mod185.hs - + testsuite/tests/module/mod185.stderr - + testsuite/tests/perf/compiler/T18923.hs - testsuite/tests/perf/compiler/all.T - testsuite/tests/plugins/plugins09.stdout - testsuite/tests/plugins/plugins10.stdout - testsuite/tests/plugins/plugins11.stdout - testsuite/tests/plugins/static-plugins.stdout - testsuite/tests/printer/T18052a.stderr - testsuite/tests/simplCore/should_compile/T13143.stderr - testsuite/tests/simplCore/should_compile/T18013.stderr - testsuite/tests/simplCore/should_compile/T7360.stderr - testsuite/tests/typecheck/should_compile/T13032.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/53c0b472dbdddea7ca4eb366c982509866ee2665...2eb43a4686bd27237749b711da4b7301a857388b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/53c0b472dbdddea7ca4eb366c982509866ee2665...2eb43a4686bd27237749b711da4b7301a857388b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Dec 6 16:51:03 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sun, 06 Dec 2020 11:51:03 -0500 Subject: [Git][ghc/ghc][wip/thread-status] 1562 commits: Be explicit about how stack usage of mvar primops are covered. Message-ID: <5fcd0bf74ce44_6b2174471c25653f@gitlab.mail> Ben Gamari pushed to branch wip/thread-status at Glasgow Haskell Compiler / GHC Commits: 8c663c2c by Andreas Klebinger at 2020-03-04T16:12:14+01:00 Be explicit about how stack usage of mvar primops are covered. This fixes #17893 [skip-ci] - - - - - cedd6f30 by Ben Gamari at 2020-03-05T14:53:12-05:00 rts: Add getCurrentThreadCPUTime helper - - - - - ace618cd by Ben Gamari at 2020-03-05T14:53:12-05:00 nonmoving-gc: Track time usage of nonmoving marking - - - - - 022b5ad5 by Ben Gamari at 2020-03-05T14:53:12-05:00 Stats: Add sync pauses to +RTS -S output - - - - - 06763234 by Ben Gamari at 2020-03-05T14:53:12-05:00 rts: Report nonmoving collector statistics in machine-readable output - - - - - 70d2b995 by Ben Gamari at 2020-03-09T06:10:52-04:00 nonmoving: Fix collection of sparks Previously sparks living in the non-moving heap would be promptly GC'd by the minor collector since pruneSparkQueue uses the BF_EVACUATED flag, which non-moving heap blocks do not have set. Fix this by implementing proper support in pruneSparkQueue for determining reachability in the non-moving heap. The story is told in Note [Spark management in the nonmoving heap]. - - - - - 9668781a by Ben Gamari at 2020-03-09T06:11:30-04:00 gitlab-ci: Disable Sphinx documentation in Alpine build - - - - - 8eb2c263 by Jean-Baptiste Mazon at 2020-03-09T16:33:37-04:00 Fix Windows breakage by not touching locales on Windows - - - - - b8dab057 by Jean-Baptiste Mazon at 2020-03-09T16:33:37-04:00 rts: ensure C numerics in heap profiles using Windows locales if needed - - - - - 7d95260f by Jean-Baptiste Mazon at 2020-03-09T16:33:37-04:00 rts: refactor and comment profile locales - - - - - 5b627813 by Ryan Scott at 2020-03-09T16:34:14-04:00 Use InstanceSigs in GND/DerivingVia-generated code (#17899) Aside from making the generated code easier to read when `-ddump-deriv` is enabled, this makes the error message in `T15073` substantially simpler (see the updated `T15073` expected stderr). Fixes #17899. - - - - - 70b50778 by Ben Gamari at 2020-03-10T02:05:42-04:00 SysTools: Ensure that error parser can handle absolute paths on Windows This fixes #17786, where the error parser fails to correctly handle the drive name in absolute Windows paths. Unfortunately I couldn't find a satisfactory way to test this. - - - - - 85b861d8 by Ben Gamari at 2020-03-10T02:05:42-04:00 testsuite: Add test for #17786 This isn't pretty but it's perhaps better than nothing. - - - - - ee2c50cb by Sylvain Henry at 2020-03-10T02:06:33-04:00 Hadrian: track missing configure results - - - - - ca8f51d4 by Ömer Sinan Ağacan at 2020-03-10T02:07:22-04:00 Add regression test for T17904 Closes #17904 - - - - - 5fa9cb82 by Richard Eisenberg at 2020-03-10T12:29:46-04:00 anyRewritableTyVar now looks in RuntimeReps Previously, anyRewritableTyVar looked only at the arg and res of `arg -> res`, but their RuntimeReps are also subject to rewriting. Easy to fix. Test case: typecheck/should_compile/T17024 Fixes #17024. - - - - - 5ba01d83 by Ben Price at 2020-03-10T12:30:27-04:00 Clarify a Lint message When developing a plugin I had a shadowing problem, where I generated code app = \f{v r7B} x{v r7B} -> f{v r7B} x{v r7B} This is obviously wrong, since the occurrence of `f` to the right of the arrow refers to the `x` binder (they share a Unique). However, it is rather confusing when Lint reports Mismatch in type between binder and occurrence Var: x{v rB7} since it is printing the binder, rather than the occurrence. It is rather easy to read this as claiming there is something wrong with the `x` occurrence! We change the report to explicitly print both the binder and the occurrence variables. - - - - - 7b2c827b by Simon Peyton Jones at 2020-03-10T12:31:15-04:00 Comments only Clarify code added in #17852 and MR !2724 - - - - - 3300eeac by Krzysztof Gogolewski at 2020-03-10T12:31:54-04:00 Misc cleanup - Remove Note [Existentials in shift_con_pat]. The function shift_con_pat has been removed 15 years ago in 23f40f0e9be6d4. - Remove kcLookupTcTyCon - it's the same as tcLookupTcTyCon - Remove ASSERT in tyConAppArgN. It's already done by getNth, and it's the only reason getNth exists. - Remove unused function nextRole - - - - - abf5736b by Krzysztof Gogolewski at 2020-03-10T18:05:01+01:00 Typos in comments [skip ci] - - - - - bb586f89 by Ben Gamari at 2020-03-11T00:14:59-04:00 rts: Prefer darwin-specific getCurrentThreadCPUTime macOS Catalina now supports a non-POSIX-compliant version of clock_gettime which cannot use the clock_gettime codepath. Fixes #17906. - - - - - 20800b9a by Sylvain Henry at 2020-03-11T08:17:19-04:00 Split GHC.Iface.Utils module * GHC.Iface.Recomp: recompilation avoidance stuff * GHC.Iface.Make: mkIface* Moved `writeIfaceFile` into GHC.Iface.Load alongside `readIface` and renamed it `writeIface` for consistency. - - - - - 1daa2029 by Greg Steuck at 2020-03-11T08:17:56-04:00 Fixed a minor typo in codegen.rst - - - - - 0bc23338 by Ryan Scott at 2020-03-11T08:18:32-04:00 Re-quantify when generalising over rewrite rule types Previously, `tcRules` would check for naughty quantification candidates (see `Note [Naughty quantification candidates]` in `TcMType`) when generalising over the type of a rewrite rule. This caused sensible-looking rewrite rules (like those in #17710) to be rejected. A more permissing (and easier-to-implement) approach is to do what is described in `Note [Generalising in tcTyFamInstEqnGuts]` in `TcTyClsDecls`: just re-quantify all the type variable binders, regardless of the order in which the user specified them. After all, the notion of type variable specificity has no real meaning in rewrite rules, since one cannot "visibly apply" a rewrite rule. I have written up this wisdom in `Note [Re-quantify type variables in rules]` in `TcRules`. As a result of this patch, compiling the `ExplicitForAllRules1` test case now generates one fewer warning than it used to. As far as I can tell, this is benign, since the thing that the disappearing warning talked about was also mentioned in an entirely separate warning. Fixes #17710. - - - - - 336eac7e by Ben Gamari at 2020-03-11T08:19:08-04:00 testsuite: Mark ghci056 and ghcilink004 as fragile in unreg As noted in #17018. Also fix fragile declaration of T13786, which only runs in the normal way. - - - - - c61b9b02 by Simon Peyton Jones at 2020-03-11T08:19:44-04:00 Deepen call stack for isIn I see quite a few warnings like: WARNING: file compiler/utils/Util.hs, line 593 Over-long elem in unionLists But the call stack is uninformative. Better to add HasDebugCallStack to isIn. Ditto isn'tIn. - - - - - 3aa9b35f by Ömer Sinan Ağacan at 2020-03-11T08:20:27-04:00 Zero any slop after compaction in compacting GC In copying GC, with the relevant debug flags enabled, we release the old blocks after a GC, and the block allocator zeroes the space before releasing a block. This effectively zeros the old heap. In compacting GC we reuse the blocks and previously we didn't zero the unused space in a compacting generation after compaction. With this patch we zero the slop between the free pointer and the end of the block when we're done with compaction and when switching to a new block (because the current block doesn't have enough space for the next object we're shifting). - - - - - 8e6febce by Sylvain Henry at 2020-03-11T20:33:37-04:00 Refactor GHC.Driver.Session (Ways and Flags) * extract flags and ways into their own modules (with some renaming) * remove one SOURCE import of GHC.Driver.Session from GHC.Driver.Phases * when GHC uses dynamic linking (WayDyn), `interpWays` was only reporting WayDyn even if the host was profiled (WayProf). Now it returns both as expected (might fix #16803). * `mkBuildTag :: [Way] -> String` wasn't reporting a canonical tag for differently ordered lists. Now we sort and nub the list to fix this. - - - - - bc41e471 by Sylvain Henry at 2020-03-11T20:33:37-04:00 Refactor interpreterDynamic and interpreterProfiled * `interpreterDynamic` and `interpreterProfiled` now take `Interp` parameters instead of DynFlags * slight refactoring of `ExternalInterp` so that we can read the iserv configuration (which is pure) without reading an MVar. - - - - - a6989971 by Sylvain Henry at 2020-03-11T20:33:37-04:00 Use a Set to represent Ways Should make `member` queries faster and avoid messing up with missing `nubSort`. Metric Increase: hie002 - - - - - cb93a1a4 by Ryan Scott at 2020-03-11T20:34:14-04:00 Make DeriveFunctor-generated code require fewer beta reductions Issue #17880 demonstrates that `DeriveFunctor`-generated code is surprisingly fragile when rank-_n_ types are involved. The culprit is that `$fmap` (the algorithm used to generate `fmap` implementations) was too keen on applying arguments with rank-_n_ types to lambdas, which fail to typecheck more often than not. In this patch, I change `$fmap` (both the specification and the implementation) to produce code that avoids creating as many lambdas, avoiding problems when rank-_n_ field types arise. See the comments titled "Functor instances" in `TcGenFunctor` for a more detailed description. Not only does this fix #17880, but it also ensures that the code that `DeriveFunctor` generates will continue to work after simplified subsumption is implemented (see #17775). What is truly amazing is that #17880 is actually a regression (introduced in GHC 7.6.3) caused by commit 49ca2a37bef18aa57235ff1dbbf1cc0434979b1e, the fix #7436. Prior to that commit, the version of `$fmap` that was used was almost identical to the one used in this patch! Why did that commit change `$fmap` then? It was to avoid severe performance issues that would arise for recursive `fmap` implementations, such as in the example below: ```hs data List a = Nil | Cons a (List a) deriving Functor -- ===> instance Functor List where fmap f Nil = Nil fmap f (Cons x xs) = Cons (f x) (fmap (\y -> f y) xs) ``` The fact that `\y -> f y` was eta expanded caused significant performance overheads. Commit 49ca2a37bef18aa57235ff1dbbf1cc0434979b1e fixed this performance issue, but it went too far. As a result, this patch partially reverts 49ca2a37bef18aa57235ff1dbbf1cc0434979b1e. To ensure that the performance issues pre-#7436 do not resurface, I have taken some precautionary measures: * I have added a special case to `$fmap` for situations where the last type variable in an application of some type occurs directly. If this special case fires, we avoid creating a lambda expression. This ensures that we generate `fmap f (Cons x xs) = Cons (f x) (fmap f xs)` in the derived `Functor List` instance above. For more details, see `Note [Avoid unnecessary eta expansion in derived fmap implementations]` in `TcGenFunctor`. * I have added a `T7436b` test case to ensure that the performance of this derived `Functor List`-style code does not regress. When implementing this, I discovered that `$replace`, the algorithm which generates implementations of `(<$)`, has a special case that is very similar to the `$fmap` special case described above. `$replace` marked this special case with a custom `Replacer` data type, which was a bit overkill. In order to use the same machinery for both `Functor` methods, I ripped out `Replacer` and instead implemented a simple way to detect the special case. See the updated commentary in `Note [Deriving <$]` for more details. - - - - - 1f9db3e7 by Kirill Elagin at 2020-03-12T09:45:51-04:00 pretty-printer: Properly parenthesise LastStmt After ApplicatveDo strips the last `return` during renaming, the pretty printer has to restore it. However, if the return was followed by `$`, the dollar was stripped too and not restored. For example, the last stamement in: ``` foo = do x <- ... ... return $ f x ``` would be printed as: ``` return f x ``` This commit preserved the dolar, so it becomes: ``` return $ f x ``` - - - - - 5cb93af7 by Kirill Elagin at 2020-03-12T09:45:51-04:00 pretty-printer: Do not print ApplicativeDo join * Do not print `join` in ApplictiveStmt, unless ppr-debug * Print parens around multiple parallel binds When ApplicativeDo is enabled, the renamer analyses the statements of a `do` block and in certain cases marks them as needing to be rewritten using `join`. For example, if you have: ``` foo = do a <- e1 b <- e2 doSomething a b ``` it will be desugared into: ``` foo = join (doSomething <$> e1 <*> e2) ``` After renaming but before desugaring the expression is stored essentially as: ``` foo = do [will need join] (a <- e1 | b <- e2) [no return] doSomething a b ``` Before this change, the pretty printer would print a call to `join`, even though it is not needed at this stage at all. The expression will be actually rewritten into one using join only at desugaring, at which point a literal call to join will be inserted. - - - - - 3a259092 by Simon Peyton Jones at 2020-03-12T09:46:29-04:00 Expose compulsory unfoldings always The unsafeCoerce# patch requires that unsafeCoerce# has a compulsory unfolding that is always available. So we have to be careful to expose compulsory unfoldings unconditionally and consistently. We didn't get this quite right: #17871. This patch fixes it. No real surprises here. See Note [Always expose compulsory unfoldings] in GHC.Iface.Tidy - - - - - 6a65b8c2 by Alp Mestanogullari at 2020-03-13T02:29:20-04:00 hadrian: improve dependency tracking for the check-* programs The code in Rules.Register responsible for finding all the build artifacts that Cabal installs when registering a library (static/shared libs, .hi files, ...) was looking in the wrong place. This patch fixes that logic and makes sure we gather all those artifacts in a list to declare that the rule for a given `.conf` file, our proxy for "Hadrian, please install this package in the package db for this stage", also produces those artifacts under the said package database. We also were completely missing some logic to declare that the check-* programs have dependencies besides their source code, at least when testing an in-tree compiler. Finally, this patch also removes redundant packages from 'testsuitePackages', since they should already be covered by the stage<N>Packages lists from Settings.Default. With this patch, after a complete build and freezing stage 1, a change to `compiler/parser/Parser.y` results in rebuilding the ghc lib, reinstalling it, and rebuilding the few programs that depend on it, _including_ `check-ppr` and `check-api-annotations` (therefore fixing #17273). - - - - - 44fad4a9 by Sylvain Henry at 2020-03-13T02:30:22-04:00 Rename isDllName I wanted to fix the dangling comment in `isDllName` ("This is the cause of #", #8696 is already mentioned earlier). I took the opportunity to change the function name to better reflect what it does. - - - - - 2f292db8 by Paavo at 2020-03-13T02:31:03-04:00 Update documentation for closureSize - - - - - f124ff0d by Ben Gamari at 2020-03-13T02:31:40-04:00 gitlab-ci: Rework triggering of release builds Use a push option instead of tagging. - - - - - 7f25557a by Ben Gamari at 2020-03-13T10:38:09-04:00 gitlab-ci: Distinguish integer-simple test envs Previously two integer-simple jobs declared the same test environment. One (the nightly job) was built in the perf way, the other in the validate way. Consequently they had appreciably different performance characteristics, causing in the nightly job to spuriously fail with performance changes. - - - - - c12a2ec5 by Simon Peyton Jones at 2020-03-14T05:25:30-04:00 Fix Lint Ticket #17590 pointed out a bug in the way the linter dealt with type lets, exposed by the new uniqAway story. The fix is described in Note [Linting type lets]. I ended up putting the in-scope Ids in a different env field, le_ids, rather than (as before) sneaking them into the TCvSubst. Surprisingly tiresome, but done. Metric Decrease: hie002 - - - - - b989845e by Sylvain Henry at 2020-03-14T05:26:11-04:00 Hadrian: fix absolute buildroot support (#17822) Shake's "**" wildcard doesn't match absolute root. We must use "//" instead. - - - - - 4f117135 by Sylvain Henry at 2020-03-14T05:26:49-04:00 Make: refactor GMP rules Document and use simpler rules for the ghc-gmp.h header. - - - - - 7432b327 by Sylvain Henry at 2020-03-14T05:27:28-04:00 Use correct option name (-opti) (fix #17314) s/pgmo/opti - - - - - 8f7dd571 by Judah Jacobson at 2020-03-14T05:28:07-04:00 Allow overriding LD_STAGE0 and AR_STAGE0 in the configure script. Previously it was possible to override the stage0 C compiler via `CC_STAGE0`, but you couldn't override `ld` or `ar` in stage0. This change allows overriding them by setting `LD_STAGE0` or `AR_STAGE0`, respectively. Our team uses this feature internally to take more control of our GHC build and make it run more hermetically. - - - - - 7c3e39a9 by Judah Jacobson at 2020-03-14T05:28:07-04:00 Use AC_ARG_VAR for LD_STAGE0 and AR_STAGE0. - - - - - 20d4d676 by Ben Gamari at 2020-03-14T05:28:43-04:00 nonmoving: Don't traverse filled segment list in pause The non-moving collector would previously walk the entire filled segment list during the preparatory pause. However, this is far more work than is strictly necessary. We can rather get away with merely collecting the allocators' filled segment list heads and process the lists themselves during the concurrent phase. This can significantly reduce the maximum gen1 GC pause time in programs with high rates of long-lived allocations. - - - - - fdfa2d01 by Ben Gamari at 2020-03-14T05:29:18-04:00 nonmoving: Remove redundant bitmap clearing nonmovingSweep already clears the bitmap in the sweep loop. There is no reason to do so a second time. - - - - - 2f8c7767 by Simon Peyton Jones at 2020-03-14T05:29:55-04:00 Simple refactor of cheapEqExpr No change in functionality. Just seems tidier (and signficantly more efficient) to deal with ticks directly than to call stripTicksTopE. - - - - - 88f7a762 by Simon Peyton Jones at 2020-03-14T05:29:55-04:00 Improve CSE.combineAlts This patch improves the way that CSE combines identical alternatives. See #17901. I'm still not happy about the duplication between CSE.combineAlts and GHC.Core.Utils.combineIdenticalAlts; see the Notes with those functions. But this patch is a step forward. Metric Decrease: T12425 T5642 - - - - - 8b95ddd3 by Ben Gamari at 2020-03-14T05:30:31-04:00 gitlab-ci: Add integer-simple release build for Windows Closes #16144. - - - - - e3c374cc by Simon Peyton Jones at 2020-03-14T05:31:07-04:00 Wrap an implication around class-sig kind errors Ticket #17841 showed that we can get a kind error in a class signature, but lack an enclosing implication that binds its skolems. This patch * Adds the wrapping implication: the new call to checkTvConstraints in tcClassDecl1 * Simplifies the API to checkTvConstraints, which was not otherwise called at all. * Simplifies TcErrors.report_unsolved by *not* initialising the TidyEnv from the typechecker lexical envt. It's enough to do so from the free vars of the unsolved constraints; and we get silly renamings if we add variables twice: once from the lexical scope and once from the implication constraint. - - - - - 73133a3b by Simon Peyton Jones at 2020-03-14T05:31:07-04:00 Refactoring in TcSMonad This patch is just refactoring: no change in behaviour. I removed the rather complicated checkConstraintsTcS checkTvConstraintsTcS in favour of simpler functions emitImplicationTcS emitTvImplicationTcS pushLevelNoWorkList The last of these is a little strange, but overall it's much better I think. - - - - - 93c88c26 by Ben Gamari at 2020-03-14T05:31:42-04:00 base: Make `open` calls interruptible As noted in #17912, `open` system calls were `safe` rather than `interruptible`. Consequently, the program could not be interrupted with SIGINT if stuck in a slow open operation. Fix this by marking `c_safe_open` as interruptible. - - - - - bee4cdad by Vladislav Zavialov at 2020-03-14T05:32:18-04:00 Remove second tcLookupTcTyCon in tcDataDefn Before this patch, tcDataDefn used to call tcLookupTcTyCon twice in a row: 1. in bindTyClTyVars itself 2. in the continuation passed to it Now bindTyClTyVars passes the TcTyCon to the continuation, making the second lookup unnecessary. - - - - - 3f116d35 by Cale Gibbard at 2020-03-14T19:34:42-04:00 Enable stage1 build of haddock The submodule has already been bumped to contain the fix. - - - - - 49e9d739 by Ömer Sinan Ağacan at 2020-03-14T19:35:24-04:00 rts: Fix printClosure when printing fwd ptrs - - - - - 1de3ab4a by Krzysztof Gogolewski at 2020-03-14T19:36:04-04:00 Remove unused field var_inline (#17915) - - - - - d30aeb4b by Krzysztof Gogolewski at 2020-03-15T03:57:41-04:00 Document restriction on SCC pragma syntax Currently, the names of cost centres must be quoted or be lowercase identifiers. Fixes #17916. - - - - - b4774598 by Brian Foley at 2020-03-15T03:58:18-04:00 Remove some dead code >From the notes.ghc.drop list found using weeder in #17713 - - - - - dd6ffe6b by Viktor Dukhovni at 2020-03-15T03:58:55-04:00 Note platform-specific Foreign.C.Types in context Also fix the markup in the general note at the top of the module. Haddock (usability trade-off), does not support multi-line emphasised text. - - - - - 2e82465f by Sylvain Henry at 2020-03-15T10:57:10-04:00 Refactor CmmToAsm (disentangle DynFlags) This patch disentangles a bit more DynFlags from the native code generator (CmmToAsm). In more details: - add a new NCGConfig datatype in GHC.CmmToAsm.Config which contains the configuration of a native code generation session - explicitly pass NCGConfig/Platform arguments when necessary - as a consequence `sdocWithPlatform` is gone and there are only a few `sdocWithDynFlags` left - remove the use of `unsafeGlobalDynFlags` from GHC.CmmToAsm.CFG - remove `sdocDebugLevel` (now we pass the debug level via NCGConfig) There are still some places where DynFlags is used, especially because of pretty-printing (CLabel), because of Cmm helpers (such as `cmmExprType`) and because of `Outputable` instance for the instructions. These are left for future refactoring as this patch is already big. - - - - - c35c545d by Judah Jacobson at 2020-03-15T10:57:48-04:00 Add a -no-haddock flag. This flag undoes the effect of a previous "-haddock" flag. Having both flags makes it easier for build systems to enable Haddock parsing in a set of global flags, but then disable it locally for specific targets (e.g., third-party packages whose comments don't pass the validation in the latest GHC). I added the flag to expected-undocumented-flags.txt since `-haddock` was alreadyin that list. - - - - - cfcc3c9a by Ömer Sinan Ağacan at 2020-03-15T10:58:27-04:00 Fix global_link of TSOs for threads reachable via dead weaks Fixes #17785 Here's how the problem occurs: - In generation 0 we have a TSO that is finished (i.e. it has no more work to do or it is killed). - The TSO only becomes reachable after collectDeadWeakPtrs(). - After collectDeadWeakPtrs() we switch to WeakDone phase where we don't move TSOs to different lists anymore (like the next gen's thread list or the resurrected_threads list). - So the TSO will never be moved to a generation's thread list, but it will be promoted to generation 1. - Generation 1 collected via mark-compact, and because the TSO is reachable it is marked, and its `global_link` field, which is bogus at this point (because the TSO is not in a list), will be threaded. - Chaos ensues. In other words, when these conditions hold: - A TSO is reachable only after collectDeadWeakPtrs() - It's finished (what_next is ThreadComplete or ThreadKilled) - It's retained by mark-compact collector (moving collector doesn't evacuate the global_list field) We end up doing random mutations on the heap because the TSO's global_list field is not valid, but it still looks like a heap pointer so we thread it during compacting GC. The fix is simple: when we traverse old_threads lists to resurrect unreachable threads the threads that won't be resurrected currently stays on the old_threads lists. Those threads will never be visited again by MarkWeak so we now reset the global_list fields. This way compacting GC does not thread pointers to nowhere. Testing ------- The reproducer in #17785 is quite large and hard to build, because of the dependencies, so I'm not adding a regression test. In my testing the reproducer would take a less than 5 seconds to run, and once in every ~5 runs would fail with a segfault or an assertion error. In other cases it also fails with a test failure. Because the tests never fail with the bug fix, assuming the code is correct, this also means that this bug can sometimes lead to incorrect runtime results. After the fix I was able to run the reproducer repeatedly for about an hour, with no runtime crashes or test failures. To run the reproducer clone the git repo: $ git clone https://github.com/osa1/streamly --branch ghc-segfault Then clone primitive and atomic-primops from their git repos and point to the clones in cabal.project.local. The project should then be buildable using GHC HEAD. Run the executable `properties` with `+RTS -c -DZ`. In addition to the reproducer above I run the test suite using: $ make slowtest EXTRA_HC_OPTS="-debug -with-rtsopts=-DS \ -with-rtsopts=-c +RTS -c -RTS" SKIPWAY='nonmoving nonmoving_thr' This enables compacting GC always in both GHC when building the test programs and when running the test programs, and also enables sanity checking when running the test programs. These set of flags are not compatible for all tests so there are some failures, but I got the same set of failures with this patch compared to GHC HEAD. - - - - - 818b3c38 by Lysxia at 2020-03-16T23:52:42-04:00 base: add strict IO functions: readFile', getContents', hGetContents' - - - - - 18a346a4 by Sylvain Henry at 2020-03-16T23:53:24-04:00 Modules: Core (#13009) Update submodule: haddock - - - - - 92327e3a by Ömer Sinan Ağacan at 2020-03-16T23:54:04-04:00 Update sanity checking for TSOs: - Remove an invalid assumption about GC checking what_next field. The GC doesn't care about what_next at all, if a TSO is reachable then all its pointers are followed (other than global_tso, which is only followed by compacting GC). - Remove checkSTACK in checkTSO: TSO stacks will be visited in checkHeapChain, or checkLargeObjects etc. - Add an assertion in checkTSO to check that the global_link field is sane. - Did some refactor to remove forward decls in checkGlobalTSOList and added braces around single-statement if statements. - - - - - e1aa4052 by PHO at 2020-03-17T07:36:09-04:00 Don't use non-portable operator "==" in configure.ac The test operator "==" is a Bash extension and produces a wrong result if /bin/sh is not Bash. - - - - - 89f034dd by Maximilian Tagher at 2020-03-17T07:36:48-04:00 Document the units of -ddump-timings Right now, in the output of -ddump-timings to a file, you can't tell what the units are: ``` CodeGen [TemplateTestImports]: alloc=22454880 time=14.597 ``` I believe bytes/milliseconds are the correct units, but confirmation would be appreciated. I'm basing it off of this snippet from `withTiming'`: ``` when (verbosity dflags >= 2 && prtimings == PrintTimings) $ liftIO $ logInfo dflags (defaultUserStyle dflags) (text "!!!" <+> what <> colon <+> text "finished in" <+> doublePrec 2 time <+> text "milliseconds" <> comma <+> text "allocated" <+> doublePrec 3 (realToFrac alloc / 1024 / 1024) <+> text "megabytes") ``` which implies time is in milliseconds, and allocations in bytes (which divided by 1024 would be KB, and again would be MB) - - - - - beffa147 by Simon Peyton Jones at 2020-03-17T07:37:25-04:00 Implement mapTyCo like foldTyCo This patch makes mapType use the successful idiom described in TyCoRep Note [Specialising foldType] I have not yet changed any functions to use mapType, though there may be some suitable candidates. This patch should be a no-op in terms of functionality but, because it inlines the mapper itself, I'm hoping that there may be some modest perf improvements. Metric Decrease: T5631 T5642 T3064 T9020 T14683 hie002 haddock.Cabal haddock.base haddock.compiler - - - - - 5800ebfe by Ömer Sinan Ağacan at 2020-03-17T07:38:08-04:00 Don't update ModDetails with CafInfos when opts are disabled This is consistent with the interface file behavior where we omit HsNoCafRefs annotations with -fomit-interface-pragmas (implied by -O0). ModDetails and ModIface are just different representations of the same thing, so they really need to be in sync. This patch does the right thing and does not need too much explanation, but here's an example of a problem not doing this causes in !2842: -- MyInteger.hs module MyInteger ( MyInteger (MyInteger) , ToMyInteger (toMyInteger) ) where newtype MyInteger = MyInteger Integer class ToMyInteger a where toMyInteger :: a -> MyInteger instance ToMyInteger Integer where toMyInteger = MyInteger {- . succ -} -- Main.hs module Main ( main ) where import MyInteger (MyInteger (MyInteger), toMyInteger) main :: IO () main = do let (MyInteger i) = (id . toMyInteger) (41 :: Integer) print i If I build this with -O0, without this fix, we generate a ModDetails with accurate LFInfo for toMyInteger (MyInteger.$fToMyIntegerInteger) which says that it's a LFReEntrant with arity 1. This means in the use site (Main) we tag the value: R3 = MyInteger.$fToMyIntegerInteger_closure + 1; R2 = GHC.Base.id_closure; R1 = GHC.Base.._closure; Sp = Sp - 16; call stg_ap_ppp_fast(R4, R3, R2, R1) args: 24, res: 0, upd: 24; Now we change the definition by uncommenting the `succ` part and it becomes a thunk: MyInteger.$fToMyIntegerInteger [InlPrag=INLINE (sat-args=0)] :: MyInteger.ToMyInteger GHC.Integer.Type.Integer [GblId[DFunId(nt)]] = {} \u [] $ctoMyInteger_rEA; and its LFInfo is now LFThunk. This change in LFInfo makes a difference in the use site: we can no longer tag it. But becuase the interface fingerprint does not change (because ModIface does not change) we don't rebuild Main and tag the thunk. (1.2% increase in allocations when building T12545 on armv7 because we generate more code without CafInfos) Metric Increase: T12545 - - - - - 5b632dad by Paavo at 2020-03-17T07:38:48-04:00 Add example for Data.Semigroup.diff - - - - - 4d85d68b by Paavo at 2020-03-17T07:38:48-04:00 Clean up - - - - - 75168d07 by Paavo at 2020-03-17T07:38:48-04:00 Make example collapsible - - - - - 53ff2cd0 by Richard Eisenberg at 2020-03-17T13:46:57+00:00 Fix #17021 by checking more return kinds All the details are in new Note [Datatype return kinds] in TcTyClsDecls. Test case: typecheck/should_fail/T17021{,b} typecheck/should_compile/T17021a Updates haddock submodule - - - - - 528df8ec by Sylvain Henry at 2020-03-18T10:06:43-04:00 Modules: Core operations (#13009) - - - - - 4e8a71c1 by Richard Eisenberg at 2020-03-18T10:07:19-04:00 Add release note about fix to #16502. We thought we needed to update the manual, but the fix for #16502 actually brings the implementation in line with the manual. So we just alert users of how to update their code. - - - - - 5cbf9934 by Andreas Klebinger at 2020-03-19T00:39:27-04:00 Update "GHC differences to the FFI Chapter" in user guide. The old entry had a heavy focus on how things had been. Which is not what I generally look for in a user guide. I also added a small section on behaviour of nested safe ffi calls. [skip-ci] - - - - - b03fd3bc by Sebastian Graf at 2020-03-19T00:40:06-04:00 PmCheck: Use ConLikeSet to model negative info In #17911, Simon recognised many warnings stemming from over-long list unions while coverage checking Cabal's `LicenseId` module. This patch introduces a new `PmAltConSet` type which uses a `UniqDSet` instead of an association list for `ConLike`s. For `PmLit`s, it will still use an assocation list, though, because a similar map data structure would entail a lot of busy work. Fixes #17911. - - - - - 64f20756 by Sylvain Henry at 2020-03-19T12:16:49-04:00 Refactoring: use Platform instead of DynFlags when possible Metric Decrease: ManyConstructors T12707 T13035 T1969 - - - - - cb1785d9 by Ömer Sinan Ağacan at 2020-03-19T12:16:54-04:00 FastString: fix eager reading of string ptr in hashStr This read causes NULL dereferencing when len is 0. Fixes #17909 In the reproducer in #17909 this bug is triggered as follows: - SimplOpt.dealWithStringLiteral is called with a single-char string ("=" in #17909) - tailFS gets called on the FastString of the single-char string. - tailFS checks the length of the string, which is 1, and calls mkFastStringByteString on the tail of the ByteString, which is an empty ByteString as the original ByteString has only one char. - ByteString's unsafeUseAsCStringLen returns (NULL, 0) for the empty ByteString, which is passed to mkFastStringWith. - mkFastStringWith gets hash of the NULL pointer via hashStr, which fails on empty strings because of this bug. - - - - - 73a7383e by Richard Eisenberg at 2020-03-20T20:42:56-04:00 Simplify treatment of heterogeneous equality Previously, if we had a [W] (a :: k1) ~ (rhs :: k2), we would spit out a [D] k1 ~ k2 and part the W as irreducible, hoping for a unification. But we needn't do this. Instead, we now spit out a [W] co :: k2 ~ k1 and then use co to cast the rhs of the original Wanted. This means that we retain the connection between the spat-out constraint and the original. The problem with this new approach is that we cannot use the casted equality for substitution; it's too like wanteds-rewriting- wanteds. So, we forbid CTyEqCans that mention coercion holes. All the details are in Note [Equalities with incompatible kinds] in TcCanonical. There are a few knock-on effects, documented where they occur. While debugging an error in this patch, Simon and I ran into infelicities in how patterns and matches are printed; we made small improvements. This patch includes mitigations for #17828, which causes spurious pattern-match warnings. When #17828 is fixed, these lines should be removed. - - - - - faa36e5b by Sylvain Henry at 2020-03-20T20:43:41-04:00 Hadrian: ignore in-tree GMP objects with ``--lint`` - - - - - 9a96ff6b by Richard Eisenberg at 2020-03-20T20:44:17-04:00 Update core spec to reflect changes to Core. Key changes: * Adds a new rule for forall-coercions over coercion variables, which was implemented but conspicuously missing from the spec. * Adds treatment for FunCo. * Adds treatment for ForAllTy over coercion variables. * Improves commentary (including restoring a Note lost in 03d4852658e1b7407abb4da84b1b03bfa6f6db3b) in the source. No changes to running code. - - - - - 7e0451c6 by Sergej Jaskiewicz at 2020-03-20T20:44:55-04:00 Fix event message in withTiming' This typo caused generating 'end' events without the corresponding 'begin' events. - - - - - 1542a626 by Ben Gamari at 2020-03-22T22:37:47-04:00 fs.h: Add missing declarations on Windows - - - - - 3bcf2ccd by Ben Gamari at 2020-03-22T22:37:47-04:00 Bump process submodule Avoids redundant case alternative warning. - - - - - 3b363ef9 by Ben Gamari at 2020-03-22T22:37:47-04:00 testsuite: Normalize slashes in ghc-api annotations output Enable `normalise_slashes` on `annotations`, `listcomps`, and `parseTree` to fix Windows failures. - - - - - 25fc9429 by Ben Gamari at 2020-03-22T22:37:47-04:00 testsuite: Update expected output on Windows - - - - - 7f58ec6d by Ben Gamari at 2020-03-22T22:37:47-04:00 testsuite: Fix TOP of T17786 - - - - - aadcd909 by GHC GitLab CI at 2020-03-22T22:37:47-04:00 testsuite: Update expected output on Windows - - - - - dc1eb10d by GHC GitLab CI at 2020-03-22T22:37:47-04:00 hadrian: Fix executable extension passed to testsuite driver - - - - - 58f62e2c by GHC GitLab CI at 2020-03-22T22:37:47-04:00 gitlab-ci: Require that Windows-hadrian job passes - - - - - 8dd2415d by Ben Gamari at 2020-03-22T22:37:47-04:00 hadrian: Eliminate redundant .exe from GHC path Previously we were invoking: bash -c "c:/GitLabRunner/builds/eEQrxK4p/0/ghc/ghc/toolchain/bin/ghc.exe.exe testsuite/mk/ghc-config.hs -o _build/test/bin/ghc-config.exe" - - - - - 373621f6 by Ben Gamari at 2020-03-22T22:37:47-04:00 Bump hsc2hs submodule - - - - - abc02b40 by Hécate at 2020-03-22T22:38:33-04:00 Annotate the non-total function in Data.Foldable as such - - - - - 19f12557 by Josef Svenningsson at 2020-03-23T14:05:33-04:00 Fix ApplicativeDo regression #17835 A previous fix for #15344 made sure that monadic 'fail' is used properly when translating ApplicativeDo. However, it didn't properly account for when a 'fail' will be inserted which resulted in some programs failing with a type error. - - - - - 2643ba46 by Paavo at 2020-03-24T08:31:32-04:00 Add example and doc for Arg (Fixes #17153) - - - - - 703221f4 by Roland Senn at 2020-03-25T14:45:04-04:00 Use export list of Main module in function TcRnDriver.hs:check_main (Fix #16453) - Provide the export list of the `Main` module as parameter to the `compiler/typecheck/TcRnDriver.hs:check_main` function. - Instead of `lookupOccRn_maybe` call the function `lookupInfoOccRn`. It returns the list `mains_all` of all the main functions in scope. - Select from this list `mains_all` all `main` functions that are in the export list of the `Main` module. - If this new list contains exactly one single `main` function, then typechecking continues. - Otherwise issue an appropriate error message. - - - - - 3e27205a by Sebastian Graf at 2020-03-25T14:45:40-04:00 Remove -fkill-absence and -fkill-one-shot flags They seem to be a benchmarking vestige of the Cardinality paper and probably shouldn't have been merged to HEAD in the first place. - - - - - 262e42aa by Peter Trommler at 2020-03-25T22:41:39-04:00 Do not panic on linker errors - - - - - 0de03cd7 by Sylvain Henry at 2020-03-25T22:42:02-04:00 DynFlags refactoring III Use Platform instead of DynFlags when possible: * `tARGET_MIN_INT` et al. replaced with `platformMinInt` et al. * no more DynFlags in PreRules: added a new `RuleOpts` datatype * don't use `wORD_SIZE` in the compiler * make `wordAlignment` use `Platform` * make `dOUBLE_SIZE` a constant Metric Decrease: T13035 T1969 - - - - - 7a04920b by Tristan Cacqueray at 2020-03-25T22:42:06-04:00 Base: fix a typo in liftA doc This change removes an extra '|' that should not be rendered in the liftA documentation. Tracking: #17929 - - - - - 1c5a15f7 by Tristan Cacqueray at 2020-03-25T22:42:06-04:00 Base: add Control.Applicative optional example This change adds an optional example. Tracking: #17929 - - - - - 6d172e63 by Tristan Cacqueray at 2020-03-25T22:42:06-04:00 Base: add markup around Except - - - - - eb2162c8 by John Ericson at 2020-03-26T12:37:08-04:00 Remove unused `ghciTablesNextToCode` from compiler proper - - - - - f51efc4b by Joachim Breitner at 2020-03-26T12:37:09-04:00 Prepare to use run-time tablesNextToCode in compiler exclusively Factor out CPP as much as possible to prepare for runtime determinattion. Progress towards #15548 - - - - - 1c446220 by Joachim Breitner at 2020-03-26T12:37:09-04:00 Use run-time tablesNextToCode in compiler exclusively (#15548) Summary: - There is no more use of the TABLES_NEXT_TO_CODE CPP macro in `compiler/`. GHCI_TABLES_NEXT_TO_CODE is also removed entirely. The field within `PlatformMisc` within `DynFlags` is used instead. - The field is still not exposed as a CLI flag. We might consider some way to ensure the right RTS / libraries are used before doing that. Original reviewers: Original subscribers: TerrorJack, rwbarton, carter Original Differential Revision: https://phabricator.haskell.org/D5082 - - - - - 1941ef4f by Sylvain Henry at 2020-03-29T17:28:51-04:00 Modules: Types (#13009) Update Haddock submodule Metric Increase: haddock.compiler - - - - - 1c7c6f1a by Sylvain Henry at 2020-03-29T17:28:51-04:00 Remove GHC.Types.Unique.Map module This module isn't used anywhere in GHC. - - - - - f1a6c73d by Sylvain Henry at 2020-03-29T17:28:51-04:00 Merge GHC.Types.CostCentre.Init into GHC.Driver.CodeOutput - - - - - 54250f2d by Simon Peyton Jones at 2020-03-29T17:29:30-04:00 Demand analysis: simplify the demand for a RHS Ticket #17932 showed that we were using a stupid demand for the RHS of a let-binding, when the result is a product. This was the result of a "fix" in 2013, which (happily) turns out to no longer be necessary. So I just deleted the code, which simplifies the demand analyser, and fixes #17932. That in turn uncovered that the anticipation of worker/wrapper in CPR analysis was inaccurate, hence the logic that decides whether to unbox an argument in WW was extracted into a function `wantToUnbox`, now consulted by CPR analysis. I tried nofib, and got 0.0% perf changes. All this came up when messing about with !2873 (ticket #17917), but is idependent of it. Unfortunately, this patch regresses #4267 and realised that it is now blocked on #16335. - - - - - 03060b2f by Ben Gamari at 2020-03-29T17:30:05-04:00 testsuite: Fix T17786 on Windows Fixes line ending normalization issue. - - - - - 1f7995ba by Ben Gamari at 2020-03-29T17:30:05-04:00 testsuite: Fix T17786 Fix missing quoting and expected exit code. - - - - - ef9c608e by Ben Gamari at 2020-03-29T17:30:05-04:00 testsuite: Mark T12971 as broken on Windows Due to #17945. - - - - - e54500c1 by Sylvain Henry at 2020-03-29T17:30:47-04:00 Store ComponentId details As far as GHC is concerned, installed package components ("units") are identified by an opaque ComponentId string provided by Cabal. But we don't want to display it to users (as it contains a hash) so GHC queries the database to retrieve some infos about the original source package (name, version, component name). This patch caches these infos in the ComponentId itself so that we don't need to provide DynFlags (which contains installed package informations) to print a ComponentId. In the future we want GHC to support several independent package states (e.g. for plugins and for target code), hence we need to avoid implicitly querying a single global package state. - - - - - 7e7cb714 by Marius Bakke at 2020-03-29T17:31:27-04:00 testsuite: Remove test that dlopens a PIE object. glibc 2.30 disallowed dlopening PIE objects, so just remove the test. Fixes #17952. - - - - - 6c8f80d8 by Andreas Klebinger at 2020-03-29T17:32:04-04:00 Correct haddocks for testBit in Data.Bits It conflated the nth bit with the bit at offset n. Now we instead give the definition in terms of `bit and `.&.` on top of clearer phrasing. - - - - - c916f190 by Andreas Klebinger at 2020-03-29T17:32:04-04:00 Apply suggestion to libraries/base/Data/Bits.hs - - - - - 64bf7f51 by Ben Gamari at 2020-03-29T17:32:41-04:00 gitlab-ci: Add FreeBSD release job - - - - - a0d8e92e by Ryan Scott at 2020-03-29T17:33:20-04:00 Run checkNewDataCon before constraint-solving newtype constructors Within `checkValidDataCon`, we used to run `checkValidType` on the argument types of a newtype constructor before running `checkNewDataCon`, which ensures that the user does not attempt non-sensical things such as newtypes with multiple arguments or constraints. This works out in most situations, but this falls over on a corner case revealed in #17955: ```hs newtype T = Coercible () T => T () ``` `checkValidType`, among other things, peforms an ambiguity check on the context of a data constructor, and that it turn invokes the constraint solver. It turns out that there is a special case in the constraint solver for representational equalities (read: `Coercible` constraints) that causes newtypes to be unwrapped (see `Note [Unwrap newtypes first]` in `TcCanonical`). This special case does not know how to cope with an ill formed newtype like `T`, so it ends up panicking. The solution is surprisingly simple: just invoke `checkNewDataCon` before `checkValidType` to ensure that the illicit newtype constructor context is detected before the constraint solver can run amok with it. Fixes #17955. - - - - - 45eb9d8c by Krzysztof Gogolewski at 2020-03-29T17:33:59-04:00 Minor cleanup - Simplify mkBuildExpr, the function newTyVars was called only on a one-element list. - TTG: use noExtCon in more places. This is more future-proof. - In zonkExpr, panic instead of printing a warning. - - - - - f024b6e3 by Sylvain Henry at 2020-03-30T12:48:39+02:00 Expect T4267 to pass Since 54250f2d8de910b094070c1b48f086030df634b1 we expected T4267 to fail, but it passes on CI. - - - - - 57b888c0 by Ryan Scott at 2020-03-31T10:54:20-04:00 Require GHC 8.8 as the minimum compiler for bootstrapping This allows us to remove several bits of CPP that are either always true or no longer reachable. As an added bonus, we no longer need to worry about importing `Control.Monad.Fail.fail` qualified to avoid clashing with `Control.Monad.fail`, since the latter is now the same as the former. - - - - - 33f09551 by Ryan Scott at 2020-03-31T10:54:57-04:00 Add regression test for #17963 The panic in #17963 happened to be fixed by commit e3c374cc5bd7eb49649b9f507f9f7740697e3f70. This patch adds a regression test to ensure that it remains fixed. Fixes #17963. - - - - - 09a36e80 by Ömer Sinan Ağacan at 2020-03-31T10:55:37-04:00 Simplify stderrSupportsAnsiColors The combinator andM is used only once, and the code is shorter and simpler if you inline it. - - - - - 95bccdd0 by Ben Gamari at 2020-03-31T10:56:19-04:00 base: Ensure that encoding global variables aren't inlined As noted in #17970, these (e.g. `getFileSystemEncoding` and `setFileSystemEncoding`) previously had unfoldings, which would break their global-ness. While not strictly necessary, I also add a NOINLINE on `initLocaleEncoding` since it is used in `System.IO`, ensuring that we only system's query the locale encoding once. Fixes #17970. - - - - - 982aaa83 by Andreas Klebinger at 2020-03-31T10:56:55-04:00 Update hadrian index revision. Required in order to build hadrian using ghc-8.10 - - - - - 4b9c5864 by Ben Gamari at 2020-03-31T10:57:32-04:00 integer-gmp: Bump version and add changelog entry - - - - - 9b39f2e6 by Ryan Scott at 2020-04-01T01:20:00-04:00 Clean up "Eta reduction for data families" Notes Before, there were two distinct Notes named "Eta reduction for data families". This renames one of them to "Implementing eta reduction for data families" to disambiguate the two and fixes references in other parts of the codebase to ensure that they are pointing to the right place. Fixes #17313. [ci skip] - - - - - 7627eab5 by Ryan Scott at 2020-04-01T01:20:38-04:00 Fix the changelog/@since information for hGetContents'/getContents'/readFile' Fixes #17979. [ci skip] - - - - - 0002db1b by Sylvain Henry at 2020-04-01T01:21:27-04:00 Kill wORDS_BIGENDIAN and replace it with platformByteOrder (#17957) Metric Decrease: T13035 T1969 - - - - - 7b217179 by Sebastian Graf at 2020-04-01T15:03:24-04:00 PmCheck: Adjust recursion depth for inhabitation test In #17977, we ran into the reduction depth limit of the typechecker. That was only a symptom of a much broader issue: The recursion depth of the coverage checker for trying to instantiate strict fields in the `nonVoid` test was far too high (100, the `defaultMaxTcBound`). As a result, we were performing quite poorly on `T17977`. Short of a proper termination analysis to prove emptyness of a type, we just arbitrarily default to a much lower recursion limit of 3. Fixes #17977. - - - - - 3c09f636 by Andreas Klebinger at 2020-04-01T15:03:59-04:00 Make hadrian pass on the no-colour setting to GHC. Fixes #17983. - - - - - b943b25d by Simon Peyton Jones at 2020-04-02T01:45:58-04:00 Re-engineer the binder-swap transformation The binder-swap transformation is implemented by the occurrence analyser -- see Note [Binder swap] in OccurAnal. However it had a very nasty corner in it, for the case where the case scrutinee was a GlobalId. This led to trouble and hacks, and ultimately to #16296. This patch re-engineers how the occurrence analyser implements the binder-swap, by actually carrying out a substitution rather than by adding a let-binding. It's all described in Note [The binder-swap substitution]. I did a few other things along the way * Fix a bug in StgCse, which could allow a loop breaker to be CSE'd away. See Note [Care with loop breakers] in StgCse. I think it can only show up if occurrence analyser sets up bad loop breakers, but still. * Better commenting in SimplUtils.prepareAlts * A little refactoring in CoreUnfold; nothing significant e.g. rename CoreUnfold.mkTopUnfolding to mkFinalUnfolding * Renamed CoreSyn.isFragileUnfolding to hasCoreUnfolding * Move mkRuleInfo to CoreFVs We observed respectively 4.6% and 5.9% allocation decreases for the following tests: Metric Decrease: T9961 haddock.base - - - - - 42d68364 by Sebastian Graf at 2020-04-02T01:46:34-04:00 Preserve precise exceptions in strictness analysis Fix #13380 and #17676 by 1. Changing `raiseIO#` to have `topDiv` instead of `botDiv` 2. Give it special treatment in `Simplifier.Util.mkArgInfo`, treating it as if it still had `botDiv`, to recover dead code elimination. This is the first commit of the plan outlined in https://gitlab.haskell.org/ghc/ghc/-/merge_requests/2525#note_260886. - - - - - 0a88dd11 by Ömer Sinan Ağacan at 2020-04-02T01:47:25-04:00 Fix a pointer format string in RTS - - - - - 5beac042 by Ömer Sinan Ağacan at 2020-04-02T01:48:05-04:00 Remove unused closure stg_IND_direct - - - - - 88f38b03 by Ben Gamari at 2020-04-02T01:48:42-04:00 Session: Memoize stderrSupportsAnsiColors Not only is this a reasonable efficiency measure but it avoids making reentrant calls into ncurses, which is not thread-safe. See #17922. - - - - - 27740f24 by Ryan Scott at 2020-04-02T01:49:21-04:00 Make Hadrian build with Cabal-3.2 GHC 8.10 ships with `Cabal-3.2.0.0`, so it would be convenient to make Hadrian supporting building against 3.2.* instead of having to rebuild the entirety of `Cabal-3.0.0.0`. There is one API change in `Cabal-3.2.*` that affects Hadrian: the `synopsis` and `description` functions now return `ShortText` instead of `String`. Since Hadrian manipulates these `String`s in various places, I found that the simplest fix was to use CPP to convert `ShortText` to `String`s where appropriate. - - - - - 49802002 by Sylvain Henry at 2020-04-02T01:50:00-04:00 Update Stack resolver for hadrian/build-stack Broken by 57b888c0e90be7189285a6b078c30b26d0923809 - - - - - 30a63e79 by Ryan Scott at 2020-04-02T01:50:36-04:00 Fix two ASSERT buglets in reifyDataCon Two `ASSERT`s in `reifyDataCon` were always using `arg_tys`, but `arg_tys` is not meaningful for GADT constructors. In fact, it's worse than non-meaningful, since using `arg_tys` when reifying a GADT constructor can lead to failed `ASSERT`ions, as #17305 demonstrates. This patch applies the simplest possible fix to the immediate problem. The `ASSERT`s now use `r_arg_tys` instead of `arg_tys`, as the former makes sure to give something meaningful for GADT constructors. This makes the panic go away at the very least. There is still an underlying issue with the way the internals of `reifyDataCon` work, as described in https://gitlab.haskell.org/ghc/ghc/issues/17305#note_227023, but we leave that as future work, since fixing the underlying issue is much trickier (see https://gitlab.haskell.org/ghc/ghc/issues/17305#note_227087). - - - - - ef7576c4 by Zubin Duggal at 2020-04-03T06:24:56-04:00 Add outputable instances for the types in GHC.Iface.Ext.Types, add -ddump-hie flag to dump pretty printed contents of the .hie file Metric Increase: hie002 Because of the regression on i386: compile_time/bytes allocated increased from i386-linux-deb9 baseline @ HEAD~10: Expected hie002 (normal) compile_time/bytes allocated: 583014888.0 +/-10% Lower bound hie002 (normal) compile_time/bytes allocated: 524713399 Upper bound hie002 (normal) compile_time/bytes allocated: 641316377 Actual hie002 (normal) compile_time/bytes allocated: 877986292 Deviation hie002 (normal) compile_time/bytes allocated: 50.6 % *** unexpected stat test failure for hie002(normal) - - - - - 9462452a by Andreas Klebinger at 2020-04-03T06:25:33-04:00 Improve and refactor StgToCmm codegen for DataCons. We now differentiate three cases of constructor bindings: 1)Bindings which we can "replace" with a reference to an existing closure. Reference the replacement closure when accessing the binding. 2)Bindings which we can "replace" as above. But we still generate a closure which will be referenced by modules importing this binding. 3)For any other binding generate a closure. Then reference it. Before this patch 1) did only apply to local bindings and we didn't do 2) at all. - - - - - a214d214 by Moritz Bruder at 2020-04-03T06:26:11-04:00 Add singleton to NonEmpty in libraries/base This adds a definition to construct a singleton non-empty list (Data.List.NonEmpty) according to issue #17851. - - - - - f7597aa0 by Sylvain Henry at 2020-04-03T06:26:54-04:00 Testsuite: measure compiler stats for T16190 We were mistakenly measuring program stats - - - - - a485c3c4 by Sylvain Henry at 2020-04-03T06:26:54-04:00 Move blob handling into StgToCmm Move handling of big literal strings from CmmToAsm to StgToCmm. It avoids the use of `sdocWithDynFlags` (cf #10143). We might need to move this handling even higher in the pipeline in the future (cf #17960): this patch will make it easier. - - - - - cc2918a0 by Sylvain Henry at 2020-04-03T06:26:54-04:00 Refactor CmmStatics In !2959 we noticed that there was some redundant code (in GHC.Cmm.Utils and GHC.Cmm.StgToCmm.Utils) used to deal with `CmmStatics` datatype (before SRT generation) and `RawCmmStatics` datatype (after SRT generation). This patch removes this redundant code by using a single GADT for (Raw)CmmStatics. - - - - - 9e60273d by Maxim Koltsov at 2020-04-03T06:27:32-04:00 Fix haddock formatting in Control.Monad.ST.Lazy.Imp.hs - - - - - 1b7e8a94 by Andreas Klebinger at 2020-04-03T06:28:08-04:00 Turn newlines into spaces for hadrian/ghci. The newlines break the command on windows. - - - - - 4291bdda by Simon Peyton Jones at 2020-04-03T06:28:44-04:00 Major improvements to the specialiser This patch is joint work of Alexis King and Simon PJ. It does some significant refactoring of the type-class specialiser. Main highlights: * We can specialise functions with types like f :: Eq a => a -> Ord b => b => blah where the classes aren't all at the front (#16473). Here we can correctly specialise 'f' based on a call like f @Int @Bool dEqInt x dOrdBool This change really happened in an earlier patch commit 2d0cf6252957b8980d89481ecd0b79891da4b14b Author: Sandy Maguire <sandy at sandymaguire.me> Date: Thu May 16 12:12:10 2019 -0400 work that this new patch builds directly on that work, and refactors it a bit. * We can specialise functions with implicit parameters (#17930) g :: (?foo :: Bool, Show a) => a -> String Previously we could not, but now they behave just like a non-class argument as in 'f' above. * We can specialise under-saturated calls, where some (but not all of the dictionary arguments are provided (#17966). For example, we can specialise the above 'f' based on a call map (f @Int dEqInt) xs even though we don't (and can't) give Ord dictionary. This may sound exotic, but #17966 is a program from the wild, and showed significant perf loss for functions like f, if you need saturation of all dictionaries. * We fix a buglet in which a floated dictionary had a bogus demand (#17810), by using zapIdDemandInfo in the NonRec case of specBind. * A tiny side benefit: we can drop dead arguments to specialised functions; see Note [Drop dead args from specialisations] * Fixed a bug in deciding what dictionaries are "interesting"; see Note [Keep the old dictionaries interesting] This is all achieved by by building on Sandy Macguire's work in defining SpecArg, which mkCallUDs uses to describe the arguments of the call. Main changes: * Main work is in specHeader, which marched down the [InBndr] from the function definition and the [SpecArg] from the call site, together. * specCalls no longer has an arity check; the entire mechanism now handles unders-saturated calls fine. * mkCallUDs decides on an argument-by-argument basis whether to specialise a particular dictionary argument; this is new. See mk_spec_arg in mkCallUDs. It looks as if there are many more lines of code, but I think that all the extra lines are comments! - - - - - 40a85563 by Ömer Sinan Ağacan at 2020-04-03T18:26:19+03:00 Revert accidental change in 9462452 [ci skip] - - - - - bd75e5da by Ryan Scott at 2020-04-04T07:07:58-04:00 Enable ImpredicativeTypes internally when typechecking selector bindings This is necessary for certain record selectors with higher-rank types, such as the examples in #18005. See `Note [Impredicative record selectors]` in `TcTyDecls`. Fixes #18005. - - - - - dcfe29c8 by Ömer Sinan Ağacan at 2020-04-06T13:16:08-04:00 Don't override proc CafInfos in ticky builds Fixes #17947 When we have a ticky label for a proc, IdLabels for the ticky counter and proc entry share the same Name. This caused overriding proc CafInfos with the ticky CafInfos (i.e. NoCafRefs) during SRT analysis. We now ignore the ticky labels when building SRTMaps. This makes sense because: - When building the current module they don't need to be in SRTMaps as they're initialized as non-CAFFY (see mkRednCountsLabel), so they don't take part in the dependency analysis and they're never added to SRTs. (Reminder: a "dependency" in the SRT analysis is a CAFFY dependency, non-CAFFY uses are not considered as dependencies for the algorithm) - They don't appear in the interfaces as they're not exported, so it doesn't matter for cross-module concerns whether they're in the SRTMap or not. See also the new Note [Ticky labels in SRT analysis]. - - - - - cec2c71f by Simon Peyton Jones at 2020-04-06T13:16:44-04:00 Fix an tricky specialiser loop Issue #17151 was a very tricky example of a bug in which the specialiser accidentally constructs a recurive dictionary, so that everything turns into bottom. I have fixed variants of this bug at least twice before: see Note [Avoiding loops]. It was a bit of a struggle to isolate the problem, greatly aided by the work that Alexey Kuleshevich did in distilling a test case. Once I'd understood the problem, it was not difficult to fix, though it did lead me a bit of refactoring in specImports. - - - - - e850d14f by Simon Peyton Jones at 2020-04-06T13:16:44-04:00 Refactoring only This refactors DictBinds into a data type rather than a pair. No change in behaviour, just better code - - - - - f38e8d61 by Daniel Gröber at 2020-04-07T02:00:05-04:00 rts: ProfHeap: Fix memory leak when not compiled with profiling If we're doing heap profiling on an unprofiled executable we keep allocating new space in initEra via nextEra on each profiler run but we don't have a corresponding freeEra call. We do free the last era in endHeapProfiling but previous eras will have been overwritten by initEra and will never get free()ed. Metric Decrease: space_leak_001 - - - - - bcd66859 by Sebastian Graf at 2020-04-07T02:00:41-04:00 Re-export GHC.Magic.noinline from base - - - - - 3d2991f8 by Ben Gamari at 2020-04-07T18:36:09-04:00 simplifier: Kill off ufKeenessFactor We used to have another factor, ufKeenessFactor, which would scale the discounts before they were subtracted from the size. This was justified with the following comment: -- We multiple the raw discounts (args_discount and result_discount) -- ty opt_UnfoldingKeenessFactor because the former have to do with -- *size* whereas the discounts imply that there's some extra -- *efficiency* to be gained (e.g. beta reductions, case reductions) -- by inlining. However, this is highly suspect since it means that we subtract a *scaled* size from an absolute size, resulting in crazy (e.g. negative) scores in some cases (#15304). We consequently killed off ufKeenessFactor and bumped up the ufUseThreshold to compensate. Adjustment of unfolding use threshold ===================================== Since this removes a discount from our inlining heuristic, I revisited our default choice of -funfolding-use-threshold to minimize the change in overall inlining behavior. Specifically, I measured runtime allocations and executable size of nofib and the testsuite performance tests built using compilers (and core libraries) built with several values of -funfolding-use-threshold. This comes as a result of a quantitative comparison of testsuite performance and code size as a function of ufUseThreshold, comparing GHC trees using values of 50, 60, 70, 80, 90, and 100. The test set consisted of nofib and the testsuite performance tests. A full summary of these measurements are found in the description of !2608 Comparing executable sizes (relative to the base commit) across all nofib tests, we see that sizes are similar to the baseline: gmean min max median thresh 50 -6.36% -7.04% -4.82% -6.46% 60 -5.04% -5.97% -3.83% -5.11% 70 -2.90% -3.84% -2.31% -2.92% 80 -0.75% -2.16% -0.42% -0.73% 90 +0.24% -0.41% +0.55% +0.26% 100 +1.36% +0.80% +1.64% +1.37% baseline +0.00% +0.00% +0.00% +0.00% Likewise, looking at runtime allocations we see that 80 gives slightly better optimisation than the baseline: gmean min max median thresh 50 +0.16% -0.16% +4.43% +0.00% 60 +0.09% -0.00% +3.10% +0.00% 70 +0.04% -0.09% +2.29% +0.00% 80 +0.02% -1.17% +2.29% +0.00% 90 -0.02% -2.59% +1.86% +0.00% 100 +0.00% -2.59% +7.51% -0.00% baseline +0.00% +0.00% +0.00% +0.00% Finally, I had to add a NOINLINE in T4306 to ensure that `upd` is worker-wrappered as the test expects. This makes me wonder whether the inlining heuristic is now too liberal as `upd` is quite a large function. The same measure was taken in T12600. Wall clock time compiling Cabal with -O0 thresh 50 60 70 80 90 100 baseline build-Cabal 93.88 89.58 92.59 90.09 100.26 94.81 89.13 Also, this change happens to avoid the spurious test output in `plugin-recomp-change` and `plugin-recomp-change-prof` (see #17308). Metric Decrease: hie002 T12234 T13035 T13719 T14683 T4801 T5631 T5642 T9020 T9872d T9961 Metric Increase: T12150 T12425 T13701 T14697 T15426 T1969 T3064 T5837 T6048 T9203 T9872a T9872b T9872c T9872d haddock.Cabal haddock.base haddock.compiler - - - - - 255418da by Sylvain Henry at 2020-04-07T18:36:49-04:00 Modules: type-checker (#13009) Update Haddock submodule - - - - - 04b6cf94 by Ryan Scott at 2020-04-07T19:43:20-04:00 Make NoExtCon fields strict This changes every unused TTG extension constructor to be strict in its field so that the pattern-match coverage checker is smart enough any such constructors are unreachable in pattern matches. This lets us remove nearly every use of `noExtCon` in the GHC API. The only ones we cannot remove are ones underneath uses of `ghcPass`, but that is only because GHC 8.8's and 8.10's coverage checkers weren't smart enough to perform this kind of reasoning. GHC HEAD's coverage checker, on the other hand, _is_ smart enough, so we guard these uses of `noExtCon` with CPP for now. Bumps the `haddock` submodule. Fixes #17992. - - - - - 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. - - - - - ce481361 by Ben Gamari at 2020-04-09T16:17:21-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. - - - - - fa66f143 by Ben Gamari at 2020-04-09T16:17:21-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. - - - - - 39075176 by Ömer Sinan Ağacan at 2020-04-09T16:18:00-04:00 Fix CNF handling in compacting GC Fixes #17937 Previously compacting GC simply ignored CNFs. This is mostly fine as most (see "What about small compacts?" below) CNF objects don't have outgoing pointers, and are "large" (allocated in large blocks) and large objects are not moved or compacted. However if we do GC *during* sharing-preserving compaction then the CNF will have a hash table mapping objects that have been moved to the CNF to their location in the CNF, to be able to preserve sharing. This case is handled in the copying collector, in `scavenge_compact`, where we evacuate hash table entries and then rehash the table. Compacting GC ignored this case. We now visit CNFs in all generations when threading pointers to the compacted heap and thread hash table keys. A visited CNF is added to the list `nfdata_chain`. After compaction is done, we re-visit the CNFs in that list and rehash the tables. The overhead is minimal: the list is static in `Compact.c`, and link field is added to `StgCompactNFData` closure. Programs that don't use CNFs should not be affected. To test this CNF tests are now also run in a new way 'compacting_gc', which just passes `-c` to the RTS, enabling compacting GC for the oldest generation. Before this patch the result would be: Unexpected failures: compact_gc.run compact_gc [bad exit code (139)] (compacting_gc) compact_huge_array.run compact_huge_array [bad exit code (1)] (compacting_gc) With this patch all tests pass. I can also pass `-c -DS` without any failures. What about small compacts? Small CNFs are still not handled by the compacting GC. However so far I'm unable to write a test that triggers a runtime panic ("update_fwd: unknown/strange object") by allocating a small CNF in a compated heap. It's possible that I'm missing something and it's not possible to have a small CNF. NoFib Results: -------------------------------------------------------------------------------- Program Size Allocs Instrs Reads Writes -------------------------------------------------------------------------------- CS +0.1% 0.0% 0.0% +0.0% +0.0% CSD +0.1% 0.0% 0.0% 0.0% 0.0% FS +0.1% 0.0% 0.0% 0.0% 0.0% S +0.1% 0.0% 0.0% 0.0% 0.0% VS +0.1% 0.0% 0.0% 0.0% 0.0% VSD +0.1% 0.0% +0.0% +0.0% -0.0% VSM +0.1% 0.0% +0.0% -0.0% 0.0% anna +0.0% 0.0% -0.0% -0.0% -0.0% ansi +0.1% 0.0% +0.0% +0.0% +0.0% atom +0.1% 0.0% +0.0% +0.0% +0.0% awards +0.1% 0.0% +0.0% +0.0% +0.0% banner +0.1% 0.0% +0.0% +0.0% +0.0% bernouilli +0.1% 0.0% 0.0% -0.0% +0.0% binary-trees +0.1% 0.0% -0.0% -0.0% 0.0% boyer +0.1% 0.0% +0.0% +0.0% +0.0% boyer2 +0.1% 0.0% +0.0% +0.0% +0.0% bspt +0.1% 0.0% -0.0% -0.0% -0.0% cacheprof +0.1% 0.0% -0.0% -0.0% -0.0% calendar +0.1% 0.0% +0.0% +0.0% +0.0% cichelli +0.1% 0.0% +0.0% +0.0% +0.0% circsim +0.1% 0.0% +0.0% +0.0% +0.0% clausify +0.1% 0.0% -0.0% +0.0% +0.0% comp_lab_zift +0.1% 0.0% +0.0% +0.0% +0.0% compress +0.1% 0.0% +0.0% +0.0% 0.0% compress2 +0.1% 0.0% -0.0% 0.0% 0.0% constraints +0.1% 0.0% +0.0% +0.0% +0.0% cryptarithm1 +0.1% 0.0% +0.0% +0.0% +0.0% cryptarithm2 +0.1% 0.0% +0.0% +0.0% +0.0% cse +0.1% 0.0% +0.0% +0.0% +0.0% digits-of-e1 +0.1% 0.0% +0.0% -0.0% -0.0% digits-of-e2 +0.1% 0.0% -0.0% -0.0% -0.0% dom-lt +0.1% 0.0% +0.0% +0.0% +0.0% eliza +0.1% 0.0% +0.0% +0.0% +0.0% event +0.1% 0.0% +0.0% +0.0% +0.0% exact-reals +0.1% 0.0% +0.0% +0.0% +0.0% exp3_8 +0.1% 0.0% +0.0% -0.0% 0.0% expert +0.1% 0.0% +0.0% +0.0% +0.0% fannkuch-redux +0.1% 0.0% -0.0% 0.0% 0.0% fasta +0.1% 0.0% -0.0% +0.0% +0.0% fem +0.1% 0.0% -0.0% +0.0% 0.0% fft +0.1% 0.0% -0.0% +0.0% +0.0% fft2 +0.1% 0.0% +0.0% +0.0% +0.0% fibheaps +0.1% 0.0% +0.0% +0.0% +0.0% fish +0.1% 0.0% +0.0% +0.0% +0.0% fluid +0.0% 0.0% +0.0% +0.0% +0.0% fulsom +0.1% 0.0% -0.0% +0.0% 0.0% gamteb +0.1% 0.0% +0.0% +0.0% 0.0% gcd +0.1% 0.0% +0.0% +0.0% +0.0% gen_regexps +0.1% 0.0% -0.0% +0.0% 0.0% genfft +0.1% 0.0% +0.0% +0.0% +0.0% gg +0.1% 0.0% 0.0% +0.0% +0.0% grep +0.1% 0.0% -0.0% +0.0% +0.0% hidden +0.1% 0.0% +0.0% -0.0% 0.0% hpg +0.1% 0.0% -0.0% -0.0% -0.0% ida +0.1% 0.0% +0.0% +0.0% +0.0% infer +0.1% 0.0% +0.0% 0.0% -0.0% integer +0.1% 0.0% +0.0% +0.0% +0.0% integrate +0.1% 0.0% -0.0% -0.0% -0.0% k-nucleotide +0.1% 0.0% +0.0% +0.0% 0.0% kahan +0.1% 0.0% +0.0% +0.0% +0.0% knights +0.1% 0.0% -0.0% -0.0% -0.0% lambda +0.1% 0.0% +0.0% +0.0% -0.0% last-piece +0.1% 0.0% +0.0% 0.0% 0.0% lcss +0.1% 0.0% +0.0% +0.0% 0.0% life +0.1% 0.0% -0.0% +0.0% +0.0% lift +0.1% 0.0% +0.0% +0.0% +0.0% linear +0.1% 0.0% -0.0% +0.0% 0.0% listcompr +0.1% 0.0% +0.0% +0.0% +0.0% listcopy +0.1% 0.0% +0.0% +0.0% +0.0% maillist +0.1% 0.0% +0.0% -0.0% -0.0% mandel +0.1% 0.0% +0.0% +0.0% 0.0% mandel2 +0.1% 0.0% +0.0% +0.0% +0.0% mate +0.1% 0.0% +0.0% 0.0% +0.0% minimax +0.1% 0.0% -0.0% 0.0% -0.0% mkhprog +0.1% 0.0% +0.0% +0.0% +0.0% multiplier +0.1% 0.0% +0.0% 0.0% 0.0% n-body +0.1% 0.0% +0.0% +0.0% +0.0% nucleic2 +0.1% 0.0% +0.0% +0.0% +0.0% para +0.1% 0.0% 0.0% +0.0% +0.0% paraffins +0.1% 0.0% +0.0% -0.0% 0.0% parser +0.1% 0.0% -0.0% -0.0% -0.0% parstof +0.1% 0.0% +0.0% +0.0% +0.0% pic +0.1% 0.0% -0.0% -0.0% 0.0% pidigits +0.1% 0.0% +0.0% -0.0% -0.0% power +0.1% 0.0% +0.0% +0.0% +0.0% pretty +0.1% 0.0% -0.0% -0.0% -0.1% primes +0.1% 0.0% -0.0% -0.0% -0.0% primetest +0.1% 0.0% -0.0% -0.0% -0.0% prolog +0.1% 0.0% -0.0% -0.0% -0.0% puzzle +0.1% 0.0% -0.0% -0.0% -0.0% queens +0.1% 0.0% +0.0% +0.0% +0.0% reptile +0.1% 0.0% -0.0% -0.0% +0.0% reverse-complem +0.1% 0.0% +0.0% 0.0% -0.0% rewrite +0.1% 0.0% -0.0% -0.0% -0.0% rfib +0.1% 0.0% +0.0% +0.0% +0.0% rsa +0.1% 0.0% -0.0% +0.0% -0.0% scc +0.1% 0.0% -0.0% -0.0% -0.1% sched +0.1% 0.0% +0.0% +0.0% +0.0% scs +0.1% 0.0% +0.0% +0.0% +0.0% simple +0.1% 0.0% -0.0% -0.0% -0.0% solid +0.1% 0.0% +0.0% +0.0% +0.0% sorting +0.1% 0.0% -0.0% -0.0% -0.0% spectral-norm +0.1% 0.0% +0.0% +0.0% +0.0% sphere +0.1% 0.0% -0.0% -0.0% -0.0% symalg +0.1% 0.0% -0.0% -0.0% -0.0% tak +0.1% 0.0% +0.0% +0.0% +0.0% transform +0.1% 0.0% +0.0% +0.0% +0.0% treejoin +0.1% 0.0% +0.0% -0.0% -0.0% typecheck +0.1% 0.0% +0.0% +0.0% +0.0% veritas +0.0% 0.0% +0.0% +0.0% +0.0% wang +0.1% 0.0% 0.0% +0.0% +0.0% wave4main +0.1% 0.0% +0.0% +0.0% +0.0% wheel-sieve1 +0.1% 0.0% +0.0% +0.0% +0.0% wheel-sieve2 +0.1% 0.0% +0.0% +0.0% +0.0% x2n1 +0.1% 0.0% +0.0% +0.0% +0.0% -------------------------------------------------------------------------------- Min +0.0% 0.0% -0.0% -0.0% -0.1% Max +0.1% 0.0% +0.0% +0.0% +0.0% Geometric Mean +0.1% -0.0% -0.0% -0.0% -0.0% Bumping numbers of nonsensical perf tests: Metric Increase: T12150 T12234 T12425 T13035 T5837 T6048 It's simply not possible for this patch to increase allocations, and I've wasted enough time on these test in the past (see #17686). I think these tests should not be perf tests, but for now I'll bump the numbers. - - - - - dce50062 by Sylvain Henry at 2020-04-09T16:18:44-04:00 Rts: show errno on failure (#18033) - - - - - 045139f4 by Hécate at 2020-04-09T23:10:44-04:00 Add an example to liftIO and explain its purpose - - - - - 101fab6e by Sebastian Graf at 2020-04-09T23:11:21-04:00 Special case `isConstraintKindCon` on `AlgTyCon` Previously, the `tyConUnique` record selector would unfold into a huge case expression that would be inlined in all call sites, such as the `INLINE`-annotated `coreView`, see #18026. `constraintKindTyConKey` only occurs as the `Unique` of an `AlgTyCon` anyway, so we can make the code a lot more compact, but have to move it to GHC.Core.TyCon. Metric Decrease: T12150 T12234 - - - - - f5212dfc by Sebastian Graf at 2020-04-09T23:11:57-04:00 DmdAnal: No need to attach a StrictSig to DataCon workers In GHC.Types.Id.Make we were giving a strictness signature to every data constructor wrapper Id that we weren't looking at in demand analysis anyway. We used to use its CPR info, but that has its own CPR signature now. `Note [Data-con worker strictness]` then felt very out of place, so I moved it to GHC.Core.DataCon. - - - - - 75a185dc by Sylvain Henry at 2020-04-09T23:12:37-04:00 Hadrian: fix --summary - - - - - 723062ed by Ömer Sinan Ağacan at 2020-04-10T09:18:14+03:00 testsuite: Move no_lint to the top level, tweak hie002 - We don't want to benchmark linting so disable lints in hie002 perf test - Move no_lint to the top-level to be able to use it in tests other than those in `testsuite/tests/perf/compiler`. - Filter out -dstg-lint in no_lint. - hie002 allocation numbers on 32-bit are unstable, so skip it on 32-bit Metric Decrease: hie002 ManyConstructors T12150 T12234 T13035 T1969 T4801 T9233 T9961 - - - - - bcafaa82 by Peter Trommler at 2020-04-10T19:29:33-04:00 Testsuite: mark T11531 fragile The test depends on a link editor allowing undefined symbols in an ELF shared object. This is the standard but it seems some distributions patch their link editor. See the report by @hsyl20 in #11531. Fixes #11531 - - - - - 0889f5ee by Takenobu Tani at 2020-04-12T11:44:52+09:00 testsuite: Fix comment for a language extension [skip ci] - - - - - cd4f92b5 by Simon Peyton Jones at 2020-04-12T11:20:58-04:00 Significant refactor of Lint This refactoring of Lint was triggered by #17923, which is fixed by this patch. The main change is this. Instead of lintType :: Type -> LintM LintedKind we now have lintType :: Type -> LintM LintedType Previously, all of typeKind was effectively duplicate in lintType. Moreover, since we have an ambient substitution, we still had to apply the substition here and there, sometimes more than once. It was all very tricky, in the end, and made my head hurt. Now, lintType returns a fully linted type, with all substitutions performed on it. This is much simpler. The same thing is needed for Coercions. Instead of lintCoercion :: OutCoercion -> LintM (LintedKind, LintedKind, LintedType, LintedType, Role) we now have lintCoercion :: Coercion -> LintM LintedCoercion Much simpler! The code is shorter and less bug-prone. There are a lot of knock on effects. But life is now better. Metric Decrease: T1969 - - - - - 0efaf301 by Josh Meredith at 2020-04-12T11:21:34-04:00 Implement extensible interface files - - - - - 54ca66a7 by Ryan Scott at 2020-04-12T11:22:10-04:00 Use conLikeUserTyVarBinders to quantify field selector types This patch: 1. Writes up a specification for how the types of top-level field selectors should be determined in a new section of the GHC User's Guide, and 2. Makes GHC actually implement that specification by using `conLikeUserTyVarBinders` in `mkOneRecordSelector` to preserve the order and specificity of type variables written by the user. Fixes #18023. - - - - - 35799dda by Ben Gamari at 2020-04-12T11:22:50-04:00 hadrian: Don't --export-dynamic on Darwin When fixing #17962 I neglected to consider that --export-dynamic is only supported on ELF platforms. - - - - - e8029816 by Alexis King at 2020-04-12T11:23:27-04:00 Add an INLINE pragma to Control.Category.>>> This fixes #18013 by adding INLINE pragmas to both Control.Category.>>> and GHC.Desugar.>>>. The functional change in this patch is tiny (just two lines of pragmas!), but an accompanying Note explains in gory detail what’s going on. - - - - - 0da186c1 by Krzysztof Gogolewski at 2020-04-14T07:55:20-04:00 Change zipWith to zipWithEqual in a few places - - - - - 074c1ccd by Andreas Klebinger at 2020-04-14T07:55:55-04:00 Small change to the windows ticker. We already have a function to go from time to ms so use it. Also expand on the state of timer resolution. - - - - - b69cc884 by Alp Mestanogullari at 2020-04-14T07:56:38-04:00 hadrian: get rid of unnecessary levels of nesting in source-dist - - - - - d0c3b069 by Julien Debon at 2020-04-14T07:57:16-04:00 doc (Foldable): Add examples to Data.Foldable See #17929 - - - - - 5b08e0c0 by Ben Gamari at 2020-04-14T23:28:20-04:00 StgCRun: Enable unwinding only on Linux It's broken on macOS due and SmartOS due to assembler differences (#15207) so let's be conservative in enabling it. Also, refactor things to make the intent clearer. - - - - - 27cc2e7b by Ben Gamari at 2020-04-14T23:28:57-04:00 rts: Don't mark evacuate_large as inline This function has two callsites and is quite large. GCC consequently decides not to inline and warns instead. Given the situation, I can't blame it. Let's just remove the inline specifier. - - - - - 9853fc5e by Ben Gamari at 2020-04-14T23:29:48-04:00 base: Enable large file support for OFD locking impl. Not only is this a good idea in general but this should also avoid issue #17950 by ensuring that off_t is 64-bits. - - - - - 7b41f21b by Matthew Pickering at 2020-04-14T23:30:24-04:00 Hadrian: Make -i paths absolute The primary reason for this change is that ghcide does not work with relative paths. It also matches what cabal and stack do, they always pass absolute paths. - - - - - 41230e26 by Daniel Gröber at 2020-04-14T23:31:01-04:00 Zero out pinned block alignment slop when profiling The heap profiler currently cannot traverse pinned blocks because of alignment slop. This used to just be a minor annoyance as the whole block is accounted into a special cost center rather than the respective object's CCS, cf. #7275. However for the new root profiler we would like to be able to visit _every_ closure on the heap. We need to do this so we can get rid of the current 'flip' bit hack in the heap traversal code. Since info pointers are always non-zero we can in principle skip all the slop in the profiler if we can rely on it being zeroed. This assumption caused problems in the past though, commit a586b33f8e ("rts: Correct handling of LARGE ARR_WORDS in LDV profiler"), part of !1118, tried to use the same trick for BF_LARGE objects but neglected to take into account that shrink*Array# functions don't ensure that slop is zeroed when not compiling with profiling. Later, commit 0c114c6599 ("Handle large ARR_WORDS in heap census (fix as we will only be assuming slop is zeroed when profiling is on. This commit also reduces the ammount of slop we introduce in the first place by calculating the needed alignment before doing the allocation for small objects where we know the next available address. For large objects we don't know how much alignment we'll have to do yet since those details are hidden behind the allocateMightFail function so there we continue to allocate the maximum additional words we'll need to do the alignment. So we don't have to duplicate all this logic in the cmm code we pull it into the RTS allocatePinned function instead. Metric Decrease: T7257 haddock.Cabal haddock.base - - - - - 15fa9bd6 by Daniel Gröber at 2020-04-14T23:31:01-04:00 rts: Expand and add more notes regarding slop - - - - - caf3f444 by Daniel Gröber at 2020-04-14T23:31:01-04:00 rts: allocatePinned: Fix confusion about word/byte units - - - - - c3c0f662 by Daniel Gröber at 2020-04-14T23:31:01-04:00 rts: Underline some Notes as is conventional - - - - - e149dea9 by Daniel Gröber at 2020-04-14T23:31:38-04:00 rts: Fix nomenclature in OVERWRITING_CLOSURE macros The additional commentary introduced by commit 8916e64e5437 ("Implement shrinkSmallMutableArray# and resizeSmallMutableArray#.") unfortunately got this wrong. We set 'prim' to true in overwritingClosureOfs because we _don't_ want to call LDV_recordDead(). The reason is because of this "inherently used" distinction made in the LDV profiler so I rename the variable to be more appropriate. - - - - - 1dd3d18c by Daniel Gröber at 2020-04-14T23:31:38-04:00 Remove call to LDV_RECORD_CREATE for array resizing - - - - - 19de2fb0 by Daniel Gröber at 2020-04-14T23:31:38-04:00 rts: Assert LDV_recordDead is not called for inherently used closures The comments make it clear LDV_recordDead should not be called for inhererently used closures, so add an assertion to codify this fact. - - - - - 0b934e30 by Ryan Scott at 2020-04-14T23:32:14-04:00 Bump template-haskell version to 2.17.0.0 This requires bumping the `exceptions` and `text` submodules to bring in commits that bump their respective upper version bounds on `template-haskell`. Fixes #17645. Fixes #17696. Note that the new `text` commit includes a fair number of additions to the Haddocks in that library. As a result, Haddock has to do more work during the `haddock.Cabal` test case, increasing the number of allocations it requires. Therefore, ------------------------- Metric Increase: haddock.Cabal ------------------------- - - - - - 22cc8e51 by Ryan Scott at 2020-04-15T17:48:47-04:00 Fix #18052 by using pprPrefixOcc in more places This fixes several small oversights in the choice of pretty-printing function to use. Fixes #18052. - - - - - ec77b2f1 by Daniel Gröber at 2020-04-15T17:49:24-04:00 rts: ProfHeap: Fix wrong time in last heap profile sample We've had this longstanding issue in the heap profiler, where the time of the last sample in the profile is sometimes way off causing the rendered graph to be quite useless for long runs. It seems to me the problem is that we use mut_user_time() for the last sample as opposed to getRTSStats(), which we use when calling heapProfile() in GC.c. The former is equivalent to getProcessCPUTime() but the latter does some additional stuff: getProcessCPUTime() - end_init_cpu - stats.gc_cpu_ns - stats.nonmoving_gc_cpu_ns So to fix this just use getRTSStats() in both places. - - - - - 85fc32f0 by Sylvain Henry at 2020-04-17T12:45:25-04:00 Hadrian: fix dyn_o/dyn_hi rule (#17534) - - - - - bfde3b76 by Ryan Scott at 2020-04-17T12:46:02-04:00 Fix #18065 by fixing an InstCo oversight in Core Lint There was a small thinko in Core Lint's treatment of `InstCo` coercions that ultimately led to #18065. The fix: add an apostrophe. That's it! Fixes #18065. Co-authored-by: Simon Peyton Jones <simonpj at microsoft.com> - - - - - a05348eb by Cale Gibbard at 2020-04-17T13:08:47-04:00 Change the fail operator argument of BindStmt to be a Maybe Don't use noSyntaxExpr for it. There is no good way to defensively case on that, nor is it clear one ought to do so. - - - - - 79e27144 by John Ericson at 2020-04-17T13:08:47-04:00 Use trees that grow for rebindable operators for `<-` binds Also add more documentation. - - - - - 18bc16ed by Cale Gibbard at 2020-04-17T13:08:47-04:00 Use FailOperator in more places, define a couple datatypes (XBindStmtRn and XBindStmtTc) to help clarify the meaning of XBindStmt in the renamer and typechecker - - - - - 84cc8394 by Simon Peyton Jones at 2020-04-18T13:20:29-04:00 Add a missing zonk in tcHsPartialType I omitted a vital zonk when refactoring tcHsPartialType in commit 48fb3482f8cbc8a4b37161021e846105f980eed4 Author: Simon Peyton Jones <simonpj at microsoft.com> Date: Wed Jun 5 08:55:17 2019 +0100 Fix typechecking of partial type signatures This patch fixes it and adds commentary to explain why. Fixes #18008 - - - - - 2ee96ac1 by Ben Gamari at 2020-04-18T13:21:05-04:00 gitlab-ci: Bump FreeBSD bootstrap compiler to 8.10.1 - - - - - 434312e5 by Ben Gamari at 2020-04-18T13:21:05-04:00 gitlab-ci: Enable FreeBSD job for so-labelled MRs - - - - - ddffb227 by Ben Gamari at 2020-04-18T13:21:05-04:00 gitlab-ci: Use rules syntax for conditional jobs - - - - - e2586828 by Ben Gamari at 2020-04-18T13:21:05-04:00 Bump hsc2hs submodule - - - - - 15ab6cd5 by Ömer Sinan Ağacan at 2020-04-18T13:21:44-04:00 Improve prepForeignCall error reporting Show parameters and description of the error code when ffi_prep_cif fails. This may be helpful for debugging #17018. - - - - - 3ca52151 by Sylvain Henry at 2020-04-18T20:04:14+02:00 GHC.Core.Opt renaming * GHC.Core.Op => GHC.Core.Opt * GHC.Core.Opt.Simplify.Driver => GHC.Core.Opt.Driver * GHC.Core.Opt.Tidy => GHC.Core.Tidy * GHC.Core.Opt.WorkWrap.Lib => GHC.Core.Opt.WorkWrap.Utils As discussed in: * https://mail.haskell.org/pipermail/ghc-devs/2020-April/018758.html * https://gitlab.haskell.org/ghc/ghc/issues/13009#note_264650 - - - - - 15312bbb by Sylvain Henry at 2020-04-18T20:04:46+02:00 Modules (#13009) * SysTools * Parser * GHC.Builtin * GHC.Iface.Recomp * Settings Update Haddock submodule Metric Decrease: Naperian parsing001 - - - - - eaed0a32 by Alexis King at 2020-04-19T03:16:44-04:00 Add missing addInScope call for letrec binders in OccurAnal This fixes #18044, where a shadowed variable was incorrectly substituted by the binder swap on the RHS of a floated-in letrec. This can only happen when the uniques line up *just* right, so writing a regression test would be very difficult, but at least the fix is small and straightforward. - - - - - 36882493 by Shayne Fletcher at 2020-04-20T04:36:43-04:00 Derive Ord instance for Extension Metric Increase: T12150 T12234 - - - - - b43365ad by Simon Peyton Jones at 2020-04-20T04:37:20-04:00 Fix a buglet in redundant-constraint warnings Ticket #18036 pointed out that we were reporting a redundant constraint when it really really wasn't. Turned out to be a buglet in the SkolemInfo for the relevant implication constraint. Easily fixed! - - - - - d5fae7da by Ömer Sinan Ağacan at 2020-04-20T14:39:28-04:00 Mark T12010 fragile on 32-bit - - - - - bca02fca by Adam Sandberg Ericsson at 2020-04-21T06:38:45-04:00 docs: drop note about not supporting shared libraries on unix systems [skip ci] - - - - - 6655f933 by Sylvain Henry at 2020-04-21T06:39:32-04:00 Use ParserFlags in GHC.Runtime.Eval (#17957) Instead of passing `DynFlags` to functions such as `isStmt` and `hasImport` in `GHC.Runtime.Eval` we pass `ParserFlags`. It's a much simpler structure that can be created purely with `mkParserFlags'`. - - - - - 70be0fbc by Sylvain Henry at 2020-04-21T06:39:32-04:00 GHC.Runtime: avoid DynFlags (#17957) * add `getPlatform :: TcM Platform` helper * remove unused `DynFlags` parameter from `emptyPLS` - - - - - 35e43d48 by Sylvain Henry at 2020-04-21T06:39:32-04:00 Avoid DynFlags in Ppr code (#17957) * replace `DynFlags` parameters with `SDocContext` parameters for a few Ppr related functions: `bufLeftRenderSDoc`, `printSDoc`, `printSDocLn`, `showSDocOneLine`. * remove the use of `pprCols :: DynFlags -> Int` in Outputable. We already have the information via `sdocLineLength :: SDocContext -> Int` - - - - - ce5c2999 by Sylvain Henry at 2020-04-21T06:39:32-04:00 Avoid using sdocWithDynFlags (#17957) Remove one use of `sdocWithDynFlags` from `GHC.CmmToLlvm.llvmCodeGen'` and from `GHC.Driver.CodeOutput.profilingInitCode` - - - - - f2a98996 by Sylvain Henry at 2020-04-21T06:39:32-04:00 Avoid `sdocWithDynFlags` in `pprCLbl` (#17957) * add a `DynFlags` parameter to `pprCLbl` * put `maybe_underscore` and `pprAsmCLbl` in a `where` clause to avoid `DynFlags` parameters - - - - - 747093b7 by Sylvain Henry at 2020-04-21T06:39:32-04:00 CmmToAsm DynFlags refactoring (#17957) * Remove `DynFlags` parameter from `isDynLinkName`: `isDynLinkName` used to test the global `ExternalDynamicRefs` flag. Now we test it outside of `isDynLinkName` * Add new fields into `NCGConfig`: current unit id, sse/bmi versions, externalDynamicRefs, etc. * Replace many uses of `DynFlags` by `NCGConfig` * Moved `BMI/SSE` datatypes into `GHC.Platform` - - - - - ffd7eef2 by Takenobu Tani at 2020-04-22T23:09:50-04:00 stg-spec: Modify file paths according to new module hierarchy This patch updates file paths according to new module hierarchy [1]: * GHC/Stg/Syntax.hs <= stgSyn/StgSyn.hs * GHC/Types/Literal.hs <= basicTypes/Literal.hs * GHC/Types/CostCentre.hs <= profiling/CostCentre.hs This patch also updates old file path [2]: * utils/genapply/Main.hs <= utils/genapply/GenApply.hs [1]: https://gitlab.haskell.org/ghc/ghc/-/wikis/Make-GHC-codebase-more-modular [2]: commit 0cc4aad36f [skip ci] - - - - - e8a5d81b by Jonathan DK Gibbons at 2020-04-22T23:10:28-04:00 Refactor the `MatchResult` type in the desugarer This way, it does a better job of proving whether or not the fail operator is used. - - - - - dcb7fe5a by John Ericson at 2020-04-22T23:10:28-04:00 Remove panic in dsHandleMonadicFailure Rework dsHandleMonadicFailure to be correct by construction instead of using an unreachable panic. - - - - - cde23cd4 by John Ericson at 2020-04-22T23:10:28-04:00 Inline `adjustMatchResult` It is just `fmap` - - - - - 72cb6bcc by John Ericson at 2020-04-22T23:10:28-04:00 Generalize type of `matchCanFail` - - - - - 401f7bb3 by John Ericson at 2020-04-22T23:10:28-04:00 `MatchResult'` -> `MatchResult` Inline `MatchResult` alias accordingly. - - - - - 6c9fae23 by Alexis King at 2020-04-22T23:11:12-04:00 Mark DataCon wrappers CONLIKE Now that DataCon wrappers don’t inline until phase 0 (see commit b78cc64e923716ac0512c299f42d4d0012306c05), it’s important that case-of-known-constructor and RULE matching be able to see saturated applications of DataCon wrappers in unfoldings. Making them conlike is a natural way to do it, since they are, in fact, precisely the sort of thing the CONLIKE pragma exists to solve. Fixes #18012. This also bumps the version of the parsec submodule to incorporate a patch that avoids a metric increase on the haddock perf tests. The increase was not really a flaw in this patch, as parsec was implicitly relying on inlining heuristics. The patch to parsec just adds some INLINABLE pragmas, and we get a nice performance bump out of it (well beyond the performance we lost from this patch). Metric Decrease: T12234 WWRec haddock.Cabal haddock.base haddock.compiler - - - - - 48b8951e by Roland Senn at 2020-04-22T23:11:51-04:00 Fix tab-completion for :break (#17989) In tab-completion for the `:break` command, only those identifiers should be shown, that are accepted in the `:break` command. Hence these identifiers must be - defined in an interpreted module - top-level - currently in scope - listed in a `ModBreaks` value as a possible breakpoint. The identifiers my be qualified or unqualified. To get all possible top-level breakpoints for tab-completeion with the correct qualification do: 1. Build the list called `pifsBreaks` of all pairs of (Identifier, module-filename) from the `ModBreaks` values. Here all identifiers are unqualified. 2. Build the list called `pifInscope` of all pairs of (Identifiers, module-filename) with identifiers from the `GlobalRdrEnv`. Take only those identifiers that are in scope and have the correct prefix. Here the identifiers may be qualified. 3. From the `pifInscope` list seclect all pairs that can be found in the `pifsBreaks` list, by comparing only the unqualified part of the identifier. The remaining identifiers can be used for tab-completion. This ensures, that we show only identifiers, that can be used in a `:break` command. - - - - - 34a45ee6 by Peter Trommler at 2020-04-22T23:12:27-04:00 PPC NCG: Add DWARF constants and debug labels Fixes #11261 - - - - - ffde2348 by Simon Peyton Jones at 2020-04-22T23:13:06-04:00 Do eager instantation in terms This patch implements eager instantiation, a small but critical change to the type inference engine, #17173. The main change is this: When inferring types, always return an instantiated type (for now, deeply instantiated; in future shallowly instantiated) There is more discussion in https://www.tweag.io/posts/2020-04-02-lazy-eager-instantiation.html There is quite a bit of refactoring in this patch: * The ir_inst field of GHC.Tc.Utils.TcType.InferResultk has entirely gone. So tcInferInst and tcInferNoInst have collapsed into tcInfer. * Type inference of applications, via tcInferApp and tcInferAppHead, are substantially refactored, preparing the way for Quick Look impredicativity. * New pure function GHC.Tc.Gen.Expr.collectHsArgs and applyHsArgs are beatifully dual. We can see the zipper! * GHC.Tc.Gen.Expr.tcArgs is now much nicer; no longer needs to return a wrapper * In HsExpr, HsTypeApp now contains the the actual type argument, and is used in desugaring, rather than putting it in a mysterious wrapper. * I struggled a bit with good error reporting in Unify.matchActualFunTysPart. It's a little bit simpler than before, but still not great. Some smaller things * Rename tcPolyExpr --> tcCheckExpr tcMonoExpr --> tcLExpr * tcPatSig moves from GHC.Tc.Gen.HsType to GHC.Tc.Gen.Pat Metric Decrease: T9961 Reduction of 1.6% in comiler allocation on T9961, I think. - - - - - 6f84aca3 by Ben Gamari at 2020-04-22T23:13:43-04:00 rts: Ensure that sigaction structs are initialized I noticed these may have uninitialized fields when looking into #18037. The reporter says that zeroing them doesn't fix the MSAN failures they observe but zeroing them is the right thing to do regardless. - - - - - c29f0fa6 by Andreas Klebinger at 2020-04-22T23:14:21-04:00 Add "ddump-cmm-opt" as alias for "ddump-opt-cmm". - - - - - 4b4a8b60 by Ben Gamari at 2020-04-22T23:14:57-04:00 llvmGen: Remove -fast-llvm flag Issue #18076 drew my attention to the undocumented `-fast-llvm` flag for the LLVM code generator introduced in 22733532171330136d87533d523f565f2a4f102f. Speaking to Moritz about this, the motivation for this flag was to avoid potential incompatibilities between LLVM and the assembler/linker toolchain by making LLVM responsible for machine-code generation. Unfortunately, this cannot possibly work: the LLVM backend's mangler performs a number of transforms on the assembler generated by LLVM that are necessary for correctness. These are currently: * mangling Haskell functions' symbol types to be `object` instead of `function` on ELF platforms (necessary for tables-next-to-code) * mangling AVX instructions to ensure that we don't assume alignment (which LLVM otherwise does) * mangling Darwin's subsections-via-symbols directives Given that these are all necessary I don't believe that we can support `-fast-llvm`. Let's rather remove it. - - - - - 831b6642 by Moritz Angermann at 2020-04-22T23:15:33-04:00 Fix build warning; add more informative information to the linker; fix linker for empty sections - - - - - c409961a by Ryan Scott at 2020-04-22T23:16:12-04:00 Update commentary and slightly refactor GHC.Tc.Deriv.Infer There was some out-of-date commentary in `GHC.Tc.Deriv.Infer` that has been modernized. Along the way, I removed the `bad` constraints in `simplifyDeriv`, which did not serve any useful purpose (besides being printed in debugging output). Fixes #18073. - - - - - 125aa2b8 by Ömer Sinan Ağacan at 2020-04-22T23:16:51-04:00 Remove leftover comment in tcRnModule', redundant bind The code for the comment was moved in dc8c03b2a5c but the comment was forgotten. - - - - - 8ea37b01 by Sylvain Henry at 2020-04-22T23:17:34-04:00 RTS: workaround a Linux kernel bug in timerfd Reading a timerfd may return 0: https://lkml.org/lkml/2019/8/16/335. This is currently undocumented behavior and documentation "won't happen anytime soon" (https://lkml.org/lkml/2020/2/13/295). With this patch, we just ignore the result instead of crashing. It may fix #18033 but we can't be sure because we don't have enough information. See also this discussion about the kernel bug: https://github.com/Azure/sonic-swss-common/pull/302/files/1f070e7920c2e5d63316c0105bf4481e73d72dc9 - - - - - cd8409c2 by Ryan Scott at 2020-04-23T11:39:24-04:00 Create di_scoped_tvs for associated data family instances properly See `Note [Associated data family instances and di_scoped_tvs]` in `GHC.Tc.TyCl.Instance`, which explains all of the moving parts. Fixes #18055. - - - - - 339e8ece by Ben Gamari at 2020-04-23T11:40:02-04:00 hadrian/ghci: Allow arguments to be passed to GHCi Previously the arguments passed to hadrian/ghci were passed both to `hadrian` and GHCi. This is rather odd given that there are essentially not arguments in the intersection of the two. Let's just pass them to GHCi; this allows `hadrian/ghci -Werror`. - - - - - 5946c85a by Ben Gamari at 2020-04-23T11:40:38-04:00 testsuite: Don't attempt to read .std{err,out} files if they don't exist Simon reports that he was previously seeing framework failures due to an attempt to read the non-existing T13456.stderr. While I don't know exactly what this is due to, it does seem like a non-existing .std{out,err} file should be equivalent to an empty file. Teach the testsuite driver to treat it as such. - - - - - c42754d5 by John Ericson at 2020-04-23T18:32:43-04:00 Trees That Grow refactor for `ConPat` and `CoPat` - `ConPat{In,Out}` -> `ConPat` - `CoPat` -> `XPat (CoPat ..)` Note that `GHC.HS.*` still uses `HsWrap`, but only when `p ~ GhcTc`. After this change, moving the type family instances out of `GHC.HS.*` is sufficient to break the cycle. Add XCollectPat class to decide how binders are collected from XXPat based on the pass. Previously we did this with IsPass, but that doesn't work for Haddock's DocNameI, and the constraint doesn't express what actual distinction is being made. Perhaps a class for collecting binders more generally is in order, but we haven't attempted this yet. Pure refactor of code around ConPat - InPat/OutPat synonyms removed - rename several identifiers - redundant constraints removed - move extension field in ConPat to be first - make ConPat use record syntax more consistently Fix T6145 (ConPatIn became ConPat) Add comments from SPJ. Add comment about haddock's use of CollectPass. Updates haddock submodule. - - - - - 72da0c29 by mniip at 2020-04-23T18:33:21-04:00 Add :doc to GHC.Prim - - - - - 2c23e2e3 by mniip at 2020-04-23T18:33:21-04:00 Include docs for non-primop entries in primops.txt as well - - - - - 0ac29c88 by mniip at 2020-04-23T18:33:21-04:00 GHC.Prim docs: note and test - - - - - b0fbfc75 by John Ericson at 2020-04-24T12:07:14-04:00 Switch order on `GhcMake.IsBoot` In !1798 we were requested to replace many `Bool`s with this data type. But those bools had `False` meaning `NotBoot`, so the `Ord` instance would be flipped if we use this data-type as-is. Since the planned formally-`Bool` occurrences vastly outnumber the current occurrences, we figured it would be better to conform the `Ord` instance to how the `Bool` is used now, fixing any issues, rather than fix them currently with the bigger refactor later in !1798. That way, !1798 can be a "pure" refactor with no behavioral changes. - - - - - af332442 by Sylvain Henry at 2020-04-26T13:55:14-04:00 Modules: Utils and Data (#13009) Update Haddock submodule Metric Increase: haddock.compiler - - - - - cd4434c8 by Sylvain Henry at 2020-04-26T13:55:16-04:00 Fix misleading Ptr phantom type in SerializedCompact (#15653) - - - - - 22bf5c73 by Ömer Sinan Ağacan at 2020-04-26T13:55:22-04:00 Tweak includes in non-moving GC headers We don't use hash tables in non-moving GC so remove the includes. This breaks Compact.c as existing includes no longer include Hash.h, so include Hash.h explicitly in Compact.c. - - - - - 99823ed2 by Sylvain Henry at 2020-04-27T20:24:46-04:00 TH: fix Show/Eq/Ord instances for Bytes (#16457) We shouldn't compare pointer values but the actual bytes. - - - - - c62271a2 by Alp Mestanogullari at 2020-04-27T20:25:33-04:00 hadrian: always capture both stdout and stderr when running a builder fails The idea being that when a builder('s command) fails, we quite likely want to have all the information available to figure out why. Depending on the builder _and_ the particular problem, the useful bits of information can be printed on stdout or stderr. We accomplish this by defining a simple wrapper for Shake's `cmd` function, that just _always_ captures both streams in case the command returns a non-zero exit code, and by using this wrapper everywhere in `hadrian/src/Builder.hs`. Fixes #18089. - - - - - 4b9764db by Ryan Scott at 2020-04-28T15:40:04-04:00 Define a Quote IO instance Fixes #18103. - - - - - 518a63d4 by Ryan Scott at 2020-04-28T15:40:42-04:00 Make boxed 1-tuples have known keys Unlike other tuples, which use special syntax and are "known" by way of a special `isBuiltInOcc_maybe` code path, boxed 1-tuples do not use special syntax. Therefore, in order to make sure that the internals of GHC are aware of the `data Unit a = Unit a` definition in `GHC.Tuple`, we give `Unit` known keys. For the full details, see `Note [One-tuples] (Wrinkle: Make boxed one-tuple names have known keys)` in `GHC.Builtin.Types`. Fixes #18097. - - - - - 2cfc4ab9 by Sylvain Henry at 2020-04-30T01:56:56-04:00 Document backpack fields in DynFlags - - - - - 10a2ba90 by Sylvain Henry at 2020-04-30T01:56:56-04:00 Refactor UnitInfo * Rename InstalledPackageInfo into GenericUnitInfo The name InstalledPackageInfo is only kept for alleged backward compatibility reason in Cabal. ghc-boot has its own stripped down copy of this datatype but it doesn't need to keep the name. Internally we already use type aliases (UnitInfo in GHC, PackageCacheFormat in ghc-pkg). * Rename UnitInfo fields: add "unit" prefix and fix misleading names * Add comments on every UnitInfo field * Rename SourcePackageId into PackageId "Package" already indicates that it's a "source package". Installed package components are called units. Update Haddock submodule - - - - - 69562e34 by Sylvain Henry at 2020-04-30T01:56:56-04:00 Remove unused `emptyGenericUnitInfo` - - - - - 9e2c8e0e by Sylvain Henry at 2020-04-30T01:56:56-04:00 Refactor UnitInfo load/store from databases Converting between UnitInfo stored in package databases and UnitInfo as they are used in ghc-pkg and ghc was done in a very convoluted way (via BinaryStringRep and DbUnitModuleRep type classes using fun deps, etc.). It was difficult to understand and even more to modify (I wanted to try to use a GADT for UnitId but fun deps got in the way). The new code uses much more straightforward functions to convert between the different representations. Much simpler. - - - - - ea717aa4 by Sylvain Henry at 2020-04-30T01:56:56-04:00 Factorize mungePackagePaths code This patch factorizes the duplicated code used in ghc-pkg and in GHC to munge package paths/urls. It also fixes haddock-html munging in GHC (allowed to be either a file or a url) to mimic ghc-pkg behavior. - - - - - 10d15f1e by Sylvain Henry at 2020-04-30T01:56:56-04:00 Refactoring unit management code Over the years the unit management code has been modified a lot to keep up with changes in Cabal (e.g. support for several library components in the same package), to integrate BackPack, etc. I found it very hard to understand as the terminology wasn't consistent, was referring to past concepts, etc. The terminology is now explained as clearly as I could in the Note "About Units" and the code is refactored to reflect it. ------------------- Many names were misleading: UnitId is not an Id but could be a virtual unit (an indefinite one instantiated on the fly), IndefUnitId constructor may contain a definite instantiated unit, etc. * Rename IndefUnitId into InstantiatedUnit * Rename IndefModule into InstantiatedModule * Rename UnitId type into Unit * Rename IndefiniteUnitId constructor into VirtUnit * Rename DefiniteUnitId constructor into RealUnit * Rename packageConfigId into mkUnit * Rename getPackageDetails into unsafeGetUnitInfo * Rename InstalledUnitId into UnitId Remove references to misleading ComponentId: a ComponentId is just an indefinite unit-id to be instantiated. * Rename ComponentId into IndefUnitId * Rename ComponentDetails into UnitPprInfo * Fix display of UnitPprInfo with empty version: this is now used for units dynamically generated by BackPack Generalize several types (Module, Unit, etc.) so that they can be used with different unit identifier types: UnitKey, UnitId, Unit, etc. * GenModule: Module, InstantiatedModule and InstalledModule are now instances of this type * Generalize DefUnitId, IndefUnitId, Unit, InstantiatedUnit, PackageDatabase Replace BackPack fake "hole" UnitId by a proper HoleUnit constructor. Add basic support for UnitKey. They should be used more in the future to avoid mixing them up with UnitId as we do now. Add many comments. Update Haddock submodule - - - - - 8bfb0219 by Sylvain Henry at 2020-04-30T01:56:56-04:00 Unit: split and rename modules Introduce GHC.Unit.* hierarchy for everything concerning units, packages and modules. Update Haddock submodule - - - - - 71484b09 by Alexis King at 2020-04-30T01:57:35-04:00 Allow block arguments in arrow control operators Arrow control operators have their own entries in the grammar, so they did not cooperate with BlockArguments. This was just a minor oversight, so this patch adjusts the grammar to add the desired behavior. fixes #18050 - - - - - a48cd2a0 by Alexis King at 2020-04-30T01:57:35-04:00 Allow LambdaCase to be used as a command in proc notation - - - - - f4d3773c by Alexis King at 2020-04-30T01:57:35-04:00 Document BlockArguments/LambdaCase support in arrow notation - - - - - 5bdfdd13 by Simon Peyton Jones at 2020-04-30T01:58:15-04:00 Add tests for #17873 - - - - - 19b701c2 by Simon Peyton Jones at 2020-04-30T07:30:13-04:00 Mark rule args as non-tail-called This was just an omission...b I'd failed to call markAllNonTailCall on rule args. I think this bug has been here a long time, but it's quite hard to trigger. Fixes #18098 - - - - - 014ef4a3 by Matthew Pickering at 2020-04-30T07:30:50-04:00 Hadrian: Improve tool-args command to support more components There is a new command to hadrian, tool:path/to/file.hs, which returns the options needed to compile that file in GHCi. This is now used in the ghci script with argument `ghc/Main.hs` but its main purpose is to support the new multi-component branch of ghcide. - - - - - 2aa67611 by Ben Gamari at 2020-04-30T21:34:44-04:00 nonmoving: Clear bitmap after initializing block size Previously nonmovingInitSegment would clear the bitmap before initializing the segment's block size. This is broken since nonmovingClearBitmap looks at the segment's block size to determine how much bitmap to clear. - - - - - 54dad3cf by Ben Gamari at 2020-04-30T21:34:44-04:00 nonmoving: Explicitly memoize block count A profile cast doubt on whether the compiler hoisted the bound out the loop as I would have expected here. It turns out it did but nevertheless it seems clearer to just do this manually. - - - - - 99ff8145 by Ben Gamari at 2020-04-30T21:34:44-04:00 nonmoving: Eagerly flush all capabilities' update remembered sets (cherry picked from commit 2fa79119570b358a4db61446396889b8260d7957) - - - - - 05b0a9fd by Ömer Sinan Ağacan at 2020-04-30T21:35:24-04:00 Remove OneShotInfo field of LFReEntrant, document OneShotInfo The field is only used in withNewTickyCounterFun and it's easier to directly pass a parameter for one-shot info to withNewTickyCounterFun instead of passing it via LFReEntrant. This also makes !2842 simpler. Other changes: - New Note (by SPJ) [OneShotInfo overview] added. - Arity argument of thunkCode removed as it's always 0. - - - - - a43620c6 by Ömer Sinan Ağacan at 2020-04-30T21:35:24-04:00 GHC.StgToCmm.Ticky: remove a few unused stuff - - - - - 780de9e1 by Sylvain Henry at 2020-05-01T10:37:39-04:00 Use platform in Iface Binary - - - - - f8386c7b by Sylvain Henry at 2020-05-01T10:37:39-04:00 Refactor PprDebug handling If `-dppr-debug` is set, then PprUser and PprDump styles are silently replaced with PprDebug style. This was done in `mkUserStyle` and `mkDumpStyle` smart constructors. As a consequence they needed a DynFlags parameter. Now we keep the original PprUser and PprDump styles until they are used to create an `SDocContext`. I.e. the substitution is only performed in `initSDocContext`. - - - - - b3df9e78 by Sylvain Henry at 2020-05-01T10:37:39-04:00 Remove PprStyle param of logging actions Use `withPprStyle` instead to apply a specific style to a SDoc. - - - - - de9fc995 by Sylvain Henry at 2020-05-01T10:37:39-04:00 Fully remove PprDebug PprDebug was a pain to deal with consistently as it is implied by `-dppr-debug` but it isn't really a PprStyle. We remove it completely and query the appropriate SDoc flag instead (`sdocPprDebug`) via helpers (`getPprDebug` and its friends). - - - - - 8b51fcbd by Sebastian Graf at 2020-05-01T10:38:16-04:00 PmCheck: Only call checkSingle if we would report warnings - - - - - fd7ea0fe by Sebastian Graf at 2020-05-01T10:38:16-04:00 PmCheck: Pick up `EvVar`s bound in `HsWrapper`s for long-distance info `HsWrapper`s introduce evidence bindings through `WpEvLam` which the pattern-match coverage checker should be made aware of. Failing to do so caused #18049, where the resulting impreciseness of imcompleteness warnings seemingly contradicted with `-Winaccessible-code`. The solution is simple: Collect all the evidence binders of an `HsWrapper` and add it to the ambient `Deltas` before desugaring the wrapped expression. But that means we pick up many more evidence bindings, even when they wrap around code without a single pattern match to check! That regressed `T3064` by over 300%, so now we are adding long-distance info lazily through judicious use of `unsafeInterleaveIO`. Fixes #18049. - - - - - 7bfe9ac5 by Ben Gamari at 2020-05-03T04:41:33-04:00 rts: Enable tracing of nonmoving heap census with -ln Previously this was not easily available to the user. Fix this. Non-moving collection lifecycle events are now reported with -lg. - - - - - c560dd07 by Ben Gamari at 2020-05-03T04:41:33-04:00 users guide: Move eventlog documentation users guide - - - - - 02543d5e by Ben Gamari at 2020-05-03T04:41:33-04:00 users guide: Add documentation for non-moving GC events - - - - - b465dd45 by Alexis King at 2020-05-03T04:42:12-04:00 Flatten nested casts in the simple optimizer Normally, we aren’t supposed to generated any nested casts, since mkCast takes care to flatten them, but the simple optimizer didn’t use mkCast, so they could show up after inlining. This isn’t really a problem, since the simplifier will clean them up immediately anyway, but it can clutter the -ddump-ds output, and it’s an extremely easy fix. closes #18112 - - - - - 8bdc03d6 by Simon Peyton Jones at 2020-05-04T01:56:59-04:00 Don't return a panic in tcNestedSplice In GHC.Tc.Gen.Splice.tcNestedSplice we were returning a typechecked expression of "panic". That is usually OK, because the result is discarded. But it happens that tcApp now looks at the typechecked expression, trivially, to ask if it is tagToEnum. So being bottom is bad. Moreover a debug-trace might print it out. So better to return a civilised expression, even though it is usually discarded. - - - - - 0bf640b1 by Baldur Blöndal at 2020-05-04T01:57:36-04:00 Don't require parentheses around via type (`-XDerivingVia'). Fixes #18130". - - - - - 30272412 by Artem Pelenitsyn at 2020-05-04T13:19:59-04:00 Remove custom ExceptionMonad class (#18075) (updating haddock submodule accordingly) - - - - - b9f7c08f by jneira at 2020-05-04T13:20:37-04:00 Remove unused hs-boot file - - - - - 1d8f80cd by Sylvain Henry at 2020-05-05T03:22:46-04:00 Remove references to -package-key * remove references to `-package-key` which has been removed in 2016 (240ddd7c39536776e955e881d709bbb039b48513) * remove support for `-this-package-key` which has been deprecated at the same time - - - - - 7bc3a65b by Sylvain Henry at 2020-05-05T03:23:31-04:00 Remove SpecConstrAnnotation (#13681) This has been deprecated since 2013. Use GHC.Types.SPEC instead. Make GHC.Exts "not-home" for haddock Metric Decrease: haddock.base - - - - - 3c862f63 by DenisFrezzato at 2020-05-05T03:24:15-04:00 Fix Haskell98 short description in documentation - - - - - 2420c555 by Ryan Scott at 2020-05-05T03:24:53-04:00 Add regression tests for #16244, #16245, #16758 Commit e3c374cc5bd7eb49649b9f507f9f7740697e3f70 ended up fixing quite a few bugs: * This commit fixes #16244 completely. A regression test has been added. * This commit fixes one program from #16245. (The program in https://gitlab.haskell.org/ghc/ghc/issues/16245#note_211369 still panics, and the program in https://gitlab.haskell.org/ghc/ghc/issues/16245#note_211400 still loops infinitely.) A regression test has been added for this program. * This commit fixes #16758. Accordingly, this patch removes the `expect_broken` label from the `T16758` test case, moves it from `should_compile` to `should_fail` (as it should produce an error message), and checks in the expected stderr. - - - - - 40c71c2c by Sylvain Henry at 2020-05-05T03:25:31-04:00 Fix colorized error messages (#18128) In b3df9e780fb2f5658412c644849cd0f1e6f50331 I broke colorized messages by using "dump" style instead of "user" style. This commits fixes it. - - - - - 7ab6ab09 by Richard Eisenberg at 2020-05-06T04:39:32-04:00 Refactor hole constraints. Previously, holes (both expression holes / out of scope variables and partial-type-signature wildcards) were emitted as *constraints* via the CHoleCan constructor. While this worked fine for error reporting, there was a fair amount of faff in keeping these constraints in line. In particular, and unlike other constraints, we could never change a CHoleCan to become CNonCanonical. In addition: * the "predicate" of a CHoleCan constraint was really the type of the hole, which is not a predicate at all * type-level holes (partial type signature wildcards) carried evidence, which was never used * tcNormalise (used in the pattern-match checker) had to create a hole constraint just to extract it again; it was quite messy The new approach is to record holes directly in WantedConstraints. It flows much more nicely now. Along the way, I did some cleaning up of commentary in GHC.Tc.Errors.Hole, which I had a hard time understanding. This was instigated by a future patch that will refactor the way predicates are handled. The fact that CHoleCan's "predicate" wasn't really a predicate is incompatible with that future patch. No test case, because this is meant to be purely internal. It turns out that this change improves the performance of the pattern-match checker, likely because fewer constraints are sloshing about in tcNormalise. I have not investigated deeply, but an improvement is not a surprise here: ------------------------- Metric Decrease: PmSeriesG ------------------------- - - - - - 420b957d by Ben Gamari at 2020-05-06T04:40:08-04:00 rts: Zero block flags with -DZ Block flags are very useful for determining the state of a block. However, some block allocator users don't touch them, leading to misleading values. Ensure that we zero then when zero-on-gc is set. This is safe and makes the flags more useful during debugging. - - - - - 740b3b8d by Ben Gamari at 2020-05-06T04:40:08-04:00 nonmoving: Fix incorrect failed_to_evac value during deadlock gc Previously we would incorrectly set the failed_to_evac flag if we evacuated a value due to a deadlock GC. This would cause us to mark more things as dirty than strictly necessary. It also turned up a nasty but which I will fix next. - - - - - b2d72c75 by Ben Gamari at 2020-05-06T04:40:08-04:00 nonmoving: Fix handling of dirty objects Previously we (incorrectly) relied on failed_to_evac to be "precise". That is, we expected it to only be true if *all* of an object's fields lived outside of the non-moving heap. However, does not match the behavior of failed_to_evac, which is true if *any* of the object's fields weren't promoted (meaning that some others *may* live in the non-moving heap). This is problematic as we skip the non-moving write barrier for dirty objects (which we can only safely do if *all* fields point outside of the non-moving heap). Clearly this arises due to a fundamental difference in the behavior expected of failed_to_evac in the moving and non-moving collector. e.g., in the moving collector it is always safe to conservatively say failed_to_evac=true whereas in the non-moving collector the safe value is false. This issue went unnoticed as I never wrote down the dirtiness invariant enforced by the non-moving collector. We now define this invariant as An object being marked as dirty implies that all of its fields are on the mark queue (or, equivalently, update remembered set). To maintain this invariant we teach nonmovingScavengeOne to push the fields of objects which we fail to evacuate to the update remembered set. This is a simple and reasonably cheap solution and avoids the complexity and fragility that other, more strict alternative invariants would require. All of this is described in a new Note, Note [Dirty flags in the non-moving collector] in NonMoving.c. - - - - - 9f3e6884 by Zubin Duggal at 2020-05-06T04:41:08-04:00 Allow atomic update of NameCache in readHieFile The situation arises in ghcide where multiple different threads may need to update the name cache, therefore with the older interface it could happen that you start reading a hie file with name cache A and produce name cache A + B, but another thread in the meantime updated the namecache to A + C. Therefore if you write the new namecache you will lose the A' updates from the second thread. Updates haddock submodule - - - - - edec6a6c by Ryan Scott at 2020-05-06T04:41:57-04:00 Make isTauTy detect higher-rank contexts Previously, `isTauTy` would only detect higher-rank `forall`s, not higher-rank contexts, which led to some minor bugs observed in #18127. Easily fixed by adding a case for `(FunTy InvisArg _ _)`. Fixes #18127. - - - - - a95e7fe0 by Ömer Sinan Ağacan at 2020-05-06T04:42:39-04:00 ELF linker: increment curSymbol after filling in fields of current entry The bug was introduced in a8b7cef4d45 which added a field to the `symbols` array elements and then updated this code incorrectly: - oc->symbols[curSymbol++] = nm; + oc->symbols[curSymbol++].name = nm; + oc->symbols[curSymbol].addr = symbol->addr; - - - - - cab1871a by Sylvain Henry at 2020-05-06T04:43:21-04:00 Move LeadingUnderscore into Platform (#17957) Avoid direct use of DynFlags to know if symbols must be prefixed by an underscore. - - - - - 94e7c563 by Sylvain Henry at 2020-05-06T04:43:21-04:00 Don't use DynFlags in showLinkerState (#17957) - - - - - 9afd9251 by Ryan Scott at 2020-05-06T04:43:58-04:00 Refactoring: Use bindSigTyVarsFV in rnMethodBinds `rnMethodBinds` was explicitly using `xoptM` to determine if `ScopedTypeVariables` is enabled before bringing type variables bound by the class/instance header into scope. However, this `xoptM` logic is already performed by the `bindSigTyVarsFV` function. This patch uses `bindSigTyVarsFV` in `rnMethodBinds` to reduce the number of places where we need to consult if `ScopedTypeVariables` is on. This is purely refactoring, and there should be no user-visible change in behavior. - - - - - 6f6d72b2 by Brian Foley at 2020-05-08T15:29:25-04:00 Remove further dead code found by a simple Python script. Avoid removing some functions that are part of an API even though they're not used in-tree at the moment. - - - - - 78bf8bf9 by Julien Debon at 2020-05-08T15:29:28-04:00 Add doc examples for Bifoldable See #17929 - - - - - 66f0a847 by Julien Debon at 2020-05-08T15:29:29-04:00 doc (Bitraversable): Add examples to Bitraversable * Add examples to Data.Bitraversable * Fix formatting for (,) in Bitraversable and Bifoldable * Fix mistake on bimapAccumR documentation See #17929 - - - - - 9749fe12 by Baldur Blöndal at 2020-05-08T15:29:32-04:00 Specify kind variables for inferred kinds in base. - - - - - 4e9aef9e by John Ericson at 2020-05-08T15:29:36-04:00 HsSigWcTypeScoping: Pull in documentation from stray location - - - - - f4d5c6df by John Ericson at 2020-05-08T15:29:36-04:00 Rename local `real_fvs` to `implicit_vs` It doesn't make sense to call the "free" variables we are about to implicitly bind the real ones. - - - - - 20570b4b by John Ericson at 2020-05-08T15:29:36-04:00 A few tiny style nits with renaming - Use case rather than guards that repeatedly scrutenize same thing. - No need for view pattern when `L` is fine. - Use type synnonym to convey the intent like elsewhere. - - - - - 09ac8de5 by John Ericson at 2020-05-08T15:29:36-04:00 Add `forAllOrNothing` function with note - - - - - bb35c0e5 by Joseph C. Sible at 2020-05-08T15:29:40-04:00 Document lawlessness of Ap's Num instance - - - - - cdd229ff by Joseph C. Sible at 2020-05-08T15:29:40-04:00 Apply suggestion to libraries/base/Data/Monoid.hs - - - - - 926d2aab by Joseph C. Sible at 2020-05-08T15:29:40-04:00 Apply more suggestions from Simon Jakobi - - - - - 7a763cff by Adam Gundry at 2020-05-08T15:29:41-04:00 Reject all duplicate declarations involving DuplicateRecordFields (fixes #17965) This fixes a bug that resulted in some programs being accepted that used the same identifier as a field label and another declaration, depending on the order they appeared in the source code. - - - - - 88e3c815 by Simon Peyton Jones at 2020-05-08T15:29:41-04:00 Fix specialisation for DFuns When specialising a DFun we must take care to saturate the unfolding. See Note [Specialising DFuns] in Specialise. Fixes #18120 - - - - - 86c77b36 by Greg Steuck at 2020-05-08T15:29:45-04:00 Remove unused SEGMENT_PROT_RWX It's been unused for a year and is problematic on any OS which requires W^X for security. - - - - - 9d97f4b5 by nineonine at 2020-05-08T15:30:03-04:00 Add test for #16167 - - - - - aa318338 by Ryan Scott at 2020-05-08T15:30:04-04:00 Bump exceptions submodule so that dist-boot is .gitignore'd `exceptions` is a stage-0 boot library as of commit 30272412fa437ab8e7a8035db94a278e10513413, which means that building `exceptions` in a GHC tree will generate a `dist-boot` directory. However, this directory was not specified in `exceptions`' `.gitignore` file, which causes it to dirty up the current `git` working directory. Accordingly, this bumps the `exceptions` submodule to commit ghc/packages/exceptions at 23c0b8a50d7592af37ca09beeec16b93080df98f, which adds `dist-boot` to the `.gitignore` file. - - - - - ea86360f by Ömer Sinan Ağacan at 2020-05-08T15:30:30-04:00 Linker.c: initialize n_symbols of ObjectCode with other fields - - - - - 951c1fb0 by Sylvain Henry at 2020-05-09T21:46:38-04:00 Fix unboxed-sums GC ptr-slot rubbish value (#17791) This patch allows boot libraries to use unboxed sums without implicitly depending on `base` package because of `absentSumFieldError`. See updated Note [aBSENT_SUM_FIELD_ERROR_ID] in GHC.Core.Make - - - - - b352d63c by Ben Gamari at 2020-05-09T21:47:14-04:00 rts: Make non-existent linker search path merely a warning As noted in #18105, previously this resulted in a rather intrusive error message. This is in contrast to the general expectation that search paths are merely places to look, not places that must exist. Fixes #18105. - - - - - cf4f1e2f by Ben Gamari at 2020-05-13T02:02:33-04:00 rts/CNF: Fix fixup comparison function Previously we would implicitly convert the difference between two words to an int, resulting in an integer overflow on 64-bit machines. Fixes #16992 - - - - - a03da9bf by Ömer Sinan Ağacan at 2020-05-13T02:03:16-04:00 Pack some of IdInfo fields into a bit field This reduces residency of compiler quite a bit on some programs. Example stats when building T10370: Before: 2,871,242,832 bytes allocated in the heap 4,693,328,008 bytes copied during GC 33,941,448 bytes maximum residency (276 sample(s)) 375,976 bytes maximum slop 83 MiB total memory in use (0 MB lost due to fragmentation) After: 2,858,897,344 bytes allocated in the heap 4,629,255,440 bytes copied during GC 32,616,624 bytes maximum residency (278 sample(s)) 314,400 bytes maximum slop 80 MiB total memory in use (0 MB lost due to fragmentation) So -3.9% residency, -1.3% bytes copied and -0.4% allocations. Fixes #17497 Metric Decrease: T9233 T9675 - - - - - 670c3e5c by Ben Gamari at 2020-05-13T02:03:54-04:00 get-win32-tarballs: Fix base URL Revert a change previously made for testing purposes. - - - - - 8ad8dc41 by Ben Gamari at 2020-05-13T02:03:54-04:00 get-win32-tarballs: Improve diagnostics output - - - - - 8c0740b7 by Simon Jakobi at 2020-05-13T02:04:33-04:00 docs: Add examples for Data.Semigroup.Arg{Min,Max} Context: #17153 - - - - - cb22348f by Ben Gamari at 2020-05-13T02:05:11-04:00 Add few cleanups of the CAF logic Give the NameSet of non-CAFfy names a proper newtype to distinguish it from all of the other NameSets floating about. - - - - - 90e38b81 by Emeka Nkurumeh at 2020-05-13T02:05:51-04:00 fix printf warning when using with ghc with clang on mingw - - - - - 86d8ac22 by Sebastian Graf at 2020-05-13T02:06:29-04:00 CprAnal: Don't attach CPR sigs to expandable bindings (#18154) Instead, look through expandable unfoldings in `cprTransform`. See the new Note [CPR for expandable unfoldings]: ``` Long static data structures (whether top-level or not) like xs = x1 : xs1 xs1 = x2 : xs2 xs2 = x3 : xs3 should not get CPR signatures, because they * Never get WW'd, so their CPR signature should be irrelevant after analysis (in fact the signature might even be harmful for that reason) * Would need to be inlined/expanded to see their constructed product * Recording CPR on them blows up interface file sizes and is redundant with their unfolding. In case of Nested CPR, this blow-up can be quadratic! But we can't just stop giving DataCon application bindings the CPR property, for example fac 0 = 1 fac n = n * fac (n-1) fac certainly has the CPR property and should be WW'd! But FloatOut will transform the first clause to lvl = 1 fac 0 = lvl If lvl doesn't have the CPR property, fac won't either. But lvl doesn't have a CPR signature to extrapolate into a CPR transformer ('cprTransform'). So instead we keep on cprAnal'ing through *expandable* unfoldings for these arity 0 bindings via 'cprExpandUnfolding_maybe'. In practice, GHC generates a lot of (nested) TyCon and KindRep bindings, one for each data declaration. It's wasteful to attach CPR signatures to each of them (and intractable in case of Nested CPR). ``` Fixes #18154. - - - - - e34bf656 by Ben Gamari at 2020-05-13T02:07:08-04:00 users-guide: Add discussion of shared object naming Fixes #18074. - - - - - 5d0f2445 by Ben Gamari at 2020-05-13T02:07:47-04:00 testsuite: Print sign of performance changes Executes the minor formatting change in the tabulated performance changes suggested in #18135. - - - - - 9e4b981f by Ben Gamari at 2020-05-13T02:08:24-04:00 testsuite: Add testcase for #18129 - - - - - 266310c3 by Ivan-Yudin at 2020-05-13T02:09:03-04:00 doc: Reformulate the opening paragraph of Ch. 4 in User's guide Removes mentioning of Hugs (it is not helpful for new users anymore). Changes the wording for the rest of the paragraph. Fixes #18132. - - - - - 55e35c0b by Baldur Blöndal at 2020-05-13T20:02:48-04:00 Predicate, Equivalence derive via `.. -> a -> All' - - - - - d7e0b57f by Alp Mestanogullari at 2020-05-13T20:03:30-04:00 hadrian: add a --freeze2 option to freeze stage 1 and 2 - - - - - d880d6b2 by Artem Pelenitsyn at 2020-05-13T20:04:11-04:00 Don't reload environment files on every setSessionDynFlags Makes `interpretPackageEnv` (which loads envirinment files) a part of `parseDynamicFlags` (parsing command-line arguments, which is typically done once) instead of `setSessionDynFlags` (which is typically called several times). Making several (transitive) calls to `interpretPackageEnv`, as before, caused #18125 #16318, which should be fixed now. - - - - - 102cfd67 by Ryan Scott at 2020-05-13T20:04:46-04:00 Factor out HsPatSigType for pat sigs/RULE term sigs (#16762) This implements chunks (2) and (3) of https://gitlab.haskell.org/ghc/ghc/issues/16762#note_270170. Namely, it introduces a dedicated `HsPatSigType` AST type, which represents the types that can appear in pattern signatures and term-level `RULE` binders. Previously, these were represented with `LHsSigWcType`. Although `LHsSigWcType` is isomorphic to `HsPatSigType`, the intended semantics of the two types are slightly different, as evidenced by the fact that they have different code paths in the renamer and typechecker. See also the new `Note [Pattern signature binders and scoping]` in `GHC.Hs.Types`. - - - - - b17574f7 by Hécate at 2020-05-13T20:05:28-04:00 fix(documentation): Fix the RST links to GHC.Prim - - - - - df021fb1 by Baldur Blöndal at 2020-05-13T20:06:06-04:00 Document (->) using inferred quantification for its runtime representations. Fixes #18142. - - - - - 1a93ea57 by Takenobu Tani at 2020-05-13T20:06:54-04:00 Tweak man page for ghc command This commit updates the ghc command's man page as followings: * Enable `man_show_urls` to show URL addresses in the `DESCRIPTION` section of ghc.rst, because sphinx currently removes hyperlinks for man pages. * Add a `SEE ALSO` section to point to the GHC homepage - - - - - a951e1ba by Takenobu Tani at 2020-05-13T20:07:37-04:00 GHCi: Add link to the user's guide in help message This commit adds a link to the user's guide in ghci's `:help` message. Newcomers could easily reach to details of ghci. - - - - - 404581ea by Jeff Happily at 2020-05-13T20:08:15-04:00 Handle single unused import - - - - - 1c999e5d by Ben Gamari at 2020-05-13T20:09:07-04:00 Ensure that printMinimalImports closes handle Fixes #18166. - - - - - c9f5a8f4 by Ben Gamari at 2020-05-13T20:09:51-04:00 hadrian: Tell testsuite driver about LLVM availability This reflects the logic present in the Make build system into Hadrian. Fixes #18167. - - - - - c05c0659 by Simon Jakobi at 2020-05-14T03:31:21-04:00 Improve some folds over Uniq[D]FM * Replace some non-deterministic lazy folds with strict folds. * Replace some O(n log n) folds in deterministic order with O(n) non-deterministic folds. * Replace some folds with set-operations on the underlying IntMaps. This reduces max residency when compiling `nofib/spectral/simple/Main.hs` with -O0 by about 1%. Maximum residency when compiling Cabal also seems reduced on the order of 3-9%. - - - - - 477f13bb by Simon Jakobi at 2020-05-14T03:31:58-04:00 Use Data.IntMap.disjoint Data.IntMap gained a dedicated `disjoint` function in containers-0.6.2.1. This patch applies this function where appropriate in hopes of modest compiler performance improvements. Closes #16806. - - - - - e9c0110c by Ben Gamari at 2020-05-14T12:25:53-04:00 IdInfo: Add reference to bitfield-packing ticket - - - - - 9bd20e83 by Sebastian Graf at 2020-05-15T10:42:09-04:00 DmdAnal: Improve handling of precise exceptions This patch does two things: Fix possible unsoundness in what was called the "IO hack" and implement part 2.1 of the "fixing precise exceptions" plan in https://gitlab.haskell.org/ghc/ghc/wikis/fixing-precise-exceptions, which, in combination with !2956, supersedes !3014 and !2525. **IO hack** The "IO hack" (which is a fallback to preserve precise exceptions semantics and thus soundness, rather than some smart thing that increases precision) is called `exprMayThrowPreciseException` now. I came up with two testcases exemplifying possible unsoundness (if twisted enough) in the old approach: - `T13380d`: Demonstrating unsoundness of the "IO hack" when resorting to manual state token threading and direct use of primops. More details below. - `T13380e`: Demonstrating unsoundness of the "IO hack" when we have Nested CPR. Not currently relevant, as we don't have Nested CPR yet. - `T13380f`: Demonstrating unsoundness of the "IO hack" for safe FFI calls. Basically, the IO hack assumed that precise exceptions can only be thrown from a case scrutinee of type `(# State# RealWorld, _ #)`. I couldn't come up with a program using the `IO` abstraction that violates this assumption. But it's easy to do so via manual state token threading and direct use of primops, see `T13380d`. Also similar code might be generated by Nested CPR in the (hopefully not too) distant future, see `T13380e`. Hence, we now have a more careful test in `forcesRealWorld` that passes `T13380{d,e}` (and will hopefully be robust to Nested CPR). **Precise exceptions** In #13380 and #17676 we saw that we didn't preserve precise exception semantics in demand analysis. We fixed that with minimal changes in !2956, but that was terribly unprincipled. That unprincipledness resulted in a loss of precision, which is tracked by these new test cases: - `T13380b`: Regression in dead code elimination, because !2956 was too syntactic about `raiseIO#` - `T13380c`: No need to apply the "IO hack" when the IO action may not throw a precise exception (and the existing IO hack doesn't detect that) Fixing both issues in !3014 turned out to be too complicated and had the potential to regress in the future. Hence we decided to only fix `T13380b` and augment the `Divergence` lattice with a new middle-layer element, `ExnOrDiv`, which means either `Diverges` (, throws an imprecise exception) or throws a *precise* exception. See the wiki page on Step 2.1 for more implementational details: https://gitlab.haskell.org/ghc/ghc/wikis/fixing-precise-exceptions#dead-code-elimination-for-raiseio-with-isdeadenddiv-introducing-exnordiv-step-21 - - - - - 568d7279 by Ben Gamari at 2020-05-15T10:42:46-04:00 GHC.Cmm.Opt: Handle MO_XX_Conv This MachOp was introduced by 2c959a1894311e59cd2fd469c1967491c1e488f3 but a wildcard match in cmmMachOpFoldM hid the fact that it wasn't handled. Ideally we would eliminate the match but this appears to be a larger task. Fixes #18141. - - - - - 5bcf8606 by Ryan Scott at 2020-05-17T08:46:38-04:00 Remove duplicate Note [When to print foralls] in GHC.Core.TyCo.Ppr There are two different Notes named `[When to print foralls]`. The most up-to-date one is in `GHC.Iface.Type`, but there is a second one in `GHC.Core.TyCo.Ppr`. The latter is less up-to-date, as it was written before GHC switched over to using ifaces to pretty-print types. I decided to just remove the latter and replace it with a reference to the former. [ci skip] - - - - - 55f0e783 by Fumiaki Kinoshita at 2020-05-21T12:10:44-04:00 base: Add Generic instances to various datatypes under GHC.* * GHC.Fingerprint.Types: Fingerprint * GHC.RTS.Flags: GiveGCStats, GCFlags, ConcFlags, DebugFlags, CCFlags, DoHeapProfile, ProfFlags, DoTrace, TraceFlags, TickyFlags, ParFlags and RTSFlags * GHC.Stats: RTSStats and GCStats * GHC.ByteOrder: ByteOrder * GHC.Unicode: GeneralCategory * GHC.Stack.Types: SrcLoc Metric Increase: haddock.base - - - - - a9311cd5 by Gert-Jan Bottu at 2020-05-21T12:11:31-04:00 Explicit Specificity Implementation for Ticket #16393. Explicit specificity allows users to manually create inferred type variables, by marking them with braces. This way, the user determines which variables can be instantiated through visible type application. The additional syntax is included in the parser, allowing users to write braces in type variable binders (type signatures, data constructors etc). This information is passed along through the renamer and verified in the type checker. The AST for type variable binders, data constructors, pattern synonyms, partial signatures and Template Haskell has been updated to include the specificity of type variables. Minor notes: - Bumps haddock submodule - Disables pattern match checking in GHC.Iface.Type with GHC 8.8 - - - - - 24e61aad by Ben Price at 2020-05-21T12:12:17-04:00 Lint should say when it is checking a rule It is rather confusing that when lint finds an error in a rule attached to a binder, it reports the error as in the RHS, not the rule: ... In the RHS of foo We add a clarifying line: ... In the RHS of foo In a rule attached to foo The implication that the rule lives inside the RHS is a bit odd, but this niggle is already present for unfoldings, whose pattern we are following. - - - - - 78c6523c by Ben Gamari at 2020-05-21T12:13:01-04:00 nonmoving: Optimise the write barrier - - - - - 13f6c9d0 by Andreas Klebinger at 2020-05-21T12:13:45-04:00 Refactor linear reg alloc to remember past assignments. When assigning registers we now first try registers we assigned to in the past, instead of picking the "first" one. This is in extremely helpful when dealing with loops for which variables are dead for part of the loop. This is important for patterns like this: foo = arg1 loop: use(foo) ... foo = getVal() goto loop; There we: * assign foo to the register of arg1. * use foo, it's dead after this use as it's overwritten after. * do other things. * look for a register to put foo in. If we pick an arbitrary one it might differ from the register the start of the loop expect's foo to be in. To fix this we simply look for past register assignments for the given variable. If we find one and the register is free we use that register. This reduces the need for fixup blocks which match the register assignment between blocks. In the example above between the end and the head of the loop. This patch also moves branch weight estimation ahead of register allocation and adds a flag to control it (cmm-static-pred). * It means the linear allocator is more likely to assign the hotter code paths first. * If it assign these first we are: + Less likely to spill on the hot path. + Less likely to introduce fixup blocks on the hot path. These two measure combined are surprisingly effective. Based on nofib we get in the mean: * -0.9% instructions executed * -0.1% reads/writes * -0.2% code size. * -0.1% compiler allocations. * -0.9% compile time. * -0.8% runtime. Most of the benefits are simply a result of removing redundant moves and spills. Reduced compiler allocations likely are the result of less code being generated. (The added lookup is mostly non-allocating). - - - - - edc2cc58 by Andreas Klebinger at 2020-05-21T12:14:25-04:00 NCG: Codelayout: Distinguish conditional and other branches. In #18053 we ended up with a suboptimal code layout because the code layout algorithm didn't distinguish between conditional and unconditional control flow. We can completely eliminate unconditional control flow instructions by placing blocks next to each other, not so much for conditionals. In terms of implementation we simply give conditional branches less weight before computing the layout. Fixes #18053 - - - - - b7a6b2f4 by Gleb Popov at 2020-05-21T12:15:26-04:00 gitlab-ci: Set locale to C.UTF-8. - - - - - a8c27cf6 by Stefan Holdermans at 2020-05-21T12:16:08-04:00 Allow spaces in GHCi :script file names This patch updates the user interface of GHCi so that file names passed to the ':script' command may contain spaces escaped with a backslash. For example: :script foo\ bar.script The implementation uses a modified version of 'words' that does not break on escaped spaces. Fixes #18027. - - - - - 82663959 by Stefan Holdermans at 2020-05-21T12:16:08-04:00 Add extra tests for GHCi :script syntax checks The syntax for GHCi's ":script" command allows for only a single file name to be passed as an argument. This patch adds a test for the cases in which a file name is missing or multiple file names are passed. Related to #T18027. - - - - - a0b79e1b by Stefan Holdermans at 2020-05-21T12:16:08-04:00 Allow GHCi :script file names in double quotes This patch updates the user interface of GHCi so that file names passed to the ':script' command can be wrapped in double quotes. For example: :script "foo bar.script" The implementation uses a modified version of 'words' that treats character sequences enclosed in double quotes as single words. Fixes #18027. - - - - - cf566330 by Stefan Holdermans at 2020-05-21T12:16:08-04:00 Update documentation for GHCi :script This patch adds the fixes that allow for file names containing spaces to be passed to GHCi's ':script' command to the release notes for 8.12 and expands the user-guide documentation for ':script' by mentioning how such file names can be passed. Related to #18027. - - - - - 0004ccb8 by Tuan Le at 2020-05-21T12:16:46-04:00 llvmGen: Consider Relocatable read-only data as not constantReferences: #18137 - - - - - 964d3ea2 by John Ericson at 2020-05-21T12:17:30-04:00 Use `Checker` for `tc_pat` - - - - - b797aa42 by John Ericson at 2020-05-21T12:17:30-04:00 Use `Checker` for `tc_lpat` and `tc_lpats` - - - - - 5108e84a by John Ericson at 2020-05-21T12:17:30-04:00 More judiciously panic in `ts_pat` - - - - - 510e0451 by John Ericson at 2020-05-21T12:17:30-04:00 Put `PatEnv` first in `GHC.Tc.Gen.Pat.Checker` - - - - - cb4231db by John Ericson at 2020-05-21T12:17:30-04:00 Tiny cleaup eta-reduce away a function argument In GHC, not in the code being compiled! - - - - - 6890c38d by John Ericson at 2020-05-21T12:17:30-04:00 Use braces with do in `SplicePat` case for consistency - - - - - 3451584f by buggymcbugfix at 2020-05-21T12:18:06-04:00 Fix spelling mistakes and typos - - - - - b552e531 by buggymcbugfix at 2020-05-21T12:18:06-04:00 Add INLINABLE pragmas to Enum list producers The INLINABLE pragmas ensure that we export stable (unoptimised) unfoldings in the interface file so we can do list fusion at usage sites. Related tickets: #15185, #8763, #18178. - - - - - e7480063 by buggymcbugfix at 2020-05-21T12:18:06-04:00 Piggyback on Enum Word methods for Word64 If we are on a 64 bit platform, we can use the efficient Enum Word methods for the Enum Word64 instance. - - - - - 892b0c41 by buggymcbugfix at 2020-05-21T12:18:06-04:00 Document INLINE(ABLE) pragmas that enable fusion - - - - - 2b363ebb by Richard Eisenberg at 2020-05-21T12:18:45-04:00 MR template should ask for key part - - - - - a95bbd0b by Sebastian Graf at 2020-05-21T12:19:37-04:00 Make `Int`'s `mod` and `rem` strict in their first arguments They used to be strict until 4d2ac2d (9 years ago). It's obviously better to be strict for performance reasons. It also blocks #18067. NoFib results: ``` -------------------------------------------------------------------------------- Program Allocs Instrs -------------------------------------------------------------------------------- integer -1.1% +0.4% wheel-sieve2 +21.2% +20.7% -------------------------------------------------------------------------------- Min -1.1% -0.0% Max +21.2% +20.7% Geometric Mean +0.2% +0.2% ``` The regression in `wheel-sieve2` is due to reboxing that likely will go away with the resolution of #18067. See !3282 for details. Fixes #18187. - - - - - d3d055b8 by Galen Huntington at 2020-05-21T12:20:18-04:00 Clarify pitfalls of NegativeLiterals; see #18022. - - - - - 1b508a9e by Alexey Kuleshevich at 2020-05-21T12:21:02-04:00 Fix wording in primops documentation to reflect the correct reasoning: * Besides resizing functions, shrinking ones also mutate the size of a mutable array and because of those two `sizeofMutabeByteArray` and `sizeofSmallMutableArray` are now deprecated * Change reference in documentation to the newer functions `getSizeof*` instead of `sizeof*` for shrinking functions * Fix incorrect mention of "byte" instead of "small" - - - - - 4ca0c8a1 by Andreas Klebinger at 2020-05-21T12:21:53-04:00 Don't variable-length encode magic iface constant. We changed to use variable length encodings for many types by default, including Word32. This makes sense for numbers but not when Word32 is meant to represent four bytes. I added a FixedLengthEncoding newtype to Binary who's instances interpret their argument as a collection of bytes instead of a number. We then use this when writing/reading magic numbers to the iface file. I also took the libery to remove the dummy iface field. This fixes #18180. - - - - - a1275081 by Krzysztof Gogolewski at 2020-05-21T12:22:35-04:00 Add a regression test for #11506 The testcase works now. See explanation in https://gitlab.haskell.org/ghc/ghc/issues/11506#note_273202 - - - - - 8a816e5f by Krzysztof Gogolewski at 2020-05-21T12:23:55-04:00 Sort deterministically metric output Previously, we sorted according to the test name and way, but the metrics (max_bytes_used/peak_megabytes_allocated etc.) were appearing in nondeterministic order. - - - - - 566cc73f by Sylvain Henry at 2020-05-21T12:24:45-04:00 Move isDynLinkName into GHC.Types.Name It doesn't belong into GHC.Unit.State - - - - - d830bbc9 by Adam Sandberg Ericsson at 2020-05-23T13:36:20-04:00 docs: fix formatting and add some links [skip ci] - - - - - 49301ad6 by Andrew Martin at 2020-05-23T13:37:01-04:00 Implement cstringLength# and FinalPtr This function and its accompanying rule resolve issue #5218. A future PR to the bytestring library will make the internal Data.ByteString.Internal.unsafePackAddress compute string length with cstringLength#. This will improve the status quo because it is eligible for constant folding. Additionally, introduce a new data constructor to ForeignPtrContents named FinalPtr. This additional data constructor, when used in the IsString instance for ByteString, leads to more Core-to-Core optimization opportunities, fewer runtime allocations, and smaller binaries. Also, this commit re-exports all the functions from GHC.CString (including cstringLength#) in GHC.Exts. It also adds a new test driver. This test driver is used to perform substring matches on Core that is dumped after all the simplifier passes. In this commit, it is used to check that constant folding of cstringLength# works. - - - - - dcd6bdcc by Ben Gamari at 2020-05-23T13:37:48-04:00 simplCore: Ignore ticks in rule templates This fixes #17619, where a tick snuck in to the template of a rule, resulting in a panic during rule matching. The tick in question was introduced via post-inlining, as discussed in `Note [Simplifying rules]`. The solution we decided upon was to simply ignore ticks in the rule template, as discussed in `Note [Tick annotations in RULE matching]`. Fixes #18162. Fixes #17619. - - - - - 82cb8913 by John Ericson at 2020-05-23T13:38:32-04:00 Fix #18145 and also avoid needless work with implicit vars - `forAllOrNothing` now is monadic, so we can trace whether we bind an explicit `forall` or not. - #18145 arose because the free vars calculation was needlessly complex. It is now greatly simplified. - Replaced some other implicit var code with `filterFreeVarsToBind`. Co-authored-by: Ryan Scott <ryan.gl.scott at gmail.com> - - - - - a60dc835 by Ben Gamari at 2020-05-23T13:39:12-04:00 Bump process submodule Fixes #17926. - - - - - 856adf54 by Ben Gamari at 2020-05-23T13:40:21-04:00 users-guide: Clarify meaning of -haddock flag Fixes #18206. - - - - - 7ae57afd by Ben Gamari at 2020-05-23T13:41:03-04:00 git: Add ignored commits file This can be used to tell git to ignore bulk renaming commits like the recently-finished module hierarchy refactoring. Configured with, git config blame.ignoreRevsFile .git-ignore-revs - - - - - 63d30e60 by jneira at 2020-05-24T01:54:42-04:00 Add hie-bios script for windows systems It is a direct translation of the sh script - - - - - 59182b88 by jneira at 2020-05-24T01:54:42-04:00 Honour previous values for CABAL and CABFLAGS The immediate goal is let the hie-bios.bat script set CABFLAGS with `-v0` and remove all cabal output except the compiler arguments - - - - - 932dc54e by jneira at 2020-05-24T01:54:42-04:00 Add specific configuration for windows in hie.yaml - - - - - e0eda070 by jneira at 2020-05-24T01:54:42-04:00 Remove not needed hie-bios output - - - - - a0ea59d6 by Sylvain Henry at 2020-05-24T01:55:24-04:00 Move Config module into GHC.Settings - - - - - 37430251 by Sylvain Henry at 2020-05-24T01:55:24-04:00 Rename GHC.Core.Arity into GHC.Core.Opt.Arity - - - - - a426abb9 by Sylvain Henry at 2020-05-24T01:55:24-04:00 Rename GHC.Hs.Types into GHC.Hs.Type See discussion in https://gitlab.haskell.org/ghc/ghc/issues/13009#note_268610 - - - - - 1c91a7a0 by Sylvain Henry at 2020-05-24T01:55:24-04:00 Bump haddock submodule - - - - - 66bd24d1 by Ryan Scott at 2020-05-24T01:56:03-04:00 Add orderingTyCon to wiredInTyCons (#18185) `Ordering` needs to be wired in for use in the built-in `CmpNat` and `CmpSymbol` type families, but somehow it was never added to the list of `wiredInTyCons`, leading to the various oddities observed in #18185. Easily fixed by moving `orderingTyCon` from `basicKnownKeyNames` to `wiredInTyCons`. Fixes #18185. - - - - - 01c43634 by Matthew Pickering at 2020-05-24T01:56:42-04:00 Remove unused hs-boot file - - - - - 7a07aa71 by Sylvain Henry at 2020-05-24T15:22:17-04:00 Hadrian: fix cross-compiler build (#16051) - - - - - 15ccca16 by Sylvain Henry at 2020-05-24T15:22:17-04:00 Hadrian: fix distDir per stage - - - - - b420fb24 by Sylvain Henry at 2020-05-24T15:22:17-04:00 Hadrian: fix hp2ps error during cross-compilation Fixed by @alp (see https://gitlab.haskell.org/ghc/ghc/issues/16051#note_274265) - - - - - cd339ef0 by Joshua Price at 2020-05-24T15:22:56-04:00 Make Unicode brackets opening/closing tokens (#18225) The tokens `[|`, `|]`, `(|`, and `|)` are opening/closing tokens as described in GHC Proposal #229. This commit makes the unicode variants (`⟦`, `⟧`, `⦇`, and `⦈`) act the same as their ASCII counterparts. - - - - - 013d7120 by Ben Gamari at 2020-05-25T09:48:17-04:00 Revert "Specify kind variables for inferred kinds in base." As noted in !3132, this has rather severe knock-on consequences in user-code. We'll need to revisit this before merging something along these lines. This reverts commit 9749fe1223d182b1f8e7e4f7378df661c509f396. - - - - - 4c4312ed by Ben Gamari at 2020-05-25T09:48:53-04:00 Coverage: Drop redundant ad-hoc boot module check To determine whether the module is a boot module Coverage.addTicksToBinds was checking for a `boot` suffix in the module source filename. This is quite ad-hoc and shouldn't be necessary; the callsite in `deSugar` already checks that the module isn't a boot module. - - - - - 1abf3c84 by Ben Gamari at 2020-05-25T09:48:53-04:00 Coverage: Make tickBoxCount strict This could otherwise easily cause a leak of (+) thunks. - - - - - b2813750 by Ben Gamari at 2020-05-25T09:48:53-04:00 Coverage: Make ccIndices strict This just seems like a good idea. - - - - - 02e278eb by Ben Gamari at 2020-05-25T09:48:53-04:00 Coverage: Don't produce ModBreaks if not HscInterpreted emptyModBreaks contains a bottom and consequently it's important that we don't use it unless necessary. - - - - - b8c014ce by Ben Gamari at 2020-05-25T09:48:53-04:00 Coverage: Factor out addMixEntry - - - - - 53814a64 by Zubin Duggal at 2020-05-26T03:03:24-04:00 Add info about typeclass evidence to .hie files See `testsuite/tests/hiefile/should_run/HieQueries.hs` and `testsuite/tests/hiefile/should_run/HieQueries.stdout` for an example of this We add two new fields, `EvidenceVarBind` and `EvidenceVarUse` to the `ContextInfo` associated with an Identifier. These are associated with the appropriate identifiers for the evidence variables collected when we come across `HsWrappers`, `TcEvBinds` and `IPBinds` while traversing the AST. Instance dictionary and superclass selector dictionaries from `tcg_insts` and classes defined in `tcg_tcs` are also recorded in the AST as originating from their definition span This allows us to save a complete picture of the evidence constructed by the constraint solver, and will let us report this to the user, enabling features like going to the instance definition from the invocation of a class method(or any other method taking a constraint) and finding all usages of a particular instance. Additionally, - Mark NodeInfo with an origin so we can differentiate between bindings origininating in the source vs those in ghc - Along with typeclass evidence info, also include information on Implicit Parameters - Add a few utility functions to HieUtils in order to query the new info Updates haddock submodule - - - - - 6604906c by Sebastian Graf at 2020-05-26T03:04:04-04:00 Make WorkWrap.Lib.isWorkerSmallEnough aware of the old arity We should allow a wrapper with up to 82 parameters when the original function had 82 parameters to begin with. I verified that this made no difference on NoFib, but then again it doesn't use huge records... Fixes #18122. - - - - - cf772f19 by Sylvain Henry at 2020-05-26T03:04:45-04:00 Enhance Note [About units] for Backpack - - - - - ede24126 by Takenobu Tani at 2020-05-27T00:13:55-04:00 core-spec: Modify file paths according to new module hierarchy This patch updates file paths according to new module hierarchy [1]: * GHC/Core.hs <= coreSyn/CoreSyn.hs * GHC/Core/Coercion.hs <= types/Coercion.hs * GHC/Core/Coercion/Axiom.hs <= types/CoAxiom.hs * GHC/Core/Coercion/Opt.hs <= types/OptCoercion.hs * GHC/Core/DataCon.hs <= basicTypes/DataCon.hs * GHC/Core/FamInstEnv.hs <= types/FamInstEnv.hs * GHC/Core/Lint.hs <= coreSyn/CoreLint.hs * GHC/Core/Subst.hs <= coreSyn/CoreSubst.hs * GHC/Core/TyCo/Rep.hs <= types/TyCoRep.hs * GHC/Core/TyCon.hs <= types/TyCon.hs * GHC/Core/Type.hs <= types/Type.hs * GHC/Core/Unify.hs <= types/Unify.hs * GHC/Types/Literal.hs <= basicTypes/Literal.hs * GHC/Types/Var.hs <= basicTypes/Var.hs [1]: https://gitlab.haskell.org/ghc/ghc/-/wikis/Make-GHC-codebase-more-modular [skip ci] - - - - - 04750304 by Ben Gamari at 2020-05-27T00:14:33-04:00 eventlog: Fix racy flushing Previously no attempt was made to avoid multiple threads writing their capability-local eventlog buffers to the eventlog writer simultaneously. This could result in multiple eventlog streams being interleaved. Fix this by documenting that the EventLogWriter's write() and flush() functions may be called reentrantly and fix the default writer to protect its FILE* by a mutex. Fixes #18210. - - - - - d6203f24 by Joshua Price at 2020-05-27T00:15:17-04:00 Make `identifier` parse unparenthesized `->` (#18060) - - - - - 28deee28 by Ben Gamari at 2020-05-28T16:23:21-04:00 GHC.Core.Unfold: Refactor traceInline This reduces duplication as well as fixes a bug wherein -dinlining-check would override -ddump-inlinings. Moreover, the new variant - - - - - 1f393e1e by Ben Gamari at 2020-05-28T16:23:21-04:00 Avoid unnecessary allocations due to tracing utilities While ticky-profiling the typechecker I noticed that hundreds of millions of SDocs are being allocated just in case -ddump-*-trace is enabled. This is awful. We avoid this by ensuring that the dump flag check is inlined into the call site, ensuring that the tracing document needn't be allocated unless it's actually needed. See Note [INLINE conditional tracing utilities] for details. Fixes #18168. Metric Decrease: T9961 haddock.Cabal haddock.base haddock.compiler - - - - - 5f621a78 by Vladislav Zavialov at 2020-05-28T16:23:58-04:00 Add Semigroup/Monoid for Q (#18123) - - - - - dc5f004c by Xavier Denis at 2020-05-28T16:24:37-04:00 Fix #18071 Run the core linter on candidate instances to ensure they are well-kinded. Better handle quantified constraints by using a CtWanted to avoid having unsolved constraints thrown away at the end by the solver. - - - - - 10e6982c by Sebastian Graf at 2020-05-28T16:25:14-04:00 FloatOut: Only eta-expand dead-end RHS if arity will increase (#18231) Otherwise we risk turning trivial RHS into non-trivial RHS, introducing unnecessary bindings in the next Simplifier run, resulting in more churn. Fixes #18231. - - - - - 08dab5f7 by Sebastian Graf at 2020-05-28T16:25:14-04:00 DmdAnal: Recognise precise exceptions from case alternatives (#18086) Consider ```hs m :: IO () m = do putStrLn "foo" error "bar" ``` `m` (from #18086) always throws a (precise or imprecise) exception or diverges. Yet demand analysis infers `<L,A>` as demand signature instead of `<L,A>x` for it. That's because the demand analyser sees `putStrLn` occuring in a case scrutinee and decides that it has to `deferAfterPreciseException`, because `putStrLn` throws a precise exception on some control flow paths. This will mask the `botDiv` `Divergence`of the single case alt containing `error` to `topDiv`. Since `putStrLn` has `topDiv` itself, the final `Divergence` is `topDiv`. This is easily fixed: `deferAfterPreciseException` works by `lub`ing with the demand type of a virtual case branch denoting the precise exceptional control flow. We used `nopDmdType` before, but we can be more precise and use `exnDmdType`, which is `nopDmdType` with `exnDiv`. Now the `Divergence` from the case alt will degrade `botDiv` to `exnDiv` instead of `topDiv`, which combines with the result from the scrutinee to `exnDiv`, and all is well. Fixes #18086. - - - - - aef95f11 by Ben Gamari at 2020-05-28T16:25:53-04:00 Ticky-ticky: Record DataCon name in ticker name This makes it significantly easier to spot the nature of allocations regressions and comes at a reasonably low cost. - - - - - 8f021b8c by Ben Gamari at 2020-05-28T16:26:34-04:00 hadrian: Don't track GHC's verbosity argument Teach hadrian to ignore GHC's -v argument in its recompilation check, thus fixing #18131. - - - - - 13d9380b by Ben Gamari at 2020-05-28T16:27:20-04:00 Rip out CmmStackInfo(updfr_space) As noted in #18232, this field is currently completely unused and moreover doesn't have a clear meaning. - - - - - f10d11fa by Andreas Klebinger at 2020-05-29T01:38:42-04:00 Fix "build/elem" RULE. An redundant constraint prevented the rule from matching. Fixing this allows a call to elem on a known list to be translated into a series of equality checks, and eventually a simple case expression. Surprisingly this seems to regress elem for strings. To avoid this we now also allow foldrCString to inline and add an UTF8 variant. This results in elem being compiled to a tight non-allocating loop over the primitive string literal which performs a linear search. In the process this commit adds UTF8 variants for some of the functions in GHC.CString. This is required to make this work for both ASCII and UTF8 strings. There are also small tweaks to the CString related rules. We now allow ourselfes the luxury to compare the folding function via eqExpr, which helps to ensure the rule fires before we inline foldrCString*. Together with a few changes to allow matching on both the UTF8 and ASCII variants of the CString functions. - - - - - bbeb2389 by Ben Gamari at 2020-05-29T01:39:19-04:00 CoreToStg: Add Outputable ArgInfo instance - - - - - 0e3361ca by Simon Peyton Jones at 2020-05-29T01:39:19-04:00 Make Lint check return type of a join point Consider join x = rhs in body It's important that the type of 'rhs' is the same as the type of 'body', but Lint wasn't checking that invariant. Now it does! This was exposed by investigation into !3113. - - - - - c49f7df0 by Simon Peyton Jones at 2020-05-29T01:39:19-04:00 Do not float join points in exprIsConApp_maybe We hvae been making exprIsConApp_maybe cleverer in recent times: commit b78cc64e923716ac0512c299f42d4d0012306c05 Date: Thu Nov 15 17:14:31 2018 +0100 Make constructor wrappers inline only during the final phase commit 7833cf407d1f608bebb1d38bb99d3035d8d735e6 Date: Thu Jan 24 17:58:50 2019 +0100 Look through newtype wrappers (Trac #16254) commit c25b135ff5b9c69a90df0ccf51b04952c2dc6ee1 Date: Thu Feb 21 12:03:22 2019 +0000 Fix exprIsConApp_maybe But alas there was still a bug, now immortalised in Note [Don't float join points] in SimpleOpt. It's quite hard to trigger because it requires a dead join point, but it came up when compiling Cabal Cabal.Distribution.Fields.Lexer.hs, when working on !3113. Happily, the fix is extremly easy. Finding the bug was not so easy. - - - - - 46720997 by Ben Gamari at 2020-05-29T01:39:19-04:00 Allow simplification through runRW# Because runRW# inlines so late, we were previously able to do very little simplification across it. For instance, given even a simple program like case runRW# (\s -> let n = I# 42# in n) of I# n# -> f n# we previously had no way to avoid the allocation of the I#. This patch allows the simplifier to push strict contexts into the continuation of a runRW# application, as explained in in Note [Simplification of runRW#] in GHC.CoreToStg.Prep. Fixes #15127. Metric Increase: T9961 Metric Decrease: ManyConstructors Co-Authored-By: Simon Peyton-Jone <simonpj at microsoft.com> - - - - - 277c2f26 by Ben Gamari at 2020-05-29T01:39:55-04:00 Eta expand un-saturated primops Now since we no longer try to predict CAFfyness we have no need for the solution to #16846. Eta expanding unsaturated primop applications is conceptually simpler, especially in the presence of levity polymorphism. This essentially reverts cac8dc9f51e31e4c0a6cd9bc302f7e1bc7c03beb, as suggested in #18079. Closes #18079. - - - - - f44d7ae0 by Simon Jakobi at 2020-05-29T01:40:34-04:00 base: Scrap deprecation plan for Data.Monoid.{First,Last} See the discussion on the libraries mailing list for context: https://mail.haskell.org/pipermail/libraries/2020-April/030357.html - - - - - 8b494895 by Jeremy Schlatter at 2020-05-29T01:41:12-04:00 Fix typo in documentation - - - - - 998450f4 by Gleb Popov at 2020-05-29T01:41:53-04:00 Always define USE_PTHREAD_FOR_ITIMER for FreeBSD. - - - - - f9a513e0 by Alp Mestanogullari at 2020-05-29T01:42:36-04:00 hadrian: introduce 'install' target Its logic is very simple. It `need`s the `binary-dist-dir` target and runs suitable `configure` and `make install` commands for the user. A new `--prefix` command line argument is introduced to specify where GHC should be installed. - - - - - 67738db1 by Travis Whitaker at 2020-05-29T13:34:48-04:00 Build a threaded stage 1 if the bootstrapping GHC supports it. - - - - - aac19e6c by Peter Trommler at 2020-05-29T13:35:24-04:00 PPC NCG: No per-symbol .section ".toc" directives All position independent symbols are collected during code generation and emitted in one go. Prepending each symbol with a .section ".toc" directive is redundant. This patch drops the per-symbol directives leading to smaller assembler files. Fixes #18250 - - - - - 4413828b by Ben Gamari at 2020-05-30T06:07:31-04:00 rts: Teach getNumProcessors to return available processors Previously we would report the number of physical processors, which can be quite wrong in a containerized setting. Now we rather return how many processors are in our affinity mask when possible. I also refactored the code to prefer platform-specific since this will report logical CPUs instead of physical (using `machdep.cpu.thread_count` on Darwin and `cpuset_getaffinity` on FreeBSD). Fixes #14781. - - - - - 1449435c by Ben Gamari at 2020-05-30T06:07:31-04:00 users-guide: Note change in getNumProcessors in users guide - - - - - 3d960169 by Ben Gamari at 2020-05-30T06:07:31-04:00 rts: Drop compatibility shims for Windows Vista We can now assume that the thread and processor group interfaces are available. - - - - - 7f8f948c by Peter Trommler at 2020-05-30T06:08:07-04:00 PPC NCG: Fix .size directive on powerpc64 ELF v1 Thanks to Sergei Trofimovich for pointing out the issue. Fixes #18237 - - - - - 7c555b05 by Andreas Klebinger at 2020-05-30T06:08:43-04:00 Optimize GHC.Utils.Monad. Many functions in this module are recursive and as such are marked loop breakers. Which means they are unlikely to get an unfolding. This is *bad*. We always want to specialize them to specific Monads. Which requires a visible unfolding at the use site. I rewrote the recursive ones from: foo f x = ... foo x' ... to foo f x = go x where go x = ... As well as giving some pragmas to make all of them available for specialization. The end result is a reduction of allocations of about -1.4% for nofib/spectral/simple/Main.hs when compiled with `-O`. ------------------------- Metric Decrease: T12425 T14683 T5631 T9233 T9675 T9961 WWRec ------------------------- - - - - - 8b1cb5df by Ben Gamari at 2020-05-30T06:09:20-04:00 Windows: Bump Windows toolchain to 0.2 - - - - - 6947231a by Zubin Duggal at 2020-05-30T06:10:02-04:00 Simplify contexts in GHC.Iface.Ext.Ast - - - - - 2ee4f36c by Daniel Gröber at 2020-06-01T06:32:56-04:00 Cleanup OVERWRITING_CLOSURE logic The code is just more confusing than it needs to be. We don't need to mix the threaded check with the ldv profiling check since ldv's init already checks for this. Hence they can be two separate checks. Taking the sanity checking into account is also cleaner via DebugFlags.sanity. No need for checking the DEBUG define. The ZERO_SLOP_FOR_LDV_PROF and ZERO_SLOP_FOR_SANITY_CHECK definitions the old code had also make things a lot more opaque IMO so I removed those. - - - - - 6159559b by Daniel Gröber at 2020-06-01T06:32:56-04:00 Fix OVERWRITING_CLOSURE assuming closures are not inherently used The new ASSERT in LDV_recordDead() was being tripped up by MVars when removeFromMVarBlockedQueue() calls OVERWRITING_CLOSURE() via OVERWRITE_INFO(). - - - - - 38992085 by Daniel Gröber at 2020-06-01T06:32:56-04:00 Always zero shrunk mutable array slop when profiling When shrinking arrays in the profiling way we currently don't always zero the leftover slop. This means we can't traverse such closures in the heap profiler. The old Note [zeroing slop] and #8402 have some rationale for why this is so but I belive the reasoning doesn't apply to mutable closures. There users already have to ensure multiple threads don't step on each other's toes so zeroing should be safe. - - - - - b0c1f2a6 by Ben Gamari at 2020-06-01T06:33:37-04:00 testsuite: Add test for #18151 - - - - - 9a99a178 by Ben Gamari at 2020-06-01T06:33:37-04:00 testsuite: Add test for desugaring of PostfixOperators - - - - - 2b89ca5b by Ben Gamari at 2020-06-01T06:33:37-04:00 HsToCore: Eta expand left sections Strangely, the comment next to this code already alluded to the fact that even simply eta-expanding will sacrifice laziness. It's quite unclear how we regressed so far. See #18151. - - - - - d412d7a3 by Kirill Elagin at 2020-06-01T06:34:21-04:00 Winferred-safe-imports: Do not exit with error Currently, when -Winferred-safe-imports is enabled, even when it is not turned into an error, the compiler will still exit with exit code 1 if this warning was emitted. Make sure it is really treated as a warning. - - - - - f945eea5 by Ben Gamari at 2020-06-01T06:34:58-04:00 nonmoving: Optimise log2_ceil - - - - - aab606e4 by Bodigrim at 2020-06-01T06:35:36-04:00 Clarify description of fromListN - - - - - 7e5220e2 by Bodigrim at 2020-06-01T06:35:36-04:00 Apply suggestion to libraries/base/GHC/Exts.hs - - - - - f3fb1ce9 by fendor at 2020-06-01T06:36:18-04:00 Add `isInScope` check to `lintCoercion` Mirrors the behaviour of `lintType`. - - - - - 5ac4d946 by fendor at 2020-06-01T06:36:18-04:00 Lint rhs of IfaceRule - - - - - 1cef6126 by Jeremy Schlatter at 2020-06-01T06:37:00-04:00 Fix wording in documentation The duplicate "orphan instance" phrase here doesn't make sense, and was probably an accident. - - - - - 5aaf08f2 by Takenobu Tani at 2020-06-01T06:37:43-04:00 configure: Modify aclocal.m4 according to new module hierarchy This patch updates file paths according to new module hierarchy [1]: * Rename: * compiler/GHC/Parser.hs <= compiler/parser/Parser.hs * compiler/GHC/Parser/Lexer.hs <= compiler/Parser/Lexer.hs * Add: * compiler/GHC/Cmm/Lexer.hs [1]: https://gitlab.haskell.org/ghc/ghc/-/wikis/Make-GHC-codebase-more-modular - - - - - 15857ad8 by Ben Gamari at 2020-06-01T06:38:26-04:00 testsuite: Don't fail if we can't unlink __symlink_test Afterall, it's possible we were unable to create it due to lack of symlink permission. - - - - - 4a7229ef by Ben Gamari at 2020-06-01T06:38:26-04:00 testsuite: Refactor ghostscript detection Tamar reported that he saw crashes due to unhandled exceptions. - - - - - 2ab37eaf by Ben Gamari at 2020-06-01T06:38:26-04:00 testsuite/perf_notes: Fix ill-typed assignments - - - - - e45d5b66 by Ben Gamari at 2020-06-01T06:38:26-04:00 testsuite/testutil: Fix bytes/str mismatch - - - - - 7002d0cb by Ben Gamari at 2020-06-01T06:38:26-04:00 testsuite: Work around spurious mypy failure - - - - - 11390e3a by Takenobu Tani at 2020-06-01T06:39:05-04:00 Clean up file paths for new module hierarchy This updates comments only. This patch replaces file references according to new module hierarchy. See also: * https://gitlab.haskell.org/ghc/ghc/-/wikis/Make-GHC-codebase-more-modular * https://gitlab.haskell.org/ghc/ghc/issues/13009 - - - - - 8f2e5732 by Takenobu Tani at 2020-06-01T06:39:05-04:00 Modify file paths to module paths for new module hierarchy This updates comments only. This patch replaces module references according to new module hierarchy [1][2]. For files under the `compiler/` directory, I replace them as module paths instead of file paths. For instance, `GHC.Unit.State` instead of `compiler/GHC/Unit/State.hs` [3]. For current and future haddock's markup, this patch encloses the module name with "" [4]. [1]: https://gitlab.haskell.org/ghc/ghc/-/wikis/Make-GHC-codebase-more-modular [2]: https://gitlab.haskell.org/ghc/ghc/issues/13009 [3]: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3375#note_276613 [4]: https://haskell-haddock.readthedocs.io/en/latest/markup.html#linking-to-modules - - - - - 68b71c4a by Tom Ellis at 2020-06-01T06:39:55-04:00 Rename the singleton tuple GHC.Tuple.Unit to GHC.Tuple.Solo - - - - - 95da76c2 by Sylvain Henry at 2020-06-01T06:40:41-04:00 Hadrian: fix binary-dist target for cross-compilation - - - - - 730fcd54 by Vladislav Zavialov at 2020-06-01T06:41:18-04:00 Improve parser error messages for the @-operator Since GHC diverges from the Haskell Report by allowing the user to define (@) as an infix operator, we better give a good error message when the user does so unintentionally. In general, this is rather hard to do, as some failures will be discovered only in the renamer or the type checker: x :: (Integer, Integer) x @ (a, b) = (1, 2) This patch does *not* address this general case. However, it gives much better error messages when the binding is not syntactically valid: pairs xs @ (_:xs') = zip xs xs' Before this patch, the error message was rather puzzling: <interactive>:1:1: error: Parse error in pattern: pairs After this patch, the error message includes a hint: <interactive>:1:1: error: Parse error in pattern: pairs In a function binding for the ‘@’ operator. Perhaps you meant an as-pattern, which must not be surrounded by whitespace - - - - - 0fde5377 by Vladislav Zavialov at 2020-06-01T06:41:18-04:00 Improve parser error messages for TypeApplications With this patch, we always parse f @t as a type application, thereby producing better error messages. This steals two syntactic forms: * Prefix form of the @-operator in expressions. Since the @-operator is a divergence from the Haskell Report anyway, this is not a major loss. * Prefix form of @-patterns. Since we are stealing loose infix form anyway, might as well sacrifice the prefix form for the sake of much better error messages. - - - - - c68e7e1e by Vladislav Zavialov at 2020-06-01T06:41:18-04:00 Improve parser error messages for TemplateHaskellQuotes While [e| |], [t| |], [d| |], and so on, steal syntax from list comprehensions, [| |] and [|| ||] do not steal any syntax. Thus we can improve error messages by always accepting them in the lexer. Turns out the renamer already performs necessary validation. - - - - - 120aedbd by Ben Gamari at 2020-06-01T16:07:02-04:00 gitlab-ci: Disable use of ld.lld on ARMv7 It turns out that lld non-deterministically fails on ARMv7. I suspect this may be due to the a kernel regression as this only started happening when we upgraded to 5.4. Nevertheless, easily avoided by simply sticking with gold. Works around #18280. - - - - - d6279ff0 by Ben Gamari at 2020-06-02T13:03:30-04:00 gitlab-ci: Ensure that workaround for #18280 applies to bindisttest We need to ensure that the `configure` flags working around #18280 are propagated to the bindisttest `configure` as well. - - - - - cb5c31b5 by Ben Gamari at 2020-06-03T17:55:04-04:00 gitlab-ci: Allow ARMv7 job to fail Due to #18298. - - - - - 32a4ae90 by John Ericson at 2020-06-04T04:34:42-04:00 Clean up boot vs non-boot disambiguating types We often have (ModuleName, Bool) or (Module, Bool) pairs for "extended" module names (without or with a unit id) disambiguating boot and normal modules. We think this is important enough across the compiler that it deserves a new nominal product type. We do this with synnoyms and a functor named with a `Gen` prefix, matching other newly created definitions. It was also requested that we keep custom `IsBoot` / `NotBoot` sum type. So we have it too. This means changing many the many bools to use that instead. Updates `haddock` submodule. - - - - - c05756cd by Niklas Hambüchen at 2020-06-04T04:35:24-04:00 docs: Add more details on InterruptibleFFI. Details from https://gitlab.haskell.org/ghc/ghc/issues/8684 and https://github.com/takano-akio/filelock/pull/7#discussion_r280332430 - - - - - 1b975aed by Andrew Martin at 2020-06-04T04:36:03-04:00 Allow finalizeForeignPtr to be called on FinalPtr/PlainPtr. MR 2165 (commit 49301ad6226d9a83d110bee8c419615dd94f5ded) regressed finalizeForeignPtr by throwing exceptions when PlainPtr was encounterd. This regression did not make it into a release of GHC. Here, the original behavior is restored, and FinalPtr is given the same treatment as PlainPtr. - - - - - 2bd3929a by Luke Lau at 2020-06-04T04:36:41-04:00 Fix documentation on type families not being extracted It looks like the location of the Names used for CoAxioms on type families are now located at their type constructors. Previously, Docs.hs thought the Names were located in the RHS, so the RealSrcSpan in the instanceMap and getInstLoc didn't match up. Fixes #18241 - - - - - 6735b9d9 by Ben Gamari at 2020-06-04T04:37:21-04:00 GHC.Hs.Instances: Compile with -O0 This module contains exclusively Data instances, which are going to be slow no matter what we do. Furthermore, they are incredibly slow to compile with optimisation (see #9557). Consequently we compile this with -O0. See #18254. - - - - - c330331a by nineonine at 2020-06-04T04:37:59-04:00 Add test for #17669 - - - - - cab684f0 by Ben Gamari at 2020-06-04T04:38:36-04:00 rts: Add Windows-specific implementation of rtsSleep Previously we would use the POSIX path, which uses `nanosleep`. However, it turns out that `nanosleep` is provided by `libpthread` on Windows. In general we don't want to incur such a dependency. Avoid this by simply using `Sleep` on Windows. Fixes #18272. - - - - - ad44b504 by Ben Gamari at 2020-06-04T04:38:36-04:00 compiler: Disable use of process jobs with process < 1.6.9 Due to #17926. - - - - - 6a4098a4 by Moritz Angermann at 2020-06-04T04:55:51-04:00 [linker] Adds void printLoadedObjects(void); This allows us to dump in-memory object code locations for debugging. Fixup printLoadedObjects prototype - - - - - af5e3a88 by Artem Pelenitsyn at 2020-06-05T03:18:49-04:00 base: fix sign confusion in log1mexp implementation (fix #17125) author: claude (https://gitlab.haskell.org/trac-claude) The correct threshold for log1mexp is -(log 2) with the current specification of log1mexp. This change improves accuracy for large negative inputs. To avoid code duplication, a small helper function is added; it isn't the default implementation in Floating because it needs Ord. This patch does nothing to address that the Haskell specification is different from that in common use in other languages. - - - - - 2b792fac by Simon Peyton Jones at 2020-06-05T09:27:50-04:00 Simple subsumption This patch simplifies GHC to use simple subsumption. Ticket #17775 Implements GHC proposal #287 https://github.com/ghc-proposals/ghc-proposals/blob/master/ proposals/0287-simplify-subsumption.rst All the motivation is described there; I will not repeat it here. The implementation payload: * tcSubType and friends become noticably simpler, because it no longer uses eta-expansion when checking subsumption. * No deeplyInstantiate or deeplySkolemise That in turn means that some tests fail, by design; they can all be fixed by eta expansion. There is a list of such changes below. Implementing the patch led me into a variety of sticky corners, so the patch includes several othe changes, some quite significant: * I made String wired-in, so that "foo" :: String rather than "foo" :: [Char] This improves error messages, and fixes #15679 * The pattern match checker relies on knowing about in-scope equality constraints, andd adds them to the desugarer's environment using addTyCsDs. But the co_fn in a FunBind was missed, and for some reason simple-subsumption ends up with dictionaries there. So I added a call to addTyCsDs. This is really part of #18049. * I moved the ic_telescope field out of Implication and into ForAllSkol instead. This is a nice win; just expresses the code much better. * There was a bug in GHC.Tc.TyCl.Instance.tcDataFamInstHeader. We called checkDataKindSig inside tc_kind_sig, /before/ solveEqualities and zonking. Obviously wrong, easily fixed. * solveLocalEqualitiesX: there was a whole mess in here, around failing fast enough. I discovered a bad latent bug where we could successfully kind-check a type signature, and use it, but have unsolved constraints that could fill in coercion holes in that signature -- aargh. It's all explained in Note [Failure in local type signatures] in GHC.Tc.Solver. Much better now. * I fixed a serious bug in anonymous type holes. IN f :: Int -> (forall a. a -> _) -> Int that "_" should be a unification variable at the /outer/ level; it cannot be instantiated to 'a'. This was plain wrong. New fields mode_lvl and mode_holes in TcTyMode, and auxiliary data type GHC.Tc.Gen.HsType.HoleMode. This fixes #16292, but makes no progress towards the more ambitious #16082 * I got sucked into an enormous refactoring of the reporting of equality errors in GHC.Tc.Errors, especially in mkEqErr1 mkTyVarEqErr misMatchMsg misMatchMsgOrCND In particular, the very tricky mkExpectedActualMsg function is gone. It took me a full day. But the result is far easier to understand. (Still not easy!) This led to various minor improvements in error output, and an enormous number of test-case error wibbles. One particular point: for occurs-check errors I now just say Can't match 'a' against '[a]' rather than using the intimidating language of "occurs check". * Pretty-printing AbsBinds Tests review * Eta expansions T11305: one eta expansion T12082: one eta expansion (undefined) T13585a: one eta expansion T3102: one eta expansion T3692: two eta expansions (tricky) T2239: two eta expansions T16473: one eta determ004: two eta expansions (undefined) annfail06: two eta (undefined) T17923: four eta expansions (a strange program indeed!) tcrun035: one eta expansion * Ambiguity check at higher rank. Now that we have simple subsumption, a type like f :: (forall a. Eq a => Int) -> Int is no longer ambiguous, because we could write g :: (forall a. Eq a => Int) -> Int g = f and it'd typecheck just fine. But f's type is a bit suspicious, and we might want to consider making the ambiguity check do a check on each sub-term. Meanwhile, these tests are accepted, whereas they were previously rejected as ambiguous: T7220a T15438 T10503 T9222 * Some more interesting error message wibbles T13381: Fine: one error (Int ~ Exp Int) rather than two (Int ~ Exp Int, Exp Int ~ Int) T9834: Small change in error (improvement) T10619: Improved T2414: Small change, due to order of unification, fine T2534: A very simple case in which a change of unification order means we get tow unsolved constraints instead of one tc211: bizarre impredicative tests; just accept this for now Updates Cabal and haddock submodules. Metric Increase: T12150 T12234 T5837 haddock.base Metric Decrease: haddock.compiler haddock.Cabal haddock.base Merge note: This appears to break the `UnliftedNewtypesDifficultUnification` test. It has been marked as broken in the interest of merging. (cherry picked from commit 66b7b195cb3dce93ed5078b80bf568efae904cc5) - - - - - 2dff8141 by Ryan Scott at 2020-06-05T14:21:24-04:00 Simplify bindLHsTyVarBndrs and bindHsQTyVars Both `bindLHsTyVarBndrs` and `bindHsQTyVars` take two separate `Maybe` arguments, which I find terribly confusing. Thankfully, it's possible to remove one `Maybe` argument from each of these functions, which this patch accomplishes: * `bindHsQTyVars` takes a `Maybe SDoc` argument, which is `Just` if GHC should warn about any of the quantified type variables going unused. However, every call site uses `Nothing` in practice. This makes sense, since it doesn't really make sense to warn about unused type variables bound by an `LHsQTyVars`. For instance, you wouldn't warn about the `a` in `data Proxy a = Proxy` going unused. As a result, I simply remove this `Maybe SDoc` argument altogether. * `bindLHsTyVarBndrs` also takes a `Maybe SDoc` argument for the same reasons that `bindHsQTyVars` took one. To make things more confusing, however, `bindLHsTyVarBndrs` also takes a separate `HsDocContext` argument, which is pretty-printed (to an `SDoc`) in warnings and error messages. In practice, the `Maybe SDoc` and the `HsDocContext` often contain the same text. See the call sites for `bindLHsTyVarBndrs` in `rnFamInstEqn` and `rnConDecl`, for instance. There are only a handful of call sites where the text differs between the `Maybe SDoc` and `HsDocContext` arguments: * In `rnHsRuleDecl`, where the `Maybe SDoc` says "`In the rule`" and the `HsDocContext` says "`In the transformation rule`". * In `rnHsTyKi`/`rn_ty`, where the `Maybe SDoc` says "`In the type`" but the `HsDocContext` is inhereted from the surrounding context (e.g., if `rnHsTyKi` were called on a top-level type signature, the `HsDocContext` would be "`In the type signature`" instead) In both cases, warnings/error messages arguably _improve_ by unifying making the `Maybe SDoc`'s text match that of the `HsDocContext`. As a result, I decided to remove the `Maybe SDoc` argument to `bindLHsTyVarBndrs` entirely and simply reuse the text from the `HsDocContext`. (I decided to change the phrase "transformation rule" to "rewrite rule" while I was in the area.) The `Maybe SDoc` argument has one other purpose: signaling when to emit "`Unused quantified type variable`" warnings. To recover this functionality, I replaced the `Maybe SDoc` argument with a boolean-like `WarnUnusedForalls` argument. The only `bindLHsTyVarBndrs` call site that chooses _not_ to emit these warnings in `bindHsQTyVars`. - - - - - e372331b by Ben Gamari at 2020-06-07T08:46:41-04:00 hadrian: Add missing deriveConstants dependency on ghcplatform.h deriveConstants wants to compile C sources which #include PosixSource.h, which itself #includes ghcplatform.h. Make sure that Hadrian knows about this dependency. Fixes #18290. - - - - - b022051a by Moritz Angermann at 2020-06-07T08:46:42-04:00 ghc-prim needs to depend on libc and libm libm is just an empty shell on musl, and all the math functions are contained in libc. - - - - - 6dae6548 by Moritz Angermann at 2020-06-07T08:46:42-04:00 Disable DLL loading if without system linker Some platforms (musl, aarch64) do not have a working dynamic linker implemented in the libc, even though we might see dlopen. It will ultimately just return that this is not supported. Hence we'll add a flag to the compiler to flat our disable loading dlls. This is needed as we will otherwise try to load the shared library even if this will subsequently fail. At that point we have given up looking for static options though. - - - - - 4a158ffc by Moritz Angermann at 2020-06-07T08:46:43-04:00 Range is actually +/-2^32, not +/-2^31 See also: https://static.docs.arm.com/ihi0056/g/aaelf64.pdf - - - - - f1bfb806 by Ben Gamari at 2020-06-07T10:49:30-04:00 OccurAnal: Avoid exponential behavior due to where clauses Previously the `Var` case of `occAnalApp` could in some cases (namely in the case of `runRW#` applications) call `occAnalRhs` two. In the case of nested `runRW#`s this results in exponential complexity. In some cases the compilation time that resulted would be very long indeed (see #18296). Fixes #18296. Metric Decrease: T9961 T12150 T12234 - - - - - 9b607671 by Takenobu Tani at 2020-06-09T08:05:46-04:00 Add link to GHC's wiki in the GHC API header This adds a URL to point to GHC's wiki in the GHC API header. Newcomers could easily find more information from the GHC API's web like [1]. [1]: Current version, https://ghc.gitlab.haskell.org/ghc/doc/libraries/ghc-8.11.0.20200604/index.html [skip ci] - - - - - 72c7fe9a by Ryan Scott at 2020-06-09T08:06:24-04:00 Make GADT constructors adhere to the forall-or-nothing rule properly Issue #18191 revealed that the types of GADT constructors don't quite adhere to the `forall`-or-nothing rule. This patch serves to clean up this sad state of affairs somewhat. The main change is not in the code itself, but in the documentation, as this patch introduces two sections to the GHC User's Guide: * A "Formal syntax for GADTs" section that presents a BNF-style grammar for what is and isn't allowed in GADT constructor types. This mostly exists to codify GHC's existing behavior, but it also imposes a new restriction that addresses #18191: the outermost `forall` and/or context in a GADT constructor is not allowed to be surrounded by parentheses. Doing so would make these `forall`s/contexts nested, and GADTs do not support nested `forall`s/contexts at present. * A "`forall`-or-nothing rule" section that describes exactly what the `forall`-or-nothing rule is all about. Surprisingly, there was no mention of this anywhere in the User's Guide up until now! To adhere the new specification in the "Formal syntax for GADTs" section of the User's Guide, the following code changes were made: * A new function, `GHC.Hs.Type.splitLHsGADTPrefixTy`, was introduced. This is very much like `splitLHsSigmaTy`, except that it avoids splitting apart any parentheses, which can be syntactically significant for GADT types. See `Note [No nested foralls or contexts in GADT constructors]` in `GHC.Hs.Type`. * `ConDeclGADTPrefixPs`, an extension constructor for `XConDecl`, was introduced so that `GHC.Parser.PostProcess.mkGadtDecl` can return it when given a prefix GADT constructor. Unlike `ConDeclGADT`, `ConDeclGADTPrefixPs` does not split the GADT type into its argument and result types, as this cannot be done until after the type is renamed (see `Note [GADT abstract syntax]` in `GHC.Hs.Decls` for why this is the case). * `GHC.Renamer.Module.rnConDecl` now has an additional case for `ConDeclGADTPrefixPs` that (1) splits apart the full `LHsType` into its `forall`s, context, argument types, and result type, and (2) checks for nested `forall`s/contexts. Step (2) used to be performed the typechecker (in `GHC.Tc.TyCl.badDataConTyCon`) rather than the renamer, but now the relevant code from the typechecker can simply be deleted. One nice side effect of this change is that we are able to give a more accurate error message for GADT constructors that use visible dependent quantification (e.g., `MkFoo :: forall a -> a -> Foo a`), which improves the stderr in the `T16326_Fail6` test case. Fixes #18191. Bumps the Haddock submodule. - - - - - a47e6442 by Ryan Scott at 2020-06-10T03:39:12-04:00 Always use rnImplicitBndrs to bring implicit tyvars into scope This implements a first step towards #16762 by changing the renamer to always use `rnImplicitBndrs` to bring implicitly bound type variables into scope. The main change is in `rnFamInstEqn` and `bindHsQTyVars`, which previously used _ad hoc_ methods of binding their implicit tyvars. There are a number of knock-on consequences: * One of the reasons that `rnFamInstEqn` used an _ad hoc_ binding mechanism was to give more precise source locations in `-Wunused-type-patterns` warnings. (See https://gitlab.haskell.org/ghc/ghc/issues/16762#note_273343 for an example of this.) However, these warnings are actually a little _too_ precise, since implicitly bound type variables don't have exact binding sites like explicitly bound type variables do. A similar problem existed for "`Different names for the same type variable`" errors involving implicit tyvars bound by `bindHsQTyVars`. Therefore, we simply accept the less precise (but more accurate) source locations from `rnImplicitBndrs` in `rnFamInstEqn` and `bindHsQTyVars`. See `Note [Source locations for implicitly bound type variables]` in `GHC.Rename.HsType` for the full story. * In order for `rnImplicitBndrs` to work in `rnFamInstEqn`, it needs to be able to look up names from the parent class (in the event that we are renaming an associated type family instance). As a result, `rnImplicitBndrs` now takes an argument of type `Maybe assoc`, which is `Just` in the event that a type family instance is associated with a class. * Previously, GHC kept track of three type synonyms for free type variables in the renamer: `FreeKiTyVars`, `FreeKiTyVarsDups` (which are allowed to contain duplicates), and `FreeKiTyVarsNoDups` (which contain no duplicates). However, making is a distinction between `-Dups` and `-NoDups` is now pointless, as all code that returns `FreeKiTyVars{,Dups,NoDups}` will eventually end up being passed to `rnImplicitBndrs`, which removes duplicates. As a result, I decided to just get rid of `FreeKiTyVarsDups` and `FreeKiTyVarsNoDups`, leaving only `FreeKiTyVars`. * The `bindLRdrNames` and `deleteBys` functions are now dead code, so I took the liberty of removing them. - - - - - 24879129 by Takenobu Tani at 2020-06-10T03:39:59-04:00 Clarify leaf module names for new module hierarchy This updates comments only. This patch replaces leaf module names according to new module hierarchy [1][2] as followings: * Expand leaf names to easily find the module path: for instance, `Id.hs` to `GHC.Types.Id`. * Modify leaf names according to new module hierarchy: for instance, `Convert.hs` to `GHC.ThToHs`. * Fix typo: for instance, `GHC.Core.TyCo.Rep.hs` to `GHC.Core.TyCo.Rep` See also !3375 [1]: https://gitlab.haskell.org/ghc/ghc/-/wikis/Make-GHC-codebase-more-modular [2]: https://gitlab.haskell.org/ghc/ghc/issues/13009 - - - - - 92de9e25 by Ömer Sinan Ağacan at 2020-06-10T03:41:07-04:00 rts: Remove unused GET_ENTRY closure macro This macro is not used and got broken in the meantime, as ENTRY_CODE was deleted. - - - - - 87102928 by Ömer Sinan Ağacan at 2020-06-10T03:41:50-04:00 Fix -fkeep-cafs flag name in users guide - - - - - ccd6843d by Shayne Fletcher at 2020-06-10T04:14:57-04:00 Expose impliedGFlags, impledOffGFlags, impliedXFlags - - - - - 7a737e89 by Ömer Sinan Ağacan at 2020-06-10T04:14:58-04:00 Cross-module LambdaFormInfo passing - Store LambdaFormInfos of exported Ids in interface files - Use them in importing modules This is for optimization purposes: if we know LambdaFormInfo of imported Ids we can generate more efficient calling code, see `getCallMethod`. Exporting (putting them in interface files or in ModDetails) and importing (reading them from interface files) are both optional. We don't assume known LambdaFormInfos anywhere and do not change how we call Ids with unknown LambdaFormInfos. Runtime, allocation, and residency numbers when building Cabal-the-library (commit 0d4ee7ba3): (Log and .hp files are in the MR: !2842) | | GHC HEAD | This patch | Diff | |-----|----------|------------|----------------| | -O0 | 0:35.89 | 0:34.10 | -1.78s, -4.98% | | -O1 | 2:24.01 | 2:23.62 | -0.39s, -0.27% | | -O2 | 2:52.23 | 2:51.35 | -0.88s, -0.51% | | | GHC HEAD | This patch | Diff | |-----|-----------------|-----------------|----------------------------| | -O0 | 54,843,608,416 | 54,878,769,544 | +35,161,128 bytes, +0.06% | | -O1 | 227,136,076,400 | 227,569,045,168 | +432,968,768 bytes, +0.19% | | -O2 | 266,147,063,296 | 266,749,643,440 | +602,580,144 bytes, +0.22% | NOTE: Residency is measured with extra runtime args: `-i0 -h` which effectively turn all GCs into major GCs, and do GC more often. | | GHC HEAD | This patch | Diff | |-----|----------------------------|------------------------------|----------------------------| | -O0 | 410,284,000 (910 samples) | 411,745,008 (906 samples) | +1,461,008 bytes, +0.35% | | -O1 | 928,580,856 (2109 samples) | 943,506,552 (2103 samples) | +14,925,696 bytes, +1.60% | | -O2 | 993,951,352 (2549 samples) | 1,010,156,328 (2545 samples) | +16,204,9760 bytes, +1.63% | NoFib results: -------------------------------------------------------------------------------- Program Size Allocs Instrs Reads Writes -------------------------------------------------------------------------------- CS 0.0% 0.0% +0.0% +0.0% +0.0% CSD 0.0% 0.0% 0.0% +0.0% +0.0% FS 0.0% 0.0% +0.0% +0.0% +0.0% S 0.0% 0.0% +0.0% +0.0% +0.0% VS 0.0% 0.0% +0.0% +0.0% +0.0% VSD 0.0% 0.0% +0.0% +0.0% +0.1% VSM 0.0% 0.0% +0.0% +0.0% +0.0% anna 0.0% 0.0% -0.3% -0.8% -0.0% ansi 0.0% 0.0% -0.0% -0.0% 0.0% atom 0.0% 0.0% -0.0% -0.0% 0.0% awards 0.0% 0.0% -0.1% -0.3% 0.0% banner 0.0% 0.0% -0.0% -0.0% -0.0% bernouilli 0.0% 0.0% -0.0% -0.0% -0.0% binary-trees 0.0% 0.0% -0.0% -0.0% +0.0% boyer 0.0% 0.0% -0.0% -0.0% 0.0% boyer2 0.0% 0.0% -0.0% -0.0% 0.0% bspt 0.0% 0.0% -0.0% -0.2% 0.0% cacheprof 0.0% 0.0% -0.1% -0.4% +0.0% calendar 0.0% 0.0% -0.0% -0.0% 0.0% cichelli 0.0% 0.0% -0.9% -2.4% 0.0% circsim 0.0% 0.0% -0.0% -0.0% 0.0% clausify 0.0% 0.0% -0.1% -0.3% 0.0% comp_lab_zift 0.0% 0.0% -0.0% -0.0% +0.0% compress 0.0% 0.0% -0.0% -0.0% -0.0% compress2 0.0% 0.0% -0.0% -0.0% 0.0% constraints 0.0% 0.0% -0.1% -0.2% -0.0% cryptarithm1 0.0% 0.0% -0.0% -0.0% 0.0% cryptarithm2 0.0% 0.0% -1.4% -4.1% -0.0% cse 0.0% 0.0% -0.0% -0.0% -0.0% digits-of-e1 0.0% 0.0% -0.0% -0.0% -0.0% digits-of-e2 0.0% 0.0% -0.0% -0.0% -0.0% dom-lt 0.0% 0.0% -0.1% -0.2% 0.0% eliza 0.0% 0.0% -0.5% -1.5% 0.0% event 0.0% 0.0% -0.0% -0.0% -0.0% exact-reals 0.0% 0.0% -0.1% -0.3% +0.0% exp3_8 0.0% 0.0% -0.0% -0.0% -0.0% expert 0.0% 0.0% -0.3% -1.0% -0.0% fannkuch-redux 0.0% 0.0% +0.0% +0.0% +0.0% fasta 0.0% 0.0% -0.0% -0.0% +0.0% fem 0.0% 0.0% -0.0% -0.0% 0.0% fft 0.0% 0.0% -0.0% -0.0% 0.0% fft2 0.0% 0.0% -0.0% -0.0% 0.0% fibheaps 0.0% 0.0% -0.0% -0.0% +0.0% fish 0.0% 0.0% 0.0% -0.0% +0.0% fluid 0.0% 0.0% -0.4% -1.2% +0.0% fulsom 0.0% 0.0% -0.0% -0.0% 0.0% gamteb 0.0% 0.0% -0.1% -0.3% 0.0% gcd 0.0% 0.0% -0.0% -0.0% 0.0% gen_regexps 0.0% 0.0% -0.0% -0.0% -0.0% genfft 0.0% 0.0% -0.0% -0.0% 0.0% gg 0.0% 0.0% -0.0% -0.0% +0.0% grep 0.0% 0.0% -0.0% -0.0% -0.0% hidden 0.0% 0.0% -0.1% -0.4% -0.0% hpg 0.0% 0.0% -0.2% -0.5% +0.0% ida 0.0% 0.0% -0.0% -0.0% +0.0% infer 0.0% 0.0% -0.3% -0.8% -0.0% integer 0.0% 0.0% -0.0% -0.0% +0.0% integrate 0.0% 0.0% -0.0% -0.0% 0.0% k-nucleotide 0.0% 0.0% -0.0% -0.0% +0.0% kahan 0.0% 0.0% -0.0% -0.0% +0.0% knights 0.0% 0.0% -2.2% -5.4% 0.0% lambda 0.0% 0.0% -0.6% -1.8% 0.0% last-piece 0.0% 0.0% -0.0% -0.0% 0.0% lcss 0.0% 0.0% -0.0% -0.1% 0.0% life 0.0% 0.0% -0.0% -0.1% 0.0% lift 0.0% 0.0% -0.2% -0.6% +0.0% linear 0.0% 0.0% -0.0% -0.0% -0.0% listcompr 0.0% 0.0% -0.0% -0.0% 0.0% listcopy 0.0% 0.0% -0.0% -0.0% 0.0% maillist 0.0% 0.0% -0.1% -0.3% +0.0% mandel 0.0% 0.0% -0.0% -0.0% 0.0% mandel2 0.0% 0.0% -0.0% -0.0% -0.0% mate +0.0% 0.0% -0.0% -0.0% -0.0% minimax 0.0% 0.0% -0.2% -1.0% 0.0% mkhprog 0.0% 0.0% -0.1% -0.2% -0.0% multiplier 0.0% 0.0% -0.0% -0.0% -0.0% n-body 0.0% 0.0% -0.0% -0.0% +0.0% nucleic2 0.0% 0.0% -0.1% -0.2% 0.0% para 0.0% 0.0% -0.0% -0.0% -0.0% paraffins 0.0% 0.0% -0.0% -0.0% 0.0% parser 0.0% 0.0% -0.2% -0.7% 0.0% parstof 0.0% 0.0% -0.0% -0.0% +0.0% pic 0.0% 0.0% -0.0% -0.0% 0.0% pidigits 0.0% 0.0% +0.0% +0.0% +0.0% power 0.0% 0.0% -0.2% -0.6% +0.0% pretty 0.0% 0.0% -0.0% -0.0% -0.0% primes 0.0% 0.0% -0.0% -0.0% 0.0% primetest 0.0% 0.0% -0.0% -0.0% -0.0% prolog 0.0% 0.0% -0.3% -1.1% 0.0% puzzle 0.0% 0.0% -0.0% -0.0% 0.0% queens 0.0% 0.0% -0.0% -0.0% +0.0% reptile 0.0% 0.0% -0.0% -0.0% 0.0% reverse-complem 0.0% 0.0% -0.0% -0.0% +0.0% rewrite 0.0% 0.0% -0.7% -2.5% -0.0% rfib 0.0% 0.0% -0.0% -0.0% 0.0% rsa 0.0% 0.0% -0.0% -0.0% 0.0% scc 0.0% 0.0% -0.1% -0.2% -0.0% sched 0.0% 0.0% -0.0% -0.0% -0.0% scs 0.0% 0.0% -1.0% -2.6% +0.0% simple 0.0% 0.0% +0.0% -0.0% +0.0% solid 0.0% 0.0% -0.0% -0.0% 0.0% sorting 0.0% 0.0% -0.6% -1.6% 0.0% spectral-norm 0.0% 0.0% +0.0% 0.0% +0.0% sphere 0.0% 0.0% -0.0% -0.0% -0.0% symalg 0.0% 0.0% -0.0% -0.0% +0.0% tak 0.0% 0.0% -0.0% -0.0% 0.0% transform 0.0% 0.0% -0.0% -0.0% 0.0% treejoin 0.0% 0.0% -0.0% -0.0% 0.0% typecheck 0.0% 0.0% -0.0% -0.0% +0.0% veritas +0.0% 0.0% -0.2% -0.4% +0.0% wang 0.0% 0.0% -0.0% -0.0% 0.0% wave4main 0.0% 0.0% -0.0% -0.0% -0.0% wheel-sieve1 0.0% 0.0% -0.0% -0.0% -0.0% wheel-sieve2 0.0% 0.0% -0.0% -0.0% +0.0% x2n1 0.0% 0.0% -0.0% -0.0% -0.0% -------------------------------------------------------------------------------- Min 0.0% 0.0% -2.2% -5.4% -0.0% Max +0.0% 0.0% +0.0% +0.0% +0.1% Geometric Mean -0.0% -0.0% -0.1% -0.3% +0.0% Metric increases micro benchmarks tracked in #17686: Metric Increase: T12150 T12234 T12425 T13035 T5837 T6048 T9233 Co-authored-by: Andreas Klebinger <klebinger.andreas at gmx.at> - - - - - 3b22b14a by Shayne Fletcher at 2020-06-10T04:15:01-04:00 Give Language a Bounded instance - - - - - 9454511b by Simon Peyton Jones at 2020-06-10T04:17:06-04:00 Optimisation in Unique.Supply This patch switches on -fno-state-hack in GHC.Types.Unique.Supply. It turned out that my fixes for #18078 (coercion floating) changed the optimisation pathway for mkSplitUniqSupply in such a way that we had an extra allocation inside the inner loop. Adding -fno-state-hack fixed that -- and indeed the loop in mkSplitUniqSupply is a classic example of the way in which -fno-state-hack can be bad; see #18238. Moreover, the new code is better than the old. They allocate the same, but the old code ends up with a partial application. The net effect is that the test perf/should_run/UniqLoop runs 20% faster! From 2.5s down to 2.0s. The allocation numbers are the same -- but elapsed time falls. Good! The bad thing about this is that it's terribly delicate. But at least it's a good example of such delicacy in action. There is a long Note [Optimising the unique supply] which now explains all this. - - - - - 6d49d5be by Simon Peyton Jones at 2020-06-10T04:17:06-04:00 Implement cast worker/wrapper properly The cast worker/wrapper transformation transforms x = e |> co into y = e x = y |> co This is done by the simplifier, but we were being careless about transferring IdInfo from x to y, and about what to do if x is a NOINLNE function. This resulted in a series of bugs: #17673, #18093, #18078. This patch fixes all that: * Main change is in GHC.Core.Opt.Simplify, and the new prepareBinding function, which does this cast worker/wrapper transform. See Note [Cast worker/wrappers]. * There is quite a bit of refactoring around prepareRhs, makeTrivial etc. It's nicer now. * Some wrappers from strictness and cast w/w, notably those for a function with a NOINLINE, should inline very late. There wasn't really a mechanism for that, which was an existing bug really; so I invented a new finalPhase = Phase (-1). It's used for all simplifier runs after the user-visible phase 2,1,0 have run. (No new runs of the simplifier are introduced thereby.) See new Note [Compiler phases] in GHC.Types.Basic; the main changes are in GHC.Core.Opt.Driver * Doing this made me trip over two places where the AnonArgFlag on a FunTy was being lost so we could end up with (Num a -> ty) rather than (Num a => ty) - In coercionLKind/coercionRKind - In contHoleType in the Simplifier I fixed the former by defining mkFunctionType and using it in coercionLKind/RKind. I could have done the same for the latter, but the information is almost to hand. So I fixed the latter by - adding sc_hole_ty to ApplyToVal (like ApplyToTy), - adding as_hole_ty to ValArg (like TyArg) - adding sc_fun_ty to StrictArg Turned out I could then remove ai_type from ArgInfo. This is just moving the deck chairs around, but it worked out nicely. See the new Note [AnonArgFlag] in GHC.Types.Var * When looking at the 'arity decrease' thing (#18093) I discovered that stable unfoldings had a much lower arity than the actual optimised function. That's what led to the arity-decrease message. Simple solution: eta-expand. It's described in Note [Eta-expand stable unfoldings] in GHC.Core.Opt.Simplify * I also discovered that unsafeCoerce wasn't being inlined if the context was boring. So (\x. f (unsafeCoerce x)) would create a thunk -- yikes! I fixed that by making inlineBoringOK a bit cleverer: see Note [Inline unsafeCoerce] in GHC.Core.Unfold. I also found that unsafeCoerceName was unused, so I removed it. I made a test case for #18078, and a very similar one for #17673. The net effect of all this on nofib is very modest, but positive: -------------------------------------------------------------------------------- Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- anna -0.4% -0.1% -3.1% -3.1% 0.0% fannkuch-redux -0.4% -0.3% -0.1% -0.1% 0.0% maillist -0.4% -0.1% -7.8% -1.0% -14.3% primetest -0.4% -15.6% -7.1% -6.6% 0.0% -------------------------------------------------------------------------------- Min -0.9% -15.6% -13.3% -14.2% -14.3% Max -0.3% 0.0% +12.1% +12.4% 0.0% Geometric Mean -0.4% -0.2% -2.3% -2.2% -0.1% All following metric decreases are compile-time allocation decreases between -1% and -3%: Metric Decrease: T5631 T13701 T14697 T15164 - - - - - 32fd37f5 by Luke Lau at 2020-06-10T04:17:22-04:00 Fix lookupGlobalOccRn_maybe sometimes reporting an error In some cases it was possible for lookupGlobalOccRn_maybe to return an error, when it should be returning a Nothing. If it called lookupExactOcc_either when there were no matching GlobalRdrElts in the otherwise case, it would return an error message. This could be caused when lookupThName_maybe in Template Haskell was looking in different namespaces (thRdrNameGuesses), guessing different namespaces that the name wasn't guaranteed to be found in. However, by addressing this some more accurate errors were being lost in the conversion to Maybes. So some of the lookup* functions have been shuffled about so that errors should always be ignored in lookup*_maybes, and propagated otherwise. This fixes #18263 - - - - - 9b283e1b by Roland Senn at 2020-06-10T04:17:34-04:00 Initialize the allocation counter in GHCi to 0 (Fixes #16012) According to the documentation for the function `getAllocationCounter` in [System.Mem](http://hackage.haskell.org/package/base-4.14.0.0/docs/System-Mem.html) initialize the allocationCounter also in GHCi to 0. - - - - - 8d07c48c by Sylvain Henry at 2020-06-10T04:17:36-04:00 test: fix conc038 We had spurious failures of conc038 test on CI with stdout: ``` newThread started -mainThread -Haskell: 2 newThread back again +mainThread 1 sec later shutting down +Haskell: 2 ``` - - - - - 4c7e9689 by Sebastian Graf at 2020-06-11T10:37:38+02:00 Release Notes: Add news from the pattern-match checker [skip ci] - - - - - 3445b965 by Sylvain Henry at 2020-06-13T02:13:01-04:00 Only test T16190 with the NCG T16190 is meant to test a NCG feature. It has already caused spurious failures in other MRs (e.g. !2165) when LLVM is used. - - - - - 2517a51c by Sylvain Henry at 2020-06-13T02:13:01-04:00 DynFlags refactoring VIII (#17957) * Remove several uses of `sdocWithDynFlags`, especially in GHC.Llvm.* * Add LlvmOpts datatype to store Llvm backend options * Remove Outputable instances (for LlvmVar, LlvmLit, LlvmStatic and Llvm.MetaExpr) which require LlvmOpts. * Rename ppMetaExpr into ppMetaAnnotExpr (pprMetaExpr is now used in place of `ppr :: MetaExpr -> SDoc`) - - - - - 7a02599a by Sylvain Henry at 2020-06-13T02:13:02-04:00 Remove unused code - - - - - 72d08610 by Sylvain Henry at 2020-06-13T02:13:02-04:00 Refactor homeUnit * rename thisPackage into homeUnit * document and refactor several Backpack things - - - - - 8dc71f55 by Sylvain Henry at 2020-06-13T02:13:02-04:00 Rename unsafeGetUnitInfo into unsafeLookupUnit - - - - - f6be6e43 by Sylvain Henry at 2020-06-13T02:13:02-04:00 Add allowVirtualUnits field in PackageState Instead of always querying DynFlags to know whether we are allowed to use virtual units (i.e. instantiated on-the-fly, cf Note [About units] in GHC.Unit), we store it once for all in `PackageState.allowVirtualUnits`. This avoids using DynFlags too much (cf #17957) and is preliminary work for #14335. - - - - - e7272d53 by Sylvain Henry at 2020-06-13T02:13:02-04:00 Enhance UnitId use * use UnitId instead of String to identify wired-in units * use UnitId instead of Unit in the backend (Unit are only use by Backpack to produce type-checked interfaces, not real code) * rename lookup functions for consistency * documentation - - - - - 9c5572cd by Sylvain Henry at 2020-06-13T02:13:02-04:00 Remove LinkerUnitId type alias - - - - - d345edfe by Sylvain Henry at 2020-06-13T02:13:02-04:00 Refactor WiredMap * Remove WiredInUnitId and WiredUnitId type aliases - - - - - 3d171cd6 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Document and refactor `mkUnit` and `mkUnitInfoMap` - - - - - d2109b4f by Sylvain Henry at 2020-06-13T02:13:03-04:00 Remove PreloadUnitId type alias - - - - - f50c19b8 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Rename listUnitInfoMap into listUnitInfo There is no Map involved - - - - - ed533ec2 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Rename Package into Unit The terminology changed over time and now package databases contain "units" (there can be several units compiled from a single Cabal package: one per-component, one for each option set, one per instantiation, etc.). We should try to be consistent internally and use "units": that's what this renaming does. Maybe one day we'll fix the UI too (e.g. replace -package-id with -unit-id, we already have -this-unit-id and ghc-pkg has -unit-id...) but it's not done in this patch. * rename getPkgFrameworkOpts into getUnitFrameworkOpts * rename UnitInfoMap into ClosureUnitInfoMap * rename InstalledPackageIndex into UnitInfoMap * rename UnusablePackages into UnusableUnits * rename PackagePrecedenceIndex into UnitPrecedenceMap * rename PackageDatabase into UnitDatabase * rename pkgDatabase into unitDatabases * rename pkgState into unitState * rename initPackages into initUnits * rename renamePackage into renameUnitInfo * rename UnusablePackageReason into UnusableUnitReason * rename getPackage* into getUnit* * etc. - - - - - 202728e5 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Make ClosureUnitInfoMap uses UnitInfoMap - - - - - 55b4263e by Sylvain Henry at 2020-06-13T02:13:03-04:00 Remove ClosureUnitInfoMap - - - - - 653d17bd by Sylvain Henry at 2020-06-13T02:13:03-04:00 Rename Package into Unit (2) * rename PackageState into UnitState * rename findWiredInPackages into findWiredInUnits * rename lookupModuleInAll[Packages,Units] * etc. - - - - - ae900605 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Move dump_mod_map into initUnits - - - - - 598cc1dd by Sylvain Henry at 2020-06-13T02:13:03-04:00 Move wiring of homeUnitInstantiations outside of mkUnitState - - - - - 437265eb by Sylvain Henry at 2020-06-13T02:13:03-04:00 Avoid timing module map dump in initUnits - - - - - 9400aa93 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Remove preload parameter of mkUnitState * Remove preload parameter (unused) * Don't explicitly return preloaded units: redundant because already returned as "preloadUnits" field of UnitState - - - - - 266bc3d9 by Sylvain Henry at 2020-06-13T02:13:03-04:00 DynFlags: refactor unwireUnit - - - - - 9e715c1b by Sylvain Henry at 2020-06-13T02:13:03-04:00 Document getPreloadUnitsAnd - - - - - bd5810dc by Sylvain Henry at 2020-06-13T02:13:03-04:00 DynFlags: remove useless add_package parameter - - - - - 36e1daf0 by Sylvain Henry at 2020-06-13T02:13:03-04:00 DynFlags: make listVisibleModuleNames take a UnitState - - - - - 5226da37 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Refactor and document add_package - - - - - 4b53aac1 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Refactor and document closeUnitDeps - - - - - 42c054f6 by Sylvain Henry at 2020-06-13T02:13:03-04:00 DynFlags: findWiredInUnits - - - - - a444d01b by Sylvain Henry at 2020-06-13T02:13:03-04:00 DynFlags: reportCycles, reportUnusable - - - - - 8408d521 by Sylvain Henry at 2020-06-13T02:13:03-04:00 DynFlags: merge_databases - - - - - fca2d25f by Sylvain Henry at 2020-06-13T02:13:03-04:00 DynFlags: add UnitConfig datatype Avoid directly querying flags from DynFlags to build the UnitState. Instead go via UnitConfig so that we could reuse this to make another UnitState for plugins. - - - - - 4274688a by Sylvain Henry at 2020-06-13T02:13:03-04:00 Move distrustAll into mkUnitState - - - - - 28d804e1 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Create helper upd_wired_in_home_instantiations - - - - - ac964c83 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Put database cache in UnitConfig - - - - - bfd0a78c by Sylvain Henry at 2020-06-13T02:13:03-04:00 Don't return preload units when we set DyNFlags Preload units can be retrieved in UnitState when needed (i.e. in GHCi) - - - - - 1fbb4bf5 by Sylvain Henry at 2020-06-13T02:13:03-04:00 NCGConfig: remove useless ncgUnitId field - - - - - c10ff7e7 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Doc: fix some comments - - - - - 456e17f0 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Bump haddock submodule and allow metric decrease Metric Decrease: T12150 T12234 T5837 Metric Increase: T16190 - - - - - 42953902 by Simon Peyton Jones at 2020-06-13T02:13:03-04:00 Trim the demand for recursive product types Ticket #18304 showed that we need to be very careful when exploring the demand (esp usage demand) on recursive product types. This patch solves the problem by trimming the demand on such types -- in effect, a form of "widening". See the Note [Trimming a demand to a type] in DmdAnal, which explains how I did this by piggy-backing on an existing mechansim for trimming demands becuase of GADTs. The significant payload of this patch is very small indeed: * Make GHC.Core.Opt.WorkWrap.Utils.typeShape use RecTcChecker to avoid looking through recursive types. But on the way * I found that ae_rec_tc was entirely inoperative and did nothing. So I removed it altogether from DmdAnal. * I moved some code around in DmdAnal and Demand. (There are no actual changes in dmdFix.) * I changed the API of DmsAnal.dmdAnalRhsLetDown to return a StrictSig rather than a decorated Id * I removed the dead function peelTsFuns from Demand Performance effects: Nofib: 0.0% changes. Not surprising, because they don't use recursive products Perf tests T12227: 1% increase in compiler allocation, becuase $cto gets w/w'd. It did not w/w before because it takes a deeply nested argument, so the worker gets too many args, so we abandon w/w altogether (see GHC.Core.Opt.WorkWrap.Utils.isWorkerSmallEnough) With this patch we trim the demands. That is not strictly necessary (since these Generic type constructors are like tuples -- they can't cause a loop) but the net result is that we now w/w $cto which is fine. UniqLoop: 16% decrease in /runtime/ allocation. The UniqSupply is a recursive product, so currently we abandon all strictness on 'churn'. With this patch 'churn' gets useful strictness, and we w/w it. Hooray Metric Decrease: UniqLoop Metric Increase: T12227 - - - - - 87d504f4 by Viktor Dukhovni at 2020-06-13T02:13:05-04:00 Add introductory prose for Data.Traversable - - - - - 9f09b608 by Oleg Grenrus at 2020-06-13T02:13:07-04:00 Fix #12073: Add MonadFix Q instance - - - - - 220c2d34 by Ben Gamari at 2020-06-13T02:13:07-04:00 testsuite: Increase size of T12150 As noted in #18319, this test was previously very fragile. Increase its size to make it more likely that its fails with its newly-increased acceptance threshold. Metric Increase: T12150 - - - - - 8bba1c26 by Ben Gamari at 2020-06-13T04:59:06-04:00 gitlab-ci: Always push perf notes Previously we ci.sh would run with `set -e` implying that we wouldn't push perf notes if the testsuite were to fail, even if it *only* failed due to perf notes. This rendered the whole performance testing story quite fragile as a single regressing commit would cause every successive commit to fail since a new baseline would not be uploaded. Fix this by ensuring that we always push performance notes. - - - - - 7a773f16 by Ben Gamari at 2020-06-13T15:10:55-04:00 gitlab-ci: Eliminate redundant push of CI metrics - - - - - a31218f7 by Ryan Scott at 2020-06-13T15:58:37-04:00 Use HsForAllTelescope to avoid inferred, visible foralls Currently, `HsForAllTy` permits the combination of `ForallVis` and `Inferred`, but you can't actually typecheck code that uses it (e.g., `forall {a} ->`). This patch refactors `HsForAllTy` to use a new `HsForAllTelescope` data type that makes a type-level distinction between visible and invisible `forall`s such that visible `forall`s do not track `Specificity`. That part of the patch is actually quite small; the rest is simply changing consumers of `HsType` to accommodate this new type. Fixes #18235. Bumps the `haddock` submodule. - - - - - c0e6dee9 by Tamar Christina at 2020-06-14T09:07:44-04:00 winio: Add Atomic Exchange PrimOp and implement Atomic Ptr exchanges. The initial version was rewritten by Tamar Christina. It was rewritten in large parts by Andreas Klebinger. Co-authored-by: Andreas Klebinger <klebinger.andreas at gmx.at> - - - - - 9a7462fb by Ben Gamari at 2020-06-14T15:35:23-04:00 codeGen: Don't discard live case binders in unsafeEqualityProof logic Previously CoreToStg would unconditionally discard cases of the form: case unsafeEqualityProof of wild { _ -> rhs } and rather replace the whole thing with `rhs`. However, in some cases (see #18227) the case binder is still live, resulting in unbound occurrences in `rhs`. Fix this by only discarding the case if the case binder is dead. Fixes #18227. - - - - - e4137c48 by Ben Gamari at 2020-06-14T15:35:23-04:00 testsuite: Add tests for #18227 T18227A is the original issue which gave rise to the ticket and depends upon bytestring. T18227B is a minimized reproducer. - - - - - 8bab9ff1 by Ben Gamari at 2020-06-14T15:35:59-04:00 hadrian: Fix rts include and library paths Fixes two bugs: * (?) and (<>) associated in a surprising way * We neglected to include libdw paths in the rts configure flags - - - - - bd761185 by Ben Gamari at 2020-06-14T15:35:59-04:00 hadrian: Drop redundant GHC arguments Cabal should already be passing this arguments to GHC. - - - - - 01f7052c by Peter Trommler at 2020-06-14T15:36:38-04:00 FFI: Fix pass small ints in foreign call wrappers The Haskell calling convention requires integer parameters smaller than wordsize to be promoted to wordsize (where the upper bits are don't care). To access such small integer parameter read a word from the parameter array and then cast that word to the small integer target type. Fixes #15933 - - - - - 502647f7 by Krzysztof Gogolewski at 2020-06-14T15:37:14-04:00 Fix "ndecreasingIndentation" in manual (#18116) - - - - - 9a9cc089 by Simon Jakobi at 2020-06-15T13:10:00-04:00 Use foldl' in unionManyUniqDSets - - - - - 761dcb84 by Moritz Angermann at 2020-06-15T13:10:36-04:00 Load .lo as well. Some archives contain so called linker objects, with the affectionate .lo suffic. For example the musl libc.a will come in that form. We still want to load those objects, hence we should not discard them and look for .lo as well. Ultimately we might want to fix this proerly by looking at the file magic. - - - - - cf01477f by Vladislav Zavialov at 2020-06-15T13:11:20-04:00 User's Guide: KnownNat evidence is Natural This bit of documentation got outdated after commit 1fcede43d2b30f33b7505e25eb6b1f321be0407f - - - - - d0dcbfe6 by Jan Hrček at 2020-06-16T20:36:38+02:00 Fix typos and formatting in user guide - - - - - 56a9e95f by Jan Hrček at 2020-06-16T20:36:38+02:00 Resolve TODO - - - - - 3e884d14 by Jan Hrček at 2020-06-16T20:36:38+02:00 Rename TcHoleErrors to GHC.Tc.Errors.Hole - - - - - d23fc678 by Stefan Schulze Frielinghaus at 2020-06-17T15:31:09-04:00 hadrian: Build with threaded runtime if available See #16873. - - - - - 0639dc10 by Sylvain Henry at 2020-06-17T15:31:53-04:00 T16190: only measure bytes_allocated Just adding `{-# LANGUAGE BangPatterns #-}` makes the two other metrics fluctuate by 13%. - - - - - 4cab6897 by Adam Sandberg Ericsson at 2020-06-17T15:32:44-04:00 docs: fix formatting in users guide - - - - - eb8115a8 by Sylvain Henry at 2020-06-17T15:33:23-04:00 Move CLabel assertions into smart constructors (#17957) It avoids using DynFlags in the Outputable instance of Clabel to check assertions at pretty-printing time. - - - - - 7faa4509 by Ben Gamari at 2020-06-17T15:43:31-04:00 base: Bump to 4.15.0.0 - - - - - 20616959 by Ben Gamari at 2020-06-17T15:43:31-04:00 configure: Use grep -q instead of --quiet The latter is apparently not supported by busybox. - - - - - 40fa237e by Krzysztof Gogolewski at 2020-06-17T16:21:58-04:00 Linear types (#15981) This is the first step towards implementation of the linear types proposal (https://github.com/ghc-proposals/ghc-proposals/pull/111). It features * A language extension -XLinearTypes * Syntax for linear functions in the surface language * Linearity checking in Core Lint, enabled with -dlinear-core-lint * Core-to-core passes are mostly compatible with linearity * Fields in a data type can be linear or unrestricted; linear fields have multiplicity-polymorphic constructors. If -XLinearTypes is disabled, the GADT syntax defaults to linear fields The following items are not yet supported: * a # m -> b syntax (only prefix FUN is supported for now) * Full multiplicity inference (multiplicities are really only checked) * Decent linearity error messages * Linear let, where, and case expressions in the surface language (each of these currently introduce the unrestricted variant) * Multiplicity-parametric fields * Syntax for annotating lambda-bound or let-bound with a multiplicity * Syntax for non-linear/multiple-field-multiplicity records * Linear projections for records with a single linear field * Linear pattern synonyms * Multiplicity coercions (test LinearPolyType) A high-level description can be found at https://ghc.haskell.org/trac/ghc/wiki/LinearTypes/Implementation Following the link above you will find a description of the changes made to Core. This commit has been authored by * Richard Eisenberg * Krzysztof Gogolewski * Matthew Pickering * Arnaud Spiwack With contributions from: * Mark Barbone * Alexander Vershilov Updates haddock submodule. - - - - - 6cb84c46 by Krzysztof Gogolewski at 2020-06-17T16:22:03-04:00 Various performance improvements This implements several general performance improvements to GHC, to offset the effect of the linear types change. General optimisations: - Add a `coreFullView` function which iterates `coreView` on the head. This avoids making function recursive solely because the iterate `coreView` themselves. As a consequence, this functions can be inlined, and trigger case-of-known constructor (_e.g._ `kindRep_maybe`, `isLiftedRuntimeRep`, `isMultiplicityTy`, `getTyVar_maybe`, `splitAppTy_maybe`, `splitFunType_maybe`, `tyConAppTyCon_maybe`). The common pattern about all these functions is that they are almost always used as views, and immediately consumed by a case expression. This commit also mark them asx `INLINE`. - In `subst_ty` add a special case for nullary `TyConApp`, which avoid allocations altogether. - Use `mkTyConApp` in `subst_ty` for the general `TyConApp`. This required quite a bit of module shuffling. case. `myTyConApp` enforces crucial sharing, which was lost during substitution. See also !2952 . - Make `subst_ty` stricter. - In `eqType` (specifically, in `nonDetCmpType`), add a special case, tested first, for the very common case of nullary `TyConApp`. `nonDetCmpType` has been made `INLINE` otherwise it is actually a regression. This is similar to the optimisations in !2952. Linear-type specific optimisations: - Use `tyConAppTyCon_maybe` instead of the more complex `eqType` in the definition of the pattern synonyms `One` and `Many`. - Break the `hs-boot` cycles between `Multiplicity.hs` and `Type.hs`: `Multiplicity` now import `Type` normally, rather than from the `hs-boot`. This way `tyConAppTyCon_maybe` can inline properly in the `One` and `Many` pattern synonyms. - Make `updateIdTypeAndMult` strict in its type and multiplicity - The `scaleIdBy` gets a specialised definition rather than being an alias to `scaleVarBy` - `splitFunTy_maybe` is given the type `Type -> Maybe (Mult, Type, Type)` instead of `Type -> Maybe (Scaled Type, Type)` - Remove the `MultMul` pattern synonym in favour of a view `isMultMul` because pattern synonyms appear not to inline well. - in `eqType`, in a `FunTy`, compare multiplicities last: they are almost always both `Many`, so it helps failing faster. - Cache `manyDataConTy` in `mkTyConApp`, to make sure that all the instances of `TyConApp ManyDataConTy []` are physically the same. This commit has been authored by * Richard Eisenberg * Krzysztof Gogolewski * Arnaud Spiwack Metric Decrease: haddock.base T12227 T12545 T12990 T1969 T3064 T5030 T9872b Metric Increase: haddock.base haddock.Cabal haddock.compiler T12150 T12234 T12425 T12707 T13035 T13056 T15164 T16190 T18304 T1969 T3064 T3294 T5631 T5642 T5837 T6048 T9020 T9233 T9675 T9872a T9961 WWRec - - - - - 57db91d8 by Sylvain Henry at 2020-06-17T16:22:03-04:00 Remove integer-simple integer-simple uses lists of words (`[Word]`) to represent big numbers instead of ByteArray#: * it is less efficient than the newer ghc-bignum native backend * it isn't compatible with the big number representation that is now shared by all the ghc-bignum backends (based on the one that was used only in integer-gmp before). As a consequence, we simply drop integer-simple - - - - - 9f96bc12 by Sylvain Henry at 2020-06-17T16:22:03-04:00 ghc-bignum library ghc-bignum is a newer package that aims to replace the legacy integer-simple and integer-gmp packages. * it supports several backends. In particular GMP is still supported and most of the code from integer-gmp has been merged in the "gmp" backend. * the pure Haskell "native" backend is new and is much faster than the previous pure Haskell implementation provided by integer-simple * new backends are easier to write because they only have to provide a few well defined functions. All the other code is common to all backends. In particular they all share the efficient small/big number distinction previously used only in integer-gmp. * backends can all be tested against the "native" backend with a simple Cabal flag. Backends are only allowed to differ in performance, their results should be the same. * Add `integer-gmp` compat package: provide some pattern synonyms and function aliases for those in `ghc-bignum`. It is intended to avoid breaking packages that depend on `integer-gmp` internals. Update submodules: text, bytestring Metric Decrease: Conversions ManyAlternatives ManyConstructors Naperian T10359 T10547 T10678 T12150 T12227 T12234 T12425 T13035 T13719 T14936 T1969 T4801 T4830 T5237 T5549 T5837 T8766 T9020 parsing001 space_leak_001 T16190 haddock.base On ARM and i386, T17499 regresses (+6% > 5%). On x86_64 unregistered, T13701 sometimes regresses (+2.2% > 2%). Metric Increase: T17499 T13701 - - - - - 96aa5787 by Sylvain Henry at 2020-06-17T16:22:03-04:00 Update compiler Thanks to ghc-bignum, the compiler can be simplified: * Types and constructors of Integer and Natural can be wired-in. It means that we don't have to query them from interfaces. It also means that numeric literals don't have to carry their type with them. * The same code is used whatever ghc-bignum backend is enabled. In particular, conversion of bignum literals into final Core expressions is now much more straightforward. Bignum closure inspection too. * GHC itself doesn't depend on any integer-* package anymore * The `integerLibrary` setting is gone. - - - - - 0f67e344 by Sylvain Henry at 2020-06-17T16:22:03-04:00 Update `base` package * GHC.Natural isn't implemented in `base` anymore. It is provided by ghc-bignum in GHC.Num.Natural. It means that we can safely use Natural primitives in `base` without fearing issues with built-in rewrite rules (cf #15286) * `base` doesn't conditionally depend on an integer-* package anymore, it depends on ghc-bignum * Some duplicated code in integer-* can now be factored in GHC.Float * ghc-bignum tries to use a uniform naming convention so most of the other changes are renaming - - - - - aa9e7b71 by Sylvain Henry at 2020-06-17T16:22:03-04:00 Update `make` based build system * replace integer-* package selection with ghc-bignum backend selection - - - - - f817d816 by Sylvain Henry at 2020-06-17T16:22:04-04:00 Update testsuite * support detection of slow ghc-bignum backend (to replace the detection of integer-simple use). There are still some test cases that the native backend doesn't handle efficiently enough. * remove tests for GMP only functions that have been removed from ghc-bignum * fix test results showing dependent packages (e.g. integer-gmp) or showing suggested instances * fix test using Integer/Natural API or showing internal names - - - - - dceecb09 by Sylvain Henry at 2020-06-17T16:22:04-04:00 Update Hadrian * support ghc-bignum backend selection in flavours and command-line * support ghc-bignum "--check" flag (compare results of selected backend against results of the native one) in flavours and command-line (e.g. pass --bignum=check-gmp" to check the "gmp" backend) * remove the hack to workaround #15286 * build GMP only when the gmp backend is used * remove hacks to workaround `text` package flags about integer-*. We fix `text` to use ghc-bignum unconditionally in another patch - - - - - fa4281d6 by Sylvain Henry at 2020-06-17T16:22:04-04:00 Bump bytestring and text submodules - - - - - 1a3f6f34 by Adam Sandberg Ericsson at 2020-06-18T23:03:36-04:00 docs: mention -hiedir in docs for -outputdir [skip ci] - - - - - 729bcb02 by Sylvain Henry at 2020-06-18T23:04:17-04:00 Hadrian: fix build on Mac OS Catalina (#17798) - - - - - 95e18292 by Andreas Klebinger at 2020-06-18T23:04:58-04:00 Relax allocation threshold for T12150. This test performs little work, so the most minor allocation changes often cause the test to fail. Increasing the threshold to 2% should help with this. - - - - - 8ce6c393 by Sebastian Graf at 2020-06-18T23:05:36-04:00 hadrian: Bump pinned cabal.project to an existent index-state - - - - - 08c1cb0f by Ömer Sinan Ağacan at 2020-06-18T23:06:21-04:00 Fix uninitialized field read in Linker.c Valgrind report of the bug when running the test `linker_unload`: ==29666== Conditional jump or move depends on uninitialised value(s) ==29666== at 0x369C5B4: setOcInitialStatus (Linker.c:1305) ==29666== by 0x369C6C5: mkOc (Linker.c:1347) ==29666== by 0x36C027A: loadArchive_ (LoadArchive.c:522) ==29666== by 0x36C0600: loadArchive (LoadArchive.c:626) ==29666== by 0x2C144CD: ??? (in /home/omer/haskell/ghc_2/testsuite/tests/rts/linker/linker_unload.run/linker_unload) ==29666== ==29666== Conditional jump or move depends on uninitialised value(s) ==29666== at 0x369C5B4: setOcInitialStatus (Linker.c:1305) ==29666== by 0x369C6C5: mkOc (Linker.c:1347) ==29666== by 0x369C9F6: preloadObjectFile (Linker.c:1507) ==29666== by 0x369CA8D: loadObj_ (Linker.c:1536) ==29666== by 0x369CB17: loadObj (Linker.c:1557) ==29666== by 0x3866BC: main (linker_unload.c:33) The problem is `mkOc` allocates a new `ObjectCode` and calls `setOcInitialStatus` without initializing the `status` field. `setOcInitialStatus` reads the field as first thing: static void setOcInitialStatus(ObjectCode* oc) { if (oc->status == OBJECT_DONT_RESOLVE) return; if (oc->archiveMemberName == NULL) { oc->status = OBJECT_NEEDED; } else { oc->status = OBJECT_LOADED; } } `setOcInitialStatus` is unsed in two places for two different purposes: in `mkOc` where we don't have the `status` field initialized yet (`mkOc` is supposed to initialize it), and `loadOc` where we do have `status` field initialized and we want to update it. Instead of splitting the function into two functions which are both called just once I inline the functions in the use sites and remove it. Fixes #18342 - - - - - da18ff99 by Tamar Christina at 2020-06-18T23:07:03-04:00 fix windows bootstrap due to linker changes - - - - - 2af0ec90 by Sylvain Henry at 2020-06-18T23:07:47-04:00 DynFlags: store default depth in SDocContext (#17957) It avoids having to use DynFlags to reach for pprUserLength. - - - - - d4a0be75 by Sylvain Henry at 2020-06-18T23:08:35-04:00 Move tablesNextToCode field into Platform tablesNextToCode is a platform setting and doesn't belong into DynFlags (#17957). Doing this is also a prerequisite to fix #14335 where we deal with two platforms (target and host) that may have different platform settings. - - - - - 809caedf by John Ericson at 2020-06-23T22:47:37-04:00 Switch from HscSource to IsBootInterface for module lookup in GhcMake We look up modules by their name, and not their contents. There is no way to separately reference a signature vs regular module; you get what you get. Only boot files can be referenced indepenently with `import {-# SOURCE #-}`. - - - - - 7750bd45 by Sylvain Henry at 2020-06-23T22:48:18-04:00 Cmm: introduce SAVE_REGS/RESTORE_REGS We don't want to save both Fn and Dn register sets on x86-64 as they are aliased to the same arch register (XMMn). Moreover, when SAVE_STGREGS was used in conjunction with `jump foo [*]` which makes a set of Cmm registers alive so that they cover all arch registers used to pass parameter, we could have Fn, Dn and XMMn alive at the same time. It made the LLVM code generator choke (see #17920). Now `SAVE_REGS/RESTORE_REGS` and `jump foo [*]` use the same set of registers. - - - - - 2636794d by Sylvain Henry at 2020-06-23T22:48:18-04:00 CmmToC: don't add extern decl to parsed Cmm data Previously, if a .cmm file *not in the RTS* contained something like: ```cmm section "rodata" { msg : bits8[] "Test\n"; } ``` It would get compiled by CmmToC into: ```c ERW_(msg); const char msg[] = "Test\012"; ``` and fail with: ``` /tmp/ghc32129_0/ghc_4.hc:5:12: error: error: conflicting types for \u2018msg\u2019 const char msg[] = "Test\012"; ^~~ In file included from /tmp/ghc32129_0/ghc_4.hc:3:0: error: /tmp/ghc32129_0/ghc_4.hc:4:6: error: note: previous declaration of \u2018msg\u2019 was here ERW_(msg); ^ /builds/hsyl20/ghc/_build/install/lib/ghc-8.11.0.20200605/lib/../lib/x86_64-linux-ghc-8.11.0.20200605/rts-1.0/include/Stg.h:253:46: error: note: in definition of macro \u2018ERW_\u2019 #define ERW_(X) extern StgWordArray (X) ^ ``` See the rationale for this on https://gitlab.haskell.org/ghc/ghc/-/wikis/commentary/compiler/backends/ppr-c#prototypes Now we don't generate these extern declarations (ERW_, etc.) for top-level data. It shouldn't change anything for the RTS (the only place we use .cmm files) as it is already special cased in `GHC.Cmm.CLabel.needsCDecl`. And hand-written Cmm can use explicit extern declarations when needed. Note that it allows `cgrun069` test to pass with CmmToC (cf #15467). - - - - - 5f6a0665 by Sylvain Henry at 2020-06-23T22:48:18-04:00 LLVM: refactor and comment register padding code (#17920) - - - - - cad62ef1 by Sylvain Henry at 2020-06-23T22:48:18-04:00 Add tests for #17920 Metric Decrease: T12150 T12234 - - - - - a2a9006b by Xavier Denis at 2020-06-23T22:48:56-04:00 Fix issue #18262 by zonking constraints after solving Zonk residual constraints in checkForExistence to reveal user type errors. Previously when `:instances` was used with instances that have TypeError constraints the result would look something like: instance [safe] s0 => Err 'A -- Defined at ../Bug2.hs:8:10 whereas after zonking, `:instances` now sees the `TypeError` and properly eliminates the constraint from the results. - - - - - 181516bc by Simon Peyton Jones at 2020-06-23T22:49:33-04:00 Fix a buglet in Simplify.simplCast This bug, revealed by #18347, is just a missing update to sc_hole_ty in simplCast. I'd missed a code path when I made the recentchanges in commit 6d49d5be904c0c01788fa7aae1b112d5b4dfaf1c Author: Simon Peyton Jones <simonpj at microsoft.com> Date: Thu May 21 12:53:35 2020 +0100 Implement cast worker/wrapper properly The fix is very easy. Two other minor changes * Tidy up in SimpleOpt.simple_opt_expr. In fact I think this is an outright bug, introduced in the fix to #18112: we were simplifying the same coercion twice *with the same substitution*, which is just wrong. It'd be a hard bug to trigger, so I just fixed it; less code too. * Better debug printing of ApplyToVal - - - - - 625a7f54 by Simon Peyton Jones at 2020-06-23T22:50:11-04:00 Two small tweaks to Coercion.simplifyArgsWorker These tweaks affect the inner loop of simplifyArgsWorker, which in turn is called from the flattener in Flatten.hs. This is a key perf bottleneck to T9872{a,b,c,d}. These two small changes have a modest but useful benefit. No change in functionality whatsoever. Relates to #18354 - - - - - b5768cce by Sylvain Henry at 2020-06-23T22:50:49-04:00 Don't use timesInt2# with GHC < 8.11 (fix #18358) - - - - - 7ad4085c by Sylvain Henry at 2020-06-23T22:51:27-04:00 Fix invalid printf format - - - - - a1f34d37 by Krzysztof Gogolewski at 2020-06-23T22:52:09-04:00 Add missing entry to freeNamesItem (#18369) - - - - - 03a708ba by Andreas Klebinger at 2020-06-25T03:54:37-04:00 Enable large address space optimization on windows. Starting with Win 8.1/Server 2012 windows no longer preallocates page tables for reserverd memory eagerly, which prevented us from using this approach in the past. We also try to allocate the heap high in the memory space. Hopefully this makes it easier to allocate things in the low 4GB of memory that need to be there. Like jump islands for the linker. - - - - - 7e6d3d09 by Roland Senn at 2020-06-25T03:54:38-04:00 In `:break ident` allow out of scope and nested identifiers (Fix #3000) This patch fixes the bug and implements the feature request of #3000. 1. If `Module` is a real module name and `identifier` a name of a top-level function in `Module` then `:break Module.identifer` works also for an `identifier` that is out of scope. 2. Extend the syntax for `:break identifier` to: :break [ModQual.]topLevelIdent[.nestedIdent]...[.nestedIdent] `ModQual` is optional and is either the effective name of a module or the local alias of a qualified import statement. `topLevelIdent` is the name of a top level function in the module referenced by `ModQual`. `nestedIdent` is optional and the name of a function nested in a let or where clause inside the previously mentioned function `nestedIdent` or `topLevelIdent`. If `ModQual` is a module name, then `topLevelIdent` can be any top level identifier in this module. If `ModQual` is missing or a local alias of a qualified import, then `topLevelIdent` must be in scope. Breakpoints can be set on arbitrarily deeply nested functions, but the whole chain of nested function names must be specified. 3. To support the new functionality rewrite the code to tab complete `:break`. - - - - - 30e42652 by Ben Gamari at 2020-06-25T03:54:39-04:00 make: Respect XELATEX variable Previously we simply ignored the XELATEX variable when building PDF documentation. - - - - - 4acc2934 by Ben Gamari at 2020-06-25T03:54:39-04:00 hadrian/make: Detect makeindex Previously we would simply assume that makeindex was available. Now we correctly detect it in `configure` and respect this conclusion in hadrian and make. - - - - - 0d61f866 by Simon Peyton Jones at 2020-06-25T03:54:40-04:00 Expunge GhcTcId GHC.Hs.Extension had type GhcPs = GhcPass 'Parsed type GhcRn = GhcPass 'Renamed type GhcTc = GhcPass 'Typechecked type GhcTcId = GhcTc The last of these, GhcTcId, is a vestige of the past. This patch expunges it from GHC. - - - - - 8ddbed4a by Adam Wespiser at 2020-06-25T03:54:40-04:00 add examples to Data.Traversable - - - - - 284001d0 by Oleg Grenrus at 2020-06-25T03:54:42-04:00 Export readBinIface_ - - - - - 90f43872 by Zubin Duggal at 2020-06-25T03:54:43-04:00 Export everything from HsToCore. This lets us reuse these functions in haddock, avoiding synchronization bugs. Also fixed some divergences with haddock in that file Updates haddock submodule - - - - - c7dd6da7 by Takenobu Tani at 2020-06-25T03:54:44-04:00 Clean up haddock hyperlinks of GHC.* (part1) This updates haddock comments only. This patch focuses to update for hyperlinks in GHC API's haddock comments, because broken links especially discourage newcomers. This includes the following hierarchies: - GHC.Hs.* - GHC.Core.* - GHC.Stg.* - GHC.Cmm.* - GHC.Types.* - GHC.Data.* - GHC.Builtin.* - GHC.Parser.* - GHC.Driver.* - GHC top - - - - - 1eb997a8 by Takenobu Tani at 2020-06-25T03:54:44-04:00 Clean up haddock hyperlinks of GHC.* (part2) This updates haddock comments only. This patch focuses to update for hyperlinks in GHC API's haddock comments, because broken links especially discourage newcomers. This includes the following hierarchies: - GHC.Iface.* - GHC.Llvm.* - GHC.Rename.* - GHC.Tc.* - GHC.HsToCore.* - GHC.StgToCmm.* - GHC.CmmToAsm.* - GHC.Runtime.* - GHC.Unit.* - GHC.Utils.* - GHC.SysTools.* - - - - - 67a86b4d by Oleg Grenrus at 2020-06-25T03:54:46-04:00 Add MonadZip and MonadFix instances for Complex These instances are taken from https://hackage.haskell.org/package/linear-1.21/docs/Linear-Instances.html They are the unique possible, so let they be in `base`. - - - - - c50ef26e by Artem Pelenitsyn at 2020-06-25T03:54:47-04:00 test suite: add reproducer for #17516 - - - - - fe281b27 by Roland Senn at 2020-06-25T03:54:48-04:00 Enable maxBound checks for OverloadedLists (Fixes #18172) Consider the Literal `[256] :: [Data.Word.Word8]` When the `OverloadedLists` extension is not active, then the `ol_ext` field in the `OverLitTc` record that is passed to the function `getIntegralLit` contains the type `Word8`. This is a simple type, and we can use its type constructor immediately for the `warnAboutOverflowedLiterals` function. When the `OverloadedLists` extension is active, then the `ol_ext` field contains the type family `Item [Word8]`. The function `nomaliseType` is used to convert it to the needed type `Word8`. - - - - - a788d4d1 by Ben Gamari at 2020-06-25T03:54:52-04:00 rts/Hash: Simplify freeing of HashListChunks While looking at #18348 I noticed that the treatment of HashLists are a bit more complex than necessary (which lead to some initial confusion on my part). Specifically, we allocate HashLists in chunks. Each chunk allocation makes two allocations: one for the chunk itself and one for a HashListChunk to link together the chunks for the purposes of freeing. Simplify this (and hopefully make the relationship between these clearer) but allocating the HashLists and HashListChunk in a single malloc. This will both make the implementation easier to follow and reduce C heap fragmentation. Note that even after this patch we fail to bound the size of the free HashList pool. However, this is a separate bug. - - - - - d3c2d59b by Sylvain Henry at 2020-06-25T03:54:55-04:00 RTS: avoid overflow on 32-bit arch (#18375) We're now correctly computing allocated bytes on 32-bit arch, so we get huge increases. Metric Increase: haddock.Cabal haddock.base haddock.compiler space_leak_001 - - - - - a3d69dc6 by Sebastian Graf at 2020-06-25T23:06:18-04:00 GHC.Core.Unify: Make UM actions one-shot by default This MR makes the UM monad in GHC.Core.Unify into a one-shot monad. See the long Note [The one-shot state monad trick]. See also #18202 and !3309, which applies this to all Reader/State-like monads in GHC for compile-time perf improvements. The pattern used here enables something similar to the state-hack, but is applicable to user-defined monads, not just `IO`. Metric Decrease 'runtime/bytes allocated' (test_env='i386-linux-deb9'): haddock.Cabal - - - - - 9ee58f8d by Matthias Pall Gissurarson at 2020-06-26T17:12:45+00:00 Implement the proposed -XQualifiedDo extension Co-authored-by: Facundo Domínguez <facundo.dominguez at tweag.io> QualifiedDo is implemented using the same placeholders for operation names in the AST that were devised for RebindableSyntax. Whenever the renamer checks which names to use for do syntax, it first checks if the do block is qualified (e.g. M.do { stmts }), in which case it searches for qualified names in the module M. This allows users to write {-# LANGUAGE QualifiedDo #-} import qualified SomeModule as M f x = M.do -- desugars to: y <- M.return x -- M.return x M.>>= \y -> M.return y -- M.return y M.>> M.return y -- M.return y See Note [QualifiedDo] and the users' guide for more details. Issue #18214 Proposal: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0216-qualified-do.rst Since we change the constructors `ITdo` and `ITmdo` to carry the new module name, we need to bump the haddock submodule to account or the new shape of these constructors. - - - - - ce987865 by Ryan Scott at 2020-06-27T11:55:21-04:00 Revamp the treatment of auxiliary bindings for derived instances This started as a simple fix for #18321 that organically grew into a much more sweeping refactor of how auxiliary bindings for derived instances are handled. I have rewritten `Note [Auxiliary binders]` in `GHC.Tc.Deriv.Generate` to explain all of the moving parts, but the highlights are: * Previously, the OccName of each auxiliary binding would be given a suffix containing a hash of its package name, module name, and parent data type to avoid name clashes. This was needlessly complicated, so we take the more direct approach of generating `Exact` `RdrName`s for each auxiliary binding with the same `OccName`, but using an underlying `System` `Name` with a fresh `Unique` for each binding. Unlike hashes, allocating new `Unique`s does not require any cleverness and avoid name clashes all the same... * ...speaking of which, in order to convince the renamer that multiple auxiliary bindings with the same `OccName` (but different `Unique`s) are kosher, we now use `rnLocalValBindsLHS` instead of `rnTopBindsLHS` to rename auxiliary bindings. Again, see `Note [Auxiliary binders]` for the full story. * I have removed the `DerivHsBind` constructor for `DerivStuff`—which was only used for `Data.Data`-related auxiliary bindings—and refactored `gen_Data_binds` to use `DerivAuxBind` instead. This brings the treatment of `Data.Data`-related auxiliary bindings in line with every other form of auxiliary binding. Fixes #18321. - - - - - a403eb91 by Sylvain Henry at 2020-06-27T11:55:59-04:00 ghc-bignum: fix division by zero (#18359) - - - - - 1b3d13b6 by Sylvain Henry at 2020-06-27T11:55:59-04:00 Fix ghc-bignum exceptions We must ensure that exceptions are not simplified. Previously we used: case raiseDivZero of _ -> 0## -- dummyValue But it was wrong because the evaluation of `raiseDivZero` was removed and the dummy value was directly returned. See new Note [ghc-bignum exceptions]. I've also removed the exception triggering primops which were fragile. We don't need them to be primops, we can have them exported by ghc-prim. I've also added a test for #18359 which triggered this patch. - - - - - a74ec37c by Simon Peyton Jones at 2020-06-27T11:56:34-04:00 Better loop detection in findTypeShape Andreas pointed out, in !3466, that my fix for #18304 was not quite right. This patch fixes it properly, by having just one RecTcChecker rather than (implicitly) two nested ones, in findTypeShape. - - - - - a04020b8 by Sylvain Henry at 2020-06-27T11:57:11-04:00 DynFlags: don't store buildTag `DynFlags.buildTag` was a field created from the set of Ways in `DynFlags.ways`. It had to be kept in sync with `DynFlags.ways` which was fragile. We want to avoid global state like this (#17957). Moreover in #14335 we also want to support loading units with different ways: target units would still use `DynFlags.ways` but plugins would use `GHC.Driver.Ways.hostFullWays`. To avoid having to deal both with build tag and with ways, we recompute the buildTag on-the-fly (should be pretty cheap) and we remove `DynFlags.buildTag` field. - - - - - 0e83efa2 by Krzysztof Gogolewski at 2020-06-27T11:57:49-04:00 Don't generalize when typechecking a tuple section The code is simpler and cleaner. - - - - - d8ba9e6f by Peter Trommler at 2020-06-28T09:19:11-04:00 RTS: Refactor Haskell-C glue for PPC 64-bit Make sure the stack is 16 byte aligned even when reserved stack bytes are not a multiple of 16 bytes. Avoid saving r2 (TOC). On ELF v1 the function descriptor of StgReturn has the same TOC as StgRun, on ELF v2 the TOC is recomputed in the function prologue. Use the ABI provided functions to save clobbered GPRs and FPRs. Improve comments. Describe what the stack looks like and how it relates to the respective ABIs. - - - - - 42f797b0 by Ryan Scott at 2020-06-28T09:19:46-04:00 Use NHsCoreTy to embed types into GND-generated code `GeneralizedNewtypeDeriving` is in the unique situation where it must produce an `LHsType GhcPs` from a Core `Type`. Historically, this was done with the `typeToLHsType` function, which walked over the entire `Type` and attempted to construct an `LHsType` with the same overall structure. `typeToLHsType` is quite complicated, however, and has been the subject of numerous bugs over the years (e.g., #14579). Luckily, there is an easier way to accomplish the same thing: the `XHsType` constructor of `HsType`. `XHsType` bundles an `NHsCoreTy`, which allows embedding a Core `Type` directly into an `HsType`, avoiding the need to laboriously convert from one to another (as `typeToLHsType` did). Moreover, renaming and typechecking an `XHsType` is simple, since one doesn't need to do anything to a Core `Type`... ...well, almost. For the reasons described in `Note [Typechecking NHsCoreTys]` in `GHC.Tc.Gen.HsType`, we must apply a substitution that we build from the local `tcl_env` type environment. But that's a relatively modest price to pay. Now that `GeneralizedNewtypeDeriving` uses `NHsCoreTy`, the `typeToLHsType` function no longer has any uses in GHC, so this patch rips it out. Some additional tweaks to `hsTypeNeedsParens` were necessary to make the new `-ddump-deriv` output correctly parenthesized, but other than that, this patch is quite straightforward. This is a mostly internal refactoring, although it is likely that `GeneralizedNewtypeDeriving`-generated code will now need fewer language extensions in certain situations than it did before. - - - - - 68530b1c by Jan Hrček at 2020-06-28T09:20:22-04:00 Fix duplicated words and typos in comments and user guide - - - - - 15b79bef by Ryan Scott at 2020-06-28T09:20:57-04:00 Add integer-gmp's ghc.mk and GNUmakefile to .gitignore - - - - - bfa5698b by Simon Peyton Jones at 2020-06-28T09:21:32-04:00 Fix a typo in Lint This simple error in GHC.Core.Litn.lintJoinLams meant that Lint reported bogus errors. Fixes #18399 - - - - - 71006532 by Ryan Scott at 2020-06-30T07:10:42-04:00 Reject nested foralls/contexts in instance types more consistently GHC is very wishy-washy about rejecting instance declarations with nested `forall`s or contexts that are surrounded by outermost parentheses. This can even lead to some strange interactions with `ScopedTypeVariables`, as demonstrated in #18240. This patch makes GHC more consistently reject instance types with nested `forall`s/contexts so as to prevent these strange interactions. On the implementation side, this patch tweaks `splitLHsInstDeclTy` and `getLHsInstDeclHead` to not look through parentheses, which can be semantically significant. I've added a `Note [No nested foralls or contexts in instance types]` in `GHC.Hs.Type` to explain why. This also introduces a `no_nested_foralls_contexts_err` function in `GHC.Rename.HsType` to catch nested `forall`s/contexts in instance types. This function is now used in `rnClsInstDecl` (for ordinary instance declarations) and `rnSrcDerivDecl` (for standalone `deriving` declarations), the latter of which fixes #18271. On the documentation side, this adds a new "Formal syntax for instance declaration types" section to the GHC User's Guide that presents a BNF-style grammar for what is and isn't allowed in instance types. Fixes #18240. Fixes #18271. - - - - - bccf3351 by Sylvain Henry at 2020-06-30T07:10:46-04:00 Add ghc-bignum to 8.12 release notes - - - - - 81704a6f by David Eichmann at 2020-06-30T07:10:48-04:00 Update ssh keys in CI performance metrics upload script - - - - - 85310fb8 by Joshua Price at 2020-06-30T07:10:49-04:00 Add missing Ix instances for tuples of size 6 through 15 (#16643) - - - - - cbb6b62f by Vladislav Zavialov at 2020-07-01T15:41:38-04:00 Implement -XLexicalNegation (GHC Proposal #229) This patch introduces a new extension, -XLexicalNegation, which detects whether the minus sign stands for negation or subtraction using the whitespace-based rules described in GHC Proposal #229. Updates haddock submodule. - - - - - fb5a0d01 by Martin Handley at 2020-07-01T15:42:14-04:00 #17169: Clarify Fixed's Enum instance. - - - - - b316804d by Simon Peyton Jones at 2020-07-01T15:42:49-04:00 Improve debug tracing for substitution This patch improves debug tracing a bit (#18395) * Remove the ancient SDoc argument to substitution, replacing it with a HasDebugCallStack constraint. The latter does the same job (indicate the call site) but much better. * Add HasDebugCallStack to simpleOptExpr, exprIsConApp_maybe I needed this to help nail the lookupIdSubst panic in #18326, #17784 - - - - - 5c9fabb8 by Hécate at 2020-07-01T15:43:25-04:00 Add most common return values for `os` and `arch` - - - - - 76d8cc74 by Ryan Scott at 2020-07-01T15:44:01-04:00 Desugar quoted uses of DerivingVia and expression type signatures properly The way that `GHC.HsToCore.Quote` desugared quoted `via` types (e.g., `deriving via forall a. [a] instance Eq a => Eq (List a)`) and explicit type annotations in signatures (e.g., `f = id @a :: forall a. a -> a`) was completely wrong, as it did not implement the scoping guidelines laid out in `Note [Scoped type variables in bindings]`. This is easily fixed. While I was in town, I did some minor cleanup of related Notes: * `Note [Scoped type variables in bindings]` and `Note [Scoped type variables in class and instance declarations]` say very nearly the same thing. I decided to just consolidate the two Notes into `Note [Scoped type variables in quotes]`. * `Note [Don't quantify implicit type variables in quotes]` is somewhat outdated, as it predates GHC 8.10, where the `forall`-or-nothing rule requires kind variables to be explicitly quantified in the presence of an explicit `forall`. As a result, the running example in that Note doesn't even compile. I have changed the example to something simpler that illustrates the same point that the original Note was making. Fixes #18388. - - - - - 44d6a335 by Andreas Klebinger at 2020-07-02T02:54:54-04:00 T16012: Be verbose on failure. - - - - - f9853330 by Ryan Scott at 2020-07-02T02:55:29-04:00 Bump ghc-prim version to 0.7.0 Fixes #18279. Bumps the `text` submodule. - - - - - 23e4e047 by Sylvain Henry at 2020-07-02T10:46:31-04:00 Hadrian: fix PowerPC64le support (#17601) [ci skip] - - - - - 3cdd8d69 by Sylvain Henry at 2020-07-02T10:47:08-04:00 NCG: correctly handle addresses with huge offsets (#15570) Before this patch we could generate addresses of this form: movzbl cP0_str+-9223372036854775808,%eax The linker can't handle them because the offset is too large: ld.lld: error: Main.o:(.text+0xB3): relocation R_X86_64_32S out of range: -9223372036852653050 is not in [-2147483648, 2147483647] With this patch we detect those cases and generate: movq $-9223372036854775808,%rax addq $cP0_str,%rax movzbl (%rax),%eax I've also refactored `getAmode` a little bit to make it easier to understand and to trace. - - - - - 4d90b3ff by Gabor Greif at 2020-07-02T20:07:59-04:00 No need for CURSES_INCLUDE_DIRS This is a leftover from ef63ff27251a20ff11e58c9303677fa31e609a88 - - - - - f08d6316 by Sylvain Henry at 2020-07-02T20:08:36-04:00 Replace Opt_SccProfilingOn flag with sccProfilingEnabled helper function SCC profiling was enabled in a convoluted way: if WayProf was enabled, Opt_SccProfilingOn general flag was set (in `GHC.Driver.Ways.wayGeneralFlags`), and then this flag was queried in various places. There is no need to go via general flags, so this patch defines a `sccProfilingEnabled :: DynFlags -> Bool` helper function that just checks whether WayProf is enabled. - - - - - 8cc7274b by Ben Gamari at 2020-07-03T02:49:27-04:00 rts/ProfHeap: Only allocate the Censuses that we need When not LDV profiling there is no reason to allocate 32 Censuses; one will do. This is a very small memory footprint optimisation, but it comes for free. - - - - - b835112c by Ben Gamari at 2020-07-03T02:49:27-04:00 rts/ProfHeap: Free old allocations when reinitialising Censuses Previously when not LDV profiling we would repeatedly reinitialise `censuses[0]` with `initEra`. This failed to free the `Arena` and `HashTable` from the old census, resulting in a memory leak. Fixes #18348. - - - - - 34be6523 by Valery Tolstov at 2020-07-03T02:50:03-04:00 Mention flags that are not enabled by -Wall (#18372) * Mention missing flags that are not actually enabled by -Wall (docs/users_guide/using-warnings.rst) * Additionally remove -Wmissing-monadfail-instances from the list of flags enabled by -Wcompat, as it is not the case since 8.8 - - - - - edc8d22b by Sylvain Henry at 2020-07-03T02:50:40-04:00 LLVM: support R9 and R10 registers d535ef006d85dbdb7cda2b09c5bc35cb80108909 allowed the use of up to 10 vanilla registers but didn't update LLVM backend to support them. This patch fixes it. - - - - - 4bf18646 by Simon Peyton Jones at 2020-07-03T08:37:42+01:00 Improve handling of data type return kinds Following a long conversation with Richard, this patch tidies up the handling of return kinds for data/newtype declarations (vanilla, family, and instance). I have substantially edited the Notes in TyCl, so they would bear careful reading. Fixes #18300, #18357 In GHC.Tc.Instance.Family.newFamInst we were checking some Lint-like properties with ASSSERT. Instead Richard and I have added a proper linter for axioms, and called it from lintGblEnv, which in turn is called in tcRnModuleTcRnM New tests (T18300, T18357) cause an ASSERT failure in HEAD. - - - - - 41d26492 by Sylvain Henry at 2020-07-03T17:33:59-04:00 DynFlags: avoid the use of sdocWithDynFlags in GHC.Core.Rules (#17957) - - - - - 7aa6ef11 by Hécate at 2020-07-03T17:34:36-04:00 Add the __GHC_FULL_VERSION__ CPP macro to expose the full GHC version - - - - - e61d5395 by Chaitanya Koparkar at 2020-07-07T13:55:59-04:00 ghc-prim: Turn some comments into haddocks [ci skip] - - - - - 37743f91 by John Ericson at 2020-07-07T13:56:00-04:00 Support `timesInt2#` in LLVM backend - - - - - 46397e53 by John Ericson at 2020-07-07T13:56:00-04:00 `genericIntMul2Op`: Call `genericWordMul2Op` directly This unblocks a refactor, and removes partiality. It might be a PowerPC regression but that should be fixable. - - - - - 8a1c0584 by John Ericson at 2020-07-07T13:56:00-04:00 Simplify `PrimopCmmEmit` Follow @simonpj's suggestion of pushing the "into regs" logic into `emitPrimOp`. With the previous commit getting rid of the recursion in `genericIntMul2Op`, this is now an easy refactor. - - - - - 6607f203 by John Ericson at 2020-07-07T13:56:00-04:00 `opAllDone` -> `opIntoRegs` The old name was and terrible and became worse after the previous commit's refactor moved non-trivial funcationlity into its body. - - - - - fdcc53ba by Sylvain Henry at 2020-07-07T13:56:00-04:00 Optimise genericIntMul2Op We shouldn't directly call 'genericWordMul2Op' in genericIntMul2Op because a target may provide a faster primop for 'WordMul2Op': we'd better use it! - - - - - 686e7225 by Moritz Angermann at 2020-07-07T13:56:01-04:00 [linker/rtsSymbols] More linker symbols Mostly symbols needed for aarch64/armv7l and in combination with musl, where we have to rely on loading *all* objects/archives - __stack_chk_* only when not DYNAMIC - - - - - 3f60b94d by Moritz Angermann at 2020-07-07T13:56:01-04:00 better if guards. - - - - - 7abffced by Moritz Angermann at 2020-07-07T13:56:01-04:00 Fix (1) - - - - - cdfeb3f2 by Moritz Angermann at 2020-07-07T13:56:01-04:00 AArch32 symbols only on aarch32. - - - - - f496c955 by Adam Sandberg Ericsson at 2020-07-07T13:56:02-04:00 add -flink-rts flag to link the rts when linking a shared or static library #18072 By default we don't link the RTS when linking shared libraries because in the most usual mode a shared library is an intermediary product, for example a Haskell library, that will be linked into some executable in the end. So we wish to defer the RTS flavour to link to the final link. However sometimes the final product is the shared library, for example when writing a plugin for some other system, so we do wish the shared library to link the RTS. For consistency we also make -staticlib honor this flag and its inversion. -staticlib currently implies -flink-shared. - - - - - c59faf67 by Stefan Schulze Frielinghaus at 2020-07-07T13:56:04-04:00 hadrian: link check-ppr against debugging RTS if ghcDebugged - - - - - 0effc57d by Adam Sandberg Ericsson at 2020-07-07T13:56:05-04:00 rts linker: teach the linker about GLIBC's special handling of *stat, mknod and atexit functions #7072 - - - - - 96153433 by Adam Sandberg Ericsson at 2020-07-07T13:56:06-04:00 hadrian: make hadrian/ghci use the bootstrap compiler from configure #18190 - - - - - 4d24f886 by Adam Sandberg Ericsson at 2020-07-07T13:56:07-04:00 hadrian: ignore cabal configure verbosity related flags #18131 - - - - - 7332bbff by Ben Gamari at 2020-07-07T13:56:08-04:00 testsuite: Widen T12234 acceptance window to 2% Previously it wasn't uncommon to see +/-1% fluctuations in compiler allocations on this test. - - - - - 180b6313 by Gabor Greif at 2020-07-07T13:56:08-04:00 When running libtool, report it as such - - - - - d3bd6897 by Sylvain Henry at 2020-07-07T13:56:11-04:00 BigNum: rename BigNat types Before this patch BigNat names were confusing because we had: * GHC.Num.BigNat.BigNat: unlifted type used everywhere else * GHC.Num.BigNat.BigNatW: lifted type only used to share static constants * GHC.Natural.BigNat: lifted type only used for backward compatibility After this patch we have: * GHC.Num.BigNat.BigNat#: unlifted type * GHC.Num.BigNat.BigNat: lifted type (reexported from GHC.Natural) Thanks to @RyanGlScott for spotting this. - - - - - 929d26db by Sylvain Henry at 2020-07-07T13:56:12-04:00 Bignum: don't build ghc-bignum with stage0 Noticed by @Ericson2314 - - - - - d25b6851 by Sylvain Henry at 2020-07-07T13:56:12-04:00 Hadrian: ghc-gmp.h shouldn't be a compiler dependency - - - - - 0ddae2ba by Sylvain Henry at 2020-07-07T13:56:14-04:00 DynFlags: factor out pprUnitId from "Outputable UnitId" instance - - - - - 204f3f5d by Krzysztof Gogolewski at 2020-07-07T13:56:18-04:00 Remove unused function pprHsForAllExtra (#18423) The function `pprHsForAllExtra` was called only on `Nothing` since 2015 (1e041b7382b6aa). - - - - - 3033e0e4 by Adam Sandberg Ericsson at 2020-07-08T20:36:49-04:00 hadrian: add flag to skip rebuilding dependency information #17636 - - - - - b7de4b96 by Stefan Schulze Frielinghaus at 2020-07-09T09:49:22-04:00 Fix GHCi :print on big-endian platforms On big-endian platforms executing import GHC.Exts data Foo = Foo Float# deriving Show foo = Foo 42.0# foo :print foo results in an arithmetic overflow exception which is caused by function index where moveBytes equals word_size - (r + item_size_b) * 8 Here we have a mixture of units. Both, word_size and item_size_b have unit bytes whereas r has unit bits. On 64-bit platforms moveBytes equals then 8 - (0 + 4) * 8 which results in a negative and therefore invalid second parameter for a shiftL operation. In order to make things more clear the expression (word .&. (mask `shiftL` moveBytes)) `shiftR` moveBytes is equivalent to (word `shiftR` moveBytes) .&. mask On big-endian platforms the shift must be a left shift instead of a right shift. For symmetry reasons not a mask is used but two shifts in order to zero out bits. Thus the fixed version equals case endian of BigEndian -> (word `shiftL` moveBits) `shiftR` zeroOutBits `shiftL` zeroOutBits LittleEndian -> (word `shiftR` moveBits) `shiftL` zeroOutBits `shiftR` zeroOutBits Fixes #16548 and #14455 - - - - - 3656dff8 by Sylvain Henry at 2020-07-09T09:50:01-04:00 LLVM: fix MO_S_Mul2 support (#18434) The value indicating if the carry is useful wasn't taken into account. - - - - - d9f09506 by Simon Peyton Jones at 2020-07-10T10:33:44-04:00 Define multiShotIO and use it in mkSplitUniqueSupply This patch is part of the ongoing eta-expansion saga; see #18238. It implements a neat trick (suggested by Sebastian Graf) that allows the programmer to disable the default one-shot behaviour of IO (the "state hack"). The trick is to use a new multiShotIO function; see Note [multiShotIO]. For now, multiShotIO is defined here in Unique.Supply; but it should ultimately be moved to the IO library. The change is necessary to get good code for GHC's unique supply; see Note [Optimising the unique supply]. However it makes no difference to GHC as-is. Rather, it makes a difference when a subsequent commit Improve eta-expansion using ArityType lands. - - - - - bce695cc by Simon Peyton Jones at 2020-07-10T10:33:44-04:00 Make arityType deal with join points As Note [Eta-expansion and join points] describes, this patch makes arityType deal correctly with join points. What was there before was not wrong, but yielded lower arities than it could. Fixes #18328 In base GHC this makes no difference to nofib. Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- n-body -0.1% -0.1% -1.2% -1.1% 0.0% -------------------------------------------------------------------------------- Min -0.1% -0.1% -55.0% -56.5% 0.0% Max -0.0% 0.0% +16.1% +13.4% 0.0% Geometric Mean -0.0% -0.0% -30.1% -31.0% -0.0% But it starts to make real difference when we land the change to the way mkDupableAlts handles StrictArg, in fixing #13253 and friends. I think this is because we then get more non-inlined join points. - - - - - 2b7c71cb by Simon Peyton Jones at 2020-07-11T12:17:02-04:00 Improve eta-expansion using ArityType As #18355 shows, we were failing to preserve one-shot info when eta-expanding. It's rather easy to fix, by using ArityType more, rather than just Arity. This patch is important to suport the one-shot monad trick; see #18202. But the extra tracking of one-shot-ness requires the patch Define multiShotIO and use it in mkSplitUniqueSupply If that patch is missing, ths patch makes things worse in GHC.Types.Uniq.Supply. With it, however, we see these improvements T3064 compiler bytes allocated -2.2% T3294 compiler bytes allocated -1.3% T12707 compiler bytes allocated -1.3% T13056 compiler bytes allocated -2.2% Metric Decrease: T3064 T3294 T12707 T13056 - - - - - de139cc4 by Artem Pelenitsyn at 2020-07-12T02:53:20-04:00 add reproducer for #15630 - - - - - c4de6a7a by Andreas Klebinger at 2020-07-12T02:53:55-04:00 Give Uniq[D]FM a phantom type for its key. This fixes #17667 and should help to avoid such issues going forward. The changes are mostly mechanical in nature. With two notable exceptions. * The register allocator. The register allocator references registers by distinct uniques. However they come from the types of VirtualReg, Reg or Unique in various places. As a result we sometimes cast the key type of the map and use functions which operate on the now typed map but take a raw Unique as actual key. The logic itself has not changed it just becomes obvious where we do so now. * <Type>Env Modules. As an example a ClassEnv is currently queried using the types `Class`, `Name`, and `TyCon`. This is safe since for a distinct class value all these expressions give the same unique. getUnique cls getUnique (classTyCon cls) getUnique (className cls) getUnique (tcName $ classTyCon cls) This is for the most part contained within the modules defining the interface. However it requires us to play dirty when we are given a `Name` to lookup in a `UniqFM Class a` map. But again the logic did not change and it's for the most part hidden behind the Env Module. Some of these cases could be avoided by refactoring but this is left for future work. We also bump the haddock submodule as it uses UniqFM. - - - - - c2cfdfde by Aaron Allen at 2020-07-13T09:00:33-04:00 Warn about empty Char enumerations (#18402) Currently the "Enumeration is empty" warning (-Wempty-enumerations) only fires for numeric literals. This patch adds support for `Char` literals so that enumerating an empty list of `Char`s will also trigger the warning. - - - - - c3ac87ec by Stefan Schulze Frielinghaus at 2020-07-13T09:01:10-04:00 hadrian: build check-ppr dynamic if GHC is build dynamic Fixes #18361 - - - - - 9ad072b4 by Simon Peyton Jones at 2020-07-13T14:52:49-04:00 Use dumpStyle when printing inlinings This just makes debug-printing consistent, and more informative. - - - - - e78c4efb by Simon Peyton Jones at 2020-07-13T14:52:49-04:00 Comments only - - - - - 7ccb760b by Simon Peyton Jones at 2020-07-13T14:52:49-04:00 Reduce result discount in conSize Ticket #18282 showed that the result discount given by conSize was massively too large. This patch reduces that discount to a constant 10, which just balances the cost of the constructor application itself. Note [Constructor size and result discount] elaborates, as does the ticket #18282. Reducing result discount reduces inlining, which affects perf. I found that I could increase the unfoldingUseThrehold from 80 to 90 in compensation; in combination with the result discount change I get these overall nofib numbers: Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- boyer -0.2% +5.4% -3.2% -3.4% 0.0% cichelli -0.1% +5.9% -11.2% -11.7% 0.0% compress2 -0.2% +9.6% -6.0% -6.8% 0.0% cryptarithm2 -0.1% -3.9% -6.0% -5.7% 0.0% gamteb -0.2% +2.6% -13.8% -14.4% 0.0% genfft -0.1% -1.6% -29.5% -29.9% 0.0% gg -0.0% -2.2% -17.2% -17.8% -20.0% life -0.1% -2.2% -62.3% -63.4% 0.0% mate +0.0% +1.4% -5.1% -5.1% -14.3% parser -0.2% -2.1% +7.4% +6.7% 0.0% primetest -0.2% -12.8% -14.3% -14.2% 0.0% puzzle -0.2% +2.1% -10.0% -10.4% 0.0% rsa -0.2% -11.7% -3.7% -3.8% 0.0% simple -0.2% +2.8% -36.7% -38.3% -2.2% wheel-sieve2 -0.1% -19.2% -48.8% -49.2% -42.9% -------------------------------------------------------------------------------- Min -0.4% -19.2% -62.3% -63.4% -42.9% Max +0.3% +9.6% +7.4% +11.0% +16.7% Geometric Mean -0.1% -0.3% -17.6% -18.0% -0.7% I'm ok with these numbers, remembering that this change removes an *exponential* increase in code size in some in-the-wild cases. I investigated compress2. The difference is entirely caused by this function no longer inlining WriteRoutines.$woutputCodes = \ (w :: [CodeEvent]) -> let result_s1Sr = case WriteRoutines.outputCodes_$s$woutput w 0# 0# 8# 9# of (# ww1, ww2 #) -> (ww1, ww2) in (# case result_s1Sr of (x, _) -> map @Int @Char WriteRoutines.outputCodes1 x , case result_s1Sr of { (_, y) -> y } #) It was right on the cusp before, driven by the excessive result discount. Too bad! Happily, the compiler/perf tests show a number of improvements: T12227 compiler bytes-alloc -6.6% T12545 compiler bytes-alloc -4.7% T13056 compiler bytes-alloc -3.3% T15263 runtime bytes-alloc -13.1% T17499 runtime bytes-alloc -14.3% T3294 compiler bytes-alloc -1.1% T5030 compiler bytes-alloc -11.7% T9872a compiler bytes-alloc -2.0% T9872b compiler bytes-alloc -1.2% T9872c compiler bytes-alloc -1.5% Metric Decrease: T12227 T12545 T13056 T15263 T17499 T3294 T5030 T9872a T9872b T9872c - - - - - 7f0b671e by Ben Gamari at 2020-07-13T14:52:49-04:00 testsuite: Widen acceptance threshold on T5837 This test is positively tiny and consequently the bytes allocated measurement will be relatively noisy. Consequently I have seen this fail spuriously quite often. - - - - - 118e1c3d by Alp Mestanogullari at 2020-07-14T21:30:52-04:00 compiler: re-engineer the treatment of rebindable if Executing on the plan described in #17582, this patch changes the way if expressions are handled in the compiler in the presence of rebindable syntax. We get rid of the SyntaxExpr field of HsIf and instead, when rebindable syntax is on, we rewrite the HsIf node to the appropriate sequence of applications of the local `ifThenElse` function. In order to be able to report good error messages, with expressions as they were written by the user (and not as desugared by the renamer), we make use of TTG extensions to extend GhcRn expression ASTs with an `HsExpansion` construct, which keeps track of a source (GhcPs) expression and the desugared (GhcRn) expression that it gives rise to. This way, we can typecheck the latter while reporting the former in error messages. In order to discard the error context lines that arise from typechecking the desugared expressions (because they talk about expressions that the user has not written), we carefully give a special treatment to the nodes fabricated by this new renaming-time transformation when typechecking them. See Note [Rebindable syntax and HsExpansion] for more details. The note also includes a recipe to apply the same treatment to other rebindable constructs. Tests 'rebindable11' and 'rebindable12' have been added to make sure we report identical error messages as before this patch under various circumstances. We also now disable rebindable syntax when processing untyped TH quotes, as per the discussion in #18102 and document the interaction of rebindable syntax and Template Haskell, both in Note [Template Haskell quotes and Rebindable Syntax] and in the user guide, adding a test to make sure that we do not regress in that regard. - - - - - 64c774b0 by Andreas Klebinger at 2020-07-14T21:31:27-04:00 Explain why keeping DynFlags in AnalEnv saves allocation. - - - - - 254245d0 by Ben Gamari at 2020-07-14T21:32:03-04:00 docs/users-guide: Update default -funfolding-use-threshold value This was changed in 3d2991f8 but I neglected to update the documentation. Fixes #18419. - - - - - 4c259f86 by Andreas Klebinger at 2020-07-14T21:32:41-04:00 Escape backslashes in json profiling reports properly. I also took the liberty to do away the fixed buffer size for escaping. Using a fixed size here can only lead to issues down the line. Fixes #18438. - - - - - 23797224 by Sergei Trofimovich at 2020-07-14T21:33:19-04:00 .gitlab: re-enable integer-simple substitute (BIGNUM_BACKEND) Recently build system migrated from INTEGER_LIBRARY to BIGNUM_BACKEND. But gitlab CI was never updated. Let's enable BIGNUM_BACKEND=native. Bug: https://gitlab.haskell.org/ghc/ghc/-/issues/18437 Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - e0db878a by Sergei Trofimovich at 2020-07-14T21:33:19-04:00 ghc-bignum: bring in sync .hs-boot files with module declarations Before this change `BIGNUM_BACKEND=native` build was failing as: ``` libraries/ghc-bignum/src/GHC/Num/BigNat/Native.hs:708:16: error: * Variable not in scope: naturalFromBigNat# :: WordArray# -> t * Perhaps you meant one of these: `naturalFromBigNat' (imported from GHC.Num.Natural), `naturalToBigNat' (imported from GHC.Num.Natural) | 708 | m' = naturalFromBigNat# m | ``` This happens because `.hs-boot` files are slightly out of date. This change brings in data and function types in sync. Bug: https://gitlab.haskell.org/ghc/ghc/-/issues/18437 Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - c9f65c36 by Stefan Schulze Frielinghaus at 2020-07-14T21:33:57-04:00 rts/Disassembler.c: Use FMT_HexWord for printing values in hex format - - - - - 58ae62eb by Matthias Andreas Benkard at 2020-07-14T21:34:35-04:00 macOS: Load frameworks without stating them first. macOS Big Sur makes the following change to how frameworks are shipped with the OS: > New in macOS Big Sur 11 beta, the system ships with a built-in > dynamic linker cache of all system-provided libraries. As part of > this change, copies of dynamic libraries are no longer present on > the filesystem. Code that attempts to check for dynamic library > presence by looking for a file at a path or enumerating a directory > will fail. Instead, check for library presence by attempting to > dlopen() the path, which will correctly check for the library in the > cache. (62986286) https://developer.apple.com/documentation/macos-release-notes/macos-big-sur-11-beta-release-notes/ Therefore, the previous method of checking whether a library exists before attempting to load it makes GHC.Runtime.Linker.loadFramework fail to find frameworks installed at /System/Library/Frameworks. GHC.Runtime.Linker.loadFramework now opportunistically loads the framework libraries without checking for their existence first, failing only if all attempts to load a given framework from any of the various possible locations fail. - - - - - cdc4a6b0 by Matthias Andreas Benkard at 2020-07-14T21:34:35-04:00 loadFramework: Output the errors collected in all loading attempts. With the recent change away from first finding and then loading a framework, loadFramework had no way of communicating the real reason why loadDLL failed if it was any reason other than the framework missing from the file system. It now collects all loading attempt errors into a list and concatenates them into a string to return to the caller. - - - - - 51dbfa52 by Ben Gamari at 2020-07-15T04:05:34-04:00 StgToCmm: Use CmmRegOff smart constructor Previously we would generate expressions of the form `CmmRegOff BaseReg 0`. This should do no harm (and really should be handled by the NCG anyways) but it's better to just generate a plain `CmmReg`. - - - - - ae11bdfd by Ben Gamari at 2020-07-15T04:06:08-04:00 testsuite: Add regression test for #17744 Test due to @monoidal. - - - - - 0e3c277a by Ben Gamari at 2020-07-15T16:41:01-04:00 Bump Cabal submodule Updates a variety of tests as Cabal is now more strict about Cabal file form. - - - - - ceed994a by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Drop Windows Vista support, require Windows 7 - - - - - 00a23bfd by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Update Windows FileSystem wrapper utilities. - - - - - 459e1c5f by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Use SlimReaderLocks and ConditonalVariables provided by the OS instead of emulated ones - - - - - 763088fc by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Small linker comment and ifdef cleanups - - - - - 1a228ff9 by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Flush event logs eagerly. - - - - - e9e04dda by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Refactor Buffer structures to be able to track async operations - - - - - 356dc3fe by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Implement new Console API - - - - - 90e69f77 by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Add IOPort synchronization primitive - - - - - 71245fcc by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Add new io-manager cmdline options - - - - - d548a3b3 by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Init Windows console Codepage to UTF-8. - - - - - 58ef6366 by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Add unsafeSplat to GHC.Event.Array - - - - - d660725e by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Add size and iterate to GHC.Event.IntTable. - - - - - 050da6dd by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Switch Testsuite to test winio by default - - - - - 4bf542bf by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Multiple refactorings and support changes. - - - - - 4489af6b by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: core threaded I/O manager - - - - - 64d8f2fe by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: core non-threaded I/O manager - - - - - 8da15a09 by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: Fix a scheduler bug with the threaded-runtime. - - - - - 84ea3d14 by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: Relaxing some constraints in io-manager. - - - - - ccf0d107 by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: Fix issues with non-threaded I/O manager after split. - - - - - b492fe6e by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: Remove some barf statements that are a bit strict. - - - - - 01423fd2 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Expand comments describing non-threaded loop - - - - - 4b69004f by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: fix FileSize unstat-able handles - - - - - 9b384270 by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: Implement new tempfile routines for winio - - - - - f1e0be82 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix input truncation when reading from handle. This was caused by not upholding the read buffer invariant that bufR == bufL == 0 for empty read buffers. - - - - - e176b625 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix output truncation for writes larger than buffer size - - - - - a831ce0e by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Rewrite bufWrite. I think it's far easier to follow the code now. It's also correct now as I had still missed a spot where we didn't update the offset. - - - - - 6aefdf62 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix offset set by bufReadEmpty. bufReadEmpty returns the bytes read *including* content that was already buffered, But for calculating the offset we only care about the number of bytes read into the new buffer. - - - - - 750ebaee by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Clean up code surrounding IOPort primitives. According to phyx these should only be read and written once per object. Not neccesarily in that order. To strengthen that guarantee the primitives will now throw an exception if we violate this invariant. As a consequence we can eliminate some code from their primops. In particular code dealing with multiple queued readers/writers now simply checks the invariant and throws an exception if it was violated. That is in contrast to mvars which will do things like wake up all readers, queue multi writers etc. - - - - - ffd31db9 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix multi threaded threadDelay and a few other small changes. Multithreaded threadDelay suffered from a race condition based on the ioManagerStatus. Since the status isn't needed for WIO I removed it completely. This resulted in a light refactoring, as consequence we will always wake up the IO manager using interruptSystemManager, which uses `postQueuedCompletionStatus` internally. I also added a few comments which hopefully makes the code easier to dive into for the next person diving in. - - - - - 6ec26df2 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 wionio: Make IO subsystem check a no-op on non-windows platforms. - - - - - 29bcd936 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Set handle offset when opening files in Append mode. Otherwise we would truncate the file. - - - - - 55c29700 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Remove debug event log trace - - - - - 9acb9f40 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix sqrt and openFile009 test cases - - - - - 57017cb7 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Allow hp2ps to build with -DDEBUG - - - - - b8cd9995 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Update output of T9681 since we now actually run it. - - - - - 10af5b14 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: A few more improvements to the IOPort primitives. - - - - - 39afc4a7 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix expected tempfiles output. Tempfiles now works properly on windows, as such we can delete the win32 specific output. - - - - - 99db46e0 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Assign thread labels to IOManager threads. - - - - - be6af732 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Properly check for the tso of an incall to be zero. - - - - - e2c6dac7 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Mark FD instances as unsupported under WINIO. - - - - - fd02ceed by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix threadDelay maxBound invocations. Instead of letting the ns timer overflow now clamp it at (maxBound :: Word64) ns. That still gives a few hundred years. - - - - - bc79f9f1 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Add comments/cleanup an import in base - - - - - 1d197f4b by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Mark outstanding_service_requests volatile. As far as I know C(99) gives no guarantees for code like bool condition; ... while(condition) sleep(); that condition will be updated if it's changed by another thread. So we are explicit here and mark it as volatile, this will force a reload from memory on each iteration. - - - - - dc438186 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Make last_event a local variable - - - - - 2fc957c5 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Add comment about thread safety of processCompletion. - - - - - 4c026b6c by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: nonthreaded: Create io processing threads in main thread. We now set a flag in the IO thread. The scheduler when looking for work will check the flag and create/queue threads accordingly. We used to create these in the IO thread. This improved performance but caused frequent segfaults. Thread creation/allocation is only safe to do if nothing currently accesses the storeagemanager. However without locks in the non-threaded runtime this can't be guaranteed. This shouldn't change performance all too much. In the past we had: * IO: Create/Queue thread. * Scheduler: Runs a few times. Eventually picks up IO processing thread. Now it's: * IO: Set flag to queue thread. * Scheduler: Pick up flag, if set create/queue thread. Eventually picks up IO processing thread. - - - - - f47c7208 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Add an exported isHeapAlloced function to the RTS - - - - - cc5d7bb1 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Queue IO processing threads at the front of the queue. This will unblock the IO thread sooner hopefully leading to higher throughput in some situations. - - - - - e7630115 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: ThreadDelay001: Use higher resolution timer. - - - - - 451b5f96 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Update T9681 output, disable T4808 on windows. T4808 tests functionality of the FD interface which won't be supported under WINIO. T9681 just has it's expected output tweaked. - - - - - dd06f930 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Wake io manager once per registerTimeout. Which is implicitly done in editTimeouts, so need to wake it up twice. - - - - - e87d0bf9 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Update placeholder comment with actual function name. - - - - - fc9025db by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Always lock win32 event queue - - - - - c24c9a1f by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Display thread labels when tracing scheduler events. - - - - - 06542b03 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Refactor non-threaded runner thread and scheduler interface. Only use a single communication point (registerAlertableWait) to inform the C side aobut both timeouts to use as well as outstanding requests. Also queue a haskell processing thread after each return from alertable waits. This way there is no risk of us missing a timer event. - - - - - 256299b1 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Remove outstanding_requests from runner. We used a variable to keep track of situations where we got entries from the IO port, but all of them had already been canceled. While we can avoid some work that way this case seems quite rare. So we give up on tracking this and instead always assume at least one of the returned entries is valid. If that's not the case no harm is done, we just perform some additional work. But it makes the runner easier to reason about. In particular we don't need to care if another thread modifies oustanding_requests after we return from waiting on the IO Port. - - - - - 3ebd8ad9 by Tamar Christina at 2020-07-15T16:41:03-04:00 winio: Various fixes related to rebase and testdriver - - - - - 6be6bcba by Tamar Christina at 2020-07-15T16:41:03-04:00 winio: Fix rebase artifacts - - - - - 2c649dc3 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Rename unsafeSplat to unsafeCopyFromBuffer - - - - - a18b73f3 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Remove unused size/iterate operations from IntTable - - - - - 16bab48e by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Detect running IO Backend via peeking at RtsConfig - - - - - 8b8405a0 by Tamar Christina at 2020-07-15T16:41:03-04:00 winio: update temp path so GCC etc can handle it. Also fix PIPE support, clean up error casting, fix memory leaks - - - - - 2092bc54 by Ben Gamari at 2020-07-15T16:41:03-04:00 winio: Minor comments/renamings - - - - - a5b5b6c0 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Checking if an error code indicates completion is now a function. - - - - - 362176fd by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Small refactor in withOverlappedEx - - - - - 32e20597 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: A few comments and commented out dbxIO - - - - - a4bfc1d9 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Don't drop buffer offset in byteView/cwcharView - - - - - b3ad2a54 by Tamar Christina at 2020-07-15T16:41:03-04:00 winio: revert BHandle changes. - - - - - 3dcd87e2 by Ben Gamari at 2020-07-15T16:41:03-04:00 winio: Fix imports - - - - - 5a371890 by Tamar Christina at 2020-07-15T16:41:03-04:00 winio: update ghc-cabal to handle new Cabal submodule bump - - - - - d07ebe0d by Ben Gamari at 2020-07-15T16:41:03-04:00 winio: Only compile sources on Windows - - - - - dcb42393 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Actually return Nothing on EOF for non-blocking read - - - - - 895a3beb by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Deduplicate logic in encodeMultiByte[Raw]IO. - - - - - e06e6734 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Deduplicate openFile logic - - - - - b59430c0 by Tamar Christina at 2020-07-15T16:41:03-04:00 winio: fix -werror issue in encoding file - - - - - f8d39a51 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Don't mention windows specific functions when building on Linux. - - - - - 6a533d2a by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: add a note about file locking in the RTS. - - - - - cf37ce34 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Add version to @since annotation - - - - - 0fafa2eb by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Rename GHC.Conc.IOCP -> GHC.Conc.WinIO - - - - - 1854fc23 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Expand GHC.Conc.POSIX description It now explains users may not use these functions when using the old IO manager. - - - - - fcc7ba41 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Fix potential spaceleak in __createUUIDTempFileErrNo - - - - - 6b3fd9fa by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Remove redundant -Wno-missing-signatures pragmas - - - - - 916fc861 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Make it explicit that we only create one IO manager - - - - - f260a721 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Note why we don't use blocking waits. - - - - - aa0a4bbf by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Remove commented out pragma - - - - - d679b544 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Remove redundant buffer write in Handle/Text.hs:bufReadEmpty - - - - - d3f94368 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Rename SmartHandles to StdHandles - - - - - bd6b8ec1 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: add comment stating failure behaviour for getUniqueFileInfo. - - - - - 12846b85 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Update IOPort haddocks. - - - - - 9f39fb14 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Add a note cross reference - - - - - 62dd5a73 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Name Haskell/OS I/O Manager explicitly in Note - - - - - fa807828 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Expand BlockedOnIOCompletion description. - - - - - f0880a1d by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Remove historical todos - - - - - 8e58e714 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Update note, remove debugging pragma. - - - - - aa4d84d5 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: flushCharReadBuffer shouldn't need to adjust offsets. - - - - - e580893a by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Remove obsolete comment about cond. variables - - - - - d54e9d79 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: fix initial linux validate build - - - - - 3cd4de46 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Fix ThreadDelay001 CPP - - - - - c88b1b9f by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Fix openFile009 merge conflict leftover - - - - - 849e8889 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Accept T9681 output. GHC now reports String instead of [Char]. - - - - - e7701818 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Fix cabal006 after upgrading cabal submodule Demand cabal 2.0 syntax instead of >= 1.20 as required by newer cabal versions. - - - - - a44f0373 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Fix stderr output for ghci/linking/dyn tests. We used to filter rtsopts, i opted to instead just accept the warning of it having no effect. This works both for -rtsopts, as well as -with-rtsopts which winio adds. - - - - - 515d9896 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Adjust T15261b stdout for --io-manager flag. - - - - - 949aaacc by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Adjust T5435_dyn_asm stderr The warning about rtsopts having no consequences is expected. So accept new stderr. - - - - - 7d424e1e by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Also accept T7037 stderr - - - - - 1f009768 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: fix cabal04 by filtering rts args - - - - - 981a9f2e by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: fix cabal01 by accepting expected stderr - - - - - b7b0464e by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: fix safePkg01 by accepting expected stderr - - - - - 32734b29 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: fix T5435_dyn_gcc by accepting expected stderr - - - - - acc5cebf by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: fix tempfiles test on linux - - - - - c577b789 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Accept accepted stderr for T3807 - - - - - c108c527 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Accept accepted stderr for linker_unload - - - - - 2b0b9a08 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Accept accepted stderr for linker_unload_multiple_objs - - - - - 67afb03c by Tamar Christina at 2020-07-15T16:41:04-04:00 winio: clarify wording on conditional variables. - - - - - 3bd41572 by Tamar Christina at 2020-07-15T16:41:04-04:00 winio: clarify comment on cooked mode. - - - - - ded58a03 by Tamar Christina at 2020-07-15T16:41:04-04:00 winio: update lockfile signature and remove mistaken symbol in rts. - - - - - 2143c492 by Ben Gamari at 2020-07-15T16:41:04-04:00 testsuite: Add winio and winio_threaded ways Reverts many of the testsuite changes - - - - - c0979cc5 by Ben Gamari at 2020-07-16T10:56:54-04:00 Merge remote-tracking branch 'origin/wip/winio' - - - - - 750a1595 by Ben Gamari at 2020-07-18T07:26:41-04:00 rts: Add --copying-gc flag to reverse effect of --nonmoving-gc Fixes #18281. - - - - - 6ba6a881 by Hécate at 2020-07-18T07:26:42-04:00 Implement `fullCompilerVersion` Follow-up of https://gitlab.haskell.org/ghc/ghc/-/issues/18403 This MR adds `fullCompilerVersion`, a function that shares the same backend as the `--numeric-version` GHC flag, exposing a full, three-digit version datatype. - - - - - e6cf27df by Hécate at 2020-07-18T07:26:43-04:00 Add a Lint hadrian rule and an .hlint.yaml file in base/ - - - - - bcb177dd by Simon Peyton Jones at 2020-07-18T07:26:43-04:00 Allow multiple case branches to have a higher rank type As #18412 points out, it should be OK for multiple case alternatives to have a higher rank type, provided they are all the same. This patch implements that change. It sweeps away GHC.Tc.Gen.Match.tauifyMultipleBranches, and friends, replacing it with an enhanced version of fillInferResult. The basic change to fillInferResult is to permit the case in which another case alternative has already filled in the result; and in that case simply unify. It's very simple actually. See the new Note [fillInferResult] in TcMType Other refactoring: - Move all the InferResult code to one place, in GHC.Tc.Utils.TcMType (previously some of it was in Unify) - Move tcInstType and friends from TcMType to Instantiate, where it more properly belongs. (TCMType was getting very long.) - - - - - e5525a51 by Simon Peyton Jones at 2020-07-18T07:26:43-04:00 Improve typechecking of NPlusK patterns This patch (due to Richard Eisenberg) improves documentation of the wrapper returned by tcSubMult (see Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify). And, more substantially, it cleans up the multiplicity handling in the typechecking of NPlusKPat - - - - - 12f90352 by Krzysztof Gogolewski at 2020-07-18T07:26:45-04:00 Remove {-# CORE #-} pragma (part of #18048) This pragma has no effect since 2011. It was introduced for External Core, which no longer exists. Updates haddock submodule. - - - - - e504c913 by Simon Peyton Jones at 2020-07-18T07:26:45-04:00 Refactor the simplification of join binders This MR (for #18449) refactors the Simplifier's treatment of join-point binders. Specifically, it puts together, into GHC.Core.Opt.Simplify.Env.adjustJoinPointType two currently-separate ways in which we adjust the type of a join point. As the comment says: -- (adjustJoinPointType mult new_res_ty join_id) does two things: -- -- 1. Set the return type of the join_id to new_res_ty -- See Note [Return type for join points] -- -- 2. Adjust the multiplicity of arrows in join_id's type, as -- directed by 'mult'. See Note [Scaling join point arguments] I think this actually fixes a latent bug, by ensuring that the seIdSubst and seInScope have the right multiplicity on the type of join points. I did some tidying up while I was at it. No more setJoinResTy, or modifyJoinResTy: instead it's done locally in Simplify.Env.adjustJoinPointType - - - - - 49b265f0 by Chaitanya Koparkar at 2020-07-18T07:26:46-04:00 Fix minor typos in a Core.hs note - - - - - 8d59aed6 by Stefan Schulze Frielinghaus at 2020-07-18T07:26:47-04:00 GHCi: Fix isLittleEndian - - - - - c26e81d1 by Ben Gamari at 2020-07-18T07:26:47-04:00 testsuite: Mark ghci tests as fragile under unreg compiler In particular I have seen T16012 fail repeatedly under the unregisterised compiler. - - - - - 868e4523 by Moritz Angermann at 2020-07-20T04:30:38-04:00 Revert "AArch32 symbols only on aarch32." This reverts commit cdfeb3f24f76e8fd30452016676e56fbc827789a. Signed-off-by: Moritz Angermann <moritz.angermann at gmail.com> - - - - - c915ba84 by Moritz Angermann at 2020-07-20T04:30:38-04:00 Revert "Fix (1)" This reverts commit 7abffced01f5680efafe44f6be2733eab321b039. Signed-off-by: Moritz Angermann <moritz.angermann at gmail.com> - - - - - 777c452a by Moritz Angermann at 2020-07-20T04:30:38-04:00 Revert "better if guards." This reverts commit 3f60b94de1f460ca3f689152860b108a19ce193e. Signed-off-by: Moritz Angermann <moritz.angermann at gmail.com> - - - - - 0dd40552 by Moritz Angermann at 2020-07-20T04:30:38-04:00 Revert "[linker/rtsSymbols] More linker symbols" This reverts commit 686e72253aed3880268dd6858eadd8c320f09e97. Signed-off-by: Moritz Angermann <moritz.angermann at gmail.com> - - - - - 30caeee7 by Sylvain Henry at 2020-07-21T06:39:33-04:00 DynFlags: remove use of sdocWithDynFlags from GHC.Stg.* (#17957) * add StgPprOpts datatype * remove Outputable instances for types that need `StgPprOpts` to be pretty-printed and explicitly call type specific ppr functions * add default `panicStgPprOpts` for panic messages (when it's not convenient to thread StgPprOpts or DynFlags down to the ppr function call) - - - - - 863c544c by Mark at 2020-07-21T06:39:34-04:00 Fix a typo in existential_quantification.rst - - - - - 05910be1 by Krzysztof Gogolewski at 2020-07-21T14:47:07-04:00 Add release notes entry for #17816 [skip ci] - - - - - a6257192 by Matthew Pickering at 2020-07-21T14:47:19-04:00 Use a newtype `Code` for the return type of typed quotations (Proposal #195) There are three problems with the current API: 1. It is hard to properly write instances for ``Quote m => m (TExp a)`` as the type is the composition of two type constructors. Doing so in your program involves making your own newtype and doing a lot of wrapping/unwrapping. For example, if I want to create a language which I can either run immediately or generate code from I could write the following with the new API. :: class Lang r where _int :: Int -> r Int _if :: r Bool -> r a -> r a -> r a instance Lang Identity where _int = Identity _if (Identity b) (Identity t) (Identity f) = Identity (if b then t else f) instance Quote m => Lang (Code m) where _int = liftTyped _if cb ct cf = [|| if $$cb then $$ct else $$cf ||] 2. When doing code generation it is common to want to store code fragments in a map. When doing typed code generation, these code fragments contain a type index so it is desirable to store them in one of the parameterised map data types such as ``DMap`` from ``dependent-map`` or ``MapF`` from ``parameterized-utils``. :: compiler :: Env -> AST a -> Code Q a data AST a where ... data Ident a = ... type Env = MapF Ident (Code Q) newtype Code m a = Code (m (TExp a)) In this example, the ``MapF`` maps an ``Ident String`` directly to a ``Code Q String``. Using one of these map types currently requires creating your own newtype and constantly wrapping every quotation and unwrapping it when using a splice. Achievable, but it creates even more syntactic noise than normal metaprogramming. 3. ``m (TExp a)`` is ugly to read and write, understanding ``Code m a`` is easier. This is a weak reason but one everyone can surely agree with. Updates text submodule. - - - - - 58235d46 by Ben Gamari at 2020-07-21T14:47:28-04:00 users-guide: Fix :rts-flag:`--copying-gc` documentation It was missing a newline. - - - - - 19e80b9a by Vladislav Zavialov at 2020-07-21T14:50:01-04:00 Accumulate Haddock comments in P (#17544, #17561, #8944) Haddock comments are, first and foremost, comments. It's very annoying to incorporate them into the grammar. We can take advantage of an important property: adding a Haddock comment does not change the parse tree in any way other than wrapping some nodes in HsDocTy and the like (and if it does, that's a bug). This patch implements the following: * Accumulate Haddock comments with their locations in the P monad. This is handled in the lexer. * After parsing, do a pass over the AST to associate Haddock comments with AST nodes using location info. * Report the leftover comments to the user as a warning (-Winvalid-haddock). - - - - - 4c719460 by David Binder at 2020-07-22T20:17:35-04:00 Fix dead link to haskell prime discussion - - - - - f2f817e4 by BinderDavid at 2020-07-22T20:17:35-04:00 Replace broken links to old haskell-prime site by working links to gitlab instance. [skip ci] - - - - - 0bf8980e by Daniel Gröber at 2020-07-22T20:18:11-04:00 Remove length field from FastString - - - - - 1010c33b by Daniel Gröber at 2020-07-22T20:18:11-04:00 Use ShortByteString for FastString There are multiple reasons we want this: - Fewer allocations: ByteString has 3 fields, ShortByteString just has one. - ByteString memory is pinned: - This can cause fragmentation issues (see for example #13110) but also - makes using FastStrings in compact regions impossible. Metric Decrease: T5837 T12150 T12234 T12425 - - - - - 8336ba78 by Daniel Gröber at 2020-07-22T20:18:11-04:00 Pass specialised utf8DecodeChar# to utf8DecodeLazy# for performance Currently we're passing a indexWord8OffAddr# type function to utf8DecodeLazy# which then passes it on to utf8DecodeChar#. By passing one of utf8DecodeCharAddr# or utf8DecodeCharByteArray# instead we benefit from the inlining and specialization already done for those. - - - - - 7484a9a4 by Daniel Gröber at 2020-07-22T20:18:11-04:00 Encoding: Add comment about tricky ForeignPtr lifetime - - - - - 5536ed28 by Daniel Gröber at 2020-07-22T20:18:11-04:00 Use IO constructor instead of `stToIO . ST` - - - - - 5b8902e3 by Daniel Gröber at 2020-07-22T20:18:11-04:00 Encoding: Remove redundant use of withForeignPtr - - - - - 5976a161 by Daniel Gröber at 2020-07-22T20:18:11-04:00 Encoding: Reformat utf8EncodeShortByteString to be more consistent - - - - - 9ddf1614 by Daniel Gröber at 2020-07-22T20:18:11-04:00 FastString: Reintroduce character count cache Metric Increase: ManyConstructors Metric Decrease: T4029 - - - - - e9491668 by Ben Gamari at 2020-07-22T20:18:46-04:00 get-win32-tarballs: Fix detection of missing tarballs This fixes the error message given by configure when the user attempts to configure without first download the win32 tarballs. - - - - - 9f3ff8fd by Andreas Klebinger at 2020-07-22T20:19:22-04:00 Enable BangPatterns, ScopedTypeVariables for ghc and hadrian by default. This is only for their respective codebases. - - - - - 0f17b930 by Sylvain Henry at 2020-07-22T20:19:59-04:00 Remove unused "ncg" flag This flag has been removed in 066b369de2c6f7da03c88206288dca29ab061b31 in 2011. - - - - - bab4ec8f by Sylvain Henry at 2020-07-22T20:19:59-04:00 Don't panic if the NCG isn't built (it is always built) - - - - - 8ea33edb by Sylvain Henry at 2020-07-22T20:19:59-04:00 Remove unused sGhcWithNativeCodeGen - - - - - e079bb72 by Sylvain Henry at 2020-07-22T20:19:59-04:00 Correctly test active backend Previously we used a platform settings to detect if the native code generator was used. This was wrong. We need to use the `DynFlags.hscTarget` field instead. - - - - - 735f9d6b by Sylvain Henry at 2020-07-22T20:19:59-04:00 Replace ghcWithNativeCodeGen with a proper Backend datatype * Represent backends with a `Backend` datatype in GHC.Driver.Backend * Don't detect the default backend to use for the target platform at compile time in Hadrian/make but at runtime. It makes "Settings" simpler and it is a step toward making GHC multi-target. * The latter change also fixes hadrian which has not been updated to take into account that the NCG now supports AIX and PPC64 (cf df26b95559fd467abc0a3a4151127c95cb5011b9 and d3c1dda60d0ec07fc7f593bfd83ec9457dfa7984) * Also we don't treat iOS specifically anymore (cf cb4878ffd18a3c70f98bdbb413cd3c4d1f054e1f) - - - - - f7cc4313 by Sylvain Henry at 2020-07-22T20:19:59-04:00 Replace HscTarget with Backend They both have the same role and Backend name is more explicit. Metric Decrease: T3064 Update Haddock submodule - - - - - 15ce1804 by Andreas Klebinger at 2020-07-22T20:20:34-04:00 Deprecate -fdmd-tx-dict-sel. It's behaviour is now unconditionally enabled as it's slightly beneficial. There are almost no benchmarks which benefit from disabling it, so it's not worth the keep this configurable. This fixes #18429. - - - - - ff1b7710 by Sylvain Henry at 2020-07-22T20:21:11-04:00 Add test for #18064 It has been fixed by 0effc57d48ace6b719a9f4cbeac67c95ad55010b - - - - - cfa89149 by Krzysztof Gogolewski at 2020-07-22T20:21:48-04:00 Define type Void# = (# #) (#18441) There's one backwards compatibility issue: GHC.Prim no longer exports Void#, we now manually re-export it from GHC.Exts. - - - - - 02f40b0d by Sebastian Graf at 2020-07-22T20:22:23-04:00 Add regression test for #18478 !3392 backported !2993 to GHC 8.10.2 which most probably is responsible for fixing #18478, which triggered a pattern match checker performance regression in GHC 8.10.1 as first observed in #17977. - - - - - 7f44df1e by Sylvain Henry at 2020-07-22T20:23:00-04:00 Minor refactoring of Unit display * for consistency, try to always use UnitPprInfo to display units to users * remove some uses of `unitPackageIdString` as it doesn't show the component name and it uses String - - - - - dff1cb3d by Moritz Angermann at 2020-07-23T07:55:29-04:00 [linker] Fix out of range relocations. mmap may return address all over the place. mmap_next will ensure we get the next free page after the requested address. This is especially important for linking on aarch64, where the memory model with PIC admits relocations in the +-4GB range, and as such we can't work with arbitrary object locations in memory. Of note: we map the rts into process space, so any mapped objects must not be ouside of the 4GB from the processes address space. - - - - - cdd0ff16 by Tamar Christina at 2020-07-24T18:12:23-04:00 winio: restore console cp on exit - - - - - c1f4f81d by Tamar Christina at 2020-07-24T18:13:00-04:00 winio: change memory allocation strategy and fix double free errors. - - - - - ba205046 by Simon Peyton Jones at 2020-07-24T18:13:35-04:00 Care with occCheckExpand in kind of occurrences Issue #18451 showed that we could get an infinite type, through over-use of occCheckExpand in the kind of an /occurrence/ of a type variable. See Note [Occurrence checking: look inside kinds] in GHC.Core.Type This patch fixes the problem by making occCheckExpand less eager to expand synonyms in kinds. It also improves pretty printing of kinds, by *not* suppressing the kind on a tyvar-binder like (a :: Const Type b) where type Const p q = p. Even though the kind of 'a' is Type, we don't want to suppress the kind ascription. Example: the error message for polykinds/T18451{a,b}. See GHC.Core.TyCo.Ppr Note [Suppressing * kinds]. - - - - - 02133353 by Zubin Duggal at 2020-07-25T00:44:30-04:00 Simplify XRec definition Change `Located X` usage to `XRec pass X` This increases the scope of the LPat experiment to almost all of GHC. Introduce UnXRec and MapXRec classes Fixes #17587 and #18408 Updates haddock submodule Co-authored-by: Philipp Krüger <philipp.krueger1 at gmail.com> - - - - - e443846b by Sylvain Henry at 2020-07-25T00:45:07-04:00 DynFlags: store printer in TraceBinIfaceReading We don't need to pass the whole DynFlags, just pass the logging function, if any. - - - - - 15b2b44f by Sylvain Henry at 2020-07-25T00:45:08-04:00 Rename GHC.Driver.Ways into GHC.Platform.Ways - - - - - 342a01af by Sylvain Henry at 2020-07-25T00:45:08-04:00 Add GHC.Platform.Profile - - - - - 6333d739 by Sylvain Henry at 2020-07-25T00:45:08-04:00 Put PlatformConstants into Platform - - - - - 9dfeca6c by Sylvain Henry at 2020-07-25T00:45:08-04:00 Remove platform constant wrappers Platform constant wrappers took a DynFlags parameter, hence implicitly used the target platform constants. We removed them to allow support for several platforms at once (#14335) and to avoid having to pass the full DynFlags to every function (#17957). Metric Decrease: T4801 - - - - - 73145d57 by Sylvain Henry at 2020-07-25T00:45:08-04:00 Remove dead code in utils/derivConstants - - - - - 7721b923 by Sylvain Henry at 2020-07-25T00:45:08-04:00 Move GHC.Platform into the compiler Previously it was in ghc-boot so that ghc-pkg could use it. However it wasn't necessary because ghc-pkg only uses a subset of it: reading target arch and OS from the settings file. This is now done via GHC.Platform.ArchOS (was called PlatformMini before). - - - - - 459afeb5 by Sylvain Henry at 2020-07-25T00:45:08-04:00 Fix build systems - - - - - 9e2930c3 by Sylvain Henry at 2020-07-25T00:45:08-04:00 Bump CountParserDeps - - - - - 6e2db34b by Sylvain Henry at 2020-07-25T00:45:08-04:00 Add accessors to ArchOS - - - - - fc0f6fbc by Stefan Schulze Frielinghaus at 2020-07-25T00:45:45-04:00 Require SMP support in order to build a threaded stage1 Fixes 18266 - - - - - a7c4439a by Matthias Andreas Benkard at 2020-07-26T13:23:24-04:00 Document loadFramework changes. (#18446) Adds commentary on the rationale for the changes made in merge request !3689. - - - - - da7269a4 by Ben Gamari at 2020-07-26T13:23:59-04:00 rts/win32: Exit with EXIT_HEAPOVERFLOW if memory commit fails Since switching to the two-step allocator, the `outofmem` test fails via `osCommitMemory` failing to commit. However, this was previously exiting with `EXIT_FAILURE`, rather than `EXIT_HEAPOVERFLOW`. I think the latter is a more reasonable exit code for this case and matches the behavior on POSIX platforms. - - - - - f153a1d0 by Ben Gamari at 2020-07-26T13:23:59-04:00 testsuite: Update win32 output for parseTree - - - - - e91672f0 by Ben Gamari at 2020-07-26T13:23:59-04:00 testsuite: Normalise WinIO error message differences Previously the old Windows IO manager threw different errors than WinIO. We now canonicalise these to the WinIO errors. - - - - - 9cbfe086 by Ben Gamari at 2020-07-26T13:23:59-04:00 gitlab-ci: Kill ssh-agent after pushing test metrics Otherwise the Windows builds hang forever waiting for the process to terminate. - - - - - 8236925f by Tamar Christina at 2020-07-26T13:24:35-04:00 winio: remove dead argument to stg_newIOPortzh - - - - - ce0a1d67 by Tamar Christina at 2020-07-26T13:25:11-04:00 winio: fix detection of tty terminals - - - - - 52685cf7 by Tamar Christina at 2020-07-26T13:25:48-04:00 winio: update codeowners - - - - - aee45d9e by Vladislav Zavialov at 2020-07-27T07:06:56-04:00 Improve NegativeLiterals (#18022, GHC Proposal #344) Before this patch, NegativeLiterals used to parse x-1 as x (-1). This may not be what the user expects, and now it is fixed: x-1 is parsed as (-) x 1. We achieve this by the following requirement: * When lexing a negative literal, it must not be preceded by a 'closing token'. This also applies to unboxed literals, e.g. -1#. See GHC Proposal #229 for the definition of a closing token. A nice consequence of this change is that -XNegativeLiterals becomes a subset of -XLexicalNegation. In other words, enabling both of those extensions has the same effect as enabling -XLexicalNegation alone. - - - - - 667ab69e by leiftw at 2020-07-27T07:07:32-04:00 fix typo referring to non-existent `-ohidir` flag, should be `-hidir` I think - - - - - 6ff89c17 by Vladislav Zavialov at 2020-07-27T07:08:07-04:00 Refactor the parser a little * Create a dedicated production for type operators * Create a dedicated type for the UNPACK pragma * Remove an outdated part of Note [Parsing data constructors is hard] - - - - - aa054d32 by Ben Gamari at 2020-07-27T20:09:07-04:00 Drop 32-bit Windows support As noted in #18487, we have reached the end of this road. - - - - - 6da73bbf by Michalis Pardalos at 2020-07-27T20:09:44-04:00 Add minimal test for #12492 - - - - - 47680cb7 by Michalis Pardalos at 2020-07-27T20:09:44-04:00 Use allocate, not ALLOC_PRIM_P for unpackClosure# ALLOC_PRIM_P fails for large closures, by directly using allocate we can handle closures which are larger than the block size. Fixes #12492 - - - - - 3d345c96 by Simon Peyton Jones at 2020-07-27T20:10:19-04:00 Eta-expand the Simplifier monad This patch eta-expands the Simplifier's monad, using the method explained in GHC.Core.Unify Note [The one-shot state monad trick]. It's part of the exta-expansion programme in #18202. It's a tiny patch, but is worth a 1-2% reduction in bytes-allocated by the compiler. Here's the list, based on the compiler-performance tests in perf/compiler: Reduction in bytes allocated T10858(normal) -0.7% T12425(optasm) -1.3% T13056(optasm) -1.8% T14683(normal) -1.1% T15164(normal) -1.3% T15630(normal) -1.4% T17516(normal) -2.3% T18282(normal) -1.6% T18304(normal) -0.8% T1969(normal) -0.6% T4801(normal) -0.8% T5321FD(normal) -0.7% T5321Fun(normal) -0.5% T5642(normal) -0.9% T6048(optasm) -1.1% T9020(optasm) -2.7% T9233(normal) -0.7% T9675(optasm) -0.5% T9961(normal) -2.9% WWRec(normal) -1.2% Metric Decrease: T12425 T9020 T9961 - - - - - 57aca6bb by Ben Gamari at 2020-07-27T20:10:54-04:00 gitlab-ci: Ensure that Hadrian jobs don't download artifacts Previously the Hadrian jobs had the default dependencies, meaning that they would download artifacts from all jobs of earlier stages. This is unneccessary. - - - - - 0a815cea by Ben Gamari at 2020-07-27T20:10:54-04:00 gitlab-ci: Bump bootstrap compiler to 8.8.4 Hopefully this will make the Windows jobs a bit more reliable. - - - - - 0bd60059 by Simon Peyton Jones at 2020-07-28T02:01:49-04:00 This patch addresses the exponential blow-up in the simplifier. Specifically: #13253 exponential inlining #10421 ditto #18140 strict constructors #18282 another nested-function call case This patch makes one really significant changes: change the way that mkDupableCont handles StrictArg. The details are explained in GHC.Core.Opt.Simplify Note [Duplicating StrictArg]. Specific changes * In mkDupableCont, when making auxiliary bindings for the other arguments of a call, add extra plumbing so that we don't forget the demand on them. Otherwise we haev to wait for another round of strictness analysis. But actually all the info is to hand. This change affects: - Make the strictness list in ArgInfo be [Demand] instead of [Bool], and rename it to ai_dmds. - Add as_dmd to ValArg - Simplify.makeTrivial takes a Demand - mkDupableContWithDmds takes a [Demand] There are a number of other small changes 1. For Ids that are used at most once in each branch of a case, make the occurrence analyser record the total number of syntactic occurrences. Previously we recorded just OneBranch or MultipleBranches. I thought this was going to be useful, but I ended up barely using it; see Note [Note [Suppress exponential blowup] in GHC.Core.Opt.Simplify.Utils Actual changes: * See the occ_n_br field of OneOcc. * postInlineUnconditionally 2. I found a small perf buglet in SetLevels; see the new function GHC.Core.Opt.SetLevels.hasFreeJoin 3. Remove the sc_cci field of StrictArg. I found I could get its information from the sc_fun field instead. Less to get wrong! 4. In ArgInfo, arrange that ai_dmds and ai_discs have a simpler invariant: they line up with the value arguments beyond ai_args This allowed a bit of nice refactoring; see isStrictArgInfo, lazyArgcontext, strictArgContext There is virtually no difference in nofib. (The runtime numbers are bogus -- I tried a few manually.) Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- fft +0.0% -2.0% -48.3% -49.4% 0.0% multiplier +0.0% -2.2% -50.3% -50.9% 0.0% -------------------------------------------------------------------------------- Min -0.4% -2.2% -59.2% -60.4% 0.0% Max +0.0% +0.1% +3.3% +4.9% 0.0% Geometric Mean +0.0% -0.0% -33.2% -34.3% -0.0% Test T18282 is an existing example of these deeply-nested strict calls. We get a big decrease in compile time (-85%) because so much less inlining takes place. Metric Decrease: T18282 - - - - - 6ee07b49 by Sylvain Henry at 2020-07-28T02:02:27-04:00 Bignum: add support for negative shifts (fix #18499) shiftR/shiftL support negative arguments despite Haskell 2010 report saying otherwise. We explicitly test for negative values which is bad (it gets in the way of constant folding, etc.). Anyway, for consistency we fix Bits instancesof Integer/Natural. - - - - - f305bbfd by Peter Trommler at 2020-07-28T02:03:02-04:00 config: Fix Haskell platform constructor w/ params Fixes #18505 - - - - - 318bb17c by Oleg Grenrus at 2020-07-28T20:54:13-04:00 Fix typo in haddock Spotted by `vilpan` on `#haskell` - - - - - 39c89862 by Sergei Trofimovich at 2020-07-28T20:54:50-04:00 ghc/mk: don't build gmp packages for BIGNUM_BACKEND=native Before this change make-based `BIGNUM_BACKEND=native` build was failing as: ``` x86_64-pc-linux-gnu-gcc: error: libraries/ghc-bignum/gmp/objs/*.o: No such file or directory ``` This happens because ghc.mk was pulling in gmp-dependent ghc-bignum library unconditionally. The change avoid building ghc-bignum. Bug: https://gitlab.haskell.org/ghc/ghc/-/issues/18437 Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - b9a880fc by Felix Wiemuth at 2020-07-29T15:06:35-04:00 Fix typo - - - - - c59064b0 by Brandon Chinn at 2020-07-29T15:07:11-04:00 Add regression test for #16341 - - - - - a61411ca by Brandon Chinn at 2020-07-29T15:07:11-04:00 Pass dit_rep_tc_args to dsm_stock_gen_fn - - - - - a26498da by Brandon Chinn at 2020-07-29T15:07:11-04:00 Pass tc_args to gen_fn - - - - - 44b11bad by Brandon Chinn at 2020-07-29T15:07:11-04:00 Filter out unreachable constructors when deriving stock instances (#16431) - - - - - bbc51916 by Simon Peyton Jones at 2020-07-29T15:07:47-04:00 Kill off sc_mult and as_mult fields They are readily derivable from other fields, so this is more efficient, and less error prone. Fixes #18494 - - - - - e3db4b4c by Peter Trommler at 2020-07-29T15:08:22-04:00 configure: Fix build system on ARM - - - - - 96c31ea1 by Sylvain Henry at 2020-07-29T15:09:02-04:00 Fix bug in Natural multiplication (fix #18509) A bug was lingering in Natural multiplication (inverting two limbs) despite QuickCheck tests used during the development leading to wrong results (independently of the selected backend). - - - - - e1dc3d7b by Krzysztof Gogolewski at 2020-07-29T15:09:39-04:00 Fix validation errors (#18510) Test T2632 is a stage1 test that failed because of the Q => Quote change. The remaining tests did not use quotation and failed when the path contained a space. - - - - - 6c68a842 by John Ericson at 2020-07-30T07:11:02-04:00 For `-fkeep-going` do not duplicate dependency edge code We now compute the deps for `-fkeep-going` the same way that the original graph calculates them, so the edges are correct. Upsweep really ought to take the graph rather than a topological sort so we are never recalculating anything, but at least things are recaluclated consistently now. - - - - - 502de556 by cgibbard at 2020-07-30T07:11:02-04:00 Add haddock comment for unfilteredEdges and move the note about drop_hs_boot_nodes into it. - - - - - 01c948eb by Ryan Scott at 2020-07-30T07:11:37-04:00 Clean up the inferred type variable restriction This patch primarily: * Documents `checkInferredVars` (previously called `check_inferred_vars`) more carefully. This is the function which throws an error message if a user quantifies an inferred type variable in a place where specificity cannot be observed. See `Note [Unobservably inferred type variables]` in `GHC.Rename.HsType`. Note that I now invoke `checkInferredVars` _alongside_ `rnHsSigType`, `rnHsWcSigType`, etc. rather than doing so _inside_ of these functions. This results in slightly more call sites for `checkInferredVars`, but it makes it much easier to enumerate the spots where the inferred type variable restriction comes into effect. * Removes the inferred type variable restriction for default method type signatures, per the discussion in #18432. As a result, this patch fixes #18432. Along the way, I performed some various cleanup: * I moved `no_nested_foralls_contexts_err` into `GHC.Rename.Utils` (under the new name `noNestedForallsContextsErr`), since it now needs to be invoked from multiple modules. I also added a helper function `addNoNestedForallsContextsErr` that throws the error message after producing it, as this is a common idiom. * In order to ensure that users cannot sneak inferred type variables into `SPECIALISE instance` pragmas by way of nested `forall`s, I now invoke `addNoNestedForallsContextsErr` when renaming `SPECIALISE instance` pragmas, much like when we rename normal instance declarations. (This probably should have originally been done as a part of the fix for #18240, but this task was somehow overlooked.) As a result, this patch fixes #18455 as a side effect. - - - - - d47324ce by Ryan Scott at 2020-07-30T07:12:16-04:00 Don't mark closed type family equations as occurrences Previously, `rnFamInstEqn` would mark the name of the type/data family used in an equation as an occurrence, regardless of what sort of family it is. Most of the time, this is the correct thing to do. The exception is closed type families, whose equations constitute its definition and therefore should not be marked as occurrences. Overzealously counting the equations of a closed type family as occurrences can cause certain warnings to not be emitted, as observed in #18470. See `Note [Type family equations and occurrences]` in `GHC.Rename.Module` for the full story. This fixes #18470 with a little bit of extra-casing in `rnFamInstEqn`. To accomplish this, I added an extra `ClosedTyFamInfo` field to the `NonAssocTyFamEqn` constructor of `AssocTyFamInfo` and refactored the relevant call sites accordingly so that this information is propagated to `rnFamInstEqn`. While I was in town, I moved `wrongTyFamName`, which checks that the name of a closed type family matches the name in an equation for that family, from the renamer to the typechecker to avoid the need for an `ASSERT`. As an added bonus, this lets us simplify the details of `ClosedTyFamInfo` a bit. - - - - - ebe2cf45 by Simon Peyton Jones at 2020-07-30T07:12:52-04:00 Remove an incorrect WARN in extendLocalRdrEnv I noticed this warning going off, and discovered that it's really fine. This small patch removes the warning, and docments what is going on. - - - - - 9f71f697 by Simon Peyton Jones at 2020-07-30T07:13:27-04:00 Add two bangs to improve perf of flattening This tiny patch improves the compile time of flatten-heavy programs by 1-2%, by adding two bangs. Addresses (somewhat) #18502 This reduces allocation by T9872b -1.1% T9872d -3.3% T5321Fun -0.2% T5631 -0.2% T5837 +0.1% T6048 +0.1% Metric Decrease: T9872b T9872d - - - - - 7c274cd5 by Sylvain Henry at 2020-07-30T22:54:48-04:00 Fix minimal imports dump for boot files (fix #18497) - - - - - 175cb5b4 by Sylvain Henry at 2020-07-30T22:55:25-04:00 DynFlags: don't use sdocWithDynFlags in datacon ppr We don't need to use `sdocWithDynFlags` to know whether we should display linear types for datacon types, we already have `sdocLinearTypes` field in `SDocContext`. Moreover we want to remove `sdocWithDynFlags` (#10143, #17957)). - - - - - 380638a3 by Sylvain Henry at 2020-07-30T22:56:03-04:00 Bignum: fix powMod for gmp backend (#18515) Also reenable integerPowMod test which had never been reenabled by mistake. - - - - - 56a7c193 by Sylvain Henry at 2020-07-31T19:32:09+02:00 Refactor CLabel pretty-printing Pretty-printing CLabel relies on sdocWithDynFlags that we want to remove (#10143, #17957). It uses it to query the backend and the platform. This patch exposes Clabel ppr functions specialised for each backend so that backend code can directly use them. - - - - - 3b15dc3c by Sylvain Henry at 2020-07-31T19:32:09+02:00 DynFlags: don't use sdocWithDynFlags in GHC.CmmToAsm.Dwarf.Types - - - - - e30fed6c by Vladislav Zavialov at 2020-08-01T04:23:04-04:00 Test case for #17652 The issue was fixed by 19e80b9af252eee760dc047765a9930ef00067ec - - - - - 22641742 by Ryan Scott at 2020-08-02T16:44:11-04:00 Remove ConDeclGADTPrefixPs This removes the `ConDeclGADTPrefixPs` per the discussion in #18517. Most of this patch simply removes code, although the code in the `rnConDecl` case for `ConDeclGADTPrefixPs` had to be moved around a bit: * The nested `forall`s check now lives in the `rnConDecl` case for `ConDeclGADT`. * The `LinearTypes`-specific code that used to live in the `rnConDecl` case for `ConDeclGADTPrefixPs` now lives in `GHC.Parser.PostProcess.mkGadtDecl`, which is now monadic so that it can check if `-XLinearTypes` is enabled. Fixes #18157. - - - - - f2d1accf by Leon Schoorl at 2020-08-02T16:44:47-04:00 Fix GHC_STAGE definition generated by make Fixes #18070 GHC_STAGE is the stage of the compiler we're building, it should be 1,2(,3?). But make was generating 0 and 1. Hadrian does this correctly using a similar `+ 1`: https://gitlab.haskell.org/ghc/ghc/-/blob/eb8115a8c4cbc842b66798480fefc7ab64d31931/hadrian/src/Rules/Generate.hs#L245 - - - - - 947206f4 by Niklas Hambüchen at 2020-08-03T07:52:33+02:00 hadrian: Fix running stage0/bin/ghc with wrong package DB. Fixes #17468. In the invocation of `cabal configure`, `--ghc-pkg-option=--global-package-db` was already given correctly to tell `stage0/bin/ghc-pkg` that it should use the package DB in `stage1/`. However, `ghc` needs to be given this information as well, not only `ghc-pkg`! Until now that was not the case; the package DB in `stage0` was given to `ghc` instead. This was wrong, because there is no binary compatibility guarantee that says that the `stage0` DB's `package.cache` (which is written by the stage0 == system-provided ghc-pkg) can be deserialised by the `ghc-pkg` from the source code tree. As a result, when trying to add fields to `InstalledPackageInfo` that get serialised into / deserialised from the `package.cache`, errors like _build/stage0/lib/package.conf.d/package.cache: GHC.PackageDb.readPackageDb: inappropriate type (Not a valid Unicode code point!) would appear. This was because the `stage0/bin/ghc would try to deserialise the newly added fields from `_build/stage0/lib/package.conf.d/package.cache`, but they were not in there because the system `ghc-pkg` doesn't know about them and thus didn't write them there. It would try to do that because any GHC by default tries to read the global package db in `../lib/package.conf.d/package.cache`. For `stage0/bin/ghc` that *can never work* as explained above, so we must disable this default via `-no-global-package-db` and give it the correct package DB explicitly. This is the same problem as #16534, and the same fix as in MR !780 (but in another context; that one was for developers trying out the `stage0/bin/ghc` == `_build/ghc-stage1` interactively, while this fix is for a `cabal configure` invocation). I also noticed that the fix for #16534 forgot to pass `-no-global-package-db`, and have fixed that in this commit as well. It only worked until now because nobody tried to add a new ghc-pkg `.conf` field since the introduction of Hadrian. - - - - - ef2ae81a by Alex Biehl at 2020-08-03T07:52:33+02:00 Hardcode RTS includes to cope with unregistered builds - - - - - d613ed76 by Sylvain Henry at 2020-08-05T03:59:27-04:00 Bignum: add backward compat integer-gmp functions Also enhance bigNatCheck# and isValidNatural test - - - - - 3f2f7718 by Sylvain Henry at 2020-08-05T03:59:27-04:00 Bignum: add more BigNat compat functions in integer-gmp - - - - - 5e12cd17 by Krzysztof Gogolewski at 2020-08-05T04:00:04-04:00 Rename Core.Opt.Driver -> Core.Opt.Pipeline Closes #18504. - - - - - 2bff2f87 by Ben Gamari at 2020-08-05T04:00:39-04:00 Revert "iserv: Don't pass --export-dynamic on FreeBSD" This reverts commit 2290eb02cf95e9cfffcb15fc9c593d5ef79c75d9. - - - - - 53ce0db5 by Ben Gamari at 2020-08-05T04:00:39-04:00 Refactor handling of object merging Previously to merge a set of object files we would invoke the linker as usual, adding -r to the command-line. However, this can result in non-sensical command-lines which causes lld to balk (#17962). To avoid this we introduce a new tool setting into GHC, -pgmlm, which is the linker which we use to merge object files. - - - - - eb7013c3 by Hécate at 2020-08-05T04:01:15-04:00 Remove all the unnecessary LANGUAGE pragmas - - - - - fbcb886d by Ryan Scott at 2020-08-05T04:01:51-04:00 Make CodeQ and TExpQ levity polymorphic The patch is quite straightforward. The only tricky part is that `Language.Haskell.TH.Lib.Internal` now must be `Trustworthy` instead of `Safe` due to the `GHC.Exts` import (in order to import `TYPE`). Since `CodeQ` has yet to appear in any released version of `template-haskell`, I didn't bother mentioning the change to `CodeQ` in the `template-haskell` release notes. Fixes #18521. - - - - - 686e06c5 by Vladislav Zavialov at 2020-08-06T13:34:05-04:00 Grammar for types and data/newtype constructors Before this patch, we parsed types into a reversed sequence of operators and operands. For example, (F x y + G a b * X) would be parsed as [X, *, b, a, G, +, y, x, F], using a simple grammar: tyapps : tyapp | tyapps tyapp tyapp : atype | PREFIX_AT atype | tyop | unpackedness Then we used a hand-written state machine to assemble this either into a type, using 'mergeOps', or into a constructor, using 'mergeDataCon'. This is due to a syntactic ambiguity: data T1 a = MkT1 a data T2 a = Ord a => MkT2 a In T1, what follows after the = sign is a data/newtype constructor declaration. However, in T2, what follows is a type (of kind Constraint). We don't know which of the two we are parsing until we encounter =>, and we cannot check for => without unlimited lookahead. This poses a few issues when it comes to e.g. infix operators: data I1 = Int :+ Bool :+ Char -- bad data I2 = Int :+ Bool :+ Char => MkI2 -- fine By this issue alone we are forced into parsing into an intermediate representation and doing a separate validation pass. However, should that intermediate representation be as low-level as a flat sequence of operators and operands? Before GHC Proposal #229, the answer was Yes, due to some particularly nasty corner cases: data T = ! A :+ ! B -- used to be fine, hard to parse data T = ! A :+ ! B => MkT -- bad However, now the answer is No, as this corner case is gone: data T = ! A :+ ! B -- bad data T = ! A :+ ! B => MkT -- bad This means we can write a proper grammar for types, overloading it in the DisambECP style, see Note [Ambiguous syntactic categories]. With this patch, we introduce a new class, DisambTD. Just like DisambECP is used to disambiguate between expressions, commands, and patterns, DisambTD is used to disambiguate between types and data/newtype constructors. This way, we get a proper, declarative grammar for constructors and types: infixtype : ftype | ftype tyop infixtype | unpackedness infixtype ftype : atype | tyop | ftype tyarg | ftype PREFIX_AT tyarg tyarg : atype | unpackedness atype And having a grammar for types means we are a step closer to using a single grammar for types and expressions. - - - - - 6770e199 by Vladislav Zavialov at 2020-08-06T13:34:05-04:00 Clean up the story around runPV/runECP_P/runECP_PV This patch started as a small documentation change, an attempt to make Note [Parser-Validator] and Note [Ambiguous syntactic categories] more clear and up-to-date. But it turned out that runECP_P/runECP_PV are weakly motivated, and it's easier to remove them than to find a good rationale/explanation for their existence. As the result, there's a bit of refactoring in addition to a documentation update. - - - - - 826d07db by Vladislav Zavialov at 2020-08-06T13:34:06-04:00 Fix debug_ppr_ty ForAllTy (#18522) Before this change, GHC would pretty-print forall k. forall a -> () as forall @k a. () which isn't even valid Haskell. - - - - - 0ddb4384 by Vladislav Zavialov at 2020-08-06T13:34:06-04:00 Fix visible forall in ppr_ty (#18522) Before this patch, this type: T :: forall k -> (k ~ k) => forall j -> k -> j -> Type was printed incorrectly as: T :: forall k j -> (k ~ k) => k -> j -> Type - - - - - d2a43225 by Richard Eisenberg at 2020-08-06T13:34:06-04:00 Fail eagerly on a lev-poly datacon arg Close #18534. See commentary in the patch. - - - - - 63348155 by Sylvain Henry at 2020-08-06T13:34:08-04:00 Use a type alias for Ways - - - - - 9570c212 by Takenobu Tani at 2020-08-06T19:46:46-04:00 users-guide: Rename 8.12 to 9.0 GHC 8.12.1 has been renamed to GHC 9.0.1. See also: https://mail.haskell.org/pipermail/ghc-devs/2020-July/019083.html [skip ci] - - - - - 3907ee01 by Cale Gibbard at 2020-08-07T08:34:46-04:00 A fix to an error message in monad comprehensions, and a move of dsHandleMonadicFailure as suggested by comments on !2330. - - - - - fa9bb70a by Cale Gibbard at 2020-08-07T08:34:46-04:00 Add some tests for fail messages in do-expressions and monad-comprehensions. - - - - - 5f036063 by Ben Gamari at 2020-08-07T08:35:21-04:00 cmm: Clean up Notes a bit - - - - - 6402c124 by Ben Gamari at 2020-08-07T08:35:21-04:00 CmmLint: Check foreign call argument register invariant As mentioned in Note [Register parameter passing] the arguments of foreign calls cannot refer to caller-saved registers. - - - - - 15b36de0 by Ben Gamari at 2020-08-07T08:35:21-04:00 nativeGen: One approach to fix #18527 Previously the code generator could produce corrupt C call sequences due to register overlap between MachOp lowerings and the platform's calling convention. We fix this using a hack described in Note [Evaluate C-call arguments before placing in destination registers]. - - - - - 3847ae0c by Ben Gamari at 2020-08-07T08:35:21-04:00 testsuite: Add test for #18527 - - - - - dd51d53b by Ben Gamari at 2020-08-07T08:35:21-04:00 testsuite: Fix prog001 Previously it failed as the `ghc` package was not visible. - - - - - e4f1b73a by Alan Zimmerman at 2020-08-07T23:58:10-04:00 ApiAnnotations; tweaks for ghc-exactprint update Remove unused ApiAnns, add one for linear arrow. Include API Annotations for trailing comma in export list. - - - - - 8a665db6 by Ben Gamari at 2020-08-07T23:58:45-04:00 configure: Fix double-negation in ld merge-objects check We want to only run the check if ld is gold. Fixes the fix to #17962. - - - - - a11c9678 by Adam Sandberg Ericsson at 2020-08-09T11:32:25+02:00 hadrian: depend on boot compiler version #18001 - - - - - c8873b52 by Alan Zimmerman at 2020-08-09T21:17:54-04:00 Api Annotations : Adjust SrcSpans for prefix bang (!). And prefix ~ (cherry picked from commit 8dbee2c578b1f642d45561be3f416119863e01eb) - - - - - 77398b67 by Sylvain Henry at 2020-08-09T21:18:34-04:00 Avoid allocations in `splitAtList` (#18535) As suspected by @simonpj in #18535, avoiding allocations in `GHC.Utils.Misc.splitAtList` when there are no leftover arguments is beneficial for performance: On CI validate-x86_64-linux-deb9-hadrian: T12227 -7% T12545 -12.3% T5030 -10% T9872a -2% T9872b -2.1% T9872c -2.5% Metric Decrease: T12227 T12545 T5030 T9872a T9872b T9872c - - - - - 8ba41a0f by Felix Yan at 2020-08-10T20:23:29-04:00 Correct a typo in ghc.mk - - - - - 1c469264 by Felix Yan at 2020-08-10T20:23:29-04:00 Add a closing parenthesis too - - - - - acf537f9 by Sylvain Henry at 2020-08-10T20:24:09-04:00 Make splitAtList strict in its arguments Also fix its slightly wrong comment Metric Decrease: T5030 T12227 T12545 - - - - - ab4d1589 by Ben Gamari at 2020-08-11T22:18:03-04:00 typecheck: Drop SPECIALISE pragmas when there is no unfolding Previously the desugarer would instead fall over when it realized that there was no unfolding for an imported function with a SPECIALISE pragma. We now rather drop the SPECIALISE pragma and throw a warning. Fixes #18118. - - - - - 0ac8c0a5 by Ben Gamari at 2020-08-11T22:18:03-04:00 testsuite: Add test for #18118 - - - - - c43078d7 by Sven Tennie at 2020-08-11T22:18:38-04:00 Add hie.yaml to ghc-heap This enables IDE support by haskell-language-server for ghc-heap. - - - - - f1088b3f by Ben Gamari at 2020-08-11T22:19:15-04:00 testsuite: Specify metrics collected by T17516 Previously it collected everything, including "max bytes used". This is problematic since the test makes no attempt to control for deviations in GC timing, resulting in high variability. Fix this by only collecting "bytes allocated". - - - - - accbc242 by Sylvain Henry at 2020-08-12T03:50:12-04:00 DynFlags: disentangle Outputable - put panic related functions into GHC.Utils.Panic - put trace related functions using DynFlags in GHC.Driver.Ppr One step closer making Outputable fully independent of DynFlags. Bump haddock submodule - - - - - db6dd810 by Ben Gamari at 2020-08-12T03:50:48-04:00 testsuite: Increase tolerance of T16916 T16916 (testing #16916) has been slightly fragile in CI due to its reliance on CPU times. While it's hard to see how to eliminate the time-dependence entirely, we can nevertheless make it more tolerant. Fixes #16966. - - - - - bee43aca by Sylvain Henry at 2020-08-12T20:52:50-04:00 Rewrite and move the monad-state hack note The note has been rewritten by @simonpj in !3851 [skip ci] - - - - - 25fdf25e by Alan Zimmerman at 2020-08-12T20:53:26-04:00 ApiAnnotations: Fix parser for new GHC 9.0 features - - - - - 7831fe05 by Ben Gamari at 2020-08-13T03:44:17-04:00 parser: Suggest ImportQualifiedPost in prepositive import warning As suggested in #18545. - - - - - 55dec4dc by Sebastian Graf at 2020-08-13T03:44:52-04:00 PmCheck: Better long-distance info for where bindings (#18533) Where bindings can see evidence from the pattern match of the `GRHSs` they belong to, but not from anything in any of the guards (which belong to one of possibly many RHSs). Before this patch, we did *not* consider said evidence, causing #18533, where the lack of considering type information from a case pattern match leads to failure to resolve the vanilla COMPLETE set of a data type. Making available that information required a medium amount of refactoring so that `checkMatches` can return a `[(Deltas, NonEmpty Deltas)]`; one `(Deltas, NonEmpty Deltas)` for each `GRHSs` of the match group. The first component of the pair is the covered set of the pattern, the second component is one covered set per RHS. Fixes #18533. Regression test case: T18533 - - - - - cf97889a by Hécate at 2020-08-13T03:45:29-04:00 Re-add BangPatterns to CodePage.hs - - - - - ffc0d578 by Sylvain Henry at 2020-08-13T09:49:56-04:00 Add HomeUnit type Since Backpack the "home unit" is much more involved than what it was before (just an identifier obtained with `-this-unit-id`). Now it is used in conjunction with `-component-id` and `-instantiated-with` to configure module instantiations and to detect if we are type-checking an indefinite unit or compiling a definite one. This patch introduces a new HomeUnit datatype which is much easier to understand. Moreover to make GHC support several packages in the same instances, we will need to handle several HomeUnits so having a dedicated (documented) type is helpful. Finally in #14335 we will also need to handle the case where we have no HomeUnit at all because we are only loading existing interfaces for plugins which live in a different space compared to units used to produce target code. Several functions will have to be refactored to accept "Maybe HomeUnit" parameters instead of implicitly querying the HomeUnit fields in DynFlags. Having a dedicated type will make this easier. Bump haddock submodule - - - - - 8a51b2ab by Sylvain Henry at 2020-08-13T21:09:15-04:00 Make IOEnv monad one-shot (#18202) On CI (x86_64-linux-deb9-hadrian, compile_time/bytes_allocated): T10421 -1.8% (threshold: +/- 1%) T10421a -1.7% (threshold: +/- 1%) T12150 -4.9% (threshold: +/- 2%) T12227 -1.6 (threshold: +/- 1%) T12425 -1.5% (threshold: +/- 1%) T12545 -3.8% (threshold: +/- 1%) T12707 -3.0% (threshold: +/- 1%) T13035 -3.0% (threshold: +/- 1%) T14683 -10.3% (threshold: +/- 2%) T3064 -6.9% (threshold: +/- 2%) T4801 -4.3% (threshold: +/- 2%) T5030 -2.6% (threshold: +/- 2%) T5321FD -3.6% (threshold: +/- 2%) T5321Fun -4.6% (threshold: +/- 2%) T5631 -19.7% (threshold: +/- 2%) T5642 -13.0% (threshold: +/- 2%) T783 -2.7 (threshold: +/- 2%) T9020 -11.1 (threshold: +/- 2%) T9961 -3.4% (threshold: +/- 2%) T1969 (compile_time/bytes_allocated) -2.2% (threshold: +/-1%) T1969 (compile_time/max_bytes_used) +24.4% (threshold: +/-20%) Additionally on other CIs: haddock.Cabal -10.0% (threshold: +/- 5%) haddock.compiler -9.5% (threshold: +/- 5%) haddock.base (max bytes used) +24.6% (threshold: +/- 15%) T10370 (max bytes used, i386) +18.4% (threshold: +/- 15%) Metric Decrease: T10421 T10421a T12150 T12227 T12425 T12545 T12707 T13035 T14683 T3064 T4801 T5030 T5321FD T5321Fun T5631 T5642 T783 T9020 T9961 haddock.Cabal haddock.compiler Metric Decrease 'compile_time/bytes allocated': T1969 Metric Increase 'compile_time/max_bytes_used': T1969 T10370 haddock.base - - - - - 9f66fdf6 by Ben Gamari at 2020-08-14T15:50:34-04:00 testsuite: Drop --io-manager flag from testsuite configuration This is no longer necessary as there are now dedicated testsuite ways which run tests with WinIO. - - - - - 55fd1dc5 by Ben Gamari at 2020-08-14T15:51:10-04:00 llvm-targets: Add i686 targets Addresses #18422. - - - - - f4cc57fa by Ben Gamari at 2020-08-18T15:38:55-04:00 Allow unsaturated runRW# applications Previously we had a very aggressive Core Lint check which caught unsaturated applications of runRW#. However, there is nothing wrong with such applications and they may naturally arise in desugared Core. For instance, the desugared Core of Data.Primitive.Array.runArray# from the `primitive` package contains: case ($) (runRW# @_ @_) (\s -> ...) of ... In this case it's almost certain that ($) will be inlined, turning the application into a saturated application. However, even if this weren't the case there isn't a problem: CorePrep (after deleting an unnecessary case) can simply generate code in its usual way, resulting in a call to the Haskell definition of runRW#. Fixes #18291. - - - - - 3ac6ae7c by Ben Gamari at 2020-08-18T15:38:55-04:00 testsuite: Add test for #18291 - - - - - a87a0b49 by Eli Schwartz at 2020-08-18T15:39:30-04:00 install: do not install sphinx doctrees These files are 100% not needed at install time, and they contain unreproducible info. See https://reproducible-builds.org/ for why this matters. - - - - - 194b25ee by Ben Gamari at 2020-08-18T15:40:05-04:00 testsuite: Allow baseline commit to be set explicitly - - - - - fdcf7645 by Ben Gamari at 2020-08-18T15:40:05-04:00 gitlab-ci: Use MR base commit as performance baseline - - - - - 9ad5cab3 by Fendor at 2020-08-18T15:40:42-04:00 Expose UnitInfoMap as it is part of the public API - - - - - aa4b744d by Ben Gamari at 2020-08-18T22:11:36-04:00 testsuite: Only run llvm ways if llc is available As noted in #18560, we previously would always run the LLVM ways since `configure` would set `SettingsLlcCommand` to something non-null when it otherwise couldn't find the `llc` executable. Now we rather probe for the existence of the `llc` executable in the testsuite driver. Fixes #18560. - - - - - 0c5ed5c7 by Sylvain Henry at 2020-08-18T22:12:13-04:00 DynFlags: refactor GHC.CmmToAsm (#17957, #10143) This patch removes the use of `sdocWithDynFlags` from GHC.CmmToAsm.*.Ppr To do that I've had to make some refactoring: * X86' and PPC's `Instr` are no longer `Outputable` as they require a `Platform` argument * `Instruction` class now exposes `pprInstr :: Platform -> instr -> SDoc` * as a consequence, I've refactored some modules to avoid .hs-boot files * added (derived) functor instances for some datatypes parametric in the instruction type. It's useful for pretty-printing as we just have to map `pprInstr` before pretty-printing the container datatype. - - - - - 731c8d3b by nineonine at 2020-08-19T18:47:39-04:00 Implement -Wredundant-bang-patterns (#17340) Add new flag '-Wredundant-bang-patterns' that enables checks for "dead" bangs. Dead bangs are the ones that under no circumstances can force a thunk that wasn't already forced. Dead bangs are a form of redundant bangs. The new check is performed in Pattern-Match Coverage Checker along with other checks (namely, redundant and inaccessible RHSs). Given f :: Bool -> Int f True = 1 f !x = 2 we can detect dead bang patterns by checking whether @x ~ ⊥@ is satisfiable where the PmBang appears in 'checkGrdTree'. If not, then clearly the bang is dead. Such a dead bang is then indicated in the annotated pattern-match tree by a 'RedundantSrcBang' wrapping. In 'redundantAndInaccessibles', we collect all dead bangs to warn about. Note that we don't want to warn for a dead bang that appears on a redundant clause. That is because in that case, we recommend to delete the clause wholly, including its leading pattern match. Dead bang patterns are redundant. But there are bang patterns which are redundant that aren't dead, for example f !() = 0 the bang still forces the match variable, before we attempt to match on (). But it is redundant with the forcing done by the () match. We currently don't detect redundant bangs that aren't dead. - - - - - eb9bdaef by Simon Peyton Jones at 2020-08-19T18:48:14-04:00 Add right-to-left rule for pattern bindings Fix #18323 by adding a few lines of code to handle non-recursive pattern bindings. see GHC.Tc.Gen.Bind Note [Special case for non-recursive pattern bindings] Alas, this confused the pattern-match overlap checker; see #18323. Note that this patch only affects pattern bindings like that for (x,y) in this program combine :: (forall a . [a] -> a) -> [forall a. a -> a] -> ((forall a . [a] -> a), [forall a. a -> a]) breaks = let (x,y) = combine head ids in x y True We need ImpredicativeTypes for those [forall a. a->a] types to be valid. And with ImpredicativeTypes the old, unprincipled "allow unification variables to unify with a polytype" story actually works quite well. So this test compiles fine (if delicatedly) with old GHCs; but not with QuickLook unless we add this patch - - - - - 293c7fba by Sylvain Henry at 2020-08-21T09:36:38-04:00 Put CFG weights into their own module (#17957) It avoids having to query DynFlags to get them - - - - - 50eb4460 by Sylvain Henry at 2020-08-21T09:36:38-04:00 Don't use DynFlags in CmmToAsm.BlockLayout (#17957) - - - - - 659eb31b by Sylvain Henry at 2020-08-21T09:36:38-04:00 NCG: Dwarf configuration * remove references to DynFlags in GHC.CmmToAsm.Dwarf * add specific Dwarf options in NCGConfig instead of directly querying the debug level - - - - - 2d8ca917 by Sylvain Henry at 2020-08-21T09:37:15-04:00 Fix -ddump-stg flag -ddump-stg was dumping the initial STG (just after Core-to-STG pass) which was misleading because we want the final STG to know if a function allocates or not. Now we have a new flag -ddump-stg-from-core for this and -ddump-stg is deprecated. - - - - - fddddbf4 by Vladislav Zavialov at 2020-08-21T09:37:49-04:00 Import qualified Prelude in Cmm/Parser.y In preparation for the next version of 'happy', c95920 added a qualified import to GHC/Parser.y but for some reason neglected GHC/Cmm/Parser.y This patch adds the missing qualified import to GHC/Cmm/Parser.y and also adds a clarifying comment to explain why this import is needed. - - - - - 989c1c27 by Ben Gamari at 2020-08-21T11:27:53-04:00 gitlab-ci: Test master branch as well While these builds are strictly speaking redundant (since every commit is tested by @marge-bot before making it into `master`), they are nevertheless useful as they are displayed in the branch's commit list in GitLab's web interface. Fixes #18595. - - - - - e67ae884 by Aditya Gupta at 2020-08-22T03:29:00-04:00 mkUnique refactoring (#18362) Move uniqFromMask from Unique.Supply to Unique. Move the the functions that call mkUnique from Unique to Builtin.Uniques - - - - - 03cfcfd4 by Wander Hillen at 2020-08-22T03:29:36-04:00 Add ubuntu 20.04 jobs for nightly and release - - - - - 3f501545 by Craig Ferguson at 2020-08-22T03:30:13-04:00 Utils: clarify docs slightly The previous comment implies `nTimes n f` is either `f^{n+1}` or `f^{2^n}` (when in fact it's `f^n`). - - - - - 8b865092 by Krzysztof Gogolewski at 2020-08-23T14:12:53+02:00 Do not print synonyms in :i (->), :i Type (#18594) This adds a new printing flag `sdocPrintTypeAbbreviations` that is used specifically to avoid ghci printing 'type (->) = (->)' and 'type Type = Type'. - - - - - d8f61182 by Krzysztof Gogolewski at 2020-08-23T14:12:56+02:00 Move pprTyTcApp' inside pprTyTcApp No semantic change - - - - - 364258e0 by Krzysztof Gogolewski at 2020-08-24T00:32:31-04:00 Fix types in silly shifts (#18589) Patch written by Simon. I have only added a testcase. - - - - - b1eb38a0 by Sylvain Henry at 2020-08-24T00:33:13-04:00 Perf: make SDoc monad one-shot (#18202) With validate-x86_64-linux-deb9-hadrian: T1969 -3.4% (threshold: +/-1%) T3294 -3.3% (threshold: +/-1%) T12707 -1.4% (threshold: +/-1%) Additionally with validate-x86_64-linux-deb9-unreg-hadrian: T4801 -2.4% (threshold: +/-2%) T13035 -1.4% (threshold: +/-1%) T13379 -2.4% (threshold: +/-2%) ManyAlternatives -2.5% (threshold: +/-2%) ManyConstructors -3.0% (threshold: +/-2%) Metric Decrease: T12707 T1969 T3294 ManyAlternatives ManyConstructors T13035 T13379 T4801 - - - - - a77b9ec2 by Krzysztof Gogolewski at 2020-08-24T10:04:20-04:00 Add a test for #18397 The bug was fixed by !3421. - - - - - 05550a5a by Sylvain Henry at 2020-08-24T10:04:59-04:00 Avoid roundtrip through SDoc As found by @monoidal on https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3885#note_295126 - - - - - 0a1ecc5f by Ben Gamari at 2020-08-25T07:37:05-04:00 SysTools.Process: Handle exceptions in readCreateProcessWithExitCode' In #18069 we are observing MVar deadlocks from somewhere in ghc.exe. This use of MVar stood out as being one of the more likely culprits. Here we make sure that it is exception-safe. - - - - - db8793ad by Richard Eisenberg at 2020-08-25T07:37:40-04:00 Use tcView, not coreView, in the pure unifier. Addresses a lingering point within #11715. - - - - - fb77207a by Simon Peyton Jones at 2020-08-25T07:38:16-04:00 Use LIdP rather than (XRec p (IdP p)) This patch mainly just replaces use of XRec p (IdP p) with LIdP p One slightly more significant change is to parameterise HsPatSynDetails over the pass rather than the argument type, so that it's uniform with HsConDeclDetails and HsConPatDetails. I also got rid of the dead code GHC.Hs.type.conDetailsArgs But this is all just minor refactoring. No change in functionality. - - - - - 8426a136 by Krzysztof Gogolewski at 2020-08-25T07:38:54-04:00 Add a test for #18585 - - - - - 2d635a50 by Takenobu Tani at 2020-08-26T04:50:21-04:00 linters: Make CPP linter skip image files This patch adds an exclusion rule for `docs/users_guide/images`, to avoid lint errors of PDF files. - - - - - b7d98cb2 by Takenobu Tani at 2020-08-26T04:50:21-04:00 users-guide: Color the logo on the front page of the PDF This patch updates the logo with a recent color scheme. This affects only the PDF version of the user's guide. See also: * https://mail.haskell.org/pipermail/ghc-devs/2020-August/019139.html * https://gitlab.haskell.org/ghc/ghc/-/wikis/logo - - - - - 0b17fa18 by Sylvain Henry at 2020-08-26T04:50:58-04:00 Refactor UnitId pretty-printing When we pretty-print a UnitId for the user, we try to map it back to its origin package name, version and component to print "package-version:component" instead of some hash. The UnitId type doesn't carry these information, so we have to look into a UnitState to find them. This is why the Outputable instance of UnitId used `sdocWithDynFlags` in order to access the `unitState` field of DynFlags. This is wrong for several reasons: 1. The DynFlags are accessed when the message is printed, not when it is generated. So we could imagine that the unitState may have changed in-between. Especially if we want to allow unit unloading. 2. We want GHC to support several independent sessions at once, hence several UnitState. The current approach supposes there is a unique UnitState as a UnitId doesn't indicate which UnitState to use. See the Note [Pretty-printing UnitId] in GHC.Unit for the new approach implemented by this patch. One step closer to remove `sdocDynFlags` field from `SDocContext` (#10143). Fix #18124. Also fix some Backpack code to use SDoc instead of String. - - - - - dc476a50 by Sylvain Henry at 2020-08-26T04:51:35-04:00 Bignum: fix BigNat subtraction (#18604) There was a confusion between the boolean expected by withNewWordArrayTrimedMaybe and the boolean returned by subtracting functions. - - - - - fcb10b6c by Peter Trommler at 2020-08-26T10:42:30-04:00 PPC and X86: Portable printing of IEEE floats GNU as and the AIX assembler support floating point literals. SPARC seems to have support too but I cannot test on SPARC. Curiously, `doubleToBytes` is also used in the LLVM backend. To avoid endianness issues when cross-compiling float and double literals are printed as C-style floating point values. The assembler then takes care of memory layout and endianness. This was brought up in #18431 by @hsyl20. - - - - - 770100e0 by Krzysztof Gogolewski at 2020-08-26T10:43:13-04:00 primops: Remove Monadic and Dyadic categories There were four categories of primops: Monadic, Dyadic, Compare, GenPrimOp. The compiler does not treat Monadic and Dyadic in any special way, we can just replace them with GenPrimOp. Compare is still used in isComparisonPrimOp. - - - - - 01ff8c89 by Aditya Gupta at 2020-08-27T14:19:26-04:00 Consolidate imports in getMinimalImports (#18264) - - - - - bacccb73 by Ryan Scott at 2020-08-27T14:20:01-04:00 Make {hsExpr,hsType,pat}NeedsParens aware of boxed 1-tuples `hsExprNeedsParens`, `hsTypeNeedsParens`, and `patNeedsParens` previously assumed that all uses of explicit tuples in the source syntax never need to be parenthesized. This is true save for one exception: boxed one-tuples, which use the `Solo` data type from `GHC.Tuple` instead of special tuple syntax. This patch adds the necessary logic to the three `*NeedsParens` functions to handle `Solo` correctly. Fixes #18612. - - - - - c6f50cea by Krzysztof Gogolewski at 2020-08-28T02:22:36-04:00 Add missing primop documentation (#18454) - Add three pseudoops to primops.txt.pp, so that Haddock renders the documentation - Update comments - Remove special case for "->" - it's no longer exported from GHC.Prim - Remove reference to Note [Compiling GHC.Prim] - the ad-hoc fix is no longer there after updates to levity polymorphism. - Document GHC.Prim - Remove the comment that lazy is levity-polymorphic. As far as I can tell, it never was: in 80e399639, only the unfolding was given an open type variable. - Remove haddock hack in GHC.Magic - no longer neccessary after adding realWorld# to primops.txt.pp. - - - - - f065b6b0 by Tamar Christina at 2020-08-28T02:23:13-04:00 Fix use distro toolchian - - - - - 4517a382 by Tamar Christina at 2020-08-28T02:23:13-04:00 document how build system find toolchains on Windows - - - - - 329f7cb9 by Ben Gamari at 2020-08-31T22:59:14-04:00 base: Better error message on invalid getSystemTimerManager call Previously we would produce a rather unhelpful pattern match failure error in the case where the user called `getSystemTimerManager` in a program which isn't built with `-threaded`. This understandably confused the user in #15616. Fixes #15616. - - - - - f6d70a8f by Roland Senn at 2020-08-31T22:59:50-04:00 Add tests for #15617. Avoid a similar regression in the future. - - - - - e5969fd0 by Roland Senn at 2020-08-31T23:00:27-04:00 Add additional tests for #18172 (Followup MR 3543) There was still one active discussion [thread](https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3543#note_284325) when MR !3543 got merged. This MR adds the requested tests exercising the changes in `compiler/GHC/HsToCore/Match/Literal.hs:warnAboutEmptyEnumerations` and its sub-functions. - - - - - fe18b482 by Ben Gamari at 2020-08-31T23:01:02-04:00 Bump Win32 and process submodules - - - - - 2da93308 by Sylvain Henry at 2020-08-31T23:01:39-04:00 Hadrian: fix slow-validate flavour (#18586) - - - - - 85e13008 by Andreas Klebinger at 2020-08-31T23:02:15-04:00 Update dominator code with fixes from the dom-lt package. Two bugs turned out in the package that have been fixed since. This MR includes this fixes in the GHC port of the code. - - - - - dffb38fa by Andreas Klebinger at 2020-08-31T23:02:15-04:00 Dominators.hs: Use unix line endings - - - - - 6189cc04 by Moritz Angermann at 2020-08-31T23:02:50-04:00 [fixup 3433] move debugBelch into IF_DEBUG(linker) The commit in dff1cb3d9c111808fec60190747272b973547c52 incorrectly left the `debugBelch` function without a comment or IF_DEBUG(linker,) decoration. This rectifies it. Needs at least a 8.10 backport, as it was backported in 6471cc6aff80d5deebbdb1bf7b677b31ed2af3d5 - - - - - bcb68a3f by Sylvain Henry at 2020-08-31T23:03:27-04:00 Don't store HomeUnit in UnitConfig Allow the creation of a UnitConfig (hence of a UnitState) without having a HomeUnit. It's required for #14335. - - - - - 0a372387 by Sylvain Henry at 2020-08-31T23:04:04-04:00 Fix documentation and fix "check" bignum backend (#18604) - - - - - eb85f125 by Moritz Angermann at 2020-08-31T23:04:39-04:00 Set the dynamic-system-linker flag to Manual This flag should be user controllable, hence Manual: True. - - - - - 380ef845 by Sven Tennie at 2020-08-31T23:05:14-04:00 Ignore more files Ignore files from "new style" cabal builds (dist-newstyle folders) and from clangd (C language server). - - - - - 74a7fbff by Takenobu Tani at 2020-08-31T23:05:51-04:00 Limit upper version of Happy for ghc-9.0 and earlier (#18620) This patch adds the upper bound of a happy version for ghc-9.0 and earlier. Currently, we can't use happy-1.20.0 for ghc-9.0. See #18620. - - - - - a4473f02 by Takenobu Tani at 2020-08-31T23:05:51-04:00 Limit upper version of Happy for ghc-9.2 (#18620) This patch adds the upper bound of a happy version for ghc-9.2. Currently, We can use happy-1.19 or happy-1.20 for ghc-9.2. See #18620. - - - - - a8a2568b by Sylvain Henry at 2020-08-31T23:06:28-04:00 Bignum: add BigNat compat functions (#18613) - - - - - 884245dd by Sylvain Henry at 2020-09-01T12:39:36-04:00 Fix FastString lexicographic ordering (fix #18562) - - - - - 4b4fbc58 by Sylvain Henry at 2020-09-01T12:39:36-04:00 Remove "Ord FastString" instance FastStrings can be compared in 2 ways: by Unique or lexically. We don't want to bless one particular way with an "Ord" instance because it leads to bugs (#18562) or to suboptimal code (e.g. using lexical comparison while a Unique comparison would suffice). UTF-8 encoding has the advantage that sorting strings by their encoded bytes also sorts them by their Unicode code points, without having to decode the actual code points. BUT GHC uses Modified UTF-8 which diverges from UTF-8 by encoding \0 as 0xC080 instead of 0x00 (to avoid null bytes in the middle of a String so that the string can still be null-terminated). This patch adds a new `utf8CompareShortByteString` function that performs sorting by bytes but that also takes Modified UTF-8 into account. It is much more performant than decoding the strings into [Char] to perform comparisons (which we did in the previous patch). Bump haddock submodule - - - - - b4edcde7 by Ben Gamari at 2020-09-01T14:53:42-04:00 testsuite: Add broken test for #18302 - - - - - bfab2a30 by Sebastian Graf at 2020-09-02T15:54:55-04:00 Turn on -XMonoLocalBinds by default (#18430) And fix the resulting type errors. Co-authored-by: Krzysztof Gogolewski <krz.gogolewski at gmail.com> Metric Decrease: parsing001 - - - - - c30cc0e9 by David Feuer at 2020-09-02T15:55:31-04:00 Remove potential space leak from Data.List.transpose Previously, `transpose` produced a list of heads and a list of tails independently. This meant that a function using only some heads, and only some tails, could potentially leak space. Use `unzip` to work around the problem by producing pairs and selector thunks instead. Time and allocation behavior will be worse, but there should be no more leak potential. - - - - - ffc3da47 by Sylvain Henry at 2020-09-02T15:56:11-04:00 Remove outdated note - - - - - 85e62123 by Sylvain Henry at 2020-09-02T15:56:48-04:00 Bignum: add missing compat import/export functions - - - - - 397c2b03 by Ben Gamari at 2020-09-03T17:31:47-04:00 configure: Work around Raspbian's silly packaging decisions See #17856. - - - - - 4891c18a by Kathryn Spiers at 2020-09-03T17:32:24-04:00 expected-undocumented-flags remove kill flags It looks like the flags were removed in https://gitlab.haskell.org/ghc/ghc/-/commit/3e27205a66b06a4501d87eb31e285eadbc693eb7 and can safely be removed here - - - - - 1d6d6488 by Sylvain Henry at 2020-09-04T16:24:20-04:00 Don't rely on CLabel's Outputable instance in CmmToC This is in preparation of the removal of sdocWithDynFlags (#10143), hence of the refactoring of CLabel's Outputable instance. - - - - - 89ce7cdf by Sylvain Henry at 2020-09-04T16:24:59-04:00 DynFlags: use Platform in foldRegs* - - - - - 220ad8d6 by Sylvain Henry at 2020-09-04T16:24:59-04:00 DynFlags: don't pass DynFlags to cmmImplementSwitchPlans - - - - - c1e54439 by Ryan Scott at 2020-09-04T16:25:35-04:00 Introduce isBoxedTupleDataCon and use it to fix #18644 The code that converts promoted tuple data constructors to `IfaceType`s in `GHC.CoreToIface` was using `isTupleDataCon`, which conflates boxed and unboxed tuple data constructors. To avoid this, this patch introduces `isBoxedTupleDataCon`, which is like `isTupleDataCon` but only works for _boxed_ tuple data constructors. While I was in town, I was horribly confused by the fact that there were separate functions named `isUnboxedTupleCon` and `isUnboxedTupleTyCon` (similarly, `isUnboxedSumCon` and `isUnboxedSumTyCon`). It turns out that the former only works for data constructors, despite its very general name! I opted to rename `isUnboxedTupleCon` to `isUnboxedTupleDataCon` (similarly, I renamed `isUnboxedSumCon` to `isUnboxedSumDataCon`) to avoid this potential confusion, as well as to be more consistent with the naming convention I used for `isBoxedTupleDataCon`. Fixes #18644. - - - - - 07bdcac3 by GHC GitLab CI at 2020-09-04T22:26:25-04:00 configure: Avoid hard-coded ld path on Windows The fix to #17962 ended up regressing on Windows as it failed to replicate the logic responsible for overriding the toolchain paths on Windows. This resulted in a hard-coded path to a directory that likely doesn't exist on the user's system (#18550). - - - - - 0be8e746 by Benjamin Maurer at 2020-09-04T22:27:01-04:00 Documented the as of yet undocumented '--print-*' GHC flags, as well as `-split-objs`, since that is related to `--print-object-splitting-supported`. See #18641 - - - - - 4813486f by Sylvain Henry at 2020-09-04T22:27:44-04:00 Move Hadrian's wiki pages in tree (fix #16165) Only the debugging page contains interesting stuff. Some of this stuff looks old (e.g. recommending "cabal install")... - - - - - 7980ae23 by GHC GitLab CI at 2020-09-05T14:50:52-04:00 rts: Consistently use stgMallocBytes instead of malloc This can help in debugging RTS memory leaks since all allocations go through the same interface. - - - - - 67059893 by Ben Gamari at 2020-09-05T14:51:27-04:00 configure: Fix whitespace - - - - - be2cc0ad by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: More intelligent detection of locale availability Previously ci.sh would unconditionally use C.UTF-8. However, this fails on Centos 7, which appears not to provide this locale. Now we first try C.UTF-8, then try en_US.UTF-8, then fail. Works around #18607. - - - - - 15dca847 by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: Rename RELEASE variable to RELEASE_JOB This interfered with the autoconf variable of the same name, breaking pre-release builds. - - - - - bec0d170 by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: Bump Windows toolchain version This should have been done when we bumped the bootstrap compiler to 8.8.4. - - - - - 9fbaee21 by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: Drop Windows make job These are a significant burden on our CI resources and end up failing quite often due to #18274. Here I drop the make jobs during validaion; it is now run only during the nightly builds. - - - - - 869f6e19 by Ben Gamari at 2020-09-05T14:51:27-04:00 testsuite: Drop Windows-specific output for parseTree The normalise_slashes normaliser should handle this. - - - - - 2c9f743c by Ben Gamari at 2020-09-05T14:51:28-04:00 testsuite: Mark T5975[ab] as broken on Windows Due to #7305. - - - - - 643785e3 by Ben Gamari at 2020-09-05T14:51:28-04:00 gitlab-ci: Fix typo A small typo in a rule regular expression. - - - - - c5413fc6 by Wander Hillen at 2020-09-07T09:33:54-04:00 Add clarification regarding poll/kqueue flags - - - - - 10434d60 by Ben Gamari at 2020-09-07T09:34:32-04:00 gitlab-ci: Configure bignum backend in Hadrian builds - - - - - d4bc9f0d by Ben Gamari at 2020-09-07T09:34:32-04:00 gitlab-ci: Use hadrian builds for Windows release artifacts - - - - - 4ff93292 by Moritz Angermann at 2020-09-07T21:18:39-04:00 [macOS] improved runpath handling In b592bd98ff25730bbe3c13d6f62a427df8c78e28 we started using -dead_strip_dylib on macOS when lining dynamic libraries and binaries. The underlying reason being the Load Command Size Limit in macOS Sierra (10.14) and later. GHC will produce @rpath/libHS... dependency entries together with a corresponding RPATH entry pointing to the location of the libHS... library. Thus for every library we produce two Load Commands. One to specify the dependent library, and one with the path where to find it. This makes relocating libraries and binaries easier, as we just need to update the RPATH entry with the install_name_tool. The dynamic linker will then subsitute each @rpath with the RPATH entries it finds in the libraries load commands or the environement, when looking up @rpath relative libraries. -dead_strip_dylibs intructs the linker to drop unused libraries. This in turn help us reduce the number of referenced libraries, and subsequently the size of the load commands. This however does not remove the RPATH entries. Subsequently we can end up (in extreme cases) with only a single @rpath/libHS... entry, but 100s or more RPATH entries in the Load Commands. This patch rectifies this (slighly unorthodox) by passing *no* -rpath arguments to the linker at link time, but -headerpad 8000. The headerpad argument is in hexadecimal and the maxium 32k of the load command size. This tells the linker to pad the load command section enough for us to inject the RPATHs later. We then proceed to link the library or binary with -dead_strip_dylibs, and *after* the linking inspect the library to find the left over (non-dead-stripped) dependencies (using otool). We find the corresponding RPATHs for each @rpath relative dependency, and inject them into the library or binary using the install_name_tool. Thus achieving a deadstripped dylib (and rpaths) build product. We can not do this in GHC, without starting to reimplement a dynamic linker as we do not know which symbols and subsequently libraries are necessary. Commissioned-by: Mercury Technologies, Inc. (mercury.com) - - - - - df04b81e by Sylvain Henry at 2020-09-07T21:19:20-04:00 Move DynFlags test into updateModDetailsIdInfos's caller (#17957) - - - - - ea1cbb8f by Ben Gamari at 2020-09-08T15:42:02-04:00 rts: Add stg_copyArray_barrier to RtsSymbols list It's incredible that this wasn't noticed until now. - - - - - d7b2f799 by Daishi Nakajima at 2020-09-08T15:42:41-04:00 testsuite: Output performance test results in tabular format this was suggested in #18417. Change the print format of the values. * Shorten commit hash * Reduce precision of the "Value" field * Shorten metrics name * e.g. runtime/bytes allocated -> run/alloc * Shorten "MetricsChange" * e.g. unchanged -> unch, increased -> incr And, print the baseline environment if there are baselines that were measured in a different environment than the current environment. If all "Baseline commit" are the same, print it once. - - - - - 44472daf by Ryan Scott at 2020-09-08T15:43:16-04:00 Make the forall-or-nothing rule only apply to invisible foralls (#18660) This fixes #18660 by changing `isLHsForAllTy` to `isLHsInvisForAllTy`, which is sufficient to make the `forall`-or-nothing rule only apply to invisible `forall`s. I also updated some related documentation and Notes while I was in the neighborhood. - - - - - 0c61cbff by Ben Gamari at 2020-09-08T15:43:54-04:00 gitlab-ci: Handle distributions without locales Previously we would assume that the `locale` utility exists. However, this is not so on Alpine as musl's locale support is essentially non-existent. (cherry picked from commit 17cdb7ac3b557a245fee1686e066f9f770ddc21e) - - - - - d989c842 by Ben Gamari at 2020-09-08T15:43:55-04:00 gitlab-ci: Accept Centos 7 C.utf8 locale Centos apparently has C.utf8 rather than C.UTF-8. (cherry picked from commit d9f85dd25a26a04d3485470afb3395ee2dec6464) - - - - - e5a2899c by John Ericson at 2020-09-09T00:46:05-04:00 Use "to" instead of "2" in internal names of conversion ops Change the constructors for the primop union, and also names of the literal conversion functions. "2" runs into trouble when we need to do conversions from fixed-width types, and end up with thing like "Int642Word". Only the names internal to GHC are changed, as I don't want to worry about breaking changes ATM. - - - - - 822f1057 by Ryan Scott at 2020-09-09T00:46:41-04:00 Postpone associated tyfam default checks until after typechecking Previously, associated type family defaults were validity-checked during typechecking. Unfortunately, the error messages that these checks produce run the risk of printing knot-tied type constructors, which will cause GHC to diverge. In order to preserve the current error message's descriptiveness, this patch postpones these validity checks until after typechecking, which are now located in the new function `GHC.Tc.Validity.checkValidAssocTyFamDeflt`. Fixes #18648. - - - - - 8c892689 by Sylvain Henry at 2020-09-09T11:19:24-04:00 DynFlags: add OptCoercionOpts Use OptCoercionOpts to avoid threading DynFlags all the way down to GHC.Core.Coercion.Opt - - - - - 3f32a9c0 by Sylvain Henry at 2020-09-09T11:19:24-04:00 DynFlags: add UnfoldingOpts and SimpleOpts Milestone: after this patch, we only use 'unsafeGlobalDynFlags' for the state hack and for debug in Outputable. - - - - - b3df72a6 by Sylvain Henry at 2020-09-09T11:19:24-04:00 DynFlags: add sm_pre_inline field into SimplMode (#17957) It avoids passing and querying DynFlags down in the simplifier. - - - - - ffae5792 by Sylvain Henry at 2020-09-09T11:19:24-04:00 Add comments about sm_dflags and simpleOptExpr - - - - - 7911d0d9 by Alan Zimmerman at 2020-09-09T11:20:03-04:00 Remove GENERATED pragma, as it is not being used @alanz pointed out on ghc-devs that the payload of this pragma does not appear to be used anywhere. I (@bgamari) did some digging and traced the pragma's addition back to d386e0d2 (way back in 2006!). It appears that it was intended to be used by code generators for use in informing the code coveraging checker about generated code provenance. When it was added it used the pragma's "payload" fields as source location information to build an "ExternalBox". However, it looks like this was dropped a year later in 55a5d8d9. At this point it seems like the pragma serves no useful purpose. Given that it also is not documented, I think we should remove it. Updates haddock submodule Closes #18639 - - - - - 5aae5b32 by Ben Gamari at 2020-09-09T18:31:40-04:00 gitlab-ci: Bump Docker images We now generate our Docker images via Dhall definitions, as described in ghc/ci-images!52. Additionally, we are far more careful about where tools come from, using the ALEX, HAPPY, HSCOLOR, and GHC environment variables (set in the Dockerfiles) to find bootstrapping tools. - - - - - 4ce9fe88 by Ben Gamari at 2020-09-09T18:31:40-04:00 hadrian: Fix leakage of GHC in PATH into build Previously hadrian would use GHC on PATH when configuring packages (or fail if there is no such GHC). Fix this. Unfortunately this runs into another bug in Cabal which we workaround. - - - - - 291a15dd by Ben Gamari at 2020-09-09T18:31:40-04:00 utils: Bump cabal-version of hp2ps and unlit - - - - - 4798caa0 by David Himmelstrup at 2020-09-09T18:32:16-04:00 rts comment: RTS_TICKY_SYMBOLS moved from rts/Linker.c to rts/RtsSymbols.c - - - - - 67ce72da by Sebastian Graf at 2020-09-10T10:35:33-04:00 Add long-distance info for pattern bindings (#18572) We didn't consider the RHS of a pattern-binding before, which led to surprising warnings listed in #18572. As can be seen from the regression test T18572, we get the expected output now. - - - - - 1207576a by Sebastian Graf at 2020-09-10T10:35:33-04:00 PmCheck: Big refactor using guard tree variants more closely following source syntax (#18565) Previously, we desugared and coverage checked plain guard trees as described in Lower Your Guards. That caused (in !3849) quite a bit of pain when we need to partially recover tree structure of the input syntax to return covered sets for long-distance information, for example. In this refactor, I introduced a guard tree variant for each relevant source syntax component of a pattern-match (mainly match groups, match, GRHS, empty case, pattern binding). I made sure to share as much coverage checking code as possible, so that the syntax-specific checking functions are just wrappers around the more substantial checking functions for the LYG primitives (`checkSequence`, `checkGrds`). The refactoring payed off in clearer code and elimination of all panics related to assumed guard tree structure and thus fixes #18565. I also took the liberty to rename and re-arrange the order of functions and comments in the module, deleted some dead and irrelevant Notes, wrote some new ones and gave an overview module haddock. - - - - - 95455982 by GHC GitLab CI at 2020-09-10T10:36:09-04:00 hadrian: Don't include -fdiagnostics-color in argument hash Otherwise the input hash will vary with whether colors are requested, which changed with `isatty`. Fixes #18672. - - - - - 6abe4a1c by Sebastian Graf at 2020-09-10T17:02:00+02:00 .gitignore *.hiedb files - - - - - 3777be14 by Sebastian Graf at 2020-09-10T17:03:12+02:00 PmCheck: Handle ⊥ and strict fields correctly (#18341) In #18341, we discovered an incorrect digression from Lower Your Guards. This MR changes what's necessary to support properly fixing #18341. In particular, bottomness constraints are now properly tracked in the oracle/inhabitation testing, as an additional field `vi_bot :: Maybe Bool` in `VarInfo`. That in turn allows us to model newtypes as advertised in the Appendix of LYG and fix #17725. Proper handling of ⊥ also fixes #17977 (once again) and fixes #18670. For some reason I couldn't follow, this also fixes #18273. I also added a couple of regression tests that were missing. Most of them were already fixed before. In summary, this patch fixes #18341, #17725, #18273, #17977 and #18670. Metric Decrease: T12227 - - - - - 1bd28931 by David Himmelstrup at 2020-09-11T09:59:43-04:00 Define TICKY_TICKY when compiling cmm RTS files. - - - - - 15e67801 by David Himmelstrup at 2020-09-11T09:59:43-04:00 Fix typos in TICKY_TICKY symbol names. - - - - - 8a5a91cb by David Himmelstrup at 2020-09-11T09:59:43-04:00 Enable TICKY_TICKY for debug builds when building with makefiles. - - - - - fc965c09 by Sandy Maguire at 2020-09-12T00:31:36-04:00 Add clamp function to Data.Ord - - - - - fb6e29e8 by Sandy Maguire at 2020-09-12T00:31:37-04:00 Add tests - - - - - 2a942285 by Sebastian Graf at 2020-09-12T00:32:13-04:00 PmCheck: Disattach COMPLETE pragma lookup from TyCons By not attaching COMPLETE pragmas with a particular TyCon and instead assume that every COMPLETE pragma is applicable everywhere, we can drastically simplify the logic that tries to initialise available COMPLETE sets of a variable during the pattern-match checking process, as well as fixing a few bugs. Of course, we have to make sure not to report any of the ill-typed/unrelated COMPLETE sets, which came up in a few regression tests. In doing so, we fix #17207, #18277 and #14422. There was a metric decrease in #18478 by ~20%. Metric Decrease: T18478 - - - - - 389a6683 by Ben Gamari at 2020-09-12T00:32:49-04:00 hadrian: Pass input file to makeindex Strangely I find that on Alpine (and apparently only on Alpine) the latex makeindex command expects to be given a filename, lest it reads from stdin. - - - - - 853d121a by Ryan Scott at 2020-09-12T00:33:25-04:00 Don't quote argument to Hadrian's test-env flag (#18656) Doing so causes the name of the test environment to gain an extra set of double quotes, which changes the name entirely. Fixes #18656. - - - - - 8440b5fa by Krzysztof Gogolewski at 2020-09-12T00:33:25-04:00 Make sure we can read past perf notes See #18656. - - - - - 2157be52 by theobat at 2020-09-12T21:27:04-04:00 Avoid iterating twice in `zipTyEnv` (#18535) zipToUFM is a new function to replace `listToUFM (zipEqual ks vs)`. An explicit recursion is preferred due to the sensible nature of fusion. T12227 -6.0% T12545 -12.3% T5030 -9.0% T9872a -1.6% T9872b -1.6% T9872c -2.0% ------------------------- Metric Decrease: T12227 T12545 T5030 T9872a T9872b T9872c ------------------------- - - - - - 69ea2fee by Sebastian Graf at 2020-09-12T21:27:40-04:00 Make `tcCheckSatisfiability` incremental (#18645) By taking and returning an `InertSet`. Every new `TcS` session can then pick up where a prior session left with `setTcSInerts`. Since we don't want to unflatten the Givens (and because it leads to infinite loops, see !3971), we introduced a new variant of `runTcS`, `runTcSInerts`, that takes and returns the `InertSet` and makes sure not to unflatten the Givens after running the `TcS` action. Fixes #18645 and #17836. Metric Decrease: T17977 T18478 - - - - - a77e48d2 by Sebastian Graf at 2020-09-12T21:27:40-04:00 Extract definition of DsM into GHC.HsToCore.Types `DsM` was previously defined in `GHC.Tc.Types`, along with `TcM`. But `GHC.Tc.Types` is in the set of transitive dependencies of `GHC.Parser`, a set which we aim to minimise. Test case `CountParserDeps` checks for that. Having `DsM` in that set means the parser also depends on the innards of the pattern-match checker in `GHC.HsToCore.PmCheck.Types`, which is the reason we have that module in the first place. In the previous commit, we represented the `TyState` by an `InertSet`, but that pulls the constraint solver as well as 250 more modules into the set of dependencies, triggering failure of `CountParserDeps`. Clearly, we want to evolve the pattern-match checker (and the desugarer) without being concerned by this test, so this patch includes a small refactor that puts `DsM` into its own module. - - - - - fd5d622a by Sebastian Graf at 2020-09-12T21:27:40-04:00 Hackily decouple the parser from the desugarer In a hopefully temporary hack, I re-used the idea from !1957 of using a nullary type family to break the dependency from GHC.Driver.Hooks on the definition of DsM ("Abstract Data"). This in turn broke the last dependency from the parser to the desugarer. More details in `Note [The Decoupling Abstract Data Hack]`. In the future, we hope to undo this hack again in favour of breaking the dependency from the parser to DynFlags altogether. - - - - - 35a7b7ec by Adam Sandberg Eriksson at 2020-09-14T17:46:16-04:00 docs: -B rts option sounds the bell on every GC (#18351) - - - - - 5ae8212c by Wander Hillen at 2020-09-14T17:46:54-04:00 Populate gitlab cache after building - - - - - a5ffb39a by Wander Hillen at 2020-09-14T17:46:54-04:00 Move ahead cabal cache restoration to before use of cabal - - - - - e8b37c21 by Wander Hillen at 2020-09-14T17:46:54-04:00 Do the hadrian rebuild multicore - - - - - 07762eb5 by Wander Hillen at 2020-09-14T17:46:54-04:00 Also cache other hadrian builds - - - - - 8610bcbe by DenisFrezzato at 2020-09-15T15:19:08-04:00 Fix rtsopts documentation - - - - - c7182a5c by Simon Peyton Jones at 2020-09-15T15:19:44-04:00 Care with implicit-parameter superclasses Two bugs, #18627 and #18649, had the same cause: we were not account for the fact that a constaint tuple might hide an implicit parameter. The solution is not hard: look for implicit parameters in superclasses. See Note [Local implicit parameters] in GHC.Core.Predicate. Then we use this new function in two places * The "short-cut solver" in GHC.Tc.Solver.Interact.shortCutSolver which simply didn't handle implicit parameters properly at all. This fixes #18627 * The specialiser, which should not specialise on implicit parameters This fixes #18649 There are some lingering worries (see Note [Local implicit parameters]) but things are much better. - - - - - 0f3884b0 by Zubin Duggal at 2020-09-15T15:20:23-04:00 Export enrichHie from GHC.Iface.Ext.Ast This is useful for `ghcide` - - - - - b3143f5a by Sylvain Henry at 2020-09-15T15:21:06-04:00 Enhance metrics output - - - - - 4283feaa by Ryan Scott at 2020-09-15T15:21:43-04:00 Introduce and use DerivClauseTys (#18662) This switches `deriv_clause_tys` so that instead of using a list of `LHsSigType`s to represent the types in a `deriving` clause, it now uses a sum type. `DctSingle` represents a `deriving` clause with no enclosing parentheses, while `DctMulti` represents a clause with enclosing parentheses. This makes pretty-printing easier and avoids confusion between `HsParTy` and the enclosing parentheses in `deriving` clauses, which are different semantically. Fixes #18662. - - - - - 90229c4b by Ryan Scott at 2020-09-16T04:53:22-04:00 Include -f{write,validate}-ide-info in the User's Guide flag reference Previously, these were omitted from the flag reference due to a layout oversight in `docs/users_guide/flags.{rst,py}`. Fixes #18426. - - - - - ce42e187 by Ben Gamari at 2020-09-16T04:53:59-04:00 rts: Fix erroneous usage of vsnprintf As pointed out in #18685, this should be snprintf not vsnprintf. This appears to be due to a cut-and-paste error. Fixes #18658. - - - - - b695e7d7 by Sylvain Henry at 2020-09-16T04:54:38-04:00 Rename ghci flag into internal-interpreter "ghci" as a flag name was confusing because it really enables the internal-interpreter. Even the ghci library had a "ghci" flag... - - - - - 8af954d2 by Sylvain Henry at 2020-09-16T04:55:17-04:00 Make ghc-boot reexport modules from ghc-boot-th Packages don't have to import both ghc-boot and ghc-boot-th. It makes the dependency graph easier to understand and to refactor. - - - - - 6baa67f5 by Adam Sandberg Eriksson at 2020-09-16T07:45:47-04:00 docs: correct haddock reference [skip ci] - - - - - 7cf09ab0 by Simon Peyton Jones at 2020-09-17T01:27:25-04:00 Do absence analysis on stable unfoldings Ticket #18638 showed that Very Bad Things happen if we fail to do absence analysis on stable unfoldings. It's all described in Note [Absence analysis for stable unfoldings and RULES]. I'm a bit surprised this hasn't bitten us before. Fortunately the fix is pretty simple. - - - - - 76d3bcbc by Leif Metcalf at 2020-09-17T01:28:01-04:00 Replace deprecated git --recursive The --recursive flag of git-clone has been replaced by the --recurse-submodules flag since git 1.7.4, released in 2011. - - - - - da8f4ddd by Richard Eisenberg at 2020-09-17T01:28:38-04:00 Document IfaceTupleTy - - - - - 3c94c816 by HaskellMouse at 2020-09-17T08:49:51-04:00 Added explicit fixity to (~). Solves #18252 - - - - - b612e396 by Cary Robbins at 2020-09-17T08:50:30-04:00 Make the 'IsString (Const a b)' instance polykinded on 'b' - - - - - 8d0c26c4 by Ben Gamari at 2020-09-17T08:51:08-04:00 rts/win32: Fix missing #include's These slipped through CI. - - - - - 76009ec8 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump Win32 submodule to 2.9.0.0 Also bumps Cabal, directory - - - - - 147bb598 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump version to 9.0 Bumps haskeline and haddock submodules. (cherry picked from commit f218cfc92f7b1a1e01190851972bb9a0e0f3c682) - - - - - 5c7387f6 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Make Z-encoding comment into a note - - - - - c12b3041 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Cosmetic - - - - - 4f461e1a by Vladislav Zavialov at 2020-09-17T08:52:19-04:00 Parser.y: clarify treatment of @{-# UNPACK #-} Before this patch, we had this parser production: ftype : ... | ftype PREFIX_AT tyarg { ... } And 'tyarg' is defined as follows: tyarg : atype { ... } | unpackedness atype { ... } So one might get the (false) impression that that parser production is intended to parse things like: F @{-# UNPACK #-} X However, the lexer wouldn't produce PREFIX_AT followed by 'unpackedness', as the '@' operator followed by '{-' is not considered prefix. Thus there's no point using 'tyarg' after PREFIX_AT, and a simple 'atype' will suffice: ftype : ... | ftype PREFIX_AT atype { ... } This change has no user-facing consequences. It just makes the grammar a bit more clear. - - - - - 9dec8600 by Benjamin Maurer at 2020-09-17T08:52:56-04:00 Documented '-m' flags for machine specific instruction extensions. See #18641 'Documenting the Expected Undocumented Flags' - - - - - ca48076a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Introduce OutputableP Some types need a Platform value to be pretty-printed: CLabel, Cmm types, instructions, etc. Before this patch they had an Outputable instance and the Platform value was obtained via sdocWithDynFlags. It meant that the *renderer* of the SDoc was responsible of passing the appropriate Platform value (e.g. via the DynFlags given to showSDoc). It put the burden of passing the Platform value on the renderer while the generator of the SDoc knows the Platform it is generating the SDoc for and there is no point passing a different Platform at rendering time. With this patch, we introduce a new OutputableP class: class OutputableP a where pdoc :: Platform -> a -> SDoc With this class we still have some polymorphism as we have with `ppr` (i.e. we can use `pdoc` on a variety of types instead of having a dedicated `pprXXX` function for each XXX type). One step closer removing `sdocWithDynFlags` (#10143) and supporting several platforms (#14335). - - - - - e45c8544 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Generalize OutputableP Add a type parameter for the environment required by OutputableP. It avoids tying Platform with OutputableP. - - - - - 37aa224a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Add note about OutputableP - - - - - 7f2785f2 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Remove pprPrec from Outputable (unused) - - - - - b689f3db by Sylvain Henry at 2020-09-17T20:04:46-04:00 Bignum: add clamping naturalToWord (fix #18697) - - - - - 0799b3de by Ben Gamari at 2020-09-18T15:55:50-04:00 rts/nonmoving: Add missing STM write barrier When updating a TRec for a TVar already part of a transaction we previously neglected to add the old value to the update remembered set. I suspect this was the cause of #18587. - - - - - c4921349 by Ben Gamari at 2020-09-18T15:56:25-04:00 rts: Refactor foreign export tracking This avoids calling `libc` in the initializers which are responsible for registering foreign exports. We believe this should avoid the corruption observed in #18548. See Note [Tracking foreign exports] in rts/ForeignExports.c for an overview of the new scheme. - - - - - 40dc9106 by Ben Gamari at 2020-09-18T15:56:25-04:00 rts: Refactor unloading of foreign export StablePtrs Previously we would allocate a linked list cell for each foreign export. Now we can avoid this by taking advantage of the fact that they are already broken into groups. - - - - - 45fa8218 by Simon Jakobi at 2020-09-19T06:57:36-04:00 Deprecate Data.Semigroup.Option Libraries email: https://mail.haskell.org/pipermail/libraries/2018-April/028724.html GHC issue: https://gitlab.haskell.org/ghc/ghc/issues/15028 Corresponding PRs for deepseq: * https://github.com/haskell/deepseq/pull/55 * https://github.com/haskell/deepseq/pull/57 Bumps the deepseq submodule. - - - - - 2229d570 by Vladislav Zavialov at 2020-09-19T15:47:24-04:00 Require happy >=1.20 - - - - - a89c2fba by Ben Gamari at 2020-09-19T15:47:24-04:00 ci.sh: Enforce minimum happy/alex versions Also, always invoke cabal-install to ensure that happy/alex symlinks are up-to-date. - - - - - 2f7ef2fb by Ben Gamari at 2020-09-19T15:47:24-04:00 gitlab-ci: Ensure that cabal-install overwrites existing executables Previously cabal-install wouldn't overwrite toolchain executables if they already existed (as they likely would due to caching). - - - - - ac213d26 by Ryan Scott at 2020-09-19T15:48:01-04:00 Wire in constraint tuples This wires in the definitions of the constraint tuple classes. The key changes are in: * `GHC.Builtin.Types`, where the `mk_ctuple` function is used to define constraint tuple type constructors, data constructors, and superclass selector functions, and * `GHC.Builtin.Uniques`. In addition to wiring in the `Unique`s for constraint tuple type and data constructors, we now must wire in the superclass selector functions. Luckily, this proves to be not that challenging. See the newly added comments. Historical note: constraint tuples used to be wired-in until about five years ago, when commit 130e93aab220bdf14d08028771f83df210da340b turned them into known-key names. This was done as part of a larger refactor to reduce the number of special cases for constraint tuples, but the commit message notes that the main reason that constraint tuples were made known-key (as opposed to boxed/unboxed tuples, which are wired in) is because it was awkward to wire in the superclass selectors. This commit solves the problem of wiring in superclass selectors. Fixes #18635. ------------------------- Metric Decrease: T10421 T12150 T12227 T12234 T12425 T13056 T13253-spj T18282 T18304 T5321FD T5321Fun T5837 T9961 Metric Decrease (test_env='x86_64-linux-deb9-unreg-hadrian'): T12707 Metric Decrease (test_env='x86_64-darwin'): T4029 ------------------------- - - - - - e195dae6 by Wander Hillen at 2020-09-19T15:48:41-04:00 Export singleton function from Data.List Data.OldList exports a monomorphized singleton function but it is not re-exported by Data.List. Adding the export to Data.List causes a conflict with a 14-year old function of the same name and type by SPJ in GHC.Utils.Misc. We can't just remove this function because that leads to a problems when building GHC with a stage0 compiler that does not have singleton in Data.List yet. We also can't hide the function in GHC.Utils.Misc since it is not possible to hide a function from a module if the module does not export the function. To work around this, all places where the Utils.Misc singleton was used now use a qualified version like Utils.singleton and in GHC.Utils.Misc we are very specific about which version we export. - - - - - 9c1b8ad9 by Sylvain Henry at 2020-09-19T15:49:19-04:00 Bump Stack resolver - - - - - d05d13ce by John Ericson at 2020-09-19T15:49:57-04:00 Cinch -fno-warn-name-shadowing down to specific GHCi module - - - - - f1accd00 by Sylvain Henry at 2020-09-19T15:49:57-04:00 Add quick-validate Hadrian flavour (quick + -Werror) - - - - - 8f8d51f1 by Andreas Klebinger at 2020-09-19T15:50:33-04:00 Fix docs who misstated how the RTS treats size suffixes. They are parsed as multiples of 1024. Not 1000. The docs used to imply otherwise. See decodeSize in rts/RtsFlags.c for the logic for this. - - - - - 2ae0edbd by Andreas Klebinger at 2020-09-19T15:50:33-04:00 Fix a codeblock in ghci.rst - - - - - 4df3aa95 by Ben Gamari at 2020-09-19T15:51:07-04:00 users guide: Fix various documentation issues - - - - - 885ecd18 by Ben Gamari at 2020-09-19T15:51:07-04:00 hadrian: Fail on Sphinx syntax errors Specifically the "Inline literal start-string without end-string" warning, which typically means that the user neglected to separate an inline code block from suffix text with a backslash. - - - - - b26cd867 by David Feuer at 2020-09-19T15:51:44-04:00 Unpack the MVar in Compact The `MVar` lock in `Compact` was unnecessarily lazy, creating an extra indirection and wasting two words. Make it strict. - - - - - 760307cf by Artyom Kuznetsov at 2020-09-19T15:52:21-04:00 Remove GADT self-reference check (#11554, #12081, #12174, fixes #15942) Reverts 430f5c84dac1eab550110d543831a70516b5cac8 - - - - - 057db94c by Ben Gamari at 2020-09-19T15:52:56-04:00 rts: Drop field initializer on thread_basic_info_data_t This struct has a number of fields and we only care that the value is initialized with zeros. This eliminates the warnings noted in #17905. - - - - - 87e2e2b1 by Vladislav Zavialov at 2020-09-19T23:55:30+03:00 Resolve shift/reduce conflicts with %shift (#17232) - - - - - 66cba46e by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Unmark T12971 as broken on Windows It's unclear why, but this no longer seems to fail. Closes #17945. - - - - - 816811d4 by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Unmark T5975[ab] as broken on Windows Sadly it's unclear *why* they have suddenly started working. Closes #7305. - - - - - 43a43d39 by Ben Gamari at 2020-09-20T20:30:57-04:00 base/testsuite: Add missing LANGUAGE pragma in ThreadDelay001 Only affected the Windows codepath. - - - - - ced8f113 by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Update expected output for outofmem on Windows The error originates from osCommitMemory rather than getMBlocks. - - - - - ea08aead by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Mark some GHCi/Makefile tests as broken on Windows See #18718. - - - - - caf6a5a3 by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Fix WinIO error message normalization This wasn't being applied to stderr. - - - - - 93ab3e8d by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Mark tempfiles as broken on Win32 without WinIO The old POSIX emulation appears to ignore the user-requested prefix. - - - - - 9df77fed by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Mark TH_spliceE5_prof as broken on Windows Due to #18721. - - - - - 1a0f8243 by Ryan Scott at 2020-09-21T16:45:47-04:00 Remove unused ThBrackCtxt and ResSigCtxt Fixes #18715. - - - - - 2f222b12 by Ryan Scott at 2020-09-21T16:45:47-04:00 Disallow constraints in KindSigCtxt This patch cleans up how `GHC.Tc.Validity` classifies `UserTypeCtxt`s that can only refer to kind-level positions, which is important for rejecting certain classes of programs. In particular, this patch: * Introduces a new `TypeOrKindCtxt` data type and `typeOrKindCtxt :: UserTypeCtxt -> TypeOrKindCtxt` function, which determines whether a `UserTypeCtxt` can refer to type-level contexts, kind-level contexts, or both. * Defines the existing `allConstraintsAllowed` and `vdqAllowed` functions in terms of `typeOrKindCtxt`, which avoids code duplication and ensures that they stay in sync in the future. The net effect of this patch is that it fixes #18714, in which it was discovered that `allConstraintsAllowed` incorrectly returned `True` for `KindSigCtxt`. Because `typeOrKindCtxt` now correctly classifies `KindSigCtxt` as a kind-level context, this bug no longer occurs. - - - - - aaa51dcf by Ben Gamari at 2020-09-21T16:46:22-04:00 hadrian: Add extra-deps: happy-1.20 to stack.yaml GHC now requires happy-1.20, which isn't available in LTS-16.14. Fixes #18726. - - - - - 6de40f83 by Simon Peyton Jones at 2020-09-22T05:37:24-04:00 Better eta-expansion (again) and don't specilise DFuns This patch fixes #18223, which made GHC generate an exponential amount of code. There are three quite separate changes in here 1. Re-engineer eta-expansion (again). The eta-expander was generating lots of intermediate stuff, which could be optimised away, but which choked the simplifier meanwhile. Relatively easy to kill it off at source. See Note [The EtaInfo mechanism] in GHC.Core.Opt.Arity. The main new thing is the use of pushCoArg in getArg_maybe. 2. Stop Specialise specalising DFuns. This is the cause of a huge (and utterly unnecessary) blowup in program size in #18223. See Note [Do not specialise DFuns] in GHC.Core.Opt.Specialise. I also refactored the Specialise monad a bit... it was silly, because it passed on unchanging values as if they were mutable state. 3. Do an extra Simplifer run, after SpecConstra and before late-Specialise. I found (investigating perf/compiler/T16473) that failing to do this was crippling *both* SpecConstr *and* Specialise. See Note [Simplify after SpecConstr] in GHC.Core.Opt.Pipeline. This change does mean an extra run of the Simplifier, but only with -O2, and I think that's acceptable. T16473 allocates *three* times less with this change. (I changed it to check runtime rather than compile time.) Some smaller consequences * I moved pushCoercion, pushCoArg and friends from SimpleOpt to Arity, because it was needed by the new etaInfoApp. And pushCoValArg now returns a MCoercion rather than Coercion for the argument Coercion. * A minor, incidental improvement to Core pretty-printing This does fix #18223, (which was otherwise uncompilable. Hooray. But there is still a big intermediate because there are some very deeply nested types in that program. Modest reductions in compile-time allocation on a couple of benchmarks T12425 -2.0% T13253 -10.3% Metric increase with -O2, due to extra simplifier run T9233 +5.8% T12227 +1.8% T15630 +5.0% There is a spurious apparent increase on heap residency on T9630, on some architectures at least. I tried it with -G1 and the residency is essentially unchanged. Metric Increase T9233 T12227 T9630 Metric Decrease T12425 T13253 - - - - - 416bd50e by Simon Peyton Jones at 2020-09-22T05:37:59-04:00 Fix the occurrence analyser Ticket #18603 demonstrated that the occurrence analyser's handling of local RULES for imported Ids (which I now call IMP-RULES) was inadequate. It led the simplifier into an infnite loop by failing to label a binder as a loop breaker. The main change in this commit is to treat IMP-RULES in a simple and uniform way: as extra rules for the local binder. See Note [IMP-RULES: local rules for imported functions] This led to quite a bit of refactoring. The result is still tricky, but it's much better than before, and better documented I think. Oh, and it fixes the bug. - - - - - 6fe8a0c7 by Sebastian Graf at 2020-09-22T05:38:35-04:00 PmCheck - Comments only: Replace /~ by ≁ - - - - - e9501547 by Sebastian Graf at 2020-09-22T05:38:35-04:00 PmCheck: Rewrite inhabitation test We used to produce inhabitants of a pattern-match refinement type Nabla in the checker in at least two different and mostly redundant ways: 1. There was `provideEvidence` (now called `generateInhabitingPatterns`) which is used by `GHC.HsToCore.PmCheck` to produce non-exhaustive patterns, which produces inhabitants of a Nabla as a sub-refinement type where all match variables are instantiated. 2. There also was `ensure{,All}Inhabited` (now called `inhabitationTest`) which worked slightly different, but was whenever new type constraints or negative term constraints were added. See below why `provideEvidence` and `ensureAllInhabited` can't be the same function, the main reason being performance. 3. And last but not least there was the `nonVoid` test, which tested that a given type was inhabited. We did use this for strict fields and -XEmptyCase in the past. The overlap of (3) with (2) was always a major pet peeve of mine. The latter was quite efficient and proven to work for recursive data types, etc, but could not handle negative constraints well (e.g. we often want to know if a *refined* type is empty, such as `{ x:[a] | x /= [] }`). Lower Your Guards suggested that we could get by with just one, by replacing both functions with `inhabitationTest` in this patch. That was only possible by implementing the structure of φ constraints as in the paper, namely the semantics of φ constructor constraints. This has a number of benefits: a. Proper handling of unlifted types and strict fields, fixing #18249, without any code duplication between `GHC.HsToCore.PmCheck.Oracle.instCon` (was `mkOneConFull`) and `GHC.HsToCore.PmCheck.checkGrd`. b. `instCon` can perform the `nonVoid` test (3) simply by emitting unliftedness constraints for strict fields. c. `nonVoid` (3) is thus simply expressed by a call to `inhabitationTest`. d. Similarly, `ensureAllInhabited` (2), which we called after adding type info, now can similarly be expressed as the fuel-based `inhabitationTest`. See the new `Note [Why inhabitationTest doesn't call generateInhabitingPatterns]` why we still have tests (1) and (2). Fixes #18249 and brings nice metric decreases for `T17836` (-76%) and `T17836b` (-46%), as well as `T18478` (-8%) at the cost of a few very minor regressions (< +2%), potentially due to the fact that `generateInhabitingPatterns` does more work to suggest the minimal COMPLETE set. Metric Decrease: T17836 T17836b - - - - - 086ef018 by Hécate at 2020-09-23T06:52:08-04:00 Remove the list of loaded modules from the ghci prompt - - - - - d7385f70 by Ben Gamari at 2020-09-23T06:52:44-04:00 Bump submodules * Bump bytestring to 0.10.12.0 * Bump Cabal to 3.4.0.0-rc3 * Bump Win32 to 2.10.0.0 - - - - - 667d6355 by Sylvain Henry at 2020-09-23T20:43:48-04:00 Refactor CLabel pretty-printing * Don't depend on the selected backend to know if we print Asm or C labels: we already have PprStyle to determine this. Moreover even when a native backend is used (NCG, LLVM) we may want to C headers containing pretty-printed labels, so it wasn't a good predicate anyway. * Make pretty-printing code clearer and avoid partiality - - - - - a584366b by Sylvain Henry at 2020-09-23T20:43:48-04:00 Remove sdocWithDynFlags (fix #10143) - - - - - a997fa01 by Sylvain Henry at 2020-09-23T20:43:48-04:00 Preliminary work towards removing DynFlags -> Driver.Ppr dependency - - - - - 31fea307 by Hécate at 2020-09-23T20:44:24-04:00 Remove redundant "do", "return" and language extensions from base - - - - - 04d64331 by syd at cs-syd.eu at 2020-09-24T13:15:54-04:00 Update Lock.hs with more documentation to make sure that the Boolean return value is clear. [skip ci] - - - - - 97cff919 by Simon Peyton Jones at 2020-09-24T13:16:32-04:00 Implement Quick Look impredicativity This patch implements Quick Look impredicativity (#18126), sticking very closely to the design in A quick look at impredicativity, Serrano et al, ICFP 2020 The main change is that a big chunk of GHC.Tc.Gen.Expr has been extracted to two new modules GHC.Tc.Gen.App GHC.Tc.Gen.Head which deal with typechecking n-ary applications, and the head of such applications, respectively. Both contain a good deal of documentation. Three other loosely-related changes are in this patch: * I implemented (partly by accident) points (2,3)) of the accepted GHC proposal "Clean up printing of foralls", namely https://github.com/ghc-proposals/ghc-proposals/blob/ master/proposals/0179-printing-foralls.rst (see #16320). In particular, see Note [TcRnExprMode] in GHC.Tc.Module - :type instantiates /inferred/, but not /specified/, quantifiers - :type +d instantiates /all/ quantifiers - :type +v is killed off That completes the implementation of the proposal, since point (1) was done in commit df08468113ab46832b7ac0a7311b608d1b418c4d Author: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> Date: Mon Feb 3 21:17:11 2020 +0100 Always display inferred variables using braces * HsRecFld (which the renamer introduces for record field selectors), is now preserved by the typechecker, rather than being rewritten back to HsVar. This is more uniform, and turned out to be more convenient in the new scheme of things. * The GHCi debugger uses a non-standard unification that allows the unification variables to unify with polytypes. We used to hack this by using ImpredicativeTypes, but that doesn't work anymore so I introduces RuntimeUnkTv. See Note [RuntimeUnkTv] in GHC.Runtime.Heap.Inspect Updates haddock submodule. WARNING: this patch won't validate on its own. It was too hard to fully disentangle it from the following patch, on type errors and kind generalisation. Changes to tests * Fixes #9730 (test added) * Fixes #7026 (test added) * Fixes most of #8808, except function `g2'` which uses a section (which doesn't play with QL yet -- see #18126) Test added * Fixes #1330. NB Church1.hs subsumes Church2.hs, which is now deleted * Fixes #17332 (test added) * Fixes #4295 * This patch makes typecheck/should_run/T7861 fail. But that turns out to be a pre-existing bug: #18467. So I have just made T7861 into expect_broken(18467) - - - - - 9fa26aa1 by Simon Peyton Jones at 2020-09-24T13:16:32-04:00 Improve kind generalisation, error messages This patch does two things: * It refactors GHC.Tc.Errors a bit. In debugging Quick Look I was forced to look in detail at error messages, and ended up doing a bit of refactoring, esp in mkTyVarEqErr'. It's still quite a mess, but a bit better, I think. * It makes a significant improvement to the kind checking of type and class declarations. Specifically, we now ensure that if kind checking fails with an unsolved constraint, all the skolems are in scope. That wasn't the case before, which led to some obscure error messages; and occasional failures with "no skolem info" (eg #16245). Both of these, and the main Quick Look patch itself, affect a /lot/ of error messages, as you can see from the number of files changed. I've checked them all; I think they are as good or better than before. Smaller things * I documented the various instances of VarBndr better. See Note [The VarBndr tyep and its uses] in GHC.Types.Var * Renamed GHC.Tc.Solver.simpl_top to simplifyTopWanteds * A bit of refactoring in bindExplicitTKTele, to avoid the footwork with Either. Simpler now. * Move promoteTyVar from GHC.Tc.Solver to GHC.Tc.Utils.TcMType Fixes #16245 (comment 211369), memorialised as typecheck/polykinds/T16245a Also fixes the three bugs in #18640 - - - - - 6d0ce0eb by Sebastian Graf at 2020-09-24T13:17:07-04:00 PmCheck: Desugar string literal patterns with -XRebindableSyntax correctly (#18708) Fixes #18708. - - - - - 007940d2 by Hécate at 2020-09-24T13:17:44-04:00 Namespace the Hadrian linting rule for base - - - - - 5b727189 by Andreas Klebinger at 2020-09-25T21:10:20-04:00 Make sizeExpr strict in the size threshold to facilitate WW. - - - - - dd664031 by Ben Gamari at 2020-09-25T21:10:56-04:00 ci.sh: Factor out common utilities - - - - - 5b78e865 by Ben Gamari at 2020-09-25T21:10:56-04:00 ci: Add ad-hoc performance testing rule - - - - - 29885f07 by Zubin Duggal at 2020-09-25T21:11:32-04:00 Stop removing definitions of record fields in GHC.Iface.Ext.Ast - - - - - 0d6519d9 by Ben Gamari at 2020-09-25T21:12:08-04:00 gitlab-ci: Drop Darwin cleanup job We now have a proper periodic clean-up script installed on the runners. - - - - - 277d20af by Sebastian Graf at 2020-09-25T21:12:44-04:00 Add regression tests for #18371 They have been fixed by !3959, I believe. Fixes #18371. - - - - - 8edf6056 by Sebastian Graf at 2020-09-25T21:12:44-04:00 Add a regression test for #18609 The egregious performance hits are gone since !4050. So we fix #18609. - - - - - 4a1b89a4 by Sebastian Graf at 2020-09-25T21:12:44-04:00 Accept new test output for #17218 The expected test output was plain wrong. It has been fixed for a long time. Thus we can close #17218. - - - - - 51606236 by Sven Tennie at 2020-09-25T21:13:19-04:00 Print RET_BIG stack closures A RET_BIG closure has a large bitmap that describes it's payload and can be printed with printLargeBitmap(). Additionally, the output for payload closures of small and big bitmaps is changed: printObj() is used to print a bit more information about what's on the stack. - - - - - 2707c4ea by Arnaud Spiwack at 2020-09-25T21:13:58-04:00 Pattern guards BindStmt always use multiplicity Many Fixes #18439 . The rhs of the pattern guard was consumed with multiplicity one, while the pattern assumed it was Many. We use Many everywhere instead. This is behaviour consistent with that of `case` expression. See #18738. - - - - - 92daad24 by Sylvain Henry at 2020-09-25T21:14:36-04:00 Bignum: refactor backend modules * move backends into GHC.Num.Backend.* * split backend selection into GHC.Num.Backend and GHC.Num.Backend.Selected to avoid duplication with the Check backend - - - - - 04bc50b3 by Sylvain Henry at 2020-09-25T21:14:36-04:00 Bignum: implement extended GCD (#18427) - - - - - 6a7dae4b by Krzysztof Gogolewski at 2020-09-25T21:15:14-04:00 Fix typed holes causing linearity errors (#18491) - - - - - 83407ffc by Krzysztof Gogolewski at 2020-09-25T21:15:53-04:00 Various documentation fixes * Remove UnliftedFFITypes from conf. Some time ago, this extension was undocumented and we had to silence a warning. This is no longer needed. * Use r'' in conf.py. This fixes a Sphinx warning: WARNING: Support for evaluating Python 2 syntax is deprecated and will be removed in Sphinx 4.0. Convert docs/users_guide/conf.py to Python 3 syntax. * Mark GHCForeignImportPrim as documented * Fix formatting in template_haskell.rst * Remove 'recursive do' from the list of unsupported items in TH - - - - - af1e84e7 by Sebastian Graf at 2020-09-26T05:36:46-04:00 PmCheck: Big refactor of module structure * Move everything from `GHC.HsToCore.PmCheck.*` to `GHC.HsToCore.Pmc.*` in analogy to `GHC.Tc`, rename exported `covCheck*` functions to `pmc*` * Rename `Pmc.Oracle` to `Pmc.Solver` * Split off the LYG desugaring and checking steps into their own modules (`Pmc.Desugar` and `Pmc.Check` respectively) * Split off a `Pmc.Utils` module with stuff shared by `Pmc.{,Desugar,Check,Solver}` * Move `Pmc.Types` to `Pmc.Solver.Types`, add a new `Pmc.Types` module with all the LYG types, which form the interfaces between `Pmc.{Desugar,Check,Solver,}`. - - - - - f08f98e8 by Sebastian Graf at 2020-09-26T05:36:46-04:00 Extract SharedIdEnv into its own module It's now named `GHC.Types.Unique.SDFM.UniqSDFM`. The implementation is more clear about its stated goals and supported operations. - - - - - 1cde295c by Sylvain Henry at 2020-09-26T05:37:23-04:00 Bignum: add bigNatFromWordArray Reimplementation of integer-gmp's byteArrayToBigNat# - - - - - bda55fa0 by Krzysztof Gogolewski at 2020-09-26T13:18:22-04:00 Make 'undefined x' linear in 'x' (#18731) - - - - - 160fba4a by Krzysztof Gogolewski at 2020-09-26T13:19:00-04:00 Disallow linear types in FFI (#18472) - - - - - e124f2a7 by Krzysztof Gogolewski at 2020-09-26T13:19:36-04:00 Fix handling of function coercions (#18747) This was broken when we added multiplicity to the function type. - - - - - 7ff43382 by Vladislav Zavialov at 2020-09-27T03:01:31+03:00 Comments: change outdated reference to mergeOps As of 686e06c59c3aa6b66895e8a501c7afb019b09e36, GHC.Parser.PostProcess.mergeOps no longer exists. [ci skip] - - - - - 4edf5527 by Vladislav Zavialov at 2020-09-27T10:04:12-04:00 Don't rearrange (->) in the renamer The parser produces an AST where the (->) is already associated correctly: 1. (->) has the least possible precedence 2. (->) is right-associative Thus we don't need to handle it in mkHsOpTyRn. - - - - - a9ce159b by Vladislav Zavialov at 2020-09-27T10:04:12-04:00 Remove outdated comment in rnHsTyKi This comment dates back to 3df40b7b78044206bbcffe3e2c0a57d901baf5e8 and does not seem relevant anymore. - - - - - 583a2070 by Richard Eisenberg at 2020-09-29T00:31:27-04:00 Optimize NthCo (FunCo ...) in coercion opt We were missing this case previously. Close #18528. Metric Decrease: T18223 T5321Fun - - - - - b31a3360 by Krzysztof Gogolewski at 2020-09-29T00:32:05-04:00 Linear types: fix kind inference when checking datacons - - - - - 5830a12c by Vladislav Zavialov at 2020-09-29T00:32:05-04:00 New linear types syntax: a %p -> b (#18459) Implements GHC Proposal #356 Updates the haddock submodule. - - - - - bca4d36d by Vladislav Zavialov at 2020-09-29T00:32:05-04:00 Improve error messages for (a %m) without LinearTypes Detect when the user forgets to enable the LinearTypes extension and produce a better error message. Steals the (a %m) syntax from TypeOperators, the workaround is to write (a % m) instead. - - - - - b9635d0a by Benjamin Maurer at 2020-09-29T00:32:43-04:00 Description of flag `-H` was in 'verbosity options', moved to 'misc'. Fixes #18699 - - - - - 74c797f6 by Benjamin Maurer at 2020-09-29T00:33:20-04:00 Workaround for #18623: GHC crashes bc. under rlimit for vmem it will reserve _all_ of it, leaving nothing for, e.g., thread stacks. Fix will only allocate 2/3rds and check whether remainder is at least large enough for minimum amount of thread stacks. - - - - - 4365d77a by Ryan Scott at 2020-09-29T00:33:57-04:00 Add regression test #18501 ghc/ghc!3220 ended up fixing #18501. This patch adds a regression test for #18501 to ensure that it stays fixed. - - - - - 8e3f00dd by Sylvain Henry at 2020-09-29T17:24:03+02:00 Make the parser module less dependent on DynFlags Bump haddock submodule - - - - - 3ab0d8f7 by Sebastian Graf at 2020-09-30T02:48:27-04:00 PmCheck: Long-distance information for LocalBinds (#18626) Now `desugarLocalBind` (formerly `desugarLet`) reasons about * `FunBind`s that * Have no pattern matches (so which aren't functions) * Have a singleton match group with a single GRHS * (which may have guards) * and looks through trivial post-typechecking `AbsBinds` in doing so to pick up the introduced renamings. And desugars to `PmLet` LYG-style guards. Since GRHSs are no longer denoted simply by `NonEmpty PmGRHS`, but also need to carry a `[PmGrd]` for the `PmLet`s from `LocalBind`s, I added `PmGRHSs` to capture that. Since we call out to the desugarer more often, I found that there were superfluous warnings emitted when desugaring e.g. case expressions. Thus, I made sure that we deactivate any warnings in the LYG desugaring steps by the new wrapper function `noCheckDs`. There's a regression test in `T18626`. Fixes #18626. - - - - - f8f60efc by Ben Gamari at 2020-09-30T02:49:03-04:00 testsuite: Mark T12971 as broken on Windows Due to #17945. - - - - - 6527fc57 by Ben Gamari at 2020-09-30T02:49:03-04:00 Bump Cabal, hsc2hs, directory, process submodules Necessary for recent Win32 bump. - - - - - df3f5880 by Sylvain Henry at 2020-09-30T02:49:41-04:00 Remove unsafeGlobalDynFlags (#17957, #14597) There are still global variables but only 3 booleans instead of a single DynFlags. - - - - - 9befd94d by Sylvain Henry at 2020-09-30T02:49:41-04:00 Remove unused global variables Some removed globals variables were still declared in the RTS. They were removed in the following commits: * 4fc6524a2a4a0003495a96c8b84783286f65c198 * 0dc7985663efa1739aafb480759e2e2e7fca2a36 * bbd3c399939311ec3e308721ab87ca6b9443f358 - - - - - 7c98699f by Richard Eisenberg at 2020-09-30T02:50:17-04:00 Omit redundant kind equality check in solver See updated Note [Use loose types in inert set] in GHC.Tc.Solver.Monad. Close #18753. - - - - - 39549826 by Sebastian Graf at 2020-09-30T02:50:54-04:00 Pmc: Don't call exprType on type arguments (#18767) Fixes #18767. - - - - - 235e410f by Richard Eisenberg at 2020-09-30T02:51:29-04:00 Regression test for #10709. Close #10709 - - - - - 5c32655f by Ben Gamari at 2020-09-30T22:31:55-04:00 hadrian/doc: Clarify documentation of key-value configuration - - - - - 0bb02873 by Sylvain Henry at 2020-10-01T18:34:53-04:00 Add test for T18574 - - - - - e393f213 by Sylvain Henry at 2020-10-01T18:34:53-04:00 Allow fusion with catMaybes (#18574) Metric Decrease: T18574 - - - - - d2cfad96 by Fendor at 2020-10-01T18:35:33-04:00 Add mainModuleNameIs and demote mainModIs Add `mainModuleNameIs` to DynFlags and demote `mainModIs` to function which uses the homeUnit from DynFlags it is created from. - - - - - fc351ab8 by Fendor at 2020-10-01T18:35:33-04:00 Use HomeUnit for main module without module declaration - - - - - dca1cb22 by Fendor at 2020-10-01T18:35:33-04:00 Remove mAIN completely - - - - - a5aaceec by Sylvain Henry at 2020-10-01T18:36:11-04:00 Use ADTs for parser errors/warnings Haskell and Cmm parsers/lexers now report errors and warnings using ADTs defined in GHC.Parser.Errors. They can be printed using functions in GHC.Parser.Errors.Ppr. Some of the errors provide hints with a separate ADT (e.g. to suggest to turn on some extension). For now, however, hints are not consistent across all messages. For example some errors contain the hints in the main message. I didn't want to change any message with this patch. I expect these changes to be discussed and implemented later. Surprisingly, this patch enhances performance. On CI (x86_64/deb9/hadrian, ghc/alloc): parsing001 -11.5% T13719 -2.7% MultiLayerModules -3.5% Naperian -3.1% Bump haddock submodule Metric Decrease: MultiLayerModules Naperian T13719 parsing001 - - - - - a946c7ef by Sylvain Henry at 2020-10-01T18:36:11-04:00 Less DynFlags in Header parsing - - - - - dafe7943 by Sylvain Henry at 2020-10-01T18:36:11-04:00 Parser: remove some unused imports These are not reported by GHC because Happy adds {-# OPTIONS_GHC -w #-} - - - - - 93d5de16 by Sylvain Henry at 2020-10-01T18:36:11-04:00 Don't import GHC.Unit to reduce the number of dependencies - - - - - e3655f81 by Sebastian Graf at 2020-10-01T18:36:47-04:00 Don't attach CPR signatures to NOINLINE data structures (#18154) Because the generated `KindRep`s don't have an unfolding, !3230 did not actually stop to compute, attach and serialise unnecessary CPR signatures for them. As already said in `Note [CPR for data structures]`, that leads to bloated interface files which is ultimately quadratic for Nested CPR. So we don't attach any CPR signature to bindings that * Are not thunks (because thunks are not in WHNF) * Have arity 0 (which means the top-level constructor is not a lambda) If the data structure has an unfolding, we continue to look through it. If not (as is the case for `KindRep`s), we look at the unchanged CPR signature and see `topCprType`, as expected. - - - - - ba5965eb by Richard Eisenberg at 2020-10-01T18:37:23-04:00 Add regression test for #18755. Close #18755 - - - - - a8018c17 by Vladislav Zavialov at 2020-10-01T18:37:58-04:00 Fix pretty-printing of the mult-polymorphic arrow A follow-up to !4020 (5830a12c46e7227c276a8a71213057595ee4fc04) - - - - - e5523324 by Sylvain Henry at 2020-10-01T18:38:35-04:00 Bignum: add integerNegate RULE - - - - - 1edd6d21 by Vladislav Zavialov at 2020-10-01T18:39:10-04:00 Refactor: remove rnHsDoc It did not do any useful work. - - - - - a9ae83af by Krzysztof Gogolewski at 2020-10-02T08:00:25-04:00 Fix typos in comments [skip ci] - - - - - b81350bb by Icelandjack at 2020-10-02T08:01:01-04:00 Replaced MkT1 with T1 in type signatures. - - - - - 3c9beab7 by Vladislav Zavialov at 2020-10-02T13:51:58-04:00 Minor TTG clean-up: comments, unused families, bottom 1. Fix and update section headers in GHC/Hs/Extension.hs 2. Delete the unused 'XCoreAnn' and 'XTickPragma' families 3. Avoid calls to 'panic' in 'pprStmt' - - - - - 12c06927 by Sylvain Henry at 2020-10-02T13:52:38-04:00 Bignum: implement integerRecipMod (#18427) - - - - - 8dd4f405 by Sylvain Henry at 2020-10-02T13:52:38-04:00 Bignum: implement integerPowMod (#18427) Incidentally fix powModInteger which was crashing in integer-gmp for negative exponents when the modular multiplicative inverse for the base didn't exist. Now we compute it explicitly with integerRecipMod so that every backend returns the same result without crashing. - - - - - 1033a720 by Krzysztof Gogolewski at 2020-10-02T13:53:23-04:00 Reject linearity in kinds in checkValidType (#18780) Patch taken from https://gitlab.haskell.org/ghc/ghc/-/issues/18624#note_300673 - - - - - b0ccba66 by Krzysztof Gogolewski at 2020-10-03T19:33:02-04:00 Small documentation fixes - Fix formatting of code blocks and a few sphinx warnings - Move the Void# change to 9.2, it was done right after the branch was cut - Fix typo in linear types documentation - Note that -Wincomplete-uni-patterns affects lazy patterns [skip ci] - - - - - 70dc2f09 by Karel Gardas at 2020-10-03T19:33:06-04:00 fix rts.cabal to use real arch names and not aliasses (fixes #18654) - - - - - bc5de347 by Sebastian Graf at 2020-10-05T13:59:24-04:00 Inline `integerDecodeDouble#` and constant-fold `decodeDouble_Int64#` instead Currently, `integerDecodeDouble#` is known-key so that it can be recognised in constant folding. But that is very brittle and doesn't survive worker/wrapper, which we even do for `NOINLINE` things since #13143. Also it is a trade-off: The implementation of `integerDecodeDouble#` allocates an `Integer` box that never cancels aways if we don't inline it. Hence we recognise the `decodeDouble_Int64#` primop instead in constant folding, so that we can inline `integerDecodeDouble#`. As a result, `integerDecodeDouble#` no longer needs to be known-key. While doing so, I realised that we don't constant-fold `decodeFloat_Int#` either, so I also added a RULE for it. `integerDecodeDouble` is dead, so I deleted it. Part of #18092. This improves the 32-bit `realToFrac`/`toRational`: Metric Decrease: T10359 - - - - - 802b5e6f by Krzysztof Gogolewski at 2020-10-05T13:59:33-04:00 Fix linear types in TH splices (#18465) - - - - - 18a3ddf7 by Ben Gamari at 2020-10-05T13:59:33-04:00 rts: Fix integer width in TICK_BUMP_BY Previously `TICK_BUMP_BY` was defined as ```c #define TICK_BUMP_BY(ctr,n) CLong[ctr] = CLong[ctr] + n ``` Yet the tickers themselves were defined as `StgInt`s. This happened to work out correctly on Linux, where `CLong` is 64-bits. However, it failed on Windows, where `CLong` is 32-bits, resulting in #18782. Fixes #18783. - - - - - 5fc4243b by Rachel at 2020-10-07T14:59:45-04:00 Document profiling flags, warning flags, and no-pie - - - - - b41f7c38 by Andreas Klebinger at 2020-10-07T15:00:20-04:00 WinIO: Small changes related to atomic request swaps. Move the atomix exchange over the Ptr type to an internal module. Fix a bug caused by us passing ptr-to-ptr instead of ptr to atomic exchange. Renamed interlockedExchange to exchangePtr. I've also added an cas primitive. It turned out we don't need it for WinIO but I'm leaving it in as it's useful for other things. - - - - - 948a14e1 by Ben Gamari at 2020-10-07T15:00:55-04:00 gitlab-ci: Fix name of Ubuntu 20.04 image - - - - - 74d4017b by Sylvain Henry at 2020-10-07T15:01:35-04:00 Fix -flink-rts (#18651) Before this patch -flink-rts could link with GHC's rts instead of the selected one. - - - - - 0e8b923d by Sylvain Henry at 2020-10-07T15:01:35-04:00 Apply suggestion to compiler/GHC/SysTools.hs - - - - - d6dff830 by Alan Zimmerman at 2020-10-07T15:02:10-04:00 Preserve as-parsed arrow type for HsUnrestrictedArrow When linear types are disabled, HsUnrestrictedArrow is treated as HslinearArrow. Move this adjustment into the type checking phase, so that the parsed source accurately represents the source as parsed. Closes #18791 - - - - - 030c5ce0 by Karel Gardas at 2020-10-07T15:02:48-04:00 hadrian: use stage0 linker to merge objects when done during the stage0 Fixes #18800. - - - - - a94db588 by Ben Gamari at 2020-10-07T15:03:23-04:00 testsuite: Allow whitespace before "Metric (in|de)crease" Several people have struggled with metric change annotations in their commit messages not being recognized due to the fact that GitLab's job log inserts a space at the beginning of each line. Teach the regular expression to accept this whitespace. - - - - - e91ddddd by Krzysztof Gogolewski at 2020-10-07T15:04:07-04:00 Misc cleanup * Include funTyCon in exposedPrimTyCons. Every single place using exposedPrimTyCons was adding funTyCon manually. * Remove unused synTyConResKind and ieLWrappedName * Add recordSelectorTyCon_maybe * In exprType, panic instead of giving a trace message and dummy output. This prevents #18767 reoccurring. * Fix compilation error in fragile concprog001 test (part of #18732) - - - - - 386c2d7f by Sylvain Henry at 2020-10-09T08:40:33-04:00 Use UnitId in the backend instead of Unit In Cmm we can only have real units identified with an UnitId. Other units (on-the-fly instantiated units and holes) are only used in type-checking backpack sessions that don't produce Cmm. - - - - - a566c83d by Simon Jakobi at 2020-10-09T08:41:09-04:00 Update containers to v0.6.4.1 Updates containers submodule. - - - - - fd984d68 by Tamar Christina at 2020-10-09T08:41:50-04:00 rts: fix race condition in StgCRun On windows the stack has to be allocated 4k at a time, otherwise we get a segfault. This is done by using a helper ___chkstk_ms that is provided by libgcc. The Haskell side already knows how to handle this but we need to do the same from STG. Previously we would drop the stack in StgRun but would only make it valid whenever the scheduler loop ran. This approach was fundamentally broken in that it falls apart when you take a signal from the OS. We see it less often because you initially get allocated a 1MB stack block which you have to blow past first. Concretely this means we must always keep the stack valid. Fixes #18601. - - - - - accdb24a by Sylvain Henry at 2020-10-09T08:42:31-04:00 Expose RTS-only ways (#18651) Some RTS ways are exposed via settings (ghcThreaded, ghcDebugged) but not all. It's simpler if the RTS exposes them all itself. - - - - - d360f343 by MaxGabriel at 2020-10-09T08:43:11-04:00 Document -Wderiving-typeable Tracking: #18641 - - - - - e48cab2a by Krzysztof Gogolewski at 2020-10-09T08:43:49-04:00 Add a flag to indicate that gcc supports -no-pie Fixes #17919. - - - - - f7e2fff9 by Hécate at 2020-10-09T08:44:26-04:00 Add linting of `base` to the CI - - - - - 45a1d493 by Andreas Klebinger at 2020-10-09T08:45:05-04:00 Use proper RTS flags when collecting residency in perf tests. Replace options like collect_stats(['peak_megabytes_allocated'],4) with collect_runtime_residency(4) and so forth. Reason being that the later also supplies some default RTS arguments which make sure residency does not fluctuate too much. The new flags mean we get new (hopefully more accurate) baselines so accept the stat changes. ------------------------- Metric Decrease: T4029 T4334 T7850 Metric Increase: T13218 T7436 ------------------------- - - - - - ef65b154 by Andreas Klebinger at 2020-10-09T08:45:42-04:00 testsuite/timeout: Fix windows specific errors. We now seem to use -Werror there. Which caused some long standing warnings to become errors. I applied changes to remove the warnings allowing the testsuite to run on windows as well. - - - - - e691a5a0 by Sylvain Henry at 2020-10-09T08:46:22-04:00 Hadrian: add quick-debug flavour - - - - - 12191a99 by Sylvain Henry at 2020-10-09T08:47:00-04:00 Bignum: match on small Integer/Natural Previously we only matched on *variables* whose unfoldings were a ConApp of the form `IS lit#` or `NS lit##`. But we forgot to match on the ConApp directly... As a consequence, constant folding only worked after the FloatOut pass which creates bindings for most sub-expressions. With this patch, matching on bignums works even with -O0 (see bignumMatch test). - - - - - 36787bba by Alan Zimmerman at 2020-10-09T08:47:36-04:00 ApiAnnotations : preserve parens in GADTs A cleanup in 7f418acf61e accidentally discarded some parens in ConDeclGADT. Make sure these stay in the AST in a usable format. Also ensure the AnnLolly does not get lost in a GADT. - - - - - 32dc7698 by Krzysztof Gogolewski at 2020-10-09T08:48:15-04:00 Linear types: fix roles in GADTs (#18799) - - - - - 9657f6f3 by Ben Gamari at 2020-10-09T08:48:52-04:00 sdist: Include hadrian sources in source distribution Previously the make build system's source distribution rules neglected to include Hadrian's sources. Fixes #18794. - - - - - c832f7e2 by Tamar Christina at 2020-10-09T08:49:33-04:00 winio: fixed timeouts non-threaded. - - - - - 6f0243ae by Tamar Christina at 2020-10-09T08:50:13-04:00 winio: fix array splat - - - - - 0fd3d360 by Tamar Christina at 2020-10-09T08:50:51-04:00 winio: fixed bytestring reading interface. - - - - - dfaef1ca by Tamar Christina at 2020-10-09T08:51:30-04:00 winio: fixed more data error. - - - - - bfdccac6 by Simon Peyton Jones at 2020-10-09T08:52:07-04:00 Fix desugaring of record updates on data families This fixes a long-standing bug in the desugaring of record updates for data families, when the latter involves a GADT. It's all explained in Note [Update for GADTs] in GHC.HsToCore.Expr. Building the correct cast is surprisingly tricky, as that Note explains. Fixes #18809. The test case (in indexed-types/should_compile/T18809) contains several examples that exercise the dark corners. - - - - - e5c7c9c8 by Ben Gamari at 2020-10-09T08:52:43-04:00 Bump win32-tarballs version to 0.3 This should fix #18774. - - - - - ef950b19 by Andreas Klebinger at 2020-10-09T08:53:21-04:00 Add TyCon Set/Env and use them in a few places. Firstly this improves code clarity. But it also has performance benefits as we no longer go through the name of the TyCon to get at it's unique. In order to make this work the recursion check for TyCon has been moved into it's own module in order to avoid import cycles. - - - - - fd302e93 by Krzysztof Gogolewski at 2020-10-09T08:54:02-04:00 Add -pgmlm and -optlm flags !3798 added documentation and semantics for the flags, but not parsing. - - - - - db236ffc by Sylvain Henry at 2020-10-09T08:54:41-04:00 Testsuite: increase timeout for T18223 (#18795) - - - - - 6a243e9d by Sylvain Henry at 2020-10-09T08:55:21-04:00 Cache HomeUnit in HscEnv (#17957) Instead of recreating the HomeUnit from the DynFlags every time we need it, we store it in the HscEnv. - - - - - 5884fd32 by Fendor at 2020-10-09T19:46:28+02:00 Move File Target parser to library #18596 - - - - - ea59fd4d by Hécate at 2020-10-10T14:49:59-04:00 Lint the compiler for extraneous LANGUAGE pragmas - - - - - 22f218b7 by Krzysztof Gogolewski at 2020-10-10T14:50:42-04:00 Linear types: fix quantification in GADTs (#18790) - - - - - 74ee1237 by Sylvain Henry at 2020-10-10T14:51:20-04:00 Bignum: fix bigNatCompareWord# bug (#18813) - - - - - 274e21f0 by Hécate at 2020-10-11T10:55:56+02:00 Remove the dependency on the ghc-linters stage - - - - - 990ea991 by Daniel Rogozin at 2020-10-11T22:20:04+03:00 Fall back to types when looking up data constructors (#18740) Before this patch, referring to a data constructor in a term-level context led to a scoping error: ghci> id Int <interactive>:1:4: error: Data constructor not in scope: Int After this patch, the renamer falls back to the type namespace and successfully finds the Int. It is then rejected in the type checker with a more useful error message: <interactive>:1:4: error: • Illegal term-level use of the type constructor ‘Int’ imported from ‘Prelude’ (and originally defined in ‘GHC.Types’) • In the first argument of ‘id’, namely ‘Int’ In the expression: id Int We also do this for type variables. - - - - - 9bbc84d2 by Sylvain Henry at 2020-10-12T18:21:51-04:00 DynFlags: refactor DmdAnal Make demand analysis usable without having to provide DynFlags. - - - - - 7fdcce6d by Wander Hillen at 2020-10-13T00:12:47-04:00 Initial ShortText code and conversion of package db code Metric Decrease: Naperian T10421 T10421a T10547 T12150 T12234 T12425 T13035 T18140 T18304 T5837 T6048 T13253-spj T18282 T18223 T3064 T9961 Metric Increase T13701 HFSKJH - - - - - 0a5f2918 by Sylvain Henry at 2020-10-13T00:13:28-04:00 Parser: don't require the HomeUnitId The HomeUnitId is only used by the Cmm parser and this one has access to the DynFlags, so it can grab the UnitId of the HomeUnit from them. Bump haddock submodule - - - - - 8f4f5794 by HaskellMouse at 2020-10-13T13:05:49+03:00 Unification of Nat and Naturals This commit removes the separate kind 'Nat' and enables promotion of type 'Natural' for using as type literal. It partially solves #10776 Now the following code will be successfully typechecked: data C = MkC Natural type CC = MkC 1 Before this change we had to create the separate type for promotion data C = MkC Natural data CP = MkCP Nat type CC = MkCP 1 But CP is uninhabited in terms. For backward compatibility type synonym `Nat` has been made: type Nat = Natural The user's documentation and tests have been updated. The haddock submodule also have been updated. - - - - - 0fc1cb54 by Ben Gamari at 2020-10-14T03:42:50-04:00 gitlab-ci: Verify that Hadrian builds with Stack As noted in #18726, this regularly breaks. Let's test it. Note that we don't actually perform a build of GHC itself; we merely test that the Hadrian executable builds and works (by invoking `hadrian --version`). - - - - - 89f4d8e9 by Ben Gamari at 2020-10-14T12:03:57-04:00 Bump LLVM version to 10.0 Fixes #18267. - - - - - 716385c9 by Ryan Scott at 2020-10-14T12:04:34-04:00 Make DataKinds the sole arbiter of kind-level literals (and friends) Previously, the use of kind-level literals, promoted tuples, and promoted lists required enabling both `DataKinds` and `PolyKinds`. This made sense back in a `TypeInType` world, but not so much now that `TypeInType`'s role has been superseded. Nowadays, `PolyKinds` only controls kind polymorphism, so let's make `DataKinds` the thing that controls the other aspects of `TypeInType`, which include literals, promoted tuples and promoted lists. There are some other things that overzealously required `PolyKinds`, which this patch fixes as well: * Previously, using constraints in kinds (e.g., `data T :: () -> Type`) required `PolyKinds`, despite the fact that this is orthogonal to kind polymorphism. This now requires `DataKinds` instead. * Previously, using kind annotations in kinds (e.g., `data T :: (Type :: Type) -> Type`) required both `KindSignatures` and `PolyKinds`. This doesn't make much sense, so it only requires `KindSignatures` now. Fixes #18831. - - - - - ac300a0d by Vladislav Zavialov at 2020-10-14T12:05:11-04:00 Remove "Operator sections" from docs/users_guide/bugs.rst The issue described in that section was fixed by 2b89ca5b850b4097447cc4908cbb0631011ce979 - - - - - bf2411a3 by Vladislav Zavialov at 2020-10-14T12:05:11-04:00 Fix PostfixOperators (#18151) This fixes a regression introduced in 2b89ca5b850b4097447cc4908cbb0631011ce979 See the new T18151x test case. - - - - - e60ae8a3 by Fumiaki Kinoshita at 2020-10-14T18:06:12-04:00 Add -Wnoncanonical-{monad,monoid}-instances to standardWarnings ------------------------- Metric Decrease: T12425 Metric Increase: T17516 ------------------------- - - - - - 15d2340c by Simon Peyton Jones at 2020-10-14T18:06:48-04:00 Fix some missed opportunities for preInlineUnconditionally There are two signficant changes here: * Ticket #18815 showed that we were missing some opportunities for preInlineUnconditionally. The one-line fix is in the code for GHC.Core.Opt.Simplify.Utils.preInlineUnconditionally, which now switches off only for INLINE pragmas. I expanded Note [Stable unfoldings and preInlineUnconditionally] to explain. * When doing this I discovered a way in which preInlineUnconditionally was occasionally /too/ eager. It's all explained in Note [Occurrences in stable unfoldings] in GHC.Core.Opt.OccurAnal, and the one-line change adding markAllMany to occAnalUnfolding. I also got confused about what NoUserInline meant, so I've renamed it to NoUserInlinePrag, and changed its pretty-printing slightly. That led to soem error messate wibbling, and touches quite a few files, but there is no change in functionality. I did a nofib run. As expected, no significant changes. Program Size Allocs ---------------------------------------- sphere -0.0% -0.4% ---------------------------------------- Min -0.0% -0.4% Max -0.0% +0.0% Geometric Mean -0.0% -0.0% I'm allowing a max-residency increase for T10370, which seems very irreproducible. (See comments on !4241.) There is always sampling error for max-residency measurements; and in any case the change shows up on some platforms but not others. Metric Increase: T10370 - - - - - 0c4bfed8 by Ben Gamari at 2020-10-14T18:07:25-04:00 users-guide: Add missing :ghc-flag: directive - - - - - 51c4b851 by Krzysztof Gogolewski at 2020-10-15T04:30:27-04:00 Remove Proxy# argument in Data.Typeable.Internal No longer neccessary - TypeRep is now indexed, there is no ambiguity. Also fix a comment in Evidence.hs, IsLabel no longer takes a Proxy#. - - - - - 809f09e8 by Sylvain Henry at 2020-10-15T04:31:07-04:00 Fix parsing of PIE flags -fPIE and -fno-PIE flags were (un)setting Opt_PIC instead of Opt_PIE. Original commit: 3625728a0e3a9b56c2b85ae7ea8bcabdd83ece6a - - - - - 3d7db148 by Ben Gamari at 2020-10-15T04:31:42-04:00 testsuite: Add missing #include on <stdlib.h> This otherwise fails on newer Clangs, which warn more aggressively on undeclared symbols. - - - - - 998803dc by Andrzej Rybczak at 2020-10-15T11:40:32+02:00 Add flags for annotating Generic{,1} methods INLINE[1] (#11068) Makes it possible for GHC to optimize away intermediate Generic representation for more types. Metric Increase: T12227 - - - - - 6b14c418 by GHC GitLab CI at 2020-10-15T21:57:50-04:00 Extend mAX_TUPLE_SIZE to 64 As well a ctuples and sums. - - - - - d495f36a by Ben Gamari at 2020-10-15T21:58:27-04:00 rts: Clean-up whitespace in Interpreter - - - - - cf10becd by Ben Gamari at 2020-10-15T21:58:27-04:00 compiler/ByteCode: Use strict Maps in bytecode assembler - - - - - ae146b53 by Ben Gamari at 2020-10-15T21:58:27-04:00 compiler/ByteCode: Make LocalLabel a newtype - - - - - cc536288 by Ben Gamari at 2020-10-15T21:58:27-04:00 compiler/ByteCode: Allow 2^32 local labels This widens LocalLabel to 2^16, avoiding the crash observed in #14334. Closes #14334. - - - - - 1bb0512f by Ben Gamari at 2020-10-16T00:15:31-04:00 mingw: Extract zst toolchain archives This should have been done when the toolchain was bumped. - - - - - bf7c5b6d by Ben Gamari at 2020-10-16T00:15:31-04:00 base: Reintroduce necessary LANGUAGE pragmas These were incorrectly removed in a recent cleanup commit. - - - - - c6b4be4b by Ben Gamari at 2020-10-16T00:15:31-04:00 testsuite: Sort metrics by metric type Closes #18838. - - - - - c7989c93 by Ben Gamari at 2020-10-16T00:15:31-04:00 testsuite: Account for -Wnoncanonical-monoid-instances changes on Windows - - - - - 330a5433 by Ben Gamari at 2020-10-16T00:15:31-04:00 rts: Add __mingw_vfprintf to RtsSymbols.c Following the model of the other printf symbols. See Note [Symbols for MinGW's printf]. - - - - - c4a69f37 by Ben Gamari at 2020-10-16T00:15:31-04:00 gitlab-ci: Remove allow_failure from Windows jobs - - - - - 9a9679db by Ben Gamari at 2020-10-16T00:15:31-04:00 gitlab-ci: Fix Hadrian bindist names - - - - - 07b0db86 by f-a at 2020-10-16T10:14:39-04:00 Clarify Eq documentation #18713 - - - - - aca0e63b by Ben Gamari at 2020-10-17T10:20:31-04:00 gitlab-ci: Allow doc-tarball job to fail Currently the Hadrian build appears not to package documentation correctly, causing doc-tarball to fail due to the Windows build. - - - - - b02a9ea7 by Ben Gamari at 2020-10-17T13:26:24-04:00 gitlab-ci: s/allow_newer/allow_failure Silly mistake on my part. - - - - - 59d7c9f4 by John Ericson at 2020-10-17T22:01:38-04:00 Skip type family defaults with hs-boot and hsig files Works around #17190, possible resolution for #17224. New design is is according to accepted [GHC Propoal 320]. Instances in signatures currently unconditionally opt into associated family defaults if no explicit instance is given. This is bad for two reasons: 1. It constrains possible instantiations to use the default, rather than possibly define the associated family differently. 2. It breaks compilation as type families are unsupported in signatures. This PR simply turns off the filling in of defaults in those cases. Additionally, it squelches a missing definition warning for hs-boot too that was only squelched for hsig before. The downsides are: 1. There is no way to opt into the default, other than copying its definition. 2. If we fixed type classes in signatures, and wanted instances to have to explicitly *out of* rather than into the default, that would now be a breaking change. The change that is most unambiguously goood is harmonizing the warning squelching between hs-boot or hsig. Maybe they should have the warning (opt out of default) maybe they shouldn't (opt in to default), but surely it should be the same for both. Add hs-boot version of a backpack test regarding class-specified defaults in instances that appear in an hs-boot file. The metrics increase is very slight and makes no sense --- at least no one has figured anything out after this languishing for a while, so I'm just going to accept it. Metric Increase: T10421a [GHC proposal 320]: https://github.com/ghc-proposals/ghc-proposals/pull/320 - - - - - 7eb46a09 by Sebastian Graf at 2020-10-17T22:02:13-04:00 Arity: Refactor fixed-point iteration in GHC.Core.Opt.Arity Arity analysis used to propagate optimistic arity types during fixed-point interation through the `ArityEnv`'s `ae_cheap_fun` field, which is like `GHC.Core.Utils.exprIsCheap`, but also considers the current iteration's optimistic arity, for the binder in question only. In #18793, we have seen that this is a problematic design, because it doesn't allow us to look through PAP bindings of that binder. Hence this patch refactors to a more traditional form with an explicit signature environment, in which we record the optimistic `ArityType` of the binder in question (and at the moment is the *only* binder that is recorded in the arity environment). - - - - - 6b3eb06a by Sebastian Graf at 2020-10-17T22:02:13-04:00 Arity: Record arity types for non-recursive lets In #18793, we saw a compelling example which requires us to look at non-recursive let-bindings during arity analysis and unleash their arity types at use sites. After the refactoring in the previous patch, the needed change is quite simple and very local to `arityType`'s defn for non-recurisve `Let`. Apart from that, we had to get rid of the second item of `Note [Dealing with bottoms]`, which was entirely a safety measure and hindered optimistic fixed-point iteration. Fixes #18793. The following metric increases are all caused by this commit and a result of the fact that we just do more work now: Metric Increase: T3294 T12545 T12707 - - - - - 451455fd by Sebastian Graf at 2020-10-17T22:02:13-04:00 Testsuite: Add dead arity analysis tests We didn't seem to test these old tests at all, judging from their expected output. - - - - - 50e9df49 by Dylan Yudaken at 2020-10-17T22:02:50-04:00 When using rts_setInCallCapability, lock incall threads This diff makes sure that incall threads, when using `rts_setInCallCapability`, will be created as locked. If the thread is not locked, the thread might end up being scheduled to a different capability. While this is mentioned in the docs for `rts_setInCallCapability,`, it makes the method significantly less useful as there is no guarantees on the capability being used. This commit also adds a test to make sure things stay on the correct capability. - - - - - 0b995759 by DylanZA at 2020-10-17T22:02:50-04:00 Apply suggestion to testsuite/tests/ffi/should_run/all.T - - - - - a91dcb66 by Sylvain Henry at 2020-10-17T22:04:02-04:00 Don't get host RTS ways via settings (#18651) To correctly perform a linking hack for Windows we need to link with the RTS GHC is currently using. We used to query the RTS ways via the "settings" file but it is fragile (#18651). The hack hasn't been fixed to take into account all the ways (Tracing) and it makes linking of GHC with another RTS more difficult (we need to link with another RTS and to regenerate the settings file). So this patch uses the ways reported by the RTS itself (GHC.Platform.Ways.hostWays) instead of the "settings" file. - - - - - d858a3ae by Hécate at 2020-10-17T22:04:38-04:00 Linting corrections * Bring back LANGUAGE pragmas in GHC.IO.Handle.Lock.Windows * Exclude some modules that are wrongfully reported - - - - - b5b3e34e by Vladislav Zavialov at 2020-10-19T18:16:20-04:00 Implement -Woperator-whitespace (#18834) This patch implements two related warnings: -Woperator-whitespace-ext-conflict warns on uses of infix operators that would be parsed differently were a particular GHC extension enabled -Woperator-whitespace warns on prefix, suffix, and tight infix uses of infix operators Updates submodules: haddock, containers. - - - - - 9648d680 by Sylvain Henry at 2020-10-19T18:16:58-04:00 Remove pdocPrec pdocPrec was only used in GHC.Cmm.DebugBlock.pprUnwindExpr, so remove it. OutputableP becomes a one-function class which might be better for performance. - - - - - ee5dcdf9 by Ben Gamari at 2020-10-20T00:47:54-04:00 testsuite: Add test for #18346 This was fixed by 4291bddaea3148908c55f235ee8978e1d9aa6f20. - - - - - 6c7a5c0c by Krzysztof Gogolewski at 2020-10-20T00:48:29-04:00 Minor comments, update linear types docs - Update comments: placeHolderTypeTc no longer exists "another level check problem" was a temporary comment from linear types - Use Mult type synonym (reported in #18676) - Mention multiplicity-polymorphic fields in linear types docs - - - - - 58a1ca38 by nineonine at 2020-10-20T00:49:07-04:00 Compile modules with `-fobject-code` enabled to byte-code when loaded with `*` prefix in ghci (#8042) The documentation states that when using :add and :load, the `*` prefix forces a module to be loaded as byte-code. However, this seems to be ignored when -fobject-code has been enabled. In that case, the compiled code is always used, regardless of whether the *-form is used. The idea is to consult the Targets in HscEnv and check the 'targetAllowObjCode' flag. If the flag for given module is set, then patch up DynFlags and select compilation backend accordingly. This would require a linear scan of course, but that shouldn't be too costly. - - - - - 59b08a5d by Ben Gamari at 2020-10-20T00:49:41-04:00 gitlab-ci: Rename FLAVOUR -> BUILD_FLAVOUR Previously the Hadrian jobs used the `FLAVOUR` environment variable to communicate which flavour `ci.sh` should build whereas `make` used `BUILD_FLAVOUR`. This caused unnecessary confusion. Consolidate these two. - - - - - ea736839 by Alan Zimmerman at 2020-10-20T08:35:34+01:00 API Annotations: Keep track of unicode for linear arrow notation The linear arrow can be parsed as `%1 ->` or a direct single token unicode equivalent. Make sure that this distinction is captured in the parsed AST by using IsUnicodeSyntax where it appears, and introduce a new API Annotation, AnnMult to represent its location when unicode is not used. Updated haddock submodule - - - - - cf3c3bcd by Ben Gamari at 2020-10-20T22:56:31-04:00 testsuite: Mark T12971 as fragile on Windows Due to #17945. - - - - - e2c4a947 by Vladislav Zavialov at 2020-10-21T16:00:30+03:00 Parser regression tests, close #12862 #12446 These issues were fixed by earlier parser changes, most likely related to whitespace-sensitive parsing. - - - - - 711929e6 by Simon Peyton Jones at 2020-10-23T02:42:59-04:00 Fix error message location in tcCheckPatSynDecl Ticket #18856 showed that we were failing to set the right location for an error message. Easy to fix, happily. Turns out that this also improves the error location in test T11010, which was bogus before but we had never noticed. - - - - - 730bb590 by Ben Gamari at 2020-10-23T02:43:33-04:00 cmm: Add Note reference to ForeignHint - - - - - b9d4dd9c by Ben Gamari at 2020-10-24T20:44:17-04:00 SMP.h: Add C11-style atomic operations - - - - - ccf2d4b0 by Ben Gamari at 2020-10-24T20:59:39-04:00 rts: Infrastructure for testing with ThreadSanitizer - - - - - a61f66d6 by Ben Gamari at 2020-10-24T20:59:39-04:00 rts/CNF: Initialize all bdescrs in group It seems wise and cheap to ensure that the whole bdescr of all blocks of a compact group is valid, even if most cases only look at the flags field. - - - - - 65136c13 by Ben Gamari at 2020-10-24T20:59:39-04:00 rts/Capability: Intialize interrupt field Previously this was left uninitialized. Also clarify some comments. - - - - - b3ce6aca by Ben Gamari at 2020-10-24T20:59:39-04:00 rts/Task: Make comments proper Notes - - - - - d3890ac7 by Ben Gamari at 2020-10-24T20:59:39-04:00 rts/SpinLock: Move to proper atomics This is fairly straightforward; we just needed to use relaxed operations for the PROF_SPIN counters and a release store instead of a write barrier. - - - - - ef88712f by Ben Gamari at 2020-10-24T20:59:39-04:00 rts/OSThreads: Fix data race Previously we would race on the cached processor count. Avoiding this is straightforward; just use relaxed operations. - - - - - 33a719c3 by Ben Gamari at 2020-10-24T20:59:39-04:00 rts/ClosureMaros: Use relaxed atomics - - - - - f08951fd by Ben Gamari at 2020-10-24T20:59:39-04:00 configure: Bump minimum-supported gcc version to 4.7 Since the __atomic_* builtins are not supported until gcc 4.7. Given that this version was released in 2012 I think this is acceptable. - - - - - d584923a by Ben Gamari at 2020-10-24T20:59:39-04:00 testsuite: Fix thread leak in hs_try_putmvar00[13] - - - - - bf1b0bc7 by Ben Gamari at 2020-10-24T20:59:39-04:00 rts: Introduce SET_HDR_RELEASE Also ensure that we also store the info table pointer last to ensure that the synchronization covers all stores. - - - - - 1a2e9f5e by Ben Gamari at 2020-10-24T21:00:19-04:00 gitlab-ci: Add nightly-x86_64-linux-deb9-tsan job - - - - - 58a5b0e5 by GHC GitLab CI at 2020-10-24T21:00:19-04:00 testsuite: Mark setnumcapabilities001 as broken with TSAN Due to #18808. - - - - - d9bc7dea by GHC GitLab CI at 2020-10-24T21:00:19-04:00 testsuite: Skip divbyzero and derefnull under TSAN ThreadSanitizer changes the output of these tests. - - - - - fcc42a10 by Ben Gamari at 2020-10-24T21:00:19-04:00 testsuite: Skip high memory usage tests with TSAN ThreadSanitizer significantly increases the memory footprint of tests, so much so that it can send machines into OOM. - - - - - cae4bb3e by Ben Gamari at 2020-10-24T21:00:19-04:00 testsuite: Mark hie002 as high_memory_usage This test has a peak residency of 1GByte; this is large enough to classify as "high" in my book. - - - - - dae1b86a by Ben Gamari at 2020-10-24T21:00:19-04:00 testsuite: Mark T9872[abc] as high_memory_usage These all have a maximum residency of over 2 GB. - - - - - c5a0bb22 by Ben Gamari at 2020-10-24T21:00:19-04:00 gitlab-ci: Disable documentation in TSAN build Haddock chews through enough memory to cause the CI builders to OOM and there's frankly no reason to build documentation in this job anyways. - - - - - 4cb1232e by Ben Gamari at 2020-10-24T21:00:19-04:00 TSANUtils: Ensure that C11 atomics are supported - - - - - 7ed15f7f by Ben Gamari at 2020-10-24T21:00:19-04:00 testsuite: Mark T3807 as broken with TSAN Due to #18883. - - - - - f7e6f012 by Ben Gamari at 2020-10-24T21:00:19-04:00 testsuite: Mark T13702 as broken with TSAN due to #18884 - - - - - 16b136b0 by Ben Gamari at 2020-10-24T21:00:36-04:00 rts: Factor out logic to identify a good capability for running a task Not only does this make the control flow a bit clearer but it also allows us to add a TSAN suppression on this logic, which requires (harmless) data races. - - - - - 2781d68c by Ben Gamari at 2020-10-24T21:00:36-04:00 rts: Annotate benign race in waitForCapability - - - - - f6b4b492 by Ben Gamari at 2020-10-24T21:00:36-04:00 rts: Clarify locking behavior of releaseCapability_ - - - - - 65219810 by Ben Gamari at 2020-10-24T21:00:36-04:00 rts: Add assertions for task ownership of capabilities - - - - - 31fa87ec by Ben Gamari at 2020-10-24T21:00:36-04:00 rts: Use relaxed atomics on n_returning_tasks This mitigates the warning of a benign race on n_returning_tasks in shouldYieldCapability. See #17261. - - - - - 6517a2ea by Ben Gamari at 2020-10-24T21:00:36-04:00 rts: Mitigate races in capability interruption logic - - - - - 2e9ba3f2 by Ben Gamari at 2020-10-24T21:00:36-04:00 rts/Capability: Use relaxed operations for last_free_capability - - - - - e10dde37 by Ben Gamari at 2020-10-24T21:00:37-04:00 rts: Use relaxed operations for cap->running_task (TODO) This shouldn't be necessary since only the owning thread of the capability should be touching this. - - - - - 855325cd by Ben Gamari at 2020-10-24T21:00:37-04:00 rts/Schedule: Use relaxed operations for sched_state - - - - - 811f915d by Ben Gamari at 2020-10-24T21:00:37-04:00 rts: Accept data race in work-stealing implementation This race is okay since the task is owned by the capability pushing it. By Note [Ownership of Task] this means that the capability is free to write to `task->cap` without taking `task->lock`. Fixes #17276. - - - - - 8d2b3c3d by Ben Gamari at 2020-10-24T21:00:37-04:00 rts: Eliminate data races on pending_sync - - - - - f8871018 by Ben Gamari at 2020-10-24T21:00:37-04:00 rts/Schedule: Eliminate data races on recent_activity We cannot safely use relaxed atomics here. - - - - - d079b943 by Ben Gamari at 2020-10-24T21:00:37-04:00 rts: Avoid data races in message handling - - - - - 06f80497 by Ben Gamari at 2020-10-24T21:00:37-04:00 rts/Messages: Drop incredibly fishy write barrier executeMessage previously had a write barrier at the beginning of its loop apparently in an attempt to synchronize with another thread's writes to the Message. I would guess that the author had intended to use a load barrier here given that there are no globally-visible writes done in executeMessage. I've removed the redundant barrier since the necessary load barrier is now provided by the ACQUIRE_LOAD. - - - - - d4a87779 by Ben Gamari at 2020-10-24T21:00:38-04:00 rts/ThreadPaused: Avoid data races - - - - - 56778ab3 by Ben Gamari at 2020-10-24T21:00:38-04:00 rts/Schedule: Eliminate data races in run queue management - - - - - 086521f7 by Ben Gamari at 2020-10-24T21:00:38-04:00 rts: Eliminate shutdown data race on task counters - - - - - abad9778 by Ben Gamari at 2020-10-24T21:00:38-04:00 rts/Threads: Avoid data races (TODO) Replace barriers with appropriate ordering. Drop redundant barrier in tryWakeupThread (the RELEASE barrier will be provided by sendMessage's mutex release). We use relaxed operations on why_blocked and the stack although it's not clear to me why this is necessary. - - - - - 2f56be8a by Ben Gamari at 2020-10-24T21:00:39-04:00 rts/Messages: Annotate benign race - - - - - 7c0cdab1 by Ben Gamari at 2020-10-24T21:00:39-04:00 rts/RaiseAsync: Synchronize what_next read - - - - - 6cc2a8a5 by Ben Gamari at 2020-10-24T21:00:39-04:00 rts/Task: Move debugTrace to avoid data race Specifically, we need to hold all_tasks_mutex to read taskCount. - - - - - bbaec97d by Ben Gamari at 2020-10-24T21:00:39-04:00 Disable flawed assertion - - - - - dd175a92 by Ben Gamari at 2020-10-24T21:00:39-04:00 Document schedulePushWork race - - - - - 3416244b by Ben Gamari at 2020-10-24T21:00:40-04:00 Capabiliity: Properly fix data race on n_returning_tasks There is a real data race but can be made safe by using proper atomic (but relaxed) accesses. - - - - - dffd9432 by Ben Gamari at 2020-10-24T21:00:40-04:00 rts: Make write of to_cap->inbox atomic This is necessary since emptyInbox may read from to_cap->inbox without taking cap->lock. - - - - - 1f4cbc29 by Ben Gamari at 2020-10-24T21:00:57-04:00 rts/BlockAlloc: Use relaxed operations - - - - - d0d07cff by Ben Gamari at 2020-10-24T21:00:57-04:00 rts: Rework handling of mutlist scavenging statistics - - - - - 9e5c7f6d by Ben Gamari at 2020-10-24T21:00:57-04:00 rts: Avoid data races in StablePtr implementation This fixes two potentially problematic data races in the StablePtr implementation: * We would fail to RELEASE the stable pointer table when enlarging it, causing other cores to potentially see uninitialized memory. * We would fail to ACQUIRE when dereferencing a stable pointer. - - - - - 316add67 by Ben Gamari at 2020-10-24T21:00:57-04:00 rts/Storage: Use atomics - - - - - 5c23bc4c by Ben Gamari at 2020-10-24T21:00:58-04:00 rts/Updates: Use proper atomic operations - - - - - 3d0f033c by Ben Gamari at 2020-10-24T21:00:58-04:00 rts/Weak: Eliminate data races By taking all_tasks_mutex in stat_exit. Also better-document the fact that the task statistics are protected by all_tasks_mutex. - - - - - edb4b92b by Ben Gamari at 2020-10-24T21:01:18-04:00 rts/WSDeque: Rewrite with proper atomics After a few attempts at shoring up the previous implementation, I ended up turning to the literature and now use the proven implementation, > N.M. Lê, A. Pop, A.Cohen, and F.Z. Nardelli. "Correct and Efficient > Work-Stealing for Weak Memory Models". PPoPP'13, February 2013, > ACM 978-1-4503-1922/13/02. Note only is this approach formally proven correct under C11 semantics but it is also proved to be a bit faster in practice. - - - - - d39bbd3d by Ben Gamari at 2020-10-24T21:01:33-04:00 rts: Use relaxed atomics for whitehole spin stats - - - - - 8f802f38 by Ben Gamari at 2020-10-24T21:01:33-04:00 rts: Avoid lock order inversion during fork Fixes #17275. - - - - - cef667b0 by GHC GitLab CI at 2020-10-24T21:01:34-04:00 rts: Use proper relaxe operations in getCurrentThreadCPUTime Here we are doing lazy initialization; it's okay if we do the check more than once, hence relaxed operation is fine. - - - - - 8cf50eb1 by Ben Gamari at 2020-10-24T21:01:54-04:00 rts/STM: Use atomics This fixes a potentially harmful race where we failed to synchronize before looking at a TVar's current_value. Also did a bit of refactoring to avoid abstract over management of max_commits. - - - - - 88a7ce38 by Ben Gamari at 2020-10-24T21:01:54-04:00 rts/stm: Strengthen orderings to SEQ_CST instead of volatile Previously the `current_value`, `first_watch_queue_entry`, and `num_updates` fields of `StgTVar` were marked as `volatile` in an attempt to provide strong ordering. Of course, this isn't sufficient. We now use proper atomic operations. In most of these cases I strengthen the ordering all the way to SEQ_CST although it's possible that some could be weakened with some thought. - - - - - f97c59ce by Ben Gamari at 2020-10-24T21:02:11-04:00 Mitigate data races in event manager startup/shutdown - - - - - c7c3f8aa by Ben Gamari at 2020-10-24T21:02:22-04:00 rts: Accept benign races in Proftimer - - - - - 5a98dfca by Ben Gamari at 2020-10-24T21:02:22-04:00 rts: Pause timer while changing capability count This avoids #17289. - - - - - 01d95525 by Ben Gamari at 2020-10-24T21:02:22-04:00 Fix #17289 - - - - - 9a528985 by Ben Gamari at 2020-10-24T21:02:23-04:00 suppress #17289 (ticker) race - - - - - 1726ec41 by Ben Gamari at 2020-10-24T21:02:23-04:00 rts: Fix timer initialization Previously `initScheduler` would attempt to pause the ticker and in so doing acquire the ticker mutex. However, initTicker, which is responsible for initializing said mutex, hadn't been called yet. - - - - - bfbe4366 by Ben Gamari at 2020-10-24T21:02:23-04:00 rts: Fix races in Pthread timer backend shudown We can generally be pretty relaxed in the barriers here since the timer thread is a loop. - - - - - 297acc71 by Ben Gamari at 2020-10-24T21:02:44-04:00 rts/Stats: Hide a few unused unnecessarily global functions - - - - - 9ad51bc9 by David Beacham at 2020-10-27T13:59:35-04:00 Fix `instance Bounded a => Bounded (Down a)` (#18716) * Flip `minBound` and `maxBound` to respect the change in ordering * Remove awkward `Enum` (and hence `Integral`) instances for `Data.Ord.Down` * Update changelog - - - - - eedec53d by Vladislav Zavialov at 2020-10-27T14:00:11-04:00 Version bump: base-4.16 (#18712) Also bumps upper bounds on base in boot libraries (incl. submodules). - - - - - 412018c1 by Tamar Christina at 2020-10-27T14:00:49-04:00 winio: simplify logic remove optimization step. - - - - - 4950dd07 by Ben Gamari at 2020-10-27T14:01:24-04:00 hadrian: Suppress xelatex output unless it fails As noted in #18835, xelatex produces an absurd amount of output, nearly all of which is meaningless. Silence this. Fixes #18835. - - - - - f3d8ab2e by Ben Gamari at 2020-10-27T14:02:00-04:00 build system: Clean mingw tarballs Tamar noticed in !4293 that the build systems fail to clean up the mingw tarballs directory (`ghc-tarballs`). Fix this in both the make build system and Hadrian. - - - - - 0b3d23af by Simon Peyton Jones at 2020-10-27T14:02:34-04:00 Fix two constraint solving problems This patch fixes two problems in the constraint solver. * An actual bug #18555: we were floating out a constraint to eagerly, and that was ultimately fatal. It's explained in Note [Do not float blocked constraints] in GHC.Core.Constraint. This is all very delicate, but it's all going to become irrelevant when we stop floating constraints (#17656). * A major performance infelicity in the flattener. When flattening (ty |> co) we *never* generated Refl, even when there was nothing at all to do. Result: we would gratuitously rewrite the constraint to exactly the same thing, wasting work. Described in #18413, and came up again in #18855. Solution: exploit the special case by calling the new function castCoercionKind1. See Note [castCoercionKind1] in GHC.Core.Coercion - - - - - f76c5a08 by Sergei Trofimovich at 2020-10-27T14:03:14-04:00 ghc.mk: amend 'make sdist' Noticed 'make sdist' failure seen as: ``` "rm" -rf sdistprep/ghc/ghc-9.1.0.20201020/hadrian/_build/ (SRC_DIST_GHC_DIR)/hadrian/dist-newstyle/ /bin/sh: -c: line 0: syntax error near unexpected token `(' ``` commit 9657f6f34 ("sdist: Include hadrian sources in source distribution") added a new cleanup path without a variable expantion. The change adds variable reference. While at it move directory cleanup to a separate statement. Amends #18794 Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - 78b52c88 by David Eichmann at 2020-10-27T14:03:51-04:00 Use config.run_ways for multi_compile_and_run tests - - - - - e3fdd419 by Alan Zimmerman at 2020-10-27T14:04:26-04:00 Api Annotations: Introduce AnnPercent for HsExplicitMult For the case foo :: a %p -> b The location of the '%' is captured, separate from the 'p' - - - - - d2a25f42 by Ben Gamari at 2020-10-27T14:05:02-04:00 gitlab-ci: Bump ci-images Bumps bootstrap compiler to 8.10.1. - - - - - 28f98b01 by Sebastian Graf at 2020-10-27T14:05:37-04:00 DmdAnal: Kill `is_thunk` case in `splitFV` The `splitFV` function implements the highly dubious hack described in `Note [Lazy und unleashable free variables]` in GHC.Core.Opt.DmdAnal. It arranges it so that demand signatures only carry strictness info on free variables. Usage info is released through other means, see the Note. It's purely for analysis performance reasons. It turns out that `splitFV` has a quite involved case for thunks that produces slightly different usage signatures and it's not clear why we need it: `splitFV` is only relevant in the LetDown case and the only time we call it on thunks is for top-level or local recursive thunks. Since usage signatures of top-level thunks can only reference other top-level bindings and we completely discard demand info we have on top-level things (see the lack of `setIdDemandInfo` in `dmdAnalTopBind`), the `is_thunk` case is completely irrelevant here. For local, recursive thunks, the added benefit of the `is_thunk` test is marginal: We get used-multiple-times in some cases where previously we had used-once if a recursive thunk has multiple call sites. It's very unlikely and not a case to optimise for. So we kill the `is_thunk` case and inline `splitFV` at its call site, exposing `isWeakDmd` from `GHC.Types.Demand` instead. The NoFib summary supports this decision: ``` Min 0.0% -0.0% Max 0.0% +0.0% Geometric Mean -0.0% -0.0% ``` - - - - - 60322f93 by Ben Gamari at 2020-10-28T21:11:39-04:00 hadrian: Don't quote metric baseline argument Previously this was quoted inappropriately. - - - - - c85eb372 by Alan Zimmerman at 2020-10-28T21:12:15-04:00 API Annotations: put constructors in alphabetical order - - - - - 795908dc by John Ericson at 2020-10-29T03:53:14-04:00 Widen acceptance threshold for T10421a Progress towards #18842. As @sgraf812 points out, widening the window is dangerous until the exponential described in #17658 is fixed. But this test has caused enough misery and is low stakes enough that we and @bgamari think it's worth it in this one case for the time being. - - - - - 0e9f6def by Sylvain Henry at 2020-10-29T03:53:52-04:00 Split GHC.Driver.Types I was working on making DynFlags stateless (#17957), especially by storing loaded plugins into HscEnv instead of DynFlags. It turned out to be complicated because HscEnv is in GHC.Driver.Types but LoadedPlugin isn't: it is in GHC.Driver.Plugins which depends on GHC.Driver.Types. I didn't feel like introducing yet another hs-boot file to break the loop. Additionally I remember that while we introduced the module hierarchy (#13009) we talked about splitting GHC.Driver.Types because it contained various unrelated types and functions, but we never executed. I didn't feel like making GHC.Driver.Types bigger with more unrelated Plugins related types, so finally I bit the bullet and split GHC.Driver.Types. As a consequence this patch moves a lot of things. I've tried to put them into appropriate modules but nothing is set in stone. Several other things moved to avoid loops. * Removed Binary instances from GHC.Utils.Binary for random compiler things * Moved Typeable Binary instances into GHC.Utils.Binary.Typeable: they import a lot of things that users of GHC.Utils.Binary don't want to depend on. * put everything related to Units/Modules under GHC.Unit: GHC.Unit.Finder, GHC.Unit.Module.{ModGuts,ModIface,Deps,etc.} * Created several modules under GHC.Types: GHC.Types.Fixity, SourceText, etc. * Split GHC.Utils.Error (into GHC.Types.Error) * Finally removed GHC.Driver.Types Note that this patch doesn't put loaded plugins into HscEnv. It's left for another patch. Bump haddock submodule - - - - - 22f5d9a9 by Sylvain Henry at 2020-10-29T03:53:52-04:00 GC: Avoid data race (#18717, #17964) - - - - - 2ef2fac4 by Ryan Scott at 2020-10-29T04:18:52-04:00 Check for large tuples more thoroughly This fixes #18723 by: * Moving the existing `GHC.Tc.Gen.HsType.bigConstraintTuple` validity check to `GHC.Rename.Utils.checkCTupSize` for consistency with `GHC.Rename.Utils.checkTupSize`, and * Using `check(C)TupSize` when checking tuple _types_, in addition to checking names, expressions, and patterns. Note that I put as many of these checks as possible in the typechecker so that GHC can properly distinguish between boxed and constraint tuples. The exception to this rule is checking names, which I perform in the renamer (in `GHC.Rename.Env`) so that we can rule out `(,, ... ,,)` and `''(,, ... ,,)` alike in one fell swoop. While I was in town, I also removed the `HsConstraintTuple` and `HsBoxedTuple` constructors of `HsTupleSort`, which are functionally unused. This requires a `haddock` submodule bump. - - - - - 7f8be3eb by Richard Eisenberg at 2020-10-29T22:08:13-04:00 Remove unnecessary gender from comments/docs While, say, alternating "he" and "she" in sequential writing may be nicer than always using "they", reading code/documentation is almost never sequential. If this small change makes individuals feel more welcome in GHC's codebase, that's a good thing. - - - - - aad1f803 by Ben Gamari at 2020-10-30T00:41:14-04:00 rts/GC: Use atomics - - - - - d0bc0517 by Ben Gamari at 2020-10-30T00:41:14-04:00 rts: Use RELEASE ordering in unlockClosure - - - - - d44f5232 by Ben Gamari at 2020-10-30T00:41:14-04:00 rts/Storage: Accept races on heap size counters - - - - - 4e4a7386 by Ben Gamari at 2020-10-30T00:41:14-04:00 rts: Join to concurrent mark thread during shutdown Previously we would take all capabilities but fail to join on the thread itself, potentially resulting in a leaked thread. - - - - - a80cc857 by GHC GitLab CI at 2020-10-30T00:41:14-04:00 rts: Fix race in GC CPU time accounting Ensure that the GC leader synchronizes with workers before calling stat_endGC. - - - - - 9902d9ec by Viktor Dukhovni at 2020-10-30T05:28:30-04:00 [skip ci] Fix typo in `callocBytes` haddock. - - - - - 105d43db by Ben Gamari at 2020-10-30T14:02:19-04:00 rts/SpinLock: Separate out slow path Not only is this in general a good idea, but it turns out that GCC unrolls the retry loop, resulting is massive code bloat in critical parts of the RTS (e.g. `evacuate`). - - - - - f7b45cde by Ben Gamari at 2020-10-30T14:02:19-04:00 rts: Use relaxed ordering on spinlock counters - - - - - 31fcb55f by Ryan Scott at 2020-10-30T18:52:50-04:00 Split HsConDecl{H98,GADT}Details Haskell98 and GADT constructors both use `HsConDeclDetails`, which includes `InfixCon`. But `InfixCon` is never used for GADT constructors, which results in an awkward unrepresentable state. This removes the unrepresentable state by: * Renaming the existing `HsConDeclDetails` synonym to `HsConDeclH98Details`, which emphasizes the fact that it is now only used for Haskell98-style data constructors, and * Creating a new `HsConDeclGADTDetails` data type with `PrefixConGADT` and `RecConGADT` constructors that closely resemble `PrefixCon` and `InfixCon` in `HsConDeclH98Details`. The key difference is that `HsConDeclGADTDetails` lacks any way to represent infix constructors. The rest of the patch is refactoring to accommodate the new structure of `HsConDecl{H98,GADT}Details`. Some highlights: * The `getConArgs` and `hsConDeclArgTys` functions have been removed, as there is no way to implement these functions uniformly for all `ConDecl`s. For the most part, their previous call sites now pattern match on the `ConDecl`s directly and do different things for `ConDeclH98`s and `ConDeclGADT`s. I did introduce one new function to make the transition easier: `getRecConArgs_maybe`, which extracts the arguments from a `RecCon(GADT)`. This is still possible since `RecCon(GADT)`s still use the same representation in both `HsConDeclH98Details` and `HsConDeclGADTDetails`, and since the pattern that `getRecConArgs_maybe` implements is used in several places, I thought it worthwhile to factor it out into its own function. * Previously, the `con_args` fields in `ConDeclH98` and `ConDeclGADT` were both of type `HsConDeclDetails`. Now, the former is of type `HsConDeclH98Details`, and the latter is of type `HsConDeclGADTDetails`, which are distinct types. As a result, I had to rename the `con_args` field in `ConDeclGADT` to `con_g_args` to make it typecheck. A consequence of all this is that the `con_args` field is now partial, so using `con_args` as a top-level field selector is dangerous. (Indeed, Haddock was using `con_args` at the top-level, which caused it to crash at runtime before I noticed what was wrong!) I decided to add a disclaimer in the 9.2.1 release notes to advertise this pitfall. Fixes #18844. Bumps the `haddock` submodule. - - - - - 57c3db96 by Ryan Scott at 2020-10-31T02:53:55-04:00 Make typechecker equality consider visibility in ForAllTys Previously, `can_eq_nc'` would equate `ForAllTy`s regardless of their `ArgFlag`, including `forall i -> i -> Type` and `forall i. i -> Type`! To fix this, `can_eq_nc'` now uses the `sameVis` function to first check if the `ArgFlag`s are equal modulo specificity. I have also updated `tcEqType`'s implementation to match this behavior. For more explanation on the "modulo specificity" part, see the new `Note [ForAllTy and typechecker equality]` in `GHC.Tc.Solver.Canonical`. While I was in town, I fixed some related documentation issues: * I added `Note [Typechecker equality]` to `GHC.Tc.Utils.TcType` to describe what exactly distinguishes `can_eq_nc'` and `tcEqType` (which implement typechecker equality) from `eqType` (which implements definitional equality, which does not care about the `ArgFlags` of `ForAllTy`s at all). * The User's Guide had some outdated prose on the specified/inferred distinction being different for types and kinds, a holdover from #15079. This is no longer the case on today's GHC, so I removed this prose, added some new prose to take its place, and added a regression test for the programs in #15079. * The User's Guide had some _more_ outdated prose on inferred type variables not being allowed in `default` type signatures for class methods, which is no longer true as of the resolution of #18432. * The related `Note [Deferred Unification]` was being referenced as `Note [Deferred unification]` elsewhere, which made it harder to `grep` for. I decided to change the name of the Note to `Deferred unification` for consistency with the capitalization style used for most other Notes. Fixes #18863. - - - - - a98593f0 by Sylvain Henry at 2020-10-31T02:54:34-04:00 Refactor numeric constant folding rules Avoid the use of global pattern synonyms. 1) I think it's going to be helpful to implement constant folding for other numeric types, especially Natural which doesn't have a wrapping behavior. We'll have to refactor these rules even more so we'd better make them less cryptic. 2) It should also be slightly faster because global pattern synonyms matched operations for every numeric types instead of the current one: e.g., ":**:" pattern was matching multiplication for both Int# and Word# types. As we will probably want to implement constant folding for other numeric types (Int8#, Int16#, etc.), it is more efficient to only match primops for a given type as we do now. - - - - - 730ef38f by Sylvain Henry at 2020-10-31T02:54:34-04:00 Simplify constant-folding (#18032) See #18032 for the details. * Use `Lit (LitNumber _ i)` instead of `isLitValue_maybe` which does more work but that is not needed for constant-folding * Don't export `GHC.Types.Literal.isLitValue_maybe` * Kill `GHC.Types.Literal.isLitValue` which isn't used - - - - - d5a53c1a by Ben Gamari at 2020-10-31T02:55:10-04:00 primops.txt.pp: Move ByteArray# primops to separate file This file will be generated. - - - - - b4278a41 by Ben Gamari at 2020-10-31T02:55:10-04:00 primops: Generate ByteArray# index/read/write primops Previously these were mostly undocumented and was ripe for potential inconsistencies. - - - - - 08e6993a by Sylvain Henry at 2020-10-31T02:55:50-04:00 Move loadDecl into IfaceToCore - - - - - cb1f755c by Tamar Christina at 2020-10-31T09:26:56-04:00 winio: Fix unused variables warnings - - - - - eb368078 by Andrzej Rybczak at 2020-10-31T09:27:34-04:00 Add testcase for #816 - - - - - bd4abdc9 by Ben Gamari at 2020-11-01T01:10:31-04:00 testsuite: Add performance test for #18698 - - - - - dfd27445 by Hécate at 2020-11-01T01:11:09-04:00 Add the proper HLint rules and remove redundant keywords from compiler - - - - - ce1bb995 by Hécate at 2020-11-01T08:52:08-05:00 Fix a leak in `transpose` This patch was authored by David Feuer <david.feuer at gmail.com> - - - - - e63db32c by Ben Gamari at 2020-11-01T08:52:44-05:00 Scav: Use bd->gen_no instead of bd->gen->no This potentially saves a cache miss per scavenge. - - - - - b1dda153 by Ben Gamari at 2020-11-01T12:58:36-05:00 rts/Stats: Protect with mutex While on face value this seems a bit heavy, I think it's far better than enforcing ordering on every access. - - - - - 5c2e6bce by Ben Gamari at 2020-11-01T12:58:36-05:00 rts: Tear down stats_mutex after exitHeapProfiling Since the latter wants to call getRTSStats. - - - - - ef25aaa1 by Ben Gamari at 2020-11-01T13:02:11-05:00 rts: Annotate hopefully "benign" races in freeGroup - - - - - 3a181553 by Ben Gamari at 2020-11-01T13:02:18-05:00 Strengthen ordering in releaseGCThreads - - - - - af474f62 by Ben Gamari at 2020-11-01T13:05:38-05:00 Suppress data race due to close This suppresses the other side of a race during shutdown. - - - - - b4686bff by Ben Gamari at 2020-11-01T13:09:59-05:00 Merge branch 'wip/tsan/ci' into wip/tsan/all - - - - - b8e66e0e by Ben Gamari at 2020-11-01T13:10:01-05:00 Merge branch 'wip/tsan/storage' into wip/tsan/all - - - - - 375512cf by Ben Gamari at 2020-11-01T13:10:02-05:00 Merge branch 'wip/tsan/wsdeque' into wip/tsan/all - - - - - 65ebf07e by Ben Gamari at 2020-11-01T13:10:03-05:00 Merge branch 'wip/tsan/misc' into wip/tsan/all - - - - - 55c375d0 by Ben Gamari at 2020-11-01T13:10:04-05:00 Merge branch 'wip/tsan/stm' into wip/tsan/all - - - - - a9f75fe2 by Ben Gamari at 2020-11-01T13:10:06-05:00 Merge branch 'wip/tsan/event-mgr' into wip/tsan/all - - - - - 8325d658 by Ben Gamari at 2020-11-01T13:10:24-05:00 Merge branch 'wip/tsan/timer' into wip/tsan/all - - - - - 07e82ba5 by Ben Gamari at 2020-11-01T13:10:35-05:00 Merge branch 'wip/tsan/stats' into wip/tsan/all - - - - - 4ce2f7d6 by GHC GitLab CI at 2020-11-02T23:45:06-05:00 testsuite: Add --top flag to driver This allows us to make `config.top` a proper Path. Previously it was a str, which caused the Ghostscript detection logic to break. - - - - - 0b772221 by Ben Gamari at 2020-11-02T23:45:42-05:00 Document that ccall convention doesn't support varargs We do not support foreign "C" imports of varargs functions. While this works on amd64, in general the platform's calling convention may need more type information that our Cmm representation can currently provide. For instance, this is the case with Darwin's AArch64 calling convention. Document this fact in the users guide and fix T5423 which makes use of a disallowed foreign import. Closes #18854. - - - - - 81006a06 by David Eichmann at 2020-11-02T23:46:19-05:00 RtsAPI: pause and resume the RTS The `rts_pause` and `rts_resume` functions have been added to `RtsAPI.h` and allow an external process to completely pause and resume the RTS. Co-authored-by: Sven Tennie <sven.tennie at gmail.com> Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> Co-authored-by: Ben Gamari <bgamari.foss at gmail.com> - - - - - bfb1e272 by Ryan Scott at 2020-11-02T23:46:55-05:00 Display results of GHC.Core.Lint.lint* functions consistently Previously, the functions in `GHC.Core.Lint` used a patchwork of different ways to display Core Lint errors: * `lintPassResult` (which is the source of most Core Lint errors) renders Core Lint errors with a distinctive banner (e.g., `*** Core Lint errors : in result of ... ***`) that sets them apart from ordinary GHC error messages. * `lintAxioms`, in contrast, uses a completely different code path that displays Core Lint errors in a rather confusing manner. For example, the program in #18770 would give these results: ``` Bug.hs:1:1: error: Bug.hs:12:1: warning: Non-*-like kind when *-like expected: RuntimeRep when checking the body of forall: 'TupleRep '[r] In the coercion axiom Bug.N:T :: []. Bug.T ~_R Any Substitution: [TCvSubst In scope: InScope {r} Type env: [axl :-> r] Co env: []] | 1 | {-# LANGUAGE DataKinds #-} | ^ ``` * Further digging reveals that `GHC.IfaceToCore` displays Core Lint errors for iface unfoldings as though they were a GHC panic. See, for example, this excerpt from #17723: ``` ghc: panic! (the 'impossible' happened) (GHC version 8.8.2 for x86_64-unknown-linux): Iface Lint failure In interface for Lib ... ``` This patch makes all of these code paths display Core Lint errors and warnings consistently. I decided to adopt the conventions that `lintPassResult` currently uses, as they appear to have been around the longest (and look the best, in my subjective opinion). We now use the `displayLintResult` function for all three scenarios mentioned above. For example, here is what the Core Lint error for the program in #18770 looks like after this patch: ``` [1 of 1] Compiling Bug ( Bug.hs, Bug.o ) *** Core Lint errors : in result of TcGblEnv axioms *** Bug.hs:12:1: warning: Non-*-like kind when *-like expected: RuntimeRep when checking the body of forall: 'TupleRep '[r_axn] In the coercion axiom N:T :: []. T ~_R Any Substitution: [TCvSubst In scope: InScope {r_axn} Type env: [axn :-> r_axn] Co env: []] *** Offending Program *** axiom N:T :: T = Any -- Defined at Bug.hs:12:1 *** End of Offense *** <no location info>: error: Compilation had errors ``` Fixes #18770. - - - - - a9e5f52c by Simon Peyton Jones at 2020-11-02T23:47:31-05:00 Expand type synonyms with :kind! The User's Guide claims that `:kind!` should expand type synonyms, but GHCi wasn't doing this in practice. Let's just update the implementation to match the specification in the User's Guide. Fixes #13795. Fixes #18828. Co-authored-by: Ryan Scott <ryan.gl.scott at gmail.com> - - - - - 1370eda7 by Ben Gamari at 2020-11-02T23:48:06-05:00 hadrian: Don't capture RunTest output There are a few reasons why capturing the output of the RunTest builder is undesirable: * there is a large amount of output which then gets unnecessarily duplicated by Hadrian if the builder fails * the output may contain codepoints which are unrepresentable in the current codepage on Windows, causing Hadrian to crash * capturing the output causes the testsuite driver to disable its colorisation logic, making the output less legible. - - - - - 78f2767d by Matthew Pickering at 2020-11-03T17:39:53-05:00 Update inlining flags documentation - - - - - 14ce454f by Sylvain Henry at 2020-11-03T17:40:34-05:00 Linker: reorganize linker related code Move linker related code into GHC.Linker. Previously it was scattered into GHC.Unit.State, GHC.Driver.Pipeline, GHC.Runtime.Linker, etc. Add documentation in GHC.Linker - - - - - 616bec0d by Alan Zimmerman at 2020-11-03T17:41:10-05:00 Restrict Linear arrow %1 to exactly literal 1 only This disallows `a %001 -> b`, and makes sure the type literal is printed from its SourceText so it is clear why. Closes #18888 - - - - - 3486ebe6 by Sylvain Henry at 2020-11-03T17:41:48-05:00 Hadrian: don't fail if ghc-tarballs dir doesn't exist - - - - - 37f0434d by Sylvain Henry at 2020-11-03T17:42:26-05:00 Constant-folding: don't pass through GHC's Int/Word (fix #11704) Constant-folding rules for integerToWord/integerToInt were performing the following coercions at compilation time: integerToWord: target's Integer -> ghc's Word -> target's Word integerToInt : target's Integer -> ghc's Int -> target's Int 1) It was wrong for cross-compilers when GHC's word size is smaller than the target one. This patch avoids passing through GHC's word-sized types: integerToWord: target's Integer -> ghc's Integer -> target's Word integerToInt : target's Integer -> ghc's Integer -> target's Int 2) Additionally we didn't wrap the target word/int literal to make it fit into the target's range! This broke the invariant of literals only containing values in range. The existing code is wrong only with a 64-bit cross-compiling GHC, targeting a 32-bit platform, and performing constant folding on a literal that doesn't fit in a 32-bit word. If GHC was built with DEBUG, the assertion in GHC.Types.Literal.mkLitWord would fail. Otherwise the bad transformation would go unnoticed. - - - - - bff74de7 by Sylvain Henry at 2020-11-03T17:43:03-05:00 Bignum: make GMP's bignat_add not recursive bignat_add was a loopbreaker with an INLINE pragma (spotted by @mpickering). This patch makes it non recursive to avoid the issue. - - - - - bb100805 by Andreas Klebinger at 2020-11-04T16:47:24-05:00 NCG: Fix 64bit int comparisons on 32bit x86 We no compare these by doing 64bit subtraction and checking the resulting flags. We used to do this differently but the old approach was broken when the high bits compared equal and the comparison was one of >= or <=. The new approach should be both correct and faster. - - - - - b790b7f9 by Andreas Klebinger at 2020-11-04T16:47:59-05:00 Testsuite: Support for user supplied package dbs We can now supply additional package dbs to the testsuite. For make the package db can be supplied by passing PACKAGE_DB=/path/to/db. In the testsuite driver it's passed via the --test-package-db argument. - - - - - 81560981 by Sylvain Henry at 2020-11-04T16:48:42-05:00 Don't use LEA with 8-bit registers (#18614) - - - - - 17d5c518 by Viktor Dukhovni at 2020-11-05T00:50:23-05:00 Naming, value types and tests for Addr# atomics The atomic Exchange and CAS operations on integral types are updated to take and return more natural `Word#` rather than `Int#` values. These are bit-block not arithmetic operations, and the sign bit plays no special role. Standardises the names to `atomic<OpType><ValType>Addr#`, where `OpType` is one of `Cas` or `Exchange` and `ValType` is presently either `Word` or `Addr`. Eventually, variants for `Word32` and `Word64` can and should be added, once #11953 and related issues (e.g. #13825) are resolved. Adds tests for `Addr#` CAS that mirror existing tests for `MutableByteArray#`. - - - - - 2125b1d6 by Ryan Scott at 2020-11-05T00:51:01-05:00 Add a regression test for #18920 Commit f594a68a5500696d94ae36425bbf4d4073aca3b2 (`Use level numbers for generalisation`) ended up fixing #18920. Let's add a regression test to ensure that it stays fixed. Fixes #18920. - - - - - e07e383a by Ryan Scott at 2020-11-06T03:45:28-05:00 Replace HsImplicitBndrs with HsOuterTyVarBndrs This refactors the GHC AST to remove `HsImplicitBndrs` and replace it with `HsOuterTyVarBndrs`, a type which records whether the outermost quantification in a type is explicit (i.e., with an outermost, invisible `forall`) or implicit. As a result of this refactoring, it is now evident in the AST where the `forall`-or-nothing rule applies: it's all the places that use `HsOuterTyVarBndrs`. See the revamped `Note [forall-or-nothing rule]` in `GHC.Hs.Type` (previously in `GHC.Rename.HsType`). Moreover, the places where `ScopedTypeVariables` brings lexically scoped type variables into scope are a subset of the places that adhere to the `forall`-or-nothing rule, so this also makes places that interact with `ScopedTypeVariables` easier to find. See the revamped `Note [Lexically scoped type variables]` in `GHC.Hs.Type` (previously in `GHC.Tc.Gen.Sig`). `HsOuterTyVarBndrs` are used in type signatures (see `HsOuterSigTyVarBndrs`) and type family equations (see `HsOuterFamEqnTyVarBndrs`). The main difference between the former and the latter is that the former cares about specificity but the latter does not. There are a number of knock-on consequences: * There is now a dedicated `HsSigType` type, which is the combination of `HsOuterSigTyVarBndrs` and `HsType`. `LHsSigType` is now an alias for an `XRec` of `HsSigType`. * Working out the details led us to a substantial refactoring of the handling of explicit (user-written) and implicit type-variable bindings in `GHC.Tc.Gen.HsType`. Instead of a confusing family of higher order functions, we now have a local data type, `SkolemInfo`, that controls how these binders are kind-checked. It remains very fiddly, not fully satisfying. But it's better than it was. Fixes #16762. Bumps the Haddock submodule. Co-authored-by: Simon Peyton Jones <simonpj at microsoft.com> Co-authored-by: Richard Eisenberg <rae at richarde.dev> Co-authored-by: Zubin Duggal <zubin at cmi.ac.in> - - - - - c85f4928 by Sylvain Henry at 2020-11-06T03:46:08-05:00 Refactor -dynamic-too handling 1) Don't modify DynFlags (too much) for -dynamic-too: now when we generate dynamic outputs for "-dynamic-too", we only set "dynamicNow" boolean field in DynFlags instead of modifying several other fields. These fields now have accessors that take dynamicNow into account. 2) Use DynamicTooState ADT to represent -dynamic-too state. It's much clearer than the undocumented "DynamicTooConditional" that was used before. As a result, we can finally remove the hscs_iface_dflags field in HscRecomp. There was a comment on this field saying: "FIXME (osa): I don't understand why this is necessary, but I spent almost two days trying to figure this out and I couldn't .. perhaps someone who understands this code better will remove this later." I don't fully understand the details, but it was needed because of the changes made to the DynFlags for -dynamic-too. There is still something very dubious in GHC.Iface.Recomp: we have to disable the "dynamicNow" flag at some point for some Backpack's "heinous hack" to continue to work. It may be because interfaces for indefinite units are always non-dynamic, or because we mix and match dynamic and non-dynamic interfaces (#9176), or something else, who knows? - - - - - 2cb87909 by Moritz Angermann at 2020-11-06T03:46:44-05:00 [AArch64] Aarch64 Always PIC - - - - - b1d2c1f3 by Ben Gamari at 2020-11-06T03:47:19-05:00 rts/Sanity: Avoid nasty race in weak pointer sanity-checking See Note [Racing weak pointer evacuation] for all of the gory details. - - - - - 638f38c5 by Ben Gamari at 2020-11-08T09:29:16-05:00 Merge remote-tracking branch 'origin/wip/tsan/all' - - - - - 22888798 by Ben Gamari at 2020-11-08T12:08:40-05:00 Fix haddock submodule The previous merge mistakenly reverted it. - - - - - d445cf05 by Ben Gamari at 2020-11-10T10:26:20-05:00 rts/linker: Fix relocation overflow in PE linker Previously the overflow check for the IMAGE_REL_AMD64_ADDR32NB relocation failed to account for the signed nature of the value. Specifically, the overflow check was: uint64_t v; v = S + A; if (v >> 32) { ... } However, `v` ultimately needs to fit into 32-bits as a signed value. Consequently, values `v > 2^31` in fact overflow yet this is not caught by the existing overflow check. Here we rewrite the overflow check to rather ensure that `INT32_MIN <= v <= INT32_MAX`. There is now quite a bit of repetition between the `IMAGE_REL_AMD64_REL32` and `IMAGE_REL_AMD64_ADDR32` cases but I am leaving fixing this for future work. This bug was first noticed by @awson. Fixes #15808. - - - - - 4c407f6e by Sylvain Henry at 2020-11-10T10:27:00-05:00 Export SPEC from GHC.Exts (#13681) - - - - - 7814cd5b by David Eichmann at 2020-11-10T10:27:35-05:00 ghc-heap: expose decoding from heap representation Co-authored-by: Sven Tennie <sven.tennie at gmail.com> Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> Co-authored-by: Ben Gamari <bgamari.foss at gmail.com> - - - - - fa344d33 by Richard Eisenberg at 2020-11-10T10:28:10-05:00 Add test case for #17186. This got fixed sometime recently; not worth it trying to figure out which commit. - - - - - 2e63a0fb by David Eichmann at 2020-11-10T10:28:46-05:00 Add code comments for StgInfoTable and StgStack structs - - - - - fcfda909 by Ben Gamari at 2020-11-11T03:19:59-05:00 nativeGen: Make makeImportsDoc take an NCGConfig rather than DynFlags It appears this was an oversight as there is no reason the full DynFlags is necessary. - - - - - 6e23695e by Ben Gamari at 2020-11-11T03:19:59-05:00 Move this_module into NCGConfig In various places in the NCG we need the Module currently being compiled. Let's move this into the environment instead of chewing threw another register. - - - - - c6264a2d by Ben Gamari at 2020-11-11T03:20:00-05:00 codeGen: Produce local symbols for module-internal functions It turns out that some important native debugging/profiling tools (e.g. perf) rely only on symbol tables for function name resolution (as opposed to using DWARF DIEs). However, previously GHC would emit temporary symbols (e.g. `.La42b`) to identify module-internal entities. Such symbols are dropped during linking and therefore not visible to runtime tools (in addition to having rather un-helpful unique names). For instance, `perf report` would often end up attributing all cost to the libc `frame_dummy` symbol since Haskell code was no covered by any proper symbol (see #17605). We now rather follow the model of C compilers and emit descriptively-named local symbols for module internal things. Since this will increase object file size this behavior can be disabled with the `-fno-expose-internal-symbols` flag. With this `perf record` can finally be used against Haskell executables. Even more, with `-g3` `perf annotate` provides inline source code. - - - - - 584058dd by Ben Gamari at 2020-11-11T03:20:00-05:00 Enable -fexpose-internal-symbols when debug level >=2 This seems like a reasonable default as the object file size increases by around 5%. - - - - - c34a4b98 by Ömer Sinan Ağacan at 2020-11-11T03:20:35-05:00 Fix and enable object unloading in GHCi Fixes #16525 by tracking dependencies between object file symbols and marking symbol liveness during garbage collection See Note [Object unloading] in CheckUnload.c for details. - - - - - 2782487f by Ray Shih at 2020-11-11T03:20:35-05:00 Add loadNativeObj and unloadNativeObj (This change is originally written by niteria) This adds two functions: * `loadNativeObj` * `unloadNativeObj` and implements them for Linux. They are useful if you want to load a shared object with Haskell code using the system linker and have GHC call dlclose() after the code is no longer referenced from the heap. Using the system linker allows you to load the shared object above outside the low-mem region. It also loads the DWARF sections in a way that `perf` understands. `dl_iterate_phdr` is what makes this implementation Linux specific. - - - - - 7a65f9e1 by GHC GitLab CI at 2020-11-11T03:20:35-05:00 rts: Introduce highMemDynamic - - - - - e9e1b2e7 by GHC GitLab CI at 2020-11-11T03:20:35-05:00 Introduce test for dynamic library unloading This uses the highMemDynamic flag introduced earlier to verify that dynamic objects are properly unloaded. - - - - - 5506f134 by Krzysztof Gogolewski at 2020-11-11T03:21:14-05:00 Force argument in setIdMult (#18925) - - - - - 787e93ae by Ben Gamari at 2020-11-11T23:14:11-05:00 testsuite: Add testcase for #18733 - - - - - 5353fd50 by Ben Gamari at 2020-11-12T10:05:30-05:00 compiler: Fix recompilation checking In ticket #18733 we noticed a rather serious deficiency in the current fingerprinting logic for recursive groups. I have described the old fingerprinting story and its problems in Note [Fingerprinting recursive groups] and have reworked the story accordingly to avoid these issues. Fixes #18733. - - - - - 63fa3997 by Sebastian Graf at 2020-11-13T14:29:39-05:00 Arity: Rework `ArityType` to fix monotonicity (#18870) As we found out in #18870, `andArityType` is not monotone, with potentially severe consequences for termination of fixed-point iteration. That showed in an abundance of "Exciting arity" DEBUG messages that are emitted whenever we do more than one step in fixed-point iteration. The solution necessitates also recording `OneShotInfo` info for `ABot` arity type. Thus we get the following definition for `ArityType`: ``` data ArityType = AT [OneShotInfo] Divergence ``` The majority of changes in this patch are the result of refactoring use sites of `ArityType` to match the new definition. The regression test `T18870` asserts that we indeed don't emit any DEBUG output anymore for a function where we previously would have. Similarly, there's a regression test `T18937` for #18937, which we expect to be broken for now. Fixes #18870. - - - - - 197d59fa by Sebastian Graf at 2020-11-13T14:29:39-05:00 Arity: Emit "Exciting arity" warning only after second iteration (#18937) See Note [Exciting arity] why we emit the warning at all and why we only do after the second iteration now. Fixes #18937. - - - - - de7ec9dd by David Eichmann at 2020-11-13T14:30:16-05:00 Add rts_listThreads and rts_listMiscRoots to RtsAPI.h These are used to find the current roots of the garbage collector. Co-authored-by: Sven Tennie's avatarSven Tennie <sven.tennie at gmail.com> Co-authored-by: Matthew Pickering's avatarMatthew Pickering <matthewtpickering at gmail.com> Co-authored-by: default avatarBen Gamari <bgamari.foss at gmail.com> - - - - - 24a86f09 by Ben Gamari at 2020-11-13T14:30:51-05:00 gitlab-ci: Cache cabal store in linting job - - - - - 0a7e592c by Ben Gamari at 2020-11-15T03:35:45-05:00 nativeGen/dwarf: Fix procedure end addresses Previously the `.debug_aranges` and `.debug_info` (DIE) DWARF information would claim that procedures (represented with a `DW_TAG_subprogram` DIE) would only span the range covered by their entry block. This omitted all of the continuation blocks (represented by `DW_TAG_lexical_block` DIEs), confusing `perf`. Fix this by introducing a end-of-procedure label and using this as the `DW_AT_high_pc` of procedure `DW_TAG_subprogram` DIEs Fixes #17605. - - - - - 1e19183d by Ben Gamari at 2020-11-15T03:35:45-05:00 nativeGen/dwarf: Only produce DW_AT_source_note DIEs in -g3 Standard debugging tools don't know how to understand these so let's not produce them unless asked. - - - - - ad73370f by Ben Gamari at 2020-11-15T03:35:45-05:00 nativeGen/dwarf: Use DW_AT_linkage instead of DW_AT_MIPS_linkage - - - - - a2539650 by Ben Gamari at 2020-11-15T03:35:45-05:00 gitlab-ci: Add DWARF release jobs for Debian 10, Fedora27 - - - - - d61adb3d by Ryan Scott at 2020-11-15T03:36:21-05:00 Name (tc)SplitForAll- functions more consistently There is a zoo of `splitForAll-` functions in `GHC.Core.Type` (as well as `tcSplitForAll-` functions in `GHC.Tc.Utils.TcType`) that all do very similar things, but vary in the particular form of type variable that they return. To make things worse, the names of these functions are often quite misleading. Some particularly egregious examples: * `splitForAllTys` returns `TyCoVar`s, but `splitSomeForAllTys` returns `VarBndr`s. * `splitSomeForAllTys` returns `VarBndr`s, but `tcSplitSomeForAllTys` returns `TyVar`s. * `splitForAllTys` returns `TyCoVar`s, but `splitForAllTysInvis` returns `InvisTVBinder`s. (This in particular arose in the context of #18939, and this finally motivated me to bite the bullet and improve the status quo vis-à-vis how we name these functions.) In an attempt to bring some sanity to how these functions are named, I have opted to rename most of these functions en masse to use consistent suffixes that describe the particular form of type variable that each function returns. In concrete terms, this amounts to: * Functions that return a `TyVar` now use the suffix `-TyVar`. This caused the following functions to be renamed: * `splitTyVarForAllTys` -> `splitForAllTyVars` * `splitForAllTy_ty_maybe` -> `splitForAllTyVar_maybe` * `tcSplitForAllTys` -> `tcSplitForAllTyVars` * `tcSplitSomeForAllTys` -> `tcSplitSomeForAllTyVars` * Functions that return a `CoVar` now use the suffix `-CoVar`. This caused the following functions to be renamed: * `splitForAllTy_co_maybe` -> `splitForAllCoVar_maybe` * Functions that return a `TyCoVar` now use the suffix `-TyCoVar`. This caused the following functions to be renamed: * `splitForAllTy` -> `splitForAllTyCoVar` * `splitForAllTys` -> `splitForAllTyCoVars` * `splitForAllTys'` -> `splitForAllTyCoVars'` * `splitForAllTy_maybe` -> `splitForAllTyCoVar_maybe` * Functions that return a `VarBndr` now use the suffix corresponding to the most relevant type synonym. This caused the following functions to be renamed: * `splitForAllVarBndrs` -> `splitForAllTyCoVarBinders` * `splitForAllTysInvis` -> `splitForAllInvisTVBinders` * `splitForAllTysReq` -> `splitForAllReqTVBinders` * `splitSomeForAllTys` -> `splitSomeForAllTyCoVarBndrs` * `tcSplitForAllVarBndrs` -> `tcSplitForAllTyVarBinders` * `tcSplitForAllTysInvis` -> `tcSplitForAllInvisTVBinders` * `tcSplitForAllTysReq` -> `tcSplitForAllReqTVBinders` * `tcSplitForAllTy_maybe` -> `tcSplitForAllTyVarBinder_maybe` Note that I left the following functions alone: * Functions that split apart things besides `ForAllTy`s, such as `splitFunTys` or `splitPiTys`. Thankfully, there are far fewer of these functions than there are functions that split apart `ForAllTy`s, so there isn't much of a pressing need to apply the new naming convention elsewhere. * Functions that split apart `ForAllCo`s in `Coercion`s, such as `GHC.Core.Coercion.splitForAllCo_maybe`. We could theoretically apply the new naming convention here, but then we'd have to figure out how to disambiguate `Type`-splitting functions from `Coercion`-splitting functions. Ultimately, the `Coercion`-splitting functions aren't used nearly as much as the `Type`-splitting functions, so I decided to leave the former alone. This is purely refactoring and should cause no change in behavior. - - - - - 645444af by Ryan Scott at 2020-11-15T03:36:21-05:00 Use tcSplitForAllInvisTyVars (not tcSplitForAllTyVars) in more places The use of `tcSplitForAllTyVars` in `tcDataFamInstHeader` was the immediate cause of #18939, and replacing it with a new `tcSplitForAllInvisTyVars` function (which behaves like `tcSplitForAllTyVars` but only splits invisible type variables) fixes the issue. However, this led me to realize that _most_ uses of `tcSplitForAllTyVars` in GHC really ought to be `tcSplitForAllInvisTyVars` instead. While I was in town, I opted to replace most uses of `tcSplitForAllTys` with `tcSplitForAllTysInvis` to reduce the likelihood of such bugs in the future. I say "most uses" above since there is one notable place where we _do_ want to use `tcSplitForAllTyVars`: in `GHC.Tc.Validity.forAllTyErr`, which produces the "`Illegal polymorphic type`" error message if you try to use a higher-rank `forall` without having `RankNTypes` enabled. Here, we really do want to split all `forall`s, not just invisible ones, or we run the risk of giving an inaccurate error message in the newly added `T18939_Fail` test case. I debated at some length whether I wanted to name the new function `tcSplitForAllInvisTyVars` or `tcSplitForAllTyVarsInvisible`, but in the end, I decided that I liked the former better. For consistency's sake, I opted to rename the existing `splitPiTysInvisible` and `splitPiTysInvisibleN` functions to `splitInvisPiTys` and `splitPiTysInvisN`, respectively, so that they use the same naming convention. As a consequence, this ended up requiring a `haddock` submodule bump. Fixes #18939. - - - - - 8887102f by Moritz Angermann at 2020-11-15T03:36:56-05:00 AArch64/arm64 adjustments This addes the necessary logic to support aarch64 on elf, as well as aarch64 on mach-o, which Apple calls arm64. We change architecture name to AArch64, which is the official arm naming scheme. - - - - - fc644b1a by Ben Gamari at 2020-11-15T03:37:31-05:00 ghc-bin: Build with eventlogging by default We now have all sorts of great facilities using the eventlog which were previously unavailable without building a custom GHC. Fix this by linking with `-eventlog` by default. - - - - - 52114fa0 by Sylvain Henry at 2020-11-16T11:48:47+01:00 Add Addr# atomic primops (#17751) This reuses the codegen used for ByteArray#'s atomic primops. - - - - - 8150f654 by Sebastian Graf at 2020-11-18T23:38:40-05:00 PmCheck: Print types of uncovered patterns (#18932) In order to avoid confusion as in #18932, we display the type of the match variables in the non-exhaustiveness warning, e.g. ``` T18932.hs:14:1: warning: [-Wincomplete-patterns] Pattern match(es) are non-exhaustive In an equation for ‘g’: Patterns of type ‘T a’, ‘T a’, ‘T a’ not matched: (MkT2 _) (MkT1 _) (MkT1 _) (MkT2 _) (MkT1 _) (MkT2 _) (MkT2 _) (MkT2 _) (MkT1 _) (MkT2 _) (MkT2 _) (MkT2 _) ... | 14 | g (MkT1 x) (MkT1 _) (MkT1 _) = x | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ``` It also allows us to omit the type signature on wildcard matches which we previously showed in only some situations, particularly `-XEmptyCase`. Fixes #18932. - - - - - 165352a2 by Krzysztof Gogolewski at 2020-11-20T02:08:36-05:00 Export indexError from GHC.Ix (#18579) - - - - - b57845c3 by Kamil Dworakowski at 2020-11-20T02:09:16-05:00 Clarify interruptible FFI wrt masking state - - - - - 321d1bd8 by Sebastian Graf at 2020-11-20T02:09:51-05:00 Fix strictness signatures of `prefetchValue*#` primops Their strictness signatures said the primops are strict in their first argument, which is wrong: Handing it a thunk will prefetch the pointer to the thunk, but not evaluate it. Hence not strict. The regression test `T8256` actually tests for laziness in the first argument, so GHC apparently never exploited the strictness signature. See also https://gitlab.haskell.org/ghc/ghc/-/issues/8256#note_310867, where this came up. - - - - - 0aec78b6 by Sebastian Graf at 2020-11-20T02:09:51-05:00 Demand: Interleave usage and strictness demands (#18903) As outlined in #18903, interleaving usage and strictness demands not only means a more compact demand representation, but also allows us to express demands that we weren't easily able to express before. Call demands are *relative* in the sense that a call demand `Cn(cd)` on `g` says "`g` is called `n` times. *Whenever `g` is called*, the result is used according to `cd`". Example from #18903: ```hs h :: Int -> Int h m = let g :: Int -> (Int,Int) g 1 = (m, 0) g n = (2 * n, 2 `div` n) {-# NOINLINE g #-} in case m of 1 -> 0 2 -> snd (g m) _ -> uncurry (+) (g m) ``` Without the interleaved representation, we would just get `L` for the strictness demand on `g`. Now we are able to express that whenever `g` is called, its second component is used strictly in denoting `g` by `1C1(P(1P(U),SP(U)))`. This would allow Nested CPR to unbox the division, for example. Fixes #18903. While fixing regressions, I also discovered and fixed #18957. Metric Decrease: T13253-spj - - - - - 3a55b3a2 by Sebastian Graf at 2020-11-20T02:09:51-05:00 Update user's guide entry on demand analysis and worker/wrapper The demand signature notation has been undocumented for a long time. The only source to understand it, apart from reading the `Outputable` instance, has been an outdated wiki page. Since the previous commits have reworked the demand lattice, I took it as an opportunity to also write some documentation about notation. - - - - - fc963932 by Greg Steuck at 2020-11-20T02:10:31-05:00 Find hadrian location more reliably in cabal-install output Fix #18944 - - - - - 9f40cf6c by Ben Gamari at 2020-11-20T02:11:07-05:00 rts/linker: Align bssSize to page size when mapping symbol extras We place symbol_extras right after bss. We also need to ensure that symbol_extras can be mprotect'd independently from the rest of the image. To ensure this we round up the size of bss to a page boundary, thus ensuring that symbol_extras is also page-aligned. - - - - - b739c319 by Ben Gamari at 2020-11-20T02:11:43-05:00 gitlab-ci: Add usage message to ci.sh - - - - - 802e9180 by Ben Gamari at 2020-11-20T02:11:43-05:00 gitlab-ci: Add VERBOSE environment variable And change the make build system's default behavior to V=0, greatly reducing build log sizes. - - - - - 2a8a979c by Ben Gamari at 2020-11-21T01:13:26-05:00 users-guide: A bit of clean-up in profiling flag documentation - - - - - 56804e33 by Ben Gamari at 2020-11-21T01:13:26-05:00 testsuite: Refactor CountParserDeps - - - - - 53ad67ea by Ben Gamari at 2020-11-21T01:13:26-05:00 Introduce -fprof-callers flag This introducing a new compiler flag to provide a convenient way to introduce profiler cost-centers on all occurrences of the named identifier. Closes #18566. - - - - - ecfd0278 by Sylvain Henry at 2020-11-21T01:14:09-05:00 Move Plugins into HscEnv (#17957) Loaded plugins have nothing to do in DynFlags so this patch moves them into HscEnv (session state). "DynFlags plugins" become "Driver plugins" to still be able to register static plugins. Bump haddock submodule - - - - - 72f2257c by Sylvain Henry at 2020-11-21T01:14:09-05:00 Don't initialize plugins in the Core2Core pipeline Some plugins can be added via TH (cf addCorePlugin). Initialize them in the driver instead of in the Core2Core pipeline. - - - - - ddbeeb3c by Ryan Scott at 2020-11-21T01:14:44-05:00 Add regression test for #10504 This issue was fixed at some point between GHC 8.0 and 8.2. Let's add a regression test to ensure that it stays fixed. Fixes #10504. - - - - - a4a6dc2a by Ben Gamari at 2020-11-21T01:15:21-05:00 dwarf: Apply info table offset consistently Previously we failed to apply the info table offset to the aranges and DIEs, meaning that we often failed to unwind in gdb. For some reason this only seemed to manifest in the RTS's Cmm closures. Nevertheless, now we can unwind completely up to `main` - - - - - 69bfbc21 by Ben Gamari at 2020-11-21T01:15:56-05:00 hadrian: Disable stripping when debug information is enabled - - - - - 7e93ae8b by Ben Gamari at 2020-11-21T13:13:29-05:00 rts: Post ticky entry counts to the eventlog We currently only post the entry counters, not the other global counters as in my experience the former are more useful. We use the heap profiler's census period to decide when to dump. Also spruces up the documentation surrounding ticky-ticky a bit. - - - - - bc9c3916 by Ben Gamari at 2020-11-22T06:28:10-05:00 Implement -ddump-c-backend argument To dump output of the C backend. - - - - - 901bc220 by Ben Gamari at 2020-11-22T12:39:02-05:00 Bump time submodule to 1.11.1 Also bumps directory, Cabal, hpc, time, and unix submodules. Closes #18847. - - - - - 92c0afbf by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Dump STG when ticky is enabled This changes the "ticky" modifier to enable dumping of final STG as this is generally needed to make sense of the ticky profiles. - - - - - d23fef68 by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Introduce notion of flavour transformers This extends Hadrian's notion of "flavour", as described in #18942. - - - - - 179d0bec by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Add a viaLlvmBackend modifier Note that this also slightly changes the semantics of these flavours as we only use LLVM for >= stage1 builds. - - - - - d4d95e51 by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Add profiled_ghc and no_dynamic_ghc modifiers - - - - - 6815603f by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Drop redundant flavour definitions Drop the profiled, LLVM, and ThreadSanitizer flavour definitions as these can now be realized with flavour transformers. - - - - - f88f4339 by Ben Gamari at 2020-11-24T02:43:20-05:00 rts: Flush eventlog buffers from flushEventLog As noted in #18043, flushTrace failed flush anything beyond the writer. This means that a significant amount of data sitting in capability-local event buffers may never get flushed, despite the users' pleads for us to flush. Fix this by making flushEventLog flush all of the event buffers before flushing the writer. Fixes #18043. - - - - - 7c03cc50 by Ben Gamari at 2020-11-24T02:43:55-05:00 gitlab-ci: Run LLVM job on appropriately-labelled MRs Namely, those marked with the ~"LLVM backend" label - - - - - 9b95d815 by Ben Gamari at 2020-11-24T02:43:55-05:00 gitlab-ci: Run LLVM builds on Debian 10 The current Debian 9 image doesn't provide LLVM 7. - - - - - 2ed3e6c0 by Ben Gamari at 2020-11-24T02:43:55-05:00 CmmToLlvm: Declare signature for memcmp Otherwise `opt` fails with: error: use of undefined value '@memcmp$def' - - - - - be5d74ca by Moritz Angermann at 2020-11-26T16:00:32-05:00 [Sized Cmm] properly retain sizes. This replaces all Word<N> = W<N># Word# and Int<N> = I<N># Int# with Word<N> = W<N># Word<N># and Int<N> = I<N># Int<N>#, thus providing us with properly sized primitives in the codegenerator instead of pretending they are all full machine words. This came up when implementing darwinpcs for arm64. The darwinpcs reqires us to pack function argugments in excess of registers on the stack. While most procedure call standards (pcs) assume arguments are just passed in 8 byte slots; and thus the caller does not know the exact signature to make the call, darwinpcs requires us to adhere to the prototype, and thus have the correct sizes. If we specify CInt in the FFI call, it should correspond to the C int, and not just be Word sized, when it's only half the size. This does change the expected output of T16402 but the new result is no less correct as it eliminates the narrowing (instead of the `and` as was previously done). Bumps the array, bytestring, text, and binary submodules. Co-Authored-By: Ben Gamari <ben at well-typed.com> Metric Increase: T13701 T14697 - - - - - a84e53f9 by Andreas Klebinger at 2020-11-26T16:00:32-05:00 RTS: Fix failed inlining of copy_tag. On windows using gcc-10 gcc failed to inline copy_tag into evacuate. To fix this we now set the always_inline attribute for the various copy* functions in Evac.c. The main motivation here is not the overhead of the function call, but rather that this allows the code to "specialize" for the size of the closure we copy which is often known at compile time. An earlier commit also tried to avoid evacuate_large inlining. But didn't quite succeed. So I also marked evacuate_large as noinline. Fixes #12416 - - - - - cdbd16f5 by Sylvain Henry at 2020-11-26T16:00:33-05:00 Fix toArgRep to support 64-bit reps on all systems [This is @Ericson2314 writing a commit message for @hsyl20's patch.] (Progress towards #11953, #17377, #17375) `Int64Rep` and `Word64Rep` are currently broken on 64-bit systems. This is because they should use "native arg rep" but instead use "large arg rep" as they do on 32-bit systems, which is either a non-concept or a 128-bit rep depending on one's vantage point. Now, these reps currently aren't used during 64-bit compilation, so the brokenness isn't observed, but I don't think that constitutes reasons not to fix it. Firstly, the linked issues there is a clearly expressed desire to use explicit-bitwidth constructs in more places. Secondly, per [1], there are other bugs that *do* manifest from not threading explicit-bitwidth information all the way through the compilation pipeline. One can therefore view this as one piece of the larger effort to do that, improve ergnomics, and squash remaining bugs. Also, this is needed for !3658. I could just merge this as part of that, but I'm keen on merging fixes "as they are ready" so the fixes that aren't ready are isolated and easier to debug. [1]: https://mail.haskell.org/pipermail/ghc-devs/2020-October/019332.html - - - - - a9378e69 by Tim Barnes at 2020-11-26T16:00:34-05:00 Set dynamic users-guide TOC spacing (fixes #18554) - - - - - 86a59d93 by Ben Gamari at 2020-11-26T16:00:34-05:00 rts: Use RTS_LIKELY in CHECK Most compilers probably already infer that `barf` diverges but it nevertheless doesn't hurt to be explicit. - - - - - 5757e82b by Matthew Pickering at 2020-11-26T16:00:35-05:00 Remove special case for GHC.ByteCode.Instr This was added in https://github.com/nomeata/ghc-heap-view/commit/34935206e51b9c86902481d84d2f368a6fd93423 GHC.ByteCode.Instr.BreakInfo no longer exists so the special case is dead code. Any check like this can be easily dealt with in client code. - - - - - d9c8b5b4 by Matthew Pickering at 2020-11-26T16:00:35-05:00 Split Up getClosureDataFromHeapRep Motivation 1. Don't enforce the repeated decoding of an info table, when the client can cache it (ghc-debug) 2. Allow the constructor information decoding to be overridden, this casues segfaults in ghc-debug - - - - - 3e3555cc by Andreas Klebinger at 2020-11-26T16:00:35-05:00 RegAlloc: Add missing raPlatformfield to RegAllocStatsSpill Fixes #18994 Co-Author: Benjamin Maurer <maurer.benjamin at gmail.com> - - - - - a1a75aa9 by Ben Gamari at 2020-11-27T06:20:41-05:00 rts: Allocate MBlocks with MAP_TOP_DOWN on Windows As noted in #18991, we would previously allocate heap in low memory. Due to this the linker, which typically *needs* low memory, would end up competing with the heap. In longer builds we end up running out of low memory entirely, leading to linking failures. - - - - - 75fc1ed5 by Sylvain Henry at 2020-11-28T15:40:23-05:00 Hadrian: fix detection of ghc-pkg for cross-compilers - - - - - 7cb5df96 by Sylvain Henry at 2020-11-28T15:40:23-05:00 hadrian: fix ghc-pkg uses (#17601) Make sure ghc-pkg doesn't read the compiler "settings" file by passing --no-user-package-db. - - - - - e3fd4226 by Ben Gamari at 2020-11-28T15:40:23-05:00 gitlab-ci: Introduce a nightly cross-compilation job This adds a job to test cross-compilation from x86-64 to AArch64 with Hadrian. Fixes #18234 - - - - - 698d3d96 by Ben Gamari at 2020-11-28T15:41:00-05:00 gitlab-ci: Only deploy GitLab Pages in ghc/ghc> The deployments are quite large and yet are currently only served for the ghc/ghc> project. - - - - - 625726f9 by David Eichmann at 2020-11-28T15:41:37-05:00 ghc-heap: partial TSO/STACK decoding Co-authored-by: Sven Tennie <sven.tennie at gmail.com> Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> Co-authored-by: Ben Gamari <bgamari.foss at gmail.com> - - - - - 22ea9c29 by Andreas Klebinger at 2020-11-28T15:42:13-05:00 Small optimization to CmmSink. Inside `regsUsedIn` we can avoid some thunks by specializing the recursion. In particular we avoid the thunk for `(f e z)` in the MachOp/Load branches, where we know this will evaluate to z. Reduces allocations for T3294 by ~1%. - - - - - bba42c62 by John Ericson at 2020-11-28T15:42:49-05:00 Make primop handler indentation more consistent - - - - - c82bc8e9 by John Ericson at 2020-11-28T15:42:49-05:00 Cleanup some primop constructor names Harmonize the internal (big sum type) names of the native vs fixed-sized number primops a bit. (Mainly by renaming the former.) No user-facing names are changed. - - - - - ae14f160 by Ben Gamari at 2020-11-28T15:43:25-05:00 testsuite: Mark T14702 as fragile on Windows Due to #18953. - - - - - 1bc104b0 by Ben Gamari at 2020-11-29T15:33:18-05:00 withTimings: Emit allocations counter This will allow us to back out the allocations per compiler pass from the eventlog. Note that we dump the allocation counter rather than the difference since this will allow us to determine how much work is done *between* `withTiming` blocks. - - - - - e992ea84 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 ThreadPaused: Don't zero slop until free vars are pushed When threadPaused blackholes a thunk it calls `OVERWRITING_CLOSURE` to zero the slop for the benefit of the sanity checker. Previously this was done *before* pushing the thunk's free variables to the update remembered set. Consequently we would pull zero'd pointers to the update remembered set. - - - - - e82cd140 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Fix regression from TSAN work The TSAN rework (specifically aad1f803) introduced a subtle regression in GC.c, swapping `g0` in place of `gen`. Whoops! Fixes #18997. - - - - - 35a5207e by GHC GitLab CI at 2020-11-29T15:33:54-05:00 rts/Messages: Add missing write barrier in THROWTO message update After a THROWTO message has been handle the message closure is overwritten by a NULL message. We must ensure that the original closure's pointers continue to be visible to the nonmoving GC. - - - - - 0120829f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Add missing write barrier in shrinkSmallByteArray - - - - - 8a4d8fb6 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 Updates: Don't zero slop until closure has been pushed Ensure that the the free variables have been pushed to the update remembered set before we zero the slop. - - - - - 2793cfdc by GHC GitLab CI at 2020-11-29T15:33:54-05:00 OSThreads: Fix error code checking pthread_join returns its error code and apparently doesn't set errno. - - - - - e391a16f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Don't join to mark_thread on shutdown The mark thread is not joinable as we detach from it on creation. - - - - - 60d088ab by Ben Gamari at 2020-11-29T15:33:54-05:00 nonmoving: Add reference to Ueno 2016 - - - - - 3aa60362 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Ensure that evacuated large objects are marked See Note [Non-moving GC: Marking evacuated objects]. - - - - - 8d304a99 by Ben Gamari at 2020-11-30T10:15:22-05:00 rts/m32: Refactor handling of allocator seeding Previously, in an attempt to reduce fragmentation, each new allocator would map a region of M32_MAX_PAGES fresh pages to seed itself. However, this ends up being extremely wasteful since it turns out that we often use fewer than this. Consequently, these pages end up getting freed which, ends up fragmenting our address space more than than we would have if we had naively allocated pages on-demand. Here we refactor m32 to avoid this waste while achieving the fragmentation mitigation previously desired. In particular, we move all page allocation into the global m32_alloc_page, which will pull a page from the free page pool. If the free page pool is empty we then refill it by allocating a region of M32_MAP_PAGES and adding them to the pool. Furthermore, we do away with the initial seeding entirely. That is, the allocator starts with no active pages: pages are rather allocated on an as-needed basis. On the whole this ends up being a pleasingly simple change, simultaneously making m32 more efficient, more robust, and simpler. Fixes #18980. - - - - - b6629289 by Ben Gamari at 2020-11-30T10:15:58-05:00 rts: Use CHECK instead of assert Use the GHC wrappers instead of <assert.h>. - - - - - 9f4efa6a by Ben Gamari at 2020-11-30T10:15:58-05:00 rts/linker: Replace some ASSERTs with CHECK In the past some people have confused ASSERT, which is for checking internal invariants, which CHECK, which should be used when checking things that might fail due to bad input (and therefore should be enabled even in the release compiler). Change some of these cases in the linker to use CHECK. - - - - - 0f8a4655 by Ryan Scott at 2020-11-30T10:16:34-05:00 Allow deploy:pages job to fail See #18973. - - - - - 49ebe369 by chessai at 2020-11-30T19:47:40-05:00 Optimisations in Data.Foldable (T17867) This PR concerns the following functions from `Data.Foldable`: * minimum * maximum * sum * product * minimumBy * maximumBy - Default implementations of these functions now use `foldl'` or `foldMap'`. - All have been marked with INLINEABLE to make room for further optimisations. - - - - - 4d79ef65 by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - 6af074ce by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - ab334262 by Viktor Dukhovni at 2020-11-30T19:48:17-05:00 dirty MVAR after mutating TSO queue head While the original head and tail of the TSO queue may be in the same generation as the MVAR, interior elements of the queue could be younger after a GC run and may then be exposed by putMVar operation that updates the queue head. Resolves #18919 - - - - - 5eb163f3 by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Don't allow shared libraries to be loaded multiple times - - - - - 490aa14d by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Initialise CCSs from native shared objects - - - - - 6ac3db5f by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Move shared library loading logic into Elf.c - - - - - b6698d73 by GHC GitLab CI at 2020-11-30T19:48:53-05:00 rts/linker: Don't declare dynamic objects with image_mapped This previously resulted in warnings due to spurious unmap failures. - - - - - b94a65af by jneira at 2020-11-30T19:49:31-05:00 Include tried paths in findToolDir error - - - - - 72a87fbc by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Move core flattening algorithm to Core.Unify This sets the stage for a later change, where this algorithm will be needed from GHC.Core.InstEnv. This commit also splits GHC.Core.Map into GHC.Core.Map.Type and GHC.Core.Map.Expr, in order to avoid module import cycles with GHC.Core. - - - - - 0dd45d0a by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Bump the # of commits searched for perf baseline The previous value of 75 meant that a feature branch with more than 75 commits would get spurious CI passes. This affects #18692, but does not fix that ticket, because if a baseline cannot be found, we should fail, not succeed. - - - - - 8bb52d91 by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Remove flattening variables This patch redesigns the flattener to simplify type family applications directly instead of using flattening meta-variables and skolems. The key new innovation is the CanEqLHS type and the new CEqCan constraint (Ct). A CanEqLHS is either a type variable or exactly-saturated type family application; either can now be rewritten using a CEqCan constraint in the inert set. Because the flattener no longer reduces all type family applications to variables, there was some performance degradation if a lengthy type family application is now flattened over and over (not making progress). To compensate, this patch contains some extra optimizations in the flattener, leading to a number of performance improvements. Close #18875. Close #18910. There are many extra parts of the compiler that had to be affected in writing this patch: * The family-application cache (formerly the flat-cache) sometimes stores coercions built from Given inerts. When these inerts get kicked out, we must kick out from the cache as well. (This was, I believe, true previously, but somehow never caused trouble.) Kicking out from the cache requires adding a filterTM function to TrieMap. * This patch obviates the need to distinguish "blocking" coercion holes from non-blocking ones (which, previously, arose from CFunEqCans). There is thus some simplification around coercion holes. * Extra commentary throughout parts of the code I read through, to preserve the knowledge I gained while working. * A change in the pure unifier around unifying skolems with other types. Unifying a skolem now leads to SurelyApart, not MaybeApart, as documented in Note [Binding when looking up instances] in GHC.Core.InstEnv. * Some more use of MCoercion where appropriate. * Previously, class-instance lookup automatically noticed that e.g. C Int was a "unifier" to a target [W] C (F Bool), because the F Bool was flattened to a variable. Now, a little more care must be taken around checking for unifying instances. * Previously, tcSplitTyConApp_maybe would split (Eq a => a). This is silly, because (=>) is not a tycon in Haskell. Fixed now, but there are some knock-on changes in e.g. TrieMap code and in the canonicaliser. * New function anyFreeVarsOf{Type,Co} to check whether a free variable satisfies a certain predicate. * Type synonyms now remember whether or not they are "forgetful"; a forgetful synonym drops at least one argument. This is useful when flattening; see flattenView. * The pattern-match completeness checker invokes the solver. This invocation might need to look through newtypes when checking representational equality. Thus, the desugarer needs to keep track of the in-scope variables to know what newtype constructors are in scope. I bet this bug was around before but never noticed. * Extra-constraints wildcards are no longer simplified before printing. See Note [Do not simplify ConstraintHoles] in GHC.Tc.Solver. * Whether or not there are Given equalities has become slightly subtler. See the new HasGivenEqs datatype. * Note [Type variable cycles in Givens] in GHC.Tc.Solver.Canonical explains a significant new wrinkle in the new approach. * See Note [What might match later?] in GHC.Tc.Solver.Interact, which explains the fix to #18910. * The inert_count field of InertCans wasn't actually used, so I removed it. Though I (Richard) did the implementation, Simon PJ was very involved in design and review. This updates the Haddock submodule to avoid #18932 by adding a type signature. ------------------------- Metric Decrease: T12227 T5030 T9872a T9872b T9872c Metric Increase: T9872d ------------------------- - - - - - d66660ba by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Rename the flattener to become the rewriter. Now that flattening doesn't produce flattening variables, it's not really flattening anything: it's rewriting. This change also means that the rewriter can no longer be confused the core flattener (in GHC.Core.Unify), which is sometimes used during type-checking. - - - - - add0aeae by Ben Gamari at 2020-12-01T19:58:17-05:00 rts: Introduce mmapAnonForLinker Previously most of the uses of mmapForLinker were mapping anonymous memory, resulting in a great deal of unnecessary repetition. Factor this out into a new helper. Also fixes a few places where error checking was missing or suboptimal. - - - - - 97d71646 by Ben Gamari at 2020-12-01T19:58:17-05:00 rts/linker: Introduce munmapForLinker Consolidates munmap calls to ensure consistent error handling. - - - - - d8872af0 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/Linker: Introduce Windows implementations for mmapForLinker, et al. - - - - - c35d0e03 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/m32: Introduce NEEDS_M32 macro Instead of relying on RTS_LINKER_USE_MMAP - - - - - 41c64eb5 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/linker: Use m32 to allocate symbol extras in PEi386 - - - - - e0b08c5f by Ben Gamari at 2020-12-03T13:01:47-05:00 gitlab-ci: Fix copy-paste error Also be more consistent in quoting. - - - - - 33ec3a06 by Ben Gamari at 2020-12-03T23:11:31-05:00 gitlab-ci: Run linters through ci.sh Ensuring that the right toolchain is used. - - - - - 4a437bc1 by Shayne Fletcher at 2020-12-05T09:06:38-05:00 Fix bad span calculations of post qualified imports - - - - - 8fac4b93 by Ben Gamari at 2020-12-05T09:07:13-05:00 testsuite: Add a test for #18923 - - - - - 9ab1ebf5 by Ben Gamari at 2020-12-06T11:50:40-05:00 Add primop to list threads A user came to #ghc yesterday wondering how best to check whether they were leaking threads. We ended up using the eventlog but it seems to me like it would be generally useful if Haskell programs could query their own threads. - - - - - 15 changed files: - + .git-ignore-revs - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - + .gitlab/common.sh - .gitlab/linters/check-cpp.py - .gitlab/merge_request_templates/merge-request.md - .gitlab/test-metrics.sh - .gitmodules - CODEOWNERS - Makefile - README.md - aclocal.m4 - + compiler/.hlint.yaml - compiler/GHC.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b47eb544c529712f8ec101a1e33f7bd0b474f8dd...9ab1ebf51688c5e2cdd18fb45939e07f6de86b65 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b47eb544c529712f8ec101a1e33f7bd0b474f8dd...9ab1ebf51688c5e2cdd18fb45939e07f6de86b65 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Dec 6 18:09:48 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sun, 06 Dec 2020 13:09:48 -0500 Subject: [Git][ghc/ghc][wip/thread-status] Add primop to list threads Message-ID: <5fcd1e6c24b62_6b21125154c271998@gitlab.mail> Ben Gamari pushed to branch wip/thread-status at Glasgow Haskell Compiler / GHC Commits: f8ec2edf by Ben Gamari at 2020-12-06T13:09:17-05:00 Add primop to list threads A user came to #ghc yesterday wondering how best to check whether they were leaking threads. We ended up using the eventlog but it seems to me like it would be generally useful if Haskell programs could query their own threads. - - - - - 12 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/StgToCmm/Prim.hs - includes/rts/Threads.h - includes/rts/storage/Closures.h - includes/stg/MiscClosures.h - libraries/base/GHC/Conc.hs - libraries/base/GHC/Conc/Sync.hs - libraries/base/tests/all.T - + libraries/base/tests/listThreads.hs - rts/PrimOps.cmm - rts/RtsSymbols.c - rts/Threads.c Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -2684,6 +2684,13 @@ primop ThreadStatusOp "threadStatus#" GenPrimOp out_of_line = True has_side_effects = True +primop ListThreadsOp "listThreads#" GenPrimOp + State# RealWorld -> (# State# RealWorld, MutableArray# RealWorld a #) + { Returns an array of {\tt ThreadId#}s. } + with + out_of_line = True + has_side_effects = True + ------------------------------------------------------------------------ section "Weak pointers" ------------------------------------------------------------------------ ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -1543,6 +1543,7 @@ emitPrimOp dflags primop = case primop of MkApUpd0_Op -> alwaysExternal NewBCOOp -> alwaysExternal UnpackClosureOp -> alwaysExternal + ListThreadsOp -> alwaysExternal ClosureSizeOp -> alwaysExternal GetApStackValOp -> alwaysExternal ClearCCSOp -> alwaysExternal ===================================== includes/rts/Threads.h ===================================== @@ -51,6 +51,10 @@ long rts_getThreadId (StgPtr tso); void rts_enableThreadAllocationLimit (StgPtr tso); void rts_disableThreadAllocationLimit (StgPtr tso); +// Forward declarations, defined in Closures.h +struct _StgMutArrPtrs; +struct _StgMutArrPtrs *listThreads (Capability *cap); + #if !defined(mingw32_HOST_OS) pid_t forkProcess (HsStablePtr *entry); #else ===================================== includes/rts/storage/Closures.h ===================================== @@ -169,7 +169,7 @@ typedef struct { StgWord payload[]; } StgArrBytes; -typedef struct { +typedef struct _StgMutArrPtrs { StgHeader header; StgWord ptrs; StgWord size; // ptrs plus card table ===================================== includes/stg/MiscClosures.h ===================================== @@ -455,6 +455,7 @@ RTS_FUN_DECL(stg_myThreadIdzh); RTS_FUN_DECL(stg_labelThreadzh); RTS_FUN_DECL(stg_isCurrentThreadBoundzh); RTS_FUN_DECL(stg_threadStatuszh); +RTS_FUN_DECL(stg_listThreadszh); RTS_FUN_DECL(stg_mkWeakzh); RTS_FUN_DECL(stg_mkWeakNoFinalizzerzh); ===================================== libraries/base/GHC/Conc.hs ===================================== @@ -45,6 +45,7 @@ module GHC.Conc , yield , labelThread , mkWeakThreadId + , listThreads , ThreadStatus(..), BlockReason(..) , threadStatus ===================================== libraries/base/GHC/Conc/Sync.hs ===================================== @@ -52,6 +52,7 @@ module GHC.Conc.Sync , yield , labelThread , mkWeakThreadId + , listThreads , ThreadStatus(..), BlockReason(..) , threadStatus @@ -524,6 +525,27 @@ runSparks = IO loop then (# s', () #) else p `seq` loop s' +-- | List the Haskell threads of the current process. +listThreads :: IO [ThreadId] +listThreads = IO $ \s -> + case listThreads# s of + (# s', marr #) -> + case unsafeFreezeArray# marr s' of + (# s'', arr #) -> (# s'', mapListArray toThreadId arr #) + where + -- Ideally we would use UnliftedArray# but sadly this doesn't exist. + -- Instead listThreads# returns a polymorphic `Array# a` and we coerce. + toThreadId :: a -> ThreadId + toThreadId tid = ThreadId (unsafeCoerce# tid) + +mapListArray :: (a -> b) -> Array# a -> [b] +mapListArray f arr = go 0# + where + go i# + | isTrue# (i# ==# sizeofArray# arr) = [] + | otherwise = case indexArray# arr i# of + (# x #) -> f x : go (i# +# 1#) + data BlockReason = BlockedOnMVar -- ^blocked on 'MVar' ===================================== libraries/base/tests/all.T ===================================== @@ -261,3 +261,4 @@ test('T17499', [collect_stats('bytes allocated',5)], compile_and_run, ['-O -w']) test('T16643', normal, compile_and_run, ['']) test('clamp', normal, compile_and_run, ['']) test('T18642', extra_run_opts('+RTS -T -RTS'), compile_and_run, ['-O2']) +test('listThreads', normal, compile_and_run, ['']) ===================================== libraries/base/tests/listThreads.hs ===================================== @@ -0,0 +1,20 @@ +import Control.Concurrent + +dummyThread :: MVar () -> Int -> IO () +dummyThread mvar n = do + labelThread ("thread-"++show n) + readMVar mvar + +main :: IO () +main = do + mvar <- newEmptyMVar + let mkThread n = do + tid <- forkIO $ readMVar mvar + labelThread tid ("thread-"++show n) + + mapM_ mkThread [0..100] + threads <- listThreads + -- TODO: Check labels + print $ length threads + putMVar mvar () + ===================================== rts/PrimOps.cmm ===================================== @@ -2865,3 +2865,11 @@ stg_setThreadAllocationCounterzh ( I64 counter ) StgTSO_alloc_limit(CurrentTSO) = counter + TO_I64(offset); return (); } + +stg_listThreadszh () +{ + P_ arr; + + ("ptr" arr) = ccall listThreads(MyCapability() "ptr"); + return (arr); +} ===================================== rts/RtsSymbols.c ===================================== @@ -685,6 +685,7 @@ SymI_HasProto(stg_isCurrentThreadBoundzh) \ SymI_HasProto(stg_isEmptyMVarzh) \ SymI_HasProto(stg_killThreadzh) \ + SymI_HasProto(stg_listThreadszh) \ SymI_HasProto(loadArchive) \ SymI_HasProto(loadObj) \ SymI_HasProto(purgeObj) \ ===================================== rts/Threads.c ===================================== @@ -844,6 +844,44 @@ loop: return true; } +StgMutArrPtrs *listThreads(Capability *cap) +{ + // First count how many threads we have... + StgWord n_threads = 0; + for (unsigned g = 0; g < RtsFlags.GcFlags.generations; g++) { + for (StgTSO *t = generations[g].threads; t != END_TSO_QUEUE; t = t->global_link) { + n_threads++; + } + } + + // Allocate a suitably-sized array... + const StgWord size = n_threads + mutArrPtrsCardTableSize(n_threads); + StgMutArrPtrs *arr = + (StgMutArrPtrs *)allocate(cap, sizeofW(StgMutArrPtrs) + size); + TICK_ALLOC_PRIM(sizeofW(StgMutArrPtrs), n, 0); + arr->ptrs = n_threads; + arr->size = size; + + // Populate it... + // N.B. we are guaranteed to see at least n_threads during this traversal + // as the only way that threads can be removed from the generations' thread lists + // is via garbage collection yet we are in an unsafe foreign call, + // precluding GC (as well as the sync phase of the non-moving collector). + StgWord i = 0; + for (unsigned g = 0; g < RtsFlags.GcFlags.generations; g++) { + for (StgTSO *t = generations[g].threads; t != END_TSO_QUEUE; t = t->global_link) { + // It's possible that new threads have been created since we counted. + // Ignore them. + if (i == n_threads) + break; + arr->payload[i] = (StgClosure *) t; + i++; + } + } + CHECKM(i == n_threads, "listThreads: Found too few threads"); + return arr; +} + /* ---------------------------------------------------------------------------- * Debugging: why is a thread blocked * ------------------------------------------------------------------------- */ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f8ec2edf7be727f6a6cd4f40d5d40a0014dd66f2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f8ec2edf7be727f6a6cd4f40d5d40a0014dd66f2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Dec 6 18:27:12 2020 From: gitlab at gitlab.haskell.org (John Ericson) Date: Sun, 06 Dec 2020 13:27:12 -0500 Subject: [Git][ghc/ghc][wip/primop-naming-consistency] 2 commits: Fix sized primitives (#19026) Message-ID: <5fcd2280579cf_6b2147a61c2731a3@gitlab.mail> John Ericson pushed to branch wip/primop-naming-consistency at Glasgow Haskell Compiler / GHC Commits: a06f9bfa by Sylvain Henry at 2020-12-03T19:40:29+01:00 Fix sized primitives (#19026) Bump Cabal, array, bytestring, text submodules - - - - - e2e89133 by John Ericson at 2020-12-06T18:24:41+00:00 Cleanup number primop conversion names Don't use "extend" or "narrow" in some of the user-facing primops names for conversions. - Names like `narrowInt32#` are misleading when `Int` is 32-bits. - Names like `extendInt64#` are flat-out wrong when `Int is 32-bits. - `narrow{Int,Word}<N>#` however map a type to itself, and so don't suffer from this problem. They are left as-is. Bumps the array, bytestring, text, and binary submodules - - - - - 30 changed files: - compiler/GHC/Builtin/bytearray-ops.txt.pp - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Data/FastString.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/Tc/Deriv/Generate.hs - libraries/Cabal - libraries/array - libraries/base/GHC/Float/ConversionUtils.hs - libraries/base/GHC/IO/Encoding/CodePage.hs - libraries/base/GHC/IO/Encoding/UTF16.hs - libraries/base/GHC/IO/Encoding/UTF32.hs - libraries/base/GHC/IO/Encoding/UTF8.hs - libraries/base/GHC/Int.hs - libraries/base/GHC/Storable.hs - libraries/base/GHC/Word.hs - libraries/binary - libraries/bytestring - libraries/ghc-bignum/src/GHC/Num/Backend/GMP.hs - libraries/ghc-bignum/src/GHC/Num/Primitives.hs - libraries/ghc-boot/GHC/Utils/Encoding.hs - libraries/ghc-heap/tests/tso_and_stack_closures.hs - libraries/ghci/GHCi/BreakArray.hs - libraries/text - testsuite/tests/array/should_run/arr020.hs - testsuite/tests/cmm/opt/T18141.hs - testsuite/tests/codeGen/should_compile/T18614.hs - testsuite/tests/codeGen/should_run/cgrun070.hs - testsuite/tests/codeGen/should_run/cgrun072.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/409bbd76fbc3182ca5f004f8ba54f2767721dad3...e2e89133e23445e78775594f244f55732dfb60ea -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/409bbd76fbc3182ca5f004f8ba54f2767721dad3...e2e89133e23445e78775594f244f55732dfb60ea You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Dec 6 18:34:56 2020 From: gitlab at gitlab.haskell.org (John Ericson) Date: Sun, 06 Dec 2020 13:34:56 -0500 Subject: [Git][ghc/ghc][wip/fixed-width-lits] 35 commits: withTimings: Emit allocations counter Message-ID: <5fcd245044ba6_6b21a31a382740b1@gitlab.mail> John Ericson pushed to branch wip/fixed-width-lits at Glasgow Haskell Compiler / GHC Commits: 1bc104b0 by Ben Gamari at 2020-11-29T15:33:18-05:00 withTimings: Emit allocations counter This will allow us to back out the allocations per compiler pass from the eventlog. Note that we dump the allocation counter rather than the difference since this will allow us to determine how much work is done *between* `withTiming` blocks. - - - - - e992ea84 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 ThreadPaused: Don't zero slop until free vars are pushed When threadPaused blackholes a thunk it calls `OVERWRITING_CLOSURE` to zero the slop for the benefit of the sanity checker. Previously this was done *before* pushing the thunk's free variables to the update remembered set. Consequently we would pull zero'd pointers to the update remembered set. - - - - - e82cd140 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Fix regression from TSAN work The TSAN rework (specifically aad1f803) introduced a subtle regression in GC.c, swapping `g0` in place of `gen`. Whoops! Fixes #18997. - - - - - 35a5207e by GHC GitLab CI at 2020-11-29T15:33:54-05:00 rts/Messages: Add missing write barrier in THROWTO message update After a THROWTO message has been handle the message closure is overwritten by a NULL message. We must ensure that the original closure's pointers continue to be visible to the nonmoving GC. - - - - - 0120829f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Add missing write barrier in shrinkSmallByteArray - - - - - 8a4d8fb6 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 Updates: Don't zero slop until closure has been pushed Ensure that the the free variables have been pushed to the update remembered set before we zero the slop. - - - - - 2793cfdc by GHC GitLab CI at 2020-11-29T15:33:54-05:00 OSThreads: Fix error code checking pthread_join returns its error code and apparently doesn't set errno. - - - - - e391a16f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Don't join to mark_thread on shutdown The mark thread is not joinable as we detach from it on creation. - - - - - 60d088ab by Ben Gamari at 2020-11-29T15:33:54-05:00 nonmoving: Add reference to Ueno 2016 - - - - - 3aa60362 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Ensure that evacuated large objects are marked See Note [Non-moving GC: Marking evacuated objects]. - - - - - 8d304a99 by Ben Gamari at 2020-11-30T10:15:22-05:00 rts/m32: Refactor handling of allocator seeding Previously, in an attempt to reduce fragmentation, each new allocator would map a region of M32_MAX_PAGES fresh pages to seed itself. However, this ends up being extremely wasteful since it turns out that we often use fewer than this. Consequently, these pages end up getting freed which, ends up fragmenting our address space more than than we would have if we had naively allocated pages on-demand. Here we refactor m32 to avoid this waste while achieving the fragmentation mitigation previously desired. In particular, we move all page allocation into the global m32_alloc_page, which will pull a page from the free page pool. If the free page pool is empty we then refill it by allocating a region of M32_MAP_PAGES and adding them to the pool. Furthermore, we do away with the initial seeding entirely. That is, the allocator starts with no active pages: pages are rather allocated on an as-needed basis. On the whole this ends up being a pleasingly simple change, simultaneously making m32 more efficient, more robust, and simpler. Fixes #18980. - - - - - b6629289 by Ben Gamari at 2020-11-30T10:15:58-05:00 rts: Use CHECK instead of assert Use the GHC wrappers instead of <assert.h>. - - - - - 9f4efa6a by Ben Gamari at 2020-11-30T10:15:58-05:00 rts/linker: Replace some ASSERTs with CHECK In the past some people have confused ASSERT, which is for checking internal invariants, which CHECK, which should be used when checking things that might fail due to bad input (and therefore should be enabled even in the release compiler). Change some of these cases in the linker to use CHECK. - - - - - 0f8a4655 by Ryan Scott at 2020-11-30T10:16:34-05:00 Allow deploy:pages job to fail See #18973. - - - - - 49ebe369 by chessai at 2020-11-30T19:47:40-05:00 Optimisations in Data.Foldable (T17867) This PR concerns the following functions from `Data.Foldable`: * minimum * maximum * sum * product * minimumBy * maximumBy - Default implementations of these functions now use `foldl'` or `foldMap'`. - All have been marked with INLINEABLE to make room for further optimisations. - - - - - 4d79ef65 by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - 6af074ce by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - ab334262 by Viktor Dukhovni at 2020-11-30T19:48:17-05:00 dirty MVAR after mutating TSO queue head While the original head and tail of the TSO queue may be in the same generation as the MVAR, interior elements of the queue could be younger after a GC run and may then be exposed by putMVar operation that updates the queue head. Resolves #18919 - - - - - 5eb163f3 by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Don't allow shared libraries to be loaded multiple times - - - - - 490aa14d by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Initialise CCSs from native shared objects - - - - - 6ac3db5f by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Move shared library loading logic into Elf.c - - - - - b6698d73 by GHC GitLab CI at 2020-11-30T19:48:53-05:00 rts/linker: Don't declare dynamic objects with image_mapped This previously resulted in warnings due to spurious unmap failures. - - - - - b94a65af by jneira at 2020-11-30T19:49:31-05:00 Include tried paths in findToolDir error - - - - - 72a87fbc by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Move core flattening algorithm to Core.Unify This sets the stage for a later change, where this algorithm will be needed from GHC.Core.InstEnv. This commit also splits GHC.Core.Map into GHC.Core.Map.Type and GHC.Core.Map.Expr, in order to avoid module import cycles with GHC.Core. - - - - - 0dd45d0a by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Bump the # of commits searched for perf baseline The previous value of 75 meant that a feature branch with more than 75 commits would get spurious CI passes. This affects #18692, but does not fix that ticket, because if a baseline cannot be found, we should fail, not succeed. - - - - - 8bb52d91 by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Remove flattening variables This patch redesigns the flattener to simplify type family applications directly instead of using flattening meta-variables and skolems. The key new innovation is the CanEqLHS type and the new CEqCan constraint (Ct). A CanEqLHS is either a type variable or exactly-saturated type family application; either can now be rewritten using a CEqCan constraint in the inert set. Because the flattener no longer reduces all type family applications to variables, there was some performance degradation if a lengthy type family application is now flattened over and over (not making progress). To compensate, this patch contains some extra optimizations in the flattener, leading to a number of performance improvements. Close #18875. Close #18910. There are many extra parts of the compiler that had to be affected in writing this patch: * The family-application cache (formerly the flat-cache) sometimes stores coercions built from Given inerts. When these inerts get kicked out, we must kick out from the cache as well. (This was, I believe, true previously, but somehow never caused trouble.) Kicking out from the cache requires adding a filterTM function to TrieMap. * This patch obviates the need to distinguish "blocking" coercion holes from non-blocking ones (which, previously, arose from CFunEqCans). There is thus some simplification around coercion holes. * Extra commentary throughout parts of the code I read through, to preserve the knowledge I gained while working. * A change in the pure unifier around unifying skolems with other types. Unifying a skolem now leads to SurelyApart, not MaybeApart, as documented in Note [Binding when looking up instances] in GHC.Core.InstEnv. * Some more use of MCoercion where appropriate. * Previously, class-instance lookup automatically noticed that e.g. C Int was a "unifier" to a target [W] C (F Bool), because the F Bool was flattened to a variable. Now, a little more care must be taken around checking for unifying instances. * Previously, tcSplitTyConApp_maybe would split (Eq a => a). This is silly, because (=>) is not a tycon in Haskell. Fixed now, but there are some knock-on changes in e.g. TrieMap code and in the canonicaliser. * New function anyFreeVarsOf{Type,Co} to check whether a free variable satisfies a certain predicate. * Type synonyms now remember whether or not they are "forgetful"; a forgetful synonym drops at least one argument. This is useful when flattening; see flattenView. * The pattern-match completeness checker invokes the solver. This invocation might need to look through newtypes when checking representational equality. Thus, the desugarer needs to keep track of the in-scope variables to know what newtype constructors are in scope. I bet this bug was around before but never noticed. * Extra-constraints wildcards are no longer simplified before printing. See Note [Do not simplify ConstraintHoles] in GHC.Tc.Solver. * Whether or not there are Given equalities has become slightly subtler. See the new HasGivenEqs datatype. * Note [Type variable cycles in Givens] in GHC.Tc.Solver.Canonical explains a significant new wrinkle in the new approach. * See Note [What might match later?] in GHC.Tc.Solver.Interact, which explains the fix to #18910. * The inert_count field of InertCans wasn't actually used, so I removed it. Though I (Richard) did the implementation, Simon PJ was very involved in design and review. This updates the Haddock submodule to avoid #18932 by adding a type signature. ------------------------- Metric Decrease: T12227 T5030 T9872a T9872b T9872c Metric Increase: T9872d ------------------------- - - - - - d66660ba by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Rename the flattener to become the rewriter. Now that flattening doesn't produce flattening variables, it's not really flattening anything: it's rewriting. This change also means that the rewriter can no longer be confused the core flattener (in GHC.Core.Unify), which is sometimes used during type-checking. - - - - - add0aeae by Ben Gamari at 2020-12-01T19:58:17-05:00 rts: Introduce mmapAnonForLinker Previously most of the uses of mmapForLinker were mapping anonymous memory, resulting in a great deal of unnecessary repetition. Factor this out into a new helper. Also fixes a few places where error checking was missing or suboptimal. - - - - - 97d71646 by Ben Gamari at 2020-12-01T19:58:17-05:00 rts/linker: Introduce munmapForLinker Consolidates munmap calls to ensure consistent error handling. - - - - - d8872af0 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/Linker: Introduce Windows implementations for mmapForLinker, et al. - - - - - c35d0e03 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/m32: Introduce NEEDS_M32 macro Instead of relying on RTS_LINKER_USE_MMAP - - - - - 41c64eb5 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/linker: Use m32 to allocate symbol extras in PEi386 - - - - - a06f9bfa by Sylvain Henry at 2020-12-03T19:40:29+01:00 Fix sized primitives (#19026) Bump Cabal, array, bytestring, text submodules - - - - - e2e89133 by John Ericson at 2020-12-06T18:24:41+00:00 Cleanup number primop conversion names Don't use "extend" or "narrow" in some of the user-facing primops names for conversions. - Names like `narrowInt32#` are misleading when `Int` is 32-bits. - Names like `extendInt64#` are flat-out wrong when `Int is 32-bits. - `narrow{Int,Word}<N>#` however map a type to itself, and so don't suffer from this problem. They are left as-is. Bumps the array, bytestring, text, and binary submodules - - - - - 522796f5 by Sylvain Henry at 2020-12-06T18:34:44+00:00 Make proper fixed-with number literals (Progress towards #11953, #17377, #17375) Besides being nicer to use, this also will allow for better constant folding for the fixed-width types, on par with what `Int#` and `Word#` have today. - - - - - 25 changed files: - .gitlab-ci.yml - compiler/GHC/Builtin/bytearray-ops.txt.pp - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Axiom.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FamInstEnv.hs - compiler/GHC/Core/InstEnv.hs - + compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Map.hs → compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/Opt/CSE.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/TyCon/Env.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/FastString.hs - compiler/GHC/Data/Maybe.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4d6a5a08fed7d8ca83423010b1426ad87687c9c1...522796f5fe9e72b5b01ac150ab8893fa56e04771 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4d6a5a08fed7d8ca83423010b1426ad87687c9c1...522796f5fe9e72b5b01ac150ab8893fa56e04771 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Dec 6 18:44:43 2020 From: gitlab at gitlab.haskell.org (John Ericson) Date: Sun, 06 Dec 2020 13:44:43 -0500 Subject: [Git][ghc/ghc][wip/int64-everywhere] 41 commits: withTimings: Emit allocations counter Message-ID: <5fcd269bec8a7_6b2174471c27497f@gitlab.mail> John Ericson pushed to branch wip/int64-everywhere at Glasgow Haskell Compiler / GHC Commits: 1bc104b0 by Ben Gamari at 2020-11-29T15:33:18-05:00 withTimings: Emit allocations counter This will allow us to back out the allocations per compiler pass from the eventlog. Note that we dump the allocation counter rather than the difference since this will allow us to determine how much work is done *between* `withTiming` blocks. - - - - - e992ea84 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 ThreadPaused: Don't zero slop until free vars are pushed When threadPaused blackholes a thunk it calls `OVERWRITING_CLOSURE` to zero the slop for the benefit of the sanity checker. Previously this was done *before* pushing the thunk's free variables to the update remembered set. Consequently we would pull zero'd pointers to the update remembered set. - - - - - e82cd140 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Fix regression from TSAN work The TSAN rework (specifically aad1f803) introduced a subtle regression in GC.c, swapping `g0` in place of `gen`. Whoops! Fixes #18997. - - - - - 35a5207e by GHC GitLab CI at 2020-11-29T15:33:54-05:00 rts/Messages: Add missing write barrier in THROWTO message update After a THROWTO message has been handle the message closure is overwritten by a NULL message. We must ensure that the original closure's pointers continue to be visible to the nonmoving GC. - - - - - 0120829f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Add missing write barrier in shrinkSmallByteArray - - - - - 8a4d8fb6 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 Updates: Don't zero slop until closure has been pushed Ensure that the the free variables have been pushed to the update remembered set before we zero the slop. - - - - - 2793cfdc by GHC GitLab CI at 2020-11-29T15:33:54-05:00 OSThreads: Fix error code checking pthread_join returns its error code and apparently doesn't set errno. - - - - - e391a16f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Don't join to mark_thread on shutdown The mark thread is not joinable as we detach from it on creation. - - - - - 60d088ab by Ben Gamari at 2020-11-29T15:33:54-05:00 nonmoving: Add reference to Ueno 2016 - - - - - 3aa60362 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Ensure that evacuated large objects are marked See Note [Non-moving GC: Marking evacuated objects]. - - - - - 8d304a99 by Ben Gamari at 2020-11-30T10:15:22-05:00 rts/m32: Refactor handling of allocator seeding Previously, in an attempt to reduce fragmentation, each new allocator would map a region of M32_MAX_PAGES fresh pages to seed itself. However, this ends up being extremely wasteful since it turns out that we often use fewer than this. Consequently, these pages end up getting freed which, ends up fragmenting our address space more than than we would have if we had naively allocated pages on-demand. Here we refactor m32 to avoid this waste while achieving the fragmentation mitigation previously desired. In particular, we move all page allocation into the global m32_alloc_page, which will pull a page from the free page pool. If the free page pool is empty we then refill it by allocating a region of M32_MAP_PAGES and adding them to the pool. Furthermore, we do away with the initial seeding entirely. That is, the allocator starts with no active pages: pages are rather allocated on an as-needed basis. On the whole this ends up being a pleasingly simple change, simultaneously making m32 more efficient, more robust, and simpler. Fixes #18980. - - - - - b6629289 by Ben Gamari at 2020-11-30T10:15:58-05:00 rts: Use CHECK instead of assert Use the GHC wrappers instead of <assert.h>. - - - - - 9f4efa6a by Ben Gamari at 2020-11-30T10:15:58-05:00 rts/linker: Replace some ASSERTs with CHECK In the past some people have confused ASSERT, which is for checking internal invariants, which CHECK, which should be used when checking things that might fail due to bad input (and therefore should be enabled even in the release compiler). Change some of these cases in the linker to use CHECK. - - - - - 0f8a4655 by Ryan Scott at 2020-11-30T10:16:34-05:00 Allow deploy:pages job to fail See #18973. - - - - - 49ebe369 by chessai at 2020-11-30T19:47:40-05:00 Optimisations in Data.Foldable (T17867) This PR concerns the following functions from `Data.Foldable`: * minimum * maximum * sum * product * minimumBy * maximumBy - Default implementations of these functions now use `foldl'` or `foldMap'`. - All have been marked with INLINEABLE to make room for further optimisations. - - - - - 4d79ef65 by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - 6af074ce by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - ab334262 by Viktor Dukhovni at 2020-11-30T19:48:17-05:00 dirty MVAR after mutating TSO queue head While the original head and tail of the TSO queue may be in the same generation as the MVAR, interior elements of the queue could be younger after a GC run and may then be exposed by putMVar operation that updates the queue head. Resolves #18919 - - - - - 5eb163f3 by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Don't allow shared libraries to be loaded multiple times - - - - - 490aa14d by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Initialise CCSs from native shared objects - - - - - 6ac3db5f by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Move shared library loading logic into Elf.c - - - - - b6698d73 by GHC GitLab CI at 2020-11-30T19:48:53-05:00 rts/linker: Don't declare dynamic objects with image_mapped This previously resulted in warnings due to spurious unmap failures. - - - - - b94a65af by jneira at 2020-11-30T19:49:31-05:00 Include tried paths in findToolDir error - - - - - 72a87fbc by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Move core flattening algorithm to Core.Unify This sets the stage for a later change, where this algorithm will be needed from GHC.Core.InstEnv. This commit also splits GHC.Core.Map into GHC.Core.Map.Type and GHC.Core.Map.Expr, in order to avoid module import cycles with GHC.Core. - - - - - 0dd45d0a by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Bump the # of commits searched for perf baseline The previous value of 75 meant that a feature branch with more than 75 commits would get spurious CI passes. This affects #18692, but does not fix that ticket, because if a baseline cannot be found, we should fail, not succeed. - - - - - 8bb52d91 by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Remove flattening variables This patch redesigns the flattener to simplify type family applications directly instead of using flattening meta-variables and skolems. The key new innovation is the CanEqLHS type and the new CEqCan constraint (Ct). A CanEqLHS is either a type variable or exactly-saturated type family application; either can now be rewritten using a CEqCan constraint in the inert set. Because the flattener no longer reduces all type family applications to variables, there was some performance degradation if a lengthy type family application is now flattened over and over (not making progress). To compensate, this patch contains some extra optimizations in the flattener, leading to a number of performance improvements. Close #18875. Close #18910. There are many extra parts of the compiler that had to be affected in writing this patch: * The family-application cache (formerly the flat-cache) sometimes stores coercions built from Given inerts. When these inerts get kicked out, we must kick out from the cache as well. (This was, I believe, true previously, but somehow never caused trouble.) Kicking out from the cache requires adding a filterTM function to TrieMap. * This patch obviates the need to distinguish "blocking" coercion holes from non-blocking ones (which, previously, arose from CFunEqCans). There is thus some simplification around coercion holes. * Extra commentary throughout parts of the code I read through, to preserve the knowledge I gained while working. * A change in the pure unifier around unifying skolems with other types. Unifying a skolem now leads to SurelyApart, not MaybeApart, as documented in Note [Binding when looking up instances] in GHC.Core.InstEnv. * Some more use of MCoercion where appropriate. * Previously, class-instance lookup automatically noticed that e.g. C Int was a "unifier" to a target [W] C (F Bool), because the F Bool was flattened to a variable. Now, a little more care must be taken around checking for unifying instances. * Previously, tcSplitTyConApp_maybe would split (Eq a => a). This is silly, because (=>) is not a tycon in Haskell. Fixed now, but there are some knock-on changes in e.g. TrieMap code and in the canonicaliser. * New function anyFreeVarsOf{Type,Co} to check whether a free variable satisfies a certain predicate. * Type synonyms now remember whether or not they are "forgetful"; a forgetful synonym drops at least one argument. This is useful when flattening; see flattenView. * The pattern-match completeness checker invokes the solver. This invocation might need to look through newtypes when checking representational equality. Thus, the desugarer needs to keep track of the in-scope variables to know what newtype constructors are in scope. I bet this bug was around before but never noticed. * Extra-constraints wildcards are no longer simplified before printing. See Note [Do not simplify ConstraintHoles] in GHC.Tc.Solver. * Whether or not there are Given equalities has become slightly subtler. See the new HasGivenEqs datatype. * Note [Type variable cycles in Givens] in GHC.Tc.Solver.Canonical explains a significant new wrinkle in the new approach. * See Note [What might match later?] in GHC.Tc.Solver.Interact, which explains the fix to #18910. * The inert_count field of InertCans wasn't actually used, so I removed it. Though I (Richard) did the implementation, Simon PJ was very involved in design and review. This updates the Haddock submodule to avoid #18932 by adding a type signature. ------------------------- Metric Decrease: T12227 T5030 T9872a T9872b T9872c Metric Increase: T9872d ------------------------- - - - - - d66660ba by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Rename the flattener to become the rewriter. Now that flattening doesn't produce flattening variables, it's not really flattening anything: it's rewriting. This change also means that the rewriter can no longer be confused the core flattener (in GHC.Core.Unify), which is sometimes used during type-checking. - - - - - add0aeae by Ben Gamari at 2020-12-01T19:58:17-05:00 rts: Introduce mmapAnonForLinker Previously most of the uses of mmapForLinker were mapping anonymous memory, resulting in a great deal of unnecessary repetition. Factor this out into a new helper. Also fixes a few places where error checking was missing or suboptimal. - - - - - 97d71646 by Ben Gamari at 2020-12-01T19:58:17-05:00 rts/linker: Introduce munmapForLinker Consolidates munmap calls to ensure consistent error handling. - - - - - d8872af0 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/Linker: Introduce Windows implementations for mmapForLinker, et al. - - - - - c35d0e03 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/m32: Introduce NEEDS_M32 macro Instead of relying on RTS_LINKER_USE_MMAP - - - - - 41c64eb5 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/linker: Use m32 to allocate symbol extras in PEi386 - - - - - a06f9bfa by Sylvain Henry at 2020-12-03T19:40:29+01:00 Fix sized primitives (#19026) Bump Cabal, array, bytestring, text submodules - - - - - e2e89133 by John Ericson at 2020-12-06T18:24:41+00:00 Cleanup number primop conversion names Don't use "extend" or "narrow" in some of the user-facing primops names for conversions. - Names like `narrowInt32#` are misleading when `Int` is 32-bits. - Names like `extendInt64#` are flat-out wrong when `Int is 32-bits. - `narrow{Int,Word}<N>#` however map a type to itself, and so don't suffer from this problem. They are left as-is. Bumps the array, bytestring, text, and binary submodules - - - - - 522796f5 by Sylvain Henry at 2020-12-06T18:34:44+00:00 Make proper fixed-with number literals (Progress towards #11953, #17377, #17375) Besides being nicer to use, this also will allow for better constant folding for the fixed-width types, on par with what `Int#` and `Word#` have today. - - - - - 6d270608 by John Ericson at 2020-12-06T18:41:02+00:00 Make fixed-size `Int32#` and `Int64#` The boxed Int64 uses Int64#, but Int32# still uses Int#. The 32-bit case is less pressing to change because it is not a source of brittle CPP---it is the same thing on all platforms. We need Int64/Word64 constant folding to avoid the let/app restriction on Core, so that is implemented now. 32-bit constant unfolding and 32-bit literals are left as follow-up. This is the bulk of #11953 Co-authored-by: Sylvain Henry <hsyl20 at gmail.com> - - - - - b906439c by John Ericson at 2020-12-06T18:44:34+00:00 Inline INT64 and WORD64 macros in primops.txt.pp The definition is now unconditional so there is no reason for that CPP. - - - - - 486a09e1 by Sylvain Henry at 2020-12-06T18:44:35+00:00 Adapt rules from #16402 to Word64#/Int64# - - - - - 90987f3c by John Ericson at 2020-12-06T18:44:35+00:00 Copy enumFrom* implementations from Int/Word for Int64/Word64 Without this, we don't get proper list fusion. I think this sort of copying is OK for now, but we absolutely need something better if we are going to make `IntN` use `IntN#` for all `N`. The degree to which proper metaprogramming has been punted upon by factoring everything through the native-sized types is disconcerting. - - - - - 2000b4ec by John Ericson at 2020-12-06T18:44:35+00:00 `integerFromInt64#` can be inlined when the word size is >= 64 bits Maybe this will help with the renaming test failure? - - - - - 4bebf98d by John Ericson at 2020-12-06T18:44:35+00:00 Add builtin rule for `divInt64#` and `modInt64#` - - - - - 22 changed files: - .gitlab-ci.yml - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/bytearray-ops.txt.pp - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Axiom.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FamInstEnv.hs - compiler/GHC/Core/InstEnv.hs - + compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Map.hs → compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/Opt/CSE.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7135eb06cf3e45edc85bffe299b7d0890aded7d1...4bebf98da0d1edee6bb1b2ffb1b7ce87eed16856 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7135eb06cf3e45edc85bffe299b7d0890aded7d1...4bebf98da0d1edee6bb1b2ffb1b7ce87eed16856 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Dec 6 18:47:07 2020 From: gitlab at gitlab.haskell.org (John Ericson) Date: Sun, 06 Dec 2020 13:47:07 -0500 Subject: [Git][ghc/ghc][wip/int64-everywhere-new-float-primops] 42 commits: withTimings: Emit allocations counter Message-ID: <5fcd272b7430e_6b2174471c2760bd@gitlab.mail> John Ericson pushed to branch wip/int64-everywhere-new-float-primops at Glasgow Haskell Compiler / GHC Commits: 1bc104b0 by Ben Gamari at 2020-11-29T15:33:18-05:00 withTimings: Emit allocations counter This will allow us to back out the allocations per compiler pass from the eventlog. Note that we dump the allocation counter rather than the difference since this will allow us to determine how much work is done *between* `withTiming` blocks. - - - - - e992ea84 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 ThreadPaused: Don't zero slop until free vars are pushed When threadPaused blackholes a thunk it calls `OVERWRITING_CLOSURE` to zero the slop for the benefit of the sanity checker. Previously this was done *before* pushing the thunk's free variables to the update remembered set. Consequently we would pull zero'd pointers to the update remembered set. - - - - - e82cd140 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Fix regression from TSAN work The TSAN rework (specifically aad1f803) introduced a subtle regression in GC.c, swapping `g0` in place of `gen`. Whoops! Fixes #18997. - - - - - 35a5207e by GHC GitLab CI at 2020-11-29T15:33:54-05:00 rts/Messages: Add missing write barrier in THROWTO message update After a THROWTO message has been handle the message closure is overwritten by a NULL message. We must ensure that the original closure's pointers continue to be visible to the nonmoving GC. - - - - - 0120829f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Add missing write barrier in shrinkSmallByteArray - - - - - 8a4d8fb6 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 Updates: Don't zero slop until closure has been pushed Ensure that the the free variables have been pushed to the update remembered set before we zero the slop. - - - - - 2793cfdc by GHC GitLab CI at 2020-11-29T15:33:54-05:00 OSThreads: Fix error code checking pthread_join returns its error code and apparently doesn't set errno. - - - - - e391a16f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Don't join to mark_thread on shutdown The mark thread is not joinable as we detach from it on creation. - - - - - 60d088ab by Ben Gamari at 2020-11-29T15:33:54-05:00 nonmoving: Add reference to Ueno 2016 - - - - - 3aa60362 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Ensure that evacuated large objects are marked See Note [Non-moving GC: Marking evacuated objects]. - - - - - 8d304a99 by Ben Gamari at 2020-11-30T10:15:22-05:00 rts/m32: Refactor handling of allocator seeding Previously, in an attempt to reduce fragmentation, each new allocator would map a region of M32_MAX_PAGES fresh pages to seed itself. However, this ends up being extremely wasteful since it turns out that we often use fewer than this. Consequently, these pages end up getting freed which, ends up fragmenting our address space more than than we would have if we had naively allocated pages on-demand. Here we refactor m32 to avoid this waste while achieving the fragmentation mitigation previously desired. In particular, we move all page allocation into the global m32_alloc_page, which will pull a page from the free page pool. If the free page pool is empty we then refill it by allocating a region of M32_MAP_PAGES and adding them to the pool. Furthermore, we do away with the initial seeding entirely. That is, the allocator starts with no active pages: pages are rather allocated on an as-needed basis. On the whole this ends up being a pleasingly simple change, simultaneously making m32 more efficient, more robust, and simpler. Fixes #18980. - - - - - b6629289 by Ben Gamari at 2020-11-30T10:15:58-05:00 rts: Use CHECK instead of assert Use the GHC wrappers instead of <assert.h>. - - - - - 9f4efa6a by Ben Gamari at 2020-11-30T10:15:58-05:00 rts/linker: Replace some ASSERTs with CHECK In the past some people have confused ASSERT, which is for checking internal invariants, which CHECK, which should be used when checking things that might fail due to bad input (and therefore should be enabled even in the release compiler). Change some of these cases in the linker to use CHECK. - - - - - 0f8a4655 by Ryan Scott at 2020-11-30T10:16:34-05:00 Allow deploy:pages job to fail See #18973. - - - - - 49ebe369 by chessai at 2020-11-30T19:47:40-05:00 Optimisations in Data.Foldable (T17867) This PR concerns the following functions from `Data.Foldable`: * minimum * maximum * sum * product * minimumBy * maximumBy - Default implementations of these functions now use `foldl'` or `foldMap'`. - All have been marked with INLINEABLE to make room for further optimisations. - - - - - 4d79ef65 by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - 6af074ce by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - ab334262 by Viktor Dukhovni at 2020-11-30T19:48:17-05:00 dirty MVAR after mutating TSO queue head While the original head and tail of the TSO queue may be in the same generation as the MVAR, interior elements of the queue could be younger after a GC run and may then be exposed by putMVar operation that updates the queue head. Resolves #18919 - - - - - 5eb163f3 by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Don't allow shared libraries to be loaded multiple times - - - - - 490aa14d by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Initialise CCSs from native shared objects - - - - - 6ac3db5f by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Move shared library loading logic into Elf.c - - - - - b6698d73 by GHC GitLab CI at 2020-11-30T19:48:53-05:00 rts/linker: Don't declare dynamic objects with image_mapped This previously resulted in warnings due to spurious unmap failures. - - - - - b94a65af by jneira at 2020-11-30T19:49:31-05:00 Include tried paths in findToolDir error - - - - - 72a87fbc by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Move core flattening algorithm to Core.Unify This sets the stage for a later change, where this algorithm will be needed from GHC.Core.InstEnv. This commit also splits GHC.Core.Map into GHC.Core.Map.Type and GHC.Core.Map.Expr, in order to avoid module import cycles with GHC.Core. - - - - - 0dd45d0a by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Bump the # of commits searched for perf baseline The previous value of 75 meant that a feature branch with more than 75 commits would get spurious CI passes. This affects #18692, but does not fix that ticket, because if a baseline cannot be found, we should fail, not succeed. - - - - - 8bb52d91 by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Remove flattening variables This patch redesigns the flattener to simplify type family applications directly instead of using flattening meta-variables and skolems. The key new innovation is the CanEqLHS type and the new CEqCan constraint (Ct). A CanEqLHS is either a type variable or exactly-saturated type family application; either can now be rewritten using a CEqCan constraint in the inert set. Because the flattener no longer reduces all type family applications to variables, there was some performance degradation if a lengthy type family application is now flattened over and over (not making progress). To compensate, this patch contains some extra optimizations in the flattener, leading to a number of performance improvements. Close #18875. Close #18910. There are many extra parts of the compiler that had to be affected in writing this patch: * The family-application cache (formerly the flat-cache) sometimes stores coercions built from Given inerts. When these inerts get kicked out, we must kick out from the cache as well. (This was, I believe, true previously, but somehow never caused trouble.) Kicking out from the cache requires adding a filterTM function to TrieMap. * This patch obviates the need to distinguish "blocking" coercion holes from non-blocking ones (which, previously, arose from CFunEqCans). There is thus some simplification around coercion holes. * Extra commentary throughout parts of the code I read through, to preserve the knowledge I gained while working. * A change in the pure unifier around unifying skolems with other types. Unifying a skolem now leads to SurelyApart, not MaybeApart, as documented in Note [Binding when looking up instances] in GHC.Core.InstEnv. * Some more use of MCoercion where appropriate. * Previously, class-instance lookup automatically noticed that e.g. C Int was a "unifier" to a target [W] C (F Bool), because the F Bool was flattened to a variable. Now, a little more care must be taken around checking for unifying instances. * Previously, tcSplitTyConApp_maybe would split (Eq a => a). This is silly, because (=>) is not a tycon in Haskell. Fixed now, but there are some knock-on changes in e.g. TrieMap code and in the canonicaliser. * New function anyFreeVarsOf{Type,Co} to check whether a free variable satisfies a certain predicate. * Type synonyms now remember whether or not they are "forgetful"; a forgetful synonym drops at least one argument. This is useful when flattening; see flattenView. * The pattern-match completeness checker invokes the solver. This invocation might need to look through newtypes when checking representational equality. Thus, the desugarer needs to keep track of the in-scope variables to know what newtype constructors are in scope. I bet this bug was around before but never noticed. * Extra-constraints wildcards are no longer simplified before printing. See Note [Do not simplify ConstraintHoles] in GHC.Tc.Solver. * Whether or not there are Given equalities has become slightly subtler. See the new HasGivenEqs datatype. * Note [Type variable cycles in Givens] in GHC.Tc.Solver.Canonical explains a significant new wrinkle in the new approach. * See Note [What might match later?] in GHC.Tc.Solver.Interact, which explains the fix to #18910. * The inert_count field of InertCans wasn't actually used, so I removed it. Though I (Richard) did the implementation, Simon PJ was very involved in design and review. This updates the Haddock submodule to avoid #18932 by adding a type signature. ------------------------- Metric Decrease: T12227 T5030 T9872a T9872b T9872c Metric Increase: T9872d ------------------------- - - - - - d66660ba by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Rename the flattener to become the rewriter. Now that flattening doesn't produce flattening variables, it's not really flattening anything: it's rewriting. This change also means that the rewriter can no longer be confused the core flattener (in GHC.Core.Unify), which is sometimes used during type-checking. - - - - - add0aeae by Ben Gamari at 2020-12-01T19:58:17-05:00 rts: Introduce mmapAnonForLinker Previously most of the uses of mmapForLinker were mapping anonymous memory, resulting in a great deal of unnecessary repetition. Factor this out into a new helper. Also fixes a few places where error checking was missing or suboptimal. - - - - - 97d71646 by Ben Gamari at 2020-12-01T19:58:17-05:00 rts/linker: Introduce munmapForLinker Consolidates munmap calls to ensure consistent error handling. - - - - - d8872af0 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/Linker: Introduce Windows implementations for mmapForLinker, et al. - - - - - c35d0e03 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/m32: Introduce NEEDS_M32 macro Instead of relying on RTS_LINKER_USE_MMAP - - - - - 41c64eb5 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/linker: Use m32 to allocate symbol extras in PEi386 - - - - - a06f9bfa by Sylvain Henry at 2020-12-03T19:40:29+01:00 Fix sized primitives (#19026) Bump Cabal, array, bytestring, text submodules - - - - - e2e89133 by John Ericson at 2020-12-06T18:24:41+00:00 Cleanup number primop conversion names Don't use "extend" or "narrow" in some of the user-facing primops names for conversions. - Names like `narrowInt32#` are misleading when `Int` is 32-bits. - Names like `extendInt64#` are flat-out wrong when `Int is 32-bits. - `narrow{Int,Word}<N>#` however map a type to itself, and so don't suffer from this problem. They are left as-is. Bumps the array, bytestring, text, and binary submodules - - - - - 522796f5 by Sylvain Henry at 2020-12-06T18:34:44+00:00 Make proper fixed-with number literals (Progress towards #11953, #17377, #17375) Besides being nicer to use, this also will allow for better constant folding for the fixed-width types, on par with what `Int#` and `Word#` have today. - - - - - 6d270608 by John Ericson at 2020-12-06T18:41:02+00:00 Make fixed-size `Int32#` and `Int64#` The boxed Int64 uses Int64#, but Int32# still uses Int#. The 32-bit case is less pressing to change because it is not a source of brittle CPP---it is the same thing on all platforms. We need Int64/Word64 constant folding to avoid the let/app restriction on Core, so that is implemented now. 32-bit constant unfolding and 32-bit literals are left as follow-up. This is the bulk of #11953 Co-authored-by: Sylvain Henry <hsyl20 at gmail.com> - - - - - b906439c by John Ericson at 2020-12-06T18:44:34+00:00 Inline INT64 and WORD64 macros in primops.txt.pp The definition is now unconditional so there is no reason for that CPP. - - - - - 486a09e1 by Sylvain Henry at 2020-12-06T18:44:35+00:00 Adapt rules from #16402 to Word64#/Int64# - - - - - 90987f3c by John Ericson at 2020-12-06T18:44:35+00:00 Copy enumFrom* implementations from Int/Word for Int64/Word64 Without this, we don't get proper list fusion. I think this sort of copying is OK for now, but we absolutely need something better if we are going to make `IntN` use `IntN#` for all `N`. The degree to which proper metaprogramming has been punted upon by factoring everything through the native-sized types is disconcerting. - - - - - 2000b4ec by John Ericson at 2020-12-06T18:44:35+00:00 `integerFromInt64#` can be inlined when the word size is >= 64 bits Maybe this will help with the renaming test failure? - - - - - 4bebf98d by John Ericson at 2020-12-06T18:44:35+00:00 Add builtin rule for `divInt64#` and `modInt64#` - - - - - 4ca0d15d by John Ericson at 2020-12-06T18:46:35+00:00 WIP: Add missing floats <-> int/word 64 rule and primops - - - - - 23 changed files: - .gitlab-ci.yml - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/bytearray-ops.txt.pp - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/CmmToAsm/CPrim.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Axiom.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FamInstEnv.hs - compiler/GHC/Core/InstEnv.hs - + compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Map.hs → compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/Opt/CSE.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f82c273ce0c3b3033698e64fd21e2f7dc858016a...4ca0d15d7cdc3715cbd1dbfe2ff42039b6a9dabd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f82c273ce0c3b3033698e64fd21e2f7dc858016a...4ca0d15d7cdc3715cbd1dbfe2ff42039b6a9dabd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Dec 6 19:12:15 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sun, 06 Dec 2020 14:12:15 -0500 Subject: [Git][ghc/ghc][wip/thread-status] Add primop to list threads Message-ID: <5fcd2d0f3b1fa_6b2113d8dc02770ee@gitlab.mail> Ben Gamari pushed to branch wip/thread-status at Glasgow Haskell Compiler / GHC Commits: c15d33a6 by Ben Gamari at 2020-12-06T14:11:41-05:00 Add primop to list threads A user came to #ghc yesterday wondering how best to check whether they were leaking threads. We ended up using the eventlog but it seems to me like it would be generally useful if Haskell programs could query their own threads. - - - - - 13 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/StgToCmm/Prim.hs - includes/rts/Threads.h - includes/rts/storage/Closures.h - includes/stg/MiscClosures.h - libraries/base/GHC/Conc.hs - libraries/base/GHC/Conc/Sync.hs - libraries/base/tests/all.T - + libraries/base/tests/listThreads.hs - + libraries/base/tests/listThreads.stdout - rts/PrimOps.cmm - rts/RtsSymbols.c - rts/Threads.c Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -2684,6 +2684,13 @@ primop ThreadStatusOp "threadStatus#" GenPrimOp out_of_line = True has_side_effects = True +primop ListThreadsOp "listThreads#" GenPrimOp + State# RealWorld -> (# State# RealWorld, MutableArray# RealWorld a #) + { Returns an array of {\tt ThreadId#}s. } + with + out_of_line = True + has_side_effects = True + ------------------------------------------------------------------------ section "Weak pointers" ------------------------------------------------------------------------ ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -1543,6 +1543,7 @@ emitPrimOp dflags primop = case primop of MkApUpd0_Op -> alwaysExternal NewBCOOp -> alwaysExternal UnpackClosureOp -> alwaysExternal + ListThreadsOp -> alwaysExternal ClosureSizeOp -> alwaysExternal GetApStackValOp -> alwaysExternal ClearCCSOp -> alwaysExternal ===================================== includes/rts/Threads.h ===================================== @@ -51,6 +51,10 @@ long rts_getThreadId (StgPtr tso); void rts_enableThreadAllocationLimit (StgPtr tso); void rts_disableThreadAllocationLimit (StgPtr tso); +// Forward declarations, defined in Closures.h +struct _StgMutArrPtrs; +struct _StgMutArrPtrs *listThreads (Capability *cap); + #if !defined(mingw32_HOST_OS) pid_t forkProcess (HsStablePtr *entry); #else ===================================== includes/rts/storage/Closures.h ===================================== @@ -169,7 +169,7 @@ typedef struct { StgWord payload[]; } StgArrBytes; -typedef struct { +typedef struct _StgMutArrPtrs { StgHeader header; StgWord ptrs; StgWord size; // ptrs plus card table ===================================== includes/stg/MiscClosures.h ===================================== @@ -455,6 +455,7 @@ RTS_FUN_DECL(stg_myThreadIdzh); RTS_FUN_DECL(stg_labelThreadzh); RTS_FUN_DECL(stg_isCurrentThreadBoundzh); RTS_FUN_DECL(stg_threadStatuszh); +RTS_FUN_DECL(stg_listThreadszh); RTS_FUN_DECL(stg_mkWeakzh); RTS_FUN_DECL(stg_mkWeakNoFinalizzerzh); ===================================== libraries/base/GHC/Conc.hs ===================================== @@ -45,6 +45,7 @@ module GHC.Conc , yield , labelThread , mkWeakThreadId + , listThreads , ThreadStatus(..), BlockReason(..) , threadStatus ===================================== libraries/base/GHC/Conc/Sync.hs ===================================== @@ -52,6 +52,7 @@ module GHC.Conc.Sync , yield , labelThread , mkWeakThreadId + , listThreads , ThreadStatus(..), BlockReason(..) , threadStatus @@ -524,6 +525,27 @@ runSparks = IO loop then (# s', () #) else p `seq` loop s' +-- | List the Haskell threads of the current process. +listThreads :: IO [ThreadId] +listThreads = IO $ \s -> + case listThreads# s of + (# s', marr #) -> + case unsafeFreezeArray# marr s' of + (# s'', arr #) -> (# s'', mapListArray toThreadId arr #) + where + -- Ideally we would use UnliftedArray# but sadly this doesn't exist. + -- Instead listThreads# returns a polymorphic `Array# a` and we coerce. + toThreadId :: a -> ThreadId + toThreadId tid = ThreadId (unsafeCoerce# tid) + +mapListArray :: (a -> b) -> Array# a -> [b] +mapListArray f arr = go 0# + where + go i# + | isTrue# (i# ==# sizeofArray# arr) = [] + | otherwise = case indexArray# arr i# of + (# x #) -> f x : go (i# +# 1#) + data BlockReason = BlockedOnMVar -- ^blocked on 'MVar' ===================================== libraries/base/tests/all.T ===================================== @@ -261,3 +261,4 @@ test('T17499', [collect_stats('bytes allocated',5)], compile_and_run, ['-O -w']) test('T16643', normal, compile_and_run, ['']) test('clamp', normal, compile_and_run, ['']) test('T18642', extra_run_opts('+RTS -T -RTS'), compile_and_run, ['-O2']) +test('listThreads', normal, compile_and_run, ['']) ===================================== libraries/base/tests/listThreads.hs ===================================== @@ -0,0 +1,22 @@ +import Control.Concurrent +import GHC.Conc.Sync + +dummyThread :: MVar () -> Int -> IO () +dummyThread mvar n = do + tid <- myThreadId + labelThread tid ("thread-"++show n) + readMVar mvar + +main :: IO () +main = do + mvar <- newEmptyMVar + let mkThread n = do + tid <- forkIO $ readMVar mvar + labelThread tid ("thread-"++show n) + + mapM_ mkThread [0..100] + threads <- listThreads + -- TODO: Check labels + print $ length threads + putMVar mvar () + ===================================== libraries/base/tests/listThreads.stdout ===================================== @@ -0,0 +1 @@ +102 ===================================== rts/PrimOps.cmm ===================================== @@ -2865,3 +2865,11 @@ stg_setThreadAllocationCounterzh ( I64 counter ) StgTSO_alloc_limit(CurrentTSO) = counter + TO_I64(offset); return (); } + +stg_listThreadszh () +{ + P_ arr; + + ("ptr" arr) = ccall listThreads(MyCapability() "ptr"); + return (arr); +} ===================================== rts/RtsSymbols.c ===================================== @@ -685,6 +685,7 @@ SymI_HasProto(stg_isCurrentThreadBoundzh) \ SymI_HasProto(stg_isEmptyMVarzh) \ SymI_HasProto(stg_killThreadzh) \ + SymI_HasProto(stg_listThreadszh) \ SymI_HasProto(loadArchive) \ SymI_HasProto(loadObj) \ SymI_HasProto(purgeObj) \ ===================================== rts/Threads.c ===================================== @@ -844,6 +844,44 @@ loop: return true; } +StgMutArrPtrs *listThreads(Capability *cap) +{ + // First count how many threads we have... + StgWord n_threads = 0; + for (unsigned g = 0; g < RtsFlags.GcFlags.generations; g++) { + for (StgTSO *t = generations[g].threads; t != END_TSO_QUEUE; t = t->global_link) { + n_threads++; + } + } + + // Allocate a suitably-sized array... + const StgWord size = n_threads + mutArrPtrsCardTableSize(n_threads); + StgMutArrPtrs *arr = + (StgMutArrPtrs *)allocate(cap, sizeofW(StgMutArrPtrs) + size); + TICK_ALLOC_PRIM(sizeofW(StgMutArrPtrs), n, 0); + arr->ptrs = n_threads; + arr->size = size; + + // Populate it... + // N.B. we are guaranteed to see at least n_threads during this traversal + // as the only way that threads can be removed from the generations' thread lists + // is via garbage collection yet we are in an unsafe foreign call, + // precluding GC (as well as the sync phase of the non-moving collector). + StgWord i = 0; + for (unsigned g = 0; g < RtsFlags.GcFlags.generations; g++) { + for (StgTSO *t = generations[g].threads; t != END_TSO_QUEUE; t = t->global_link) { + // It's possible that new threads have been created since we counted. + // Ignore them. + if (i == n_threads) + break; + arr->payload[i] = (StgClosure *) t; + i++; + } + } + CHECKM(i == n_threads, "listThreads: Found too few threads"); + return arr; +} + /* ---------------------------------------------------------------------------- * Debugging: why is a thread blocked * ------------------------------------------------------------------------- */ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c15d33a6fe35f032812a877583b2e3e4a8850ae3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c15d33a6fe35f032812a877583b2e3e4a8850ae3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Dec 7 11:21:23 2020 From: gitlab at gitlab.haskell.org (Ryan Scott) Date: Mon, 07 Dec 2020 06:21:23 -0500 Subject: [Git][ghc/ghc][wip/T18021] Reject dodgy scoping in associated family instance RHSes Message-ID: <5fce103333f79_6b2118051dc2986c4@gitlab.mail> Ryan Scott pushed to branch wip/T18021 at Glasgow Haskell Compiler / GHC Commits: 96ad03e1 by Ryan Scott at 2020-12-07T06:21:10-05:00 Reject dodgy scoping in associated family instance RHSes Commit e63518f5d6a93be111f9108c0990a1162f88d615 tried to push all of the logic of detecting out-of-scope type variables on the RHSes of associated type family instances to `GHC.Tc.Validity` by deleting a similar check in the renamer. Unfortunately, this commit went a little too far, as there are some corner cases that `GHC.Tc.Validity` doesn't detect. Consider this example: ```hs class C a where data D a instance forall a. C Int where data instance D Int = MkD a ``` If this program isn't rejected by the time it reaches the typechecker, then GHC will believe the `a` in `MkD a` is existentially quantified and accept it. This is almost surely not what the user wants! The simplest way to reject programs like this is to restore the old validity check in the renamer (search for `improperly_scoped` in `rnFamEqn`). Note that this is technically a breaking change, since the program in the `polykinds/T9574` test case (which previously compiled) will now be rejected: ```hs instance Funct ('KProxy :: KProxy o) where type Codomain 'KProxy = NatTr (Proxy :: o -> *) ``` This is because the `o` on the RHS will now be rejected for being out of scope. Luckily, this is simple to repair: ```hs instance Funct ('KProxy :: KProxy o) where type Codomain ('KProxy @o) = NatTr (Proxy :: o -> *) ``` All of the discussion is now a part of the revamped `Note [Renaming associated types]` in `GHC.Rename.Module`. A different design would be to make associated type family instances have completely separate scoping from the parent instance declaration, much like how associated type family default declarations work today. See the discussion beginning at https://gitlab.haskell.org/ghc/ghc/-/issues/18021#note_265729 for more on this point. This, however, would break even more programs that are accepted today and likely warrants a GHC proposal before going forward. In the meantime, this patch fixes the issue described in #18021 in the least invasive way possible. There are programs that are accepted today that will no longer be accepted after this patch, but they are arguably pathological programs, and they are simple to repair. Fixes #18021. - - - - - 8 changed files: - compiler/GHC/Rename/Module.hs - docs/users_guide/9.2.1-notes.rst - testsuite/tests/indexed-types/should_fail/T5515.stderr - + testsuite/tests/polykinds/T9574.stderr - testsuite/tests/polykinds/all.T - + testsuite/tests/rename/should_fail/T18021.hs - + testsuite/tests/rename/should_fail/T18021.stderr - testsuite/tests/rename/should_fail/all.T Changes: ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -725,10 +725,24 @@ rnFamEqn doc atfi rhs_kvars -- of the instance decl. See -- Note [Unused type variables in family instances] ; let nms_used = extendNameSetList rhs_fvs $ - inst_tvs ++ nms_dups + nms_dups {- (a) -} ++ inst_head_tvs {- (b) -} all_nms = hsOuterTyVarNames rn_outer_bndrs' ; warnUnusedTypePatterns all_nms nms_used + -- For associated family instances, if a type variable from the + -- parent instance declaration is mentioned on the RHS of the + -- associated family instance but not bound on the LHS, then reject + -- that type variable as being out of scope. + -- See Note [Renaming associated types] + ; let lhs_bound_vars = extendNameSetList pat_fvs all_nms + improperly_scoped cls_tkv = + cls_tkv `elemNameSet` rhs_fvs + -- Mentioned on the RHS... + && not (cls_tkv `elemNameSet` lhs_bound_vars) + -- ...but not bound on the LHS. + bad_tvs = filter improperly_scoped inst_head_tvs + ; unless (null bad_tvs) (badAssocRhs bad_tvs) + ; let eqn_fvs = rhs_fvs `plusFV` pat_fvs -- See Note [Type family equations and occurrences] all_fvs = case atfi of @@ -754,10 +768,10 @@ rnFamEqn doc atfi rhs_kvars -- The type variables from the instance head, if we are dealing with an -- associated type family instance. - inst_tvs = case atfi of - NonAssocTyFamEqn _ -> [] - AssocTyFamDeflt _ -> [] - AssocTyFamInst _ inst_tvs -> inst_tvs + inst_head_tvs = case atfi of + NonAssocTyFamEqn _ -> [] + AssocTyFamDeflt _ -> [] + AssocTyFamInst _ inst_head_tvs -> inst_head_tvs pat_kity_vars_with_dups = extractHsTyArgRdrKiTyVars pats -- It is crucial that extractHsTyArgRdrKiTyVars return @@ -774,6 +788,13 @@ rnFamEqn doc atfi rhs_kvars [loc] -> loc (loc:locs) -> loc `combineSrcSpans` last locs + badAssocRhs :: [Name] -> RnM () + badAssocRhs ns + = addErr (hang (text "The RHS of an associated type declaration mentions" + <+> text "out-of-scope variable" <> plural ns + <+> pprWithCommas (quotes . ppr) ns) + 2 (text "All such variables must be bound on the LHS")) + rnTyFamInstDecl :: AssocTyFamInfo -> TyFamInstDecl GhcPs -> RnM (TyFamInstDecl GhcRn, FreeVars) @@ -927,58 +948,155 @@ Relevant tickets: #3699, #10586, #10982 and #11451. Note [Renaming associated types] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Check that the RHS of the decl mentions only type variables that are explicitly -bound on the LHS. For example, this is not ok - class C a b where - type F a x :: * +When renaming an associated type/data family instance, we must check that the +RHS of the declaration mentions only type variables that are bound on the LHS. +Here is a simple example of something we should reject: + + class C a b where + type family F a x + instance C Int Bool where + type instance F Int x = z + +Here, `z` is mentioned on the RHS of the associated instance without being +bound anywhere on the LHS. GHC will reject `z` as being out of scope without +much fuss. + +Things get slightly trickier when the instance header itself binds type +variables. Consider this example (adapted from #5515): + instance C (p,q) r where - type F (p,q) x = (x, r) -- BAD: mentions 'r' -c.f. #5515 - -Kind variables, on the other hand, are allowed to be implicitly or explicitly -bound. As examples, this (#9574) is acceptable: - class Funct f where - type Codomain f :: * - instance Funct ('KProxy :: KProxy o) where - -- o is implicitly bound by the kind signature - -- of the LHS type pattern ('KProxy) - type Codomain 'KProxy = NatTr (Proxy :: o -> *) -And this (#14131) is also acceptable: - data family Nat :: k -> k -> * - -- k is implicitly bound by an invisible kind pattern - newtype instance Nat :: (k -> *) -> (k -> *) -> * where - Nat :: (forall xx. f xx -> g xx) -> Nat f g -We could choose to disallow this, but then associated type families would not -be able to be as expressive as top-level type synonyms. For example, this type -synonym definition is allowed: - type T = (Nothing :: Maybe a) -So for parity with type synonyms, we also allow: - type family T :: Maybe a - type instance T = (Nothing :: Maybe a) - -All this applies only for *instance* declarations. In *class* -declarations there is no RHS to worry about, and the class variables -can all be in scope (#5862): + type instance F (p,q) x = (x, r) + +If we look at the instance in isolation: + + type instance F (p,q) x = (x, r) + +Then it is evident that this is malformed, as `r` has no binding site. In the +context of the original program, however, `r` is technically in scope, as the +type variables from an instance header always scope over the associated type +family instances. So while `r` is technically in scope, it is nevertheless +extremely dodgy. See #18021 for an example of some of the bizarre behaviour +that results from this dodginess. + +To prevent these sorts of shenanigans, we reject programs like the one above +with an extra validity check in rnFamEqn. For each type variable bound in the +parent instance head, we check if it is mentioned on the RHS of the associated +family instance but not bound on the LHS. If any of the instance-head-bound +variables meet these criteria, we throw an error. +(See rnFamEqn.improperly_scoped for how this is implemented.) + +Some additional wrinkles: + +* Because of the "stop-gap" Note [Implicit quantification in type synonyms] in + GHC.Rename.HsType, a variable does not have to be mentioned by name in the + LHS in order for it to be bound on the LHS. For example, GHC currently + accepts this: + + class C2 a where + type F2 :: Maybe a + instance C2 a where + type F2 = (Nothing :: Maybe a) + + Here, the kind variable `a` in the RHS of the F2 instance is implicitly + quantified by virtue of being mentioned in an outermost kind signature. + (See Note [Implicit quantification in type synonyms] for more on this point.) + One could equivalently write the instance like so: + + instance C2 a where + type F2 @a = (Nothing :: Maybe a) + + The explicit result kinds in data family instances, which are also considered + to be part of the RHS, provide another example. This program (adapted + from #14131) is also accepted: + + class C3 k where + data Nat :: k -> k -> Type + instance C3 k where + newtype Nat :: (k -> Type) -> (k -> Type) -> Type where + Nat :: (forall xx. f xx -> g xx) -> Nat f g + -- Alternatively, + -- newtype Nat @k :: (k -> Type) -> (k -> Type) -> Type where ... + +* This Note only applies to *instance* declarations. In *class* declarations + there is no RHS to worry about, and the class variables can all be in scope + (#5862): + class Category (x :: k -> k -> *) where type Ob x :: k -> Constraint id :: Ob x a => x a a (.) :: (Ob x a, Ob x b, Ob x c) => x b c -> x a b -> x a c -Here 'k' is in scope in the kind signature, just like 'x'. -Although type family equations can bind type variables with explicit foralls, -it need not be the case that all variables that appear on the RHS must be bound -by a forall. For instance, the following is acceptable: + Here 'k' is in scope in the kind signature, just like 'x'. + +* Although type family equations can bind type variables with explicit foralls, + it need not be the case that all variables that appear on the RHS must be + bound by a forall. For instance, the following is acceptable: + + class C4 a where + type T4 a b + instance C4 (Maybe a) where + type forall b. T4 (Maybe a) b = Either a b + + Even though `a` is not bound by the forall, this is still accepted because `a` + was previously bound by the `instance C4 (Maybe a)` part. (see #16116). + +* In addition to the validity check in rnFamEqn.improperly_scoped, there is an + additional check in GHC.Tc.Validity.checkFamPatBinders that checks each family + instance equation for type variables used on the RHS but not bound on the + LHS. This is not made redundant by rmFamEqn.improperly_scoped, as there are + programs that each check will reject that the other check will not catch: + + - checkValidFamPats is used on all forms of family instances, whereas + rmFamEqn.improperly_scoped only checks associated family instances. Since + checkFamPatBinders occurs after typechecking, it can catch programs that + introduce dodgy scoping by way of type synonyms (see #7536), which is + impractical to accomplish in the renamer. + - rnFamEqn.improperly_scoped catches some programs that, if allowed to escape + the renamer, would accidentally be accepted by the typechecker. Here is one + such program (#18021): + + class C5 a where + data family D a + + instance forall a. C5 Int where + data instance D Int = MkD a + + If this is not rejected in the renamer, the typechecker would treat this + program as though the `a` were existentially quantified, like so: + + data instance D Int = forall a. MkD a + + This is likely not what the user intended! + + Here is another such program (#9574): + + class Funct f where + type Codomain f + instance Funct ('KProxy :: KProxy o) where + type Codomain 'KProxy = NatTr (Proxy :: o -> Type) + + Where: + + data Proxy (a :: k) = Proxy + data KProxy (t :: Type) = KProxy + data NatTr (c :: o -> Type) - class C a where - type T a b - instance C (Maybe a) where - type forall b. T (Maybe a) b = Either a b + Note that the `o` in the `Codomain 'KProxy` instance should be considered + improperly scoped. It does not meet the criteria for being explicitly + quantified, as it is not mentioned by name on the LHS, nor does it meet the + criteria for being implicitly quantified, as it is used in a RHS kind + signature that is not outermost (see Note [Implicit quantification in type + synonyms]). However, `o` /is/ bound by the instance header, so if this + program is not rejected by the renamer, the typechecker would treat it as + though you had written this: -Even though `a` is not bound by the forall, this is still accepted because `a` -was previously bound by the `instance C (Maybe a)` part. (see #16116). + instance Funct ('KProxy :: KProxy o) where + type Codomain ('KProxy @o) = NatTr (Proxy :: o -> Type) -In each case, the function which detects improperly bound variables on the RHS -is GHC.Tc.Validity.checkValidFamPats. + Although this is a valid program, it's probably a stretch too far to turn + `type Codomain 'KProxy = ...` into `type Codomain ('KProxy @o) = ...` here. + If the user really wants the latter, it is simple enough to communicate + their intent by mentioning `o` on the LHS by name. Note [Type family equations and occurrences] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== docs/users_guide/9.2.1-notes.rst ===================================== @@ -14,6 +14,35 @@ Language (Serrano et al, ICFP 2020). More information here: :ref:`impredicative-polymorphism`. This replaces the old (undefined, flaky) behaviour of the :extension:`ImpredicativeTypes` extension. +* GHC is stricter about checking for out-of-scope type variables on the + right-hand sides of associated type family instances that are not bound on + the left-hand side. As a result, some programs that were accidentally + accepted in previous versions of GHC will now be rejected, such as this + example: :: + + class Funct f where + type Codomain f + instance Funct ('KProxy :: KProxy o) where + type Codomain 'KProxy = NatTr (Proxy :: o -> Type) + + Where: :: + + data Proxy (a :: k) = Proxy + data KProxy (t :: Type) = KProxy + data NatTr (c :: o -> Type) + + GHC will now reject the ``o`` on the right-hand side of the ``Codomain`` + instance as being out of scope, as it does not meet the requirements for + being explicitly bound (as it is not mentioned on the left-hand side) nor + implicitly bound (as it is not mentioned in an *outermost* kind signature, + as required by :ref:`scoping-class-params`). This program can be repaired in + a backwards-compatible way by mentioning ``o`` on the left-hand side: :: + + instance Funct ('KProxy :: KProxy o) where + type Codomain ('KProxy @o) = NatTr (Proxy :: o -> Type) + -- Alternatively, + -- type Codomain ('KProxy :: KProxy o) = NatTr (Proxy :: o -> Type) + Compiler ~~~~~~~~ ===================================== testsuite/tests/indexed-types/should_fail/T5515.stderr ===================================== @@ -1,24 +1,8 @@ -T5515.hs:6:16: error: - • Expecting one more argument to ‘ctx’ - Expected a type, but ‘ctx’ has kind ‘* -> Constraint’ - • In the first argument of ‘Arg’, namely ‘ctx’ - In the first argument of ‘ctx’, namely ‘(Arg ctx)’ - In the class declaration for ‘Bome’ +T5515.hs:9:3: error: + The RHS of an associated type declaration mentions out-of-scope variable ‘a’ + All such variables must be bound on the LHS -T5515.hs:14:1: error: - • Type variable ‘a’ is mentioned in the RHS, - but not bound on the LHS of the family instance - • In the type instance declaration for ‘Arg’ - In the instance declaration for ‘Some f’ - -T5515.hs:14:10: error: - • Could not deduce (C f a0) - from the context: C f a - bound by an instance declaration: - forall f a. C f a => Some f - at T5515.hs:14:10-24 - The type variable ‘a0’ is ambiguous - • In the ambiguity check for an instance declaration - To defer the ambiguity check to use sites, enable AllowAmbiguousTypes - In the instance declaration for ‘Some f’ +T5515.hs:15:3: error: + The RHS of an associated type declaration mentions out-of-scope variable ‘a’ + All such variables must be bound on the LHS ===================================== testsuite/tests/polykinds/T9574.stderr ===================================== @@ -0,0 +1,4 @@ + +T9574.hs:13:5: error: + The RHS of an associated type declaration mentions out-of-scope variable ‘o’ + All such variables must be bound on the LHS ===================================== testsuite/tests/polykinds/all.T ===================================== @@ -107,7 +107,7 @@ test('T9725', normal, compile, ['']) test('T9750', normal, compile, ['']) test('T9569', normal, compile, ['']) test('T9838', normal, multimod_compile, ['T9838.hs','-v0']) -test('T9574', normal, compile, ['']) +test('T9574', normal, compile_fail, ['']) test('T9833', normal, compile, ['']) test('T7908', normal, compile, ['']) test('PolyInstances', normal, compile, ['']) ===================================== testsuite/tests/rename/should_fail/T18021.hs ===================================== @@ -0,0 +1,18 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +module T18021 where + +class C a where + data D a + +instance forall a. C Int where + data instance D Int = MkD1 a + +class X a b + +instance forall a. C Bool where + data instance D Bool = MkD2 + deriving (X a) ===================================== testsuite/tests/rename/should_fail/T18021.stderr ===================================== @@ -0,0 +1,8 @@ + +T18021.hs:12:3: error: + The RHS of an associated type declaration mentions out-of-scope variable ‘a’ + All such variables must be bound on the LHS + +T18021.hs:17:3: error: + The RHS of an associated type declaration mentions out-of-scope variable ‘a’ + All such variables must be bound on the LHS ===================================== testsuite/tests/rename/should_fail/all.T ===================================== @@ -156,6 +156,7 @@ test('T16504', normal, compile_fail, ['']) test('T14548', normal, compile_fail, ['']) test('T16610', normal, compile_fail, ['']) test('T17593', normal, compile_fail, ['']) +test('T18021', normal, compile_fail, ['']) test('T18145', normal, compile_fail, ['']) test('T18240a', normal, compile_fail, ['']) test('T18240b', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/96ad03e1e9a417ee9201f89968a760da0fb2d683 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/96ad03e1e9a417ee9201f89968a760da0fb2d683 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Dec 7 12:14:41 2020 From: gitlab at gitlab.haskell.org (Andreas Klebinger) Date: Mon, 07 Dec 2020 07:14:41 -0500 Subject: [Git][ghc/ghc][wip/andreask/bump_time] 5 commits: gitlab-ci: Fix copy-paste error Message-ID: <5fce1cb117195_6b211805218302116@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/bump_time at Glasgow Haskell Compiler / GHC Commits: e0b08c5f by Ben Gamari at 2020-12-03T13:01:47-05:00 gitlab-ci: Fix copy-paste error Also be more consistent in quoting. - - - - - 33ec3a06 by Ben Gamari at 2020-12-03T23:11:31-05:00 gitlab-ci: Run linters through ci.sh Ensuring that the right toolchain is used. - - - - - 4a437bc1 by Shayne Fletcher at 2020-12-05T09:06:38-05:00 Fix bad span calculations of post qualified imports - - - - - 8fac4b93 by Ben Gamari at 2020-12-05T09:07:13-05:00 testsuite: Add a test for #18923 - - - - - 8bcdb940 by Andreas Klebinger at 2020-12-07T07:14:38-05:00 Bump time submodule. This should fix #19002. - - - - - 9 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - compiler/GHC/Parser.y - libraries/time - testsuite/tests/module/all.T - + testsuite/tests/module/mod185.hs - + testsuite/tests/module/mod185.stderr - + testsuite/tests/perf/compiler/T18923.hs - testsuite/tests/perf/compiler/all.T Changes: ===================================== .gitlab-ci.yml ===================================== @@ -299,12 +299,11 @@ hadrian-ghc-in-ghci: tags: - x86_64-linux script: + - git clean -xdf && git submodule foreach git clean -xdf - .gitlab/ci.sh setup + - .gitlab/ci.sh configure - cabal update - cd hadrian; cabal new-build -j`../mk/detect-cpu-count.sh` --with-compiler=$GHC --project-file=ci.project; cd .. - - git clean -xdf && git submodule foreach git clean -xdf - - ./boot - - ./configure $CONFIGURE_ARGS # Load ghc-in-ghci then immediately exit and check the modules loaded - echo ":q" | hadrian/ghci -j`mk/detect-cpu-count.sh`| tail -n2 | grep "Ok," after_script: @@ -345,9 +344,13 @@ hadrian-ghc-in-ghci: lint-base: extends: .lint-params + variables: + BUILD_FLAVOUR: default script: - - hadrian/build -c -j stage1:lib:base - - hadrian/build -j lint:base + - .gitlab/ci.sh setup + - .gitlab/ci.sh configure + - .gitlab/ci.sh run_hadrian stage1:lib:base + - .gitlab/ci.sh run_hadrian lint:base ############################################################ # Validation via Pipelines (make) ===================================== .gitlab/ci.sh ===================================== @@ -168,13 +168,13 @@ function show_tool() { } function set_toolchain_paths() { - needs_toolchain=1 + needs_toolchain="1" case "$(uname)" in Linux) needs_toolchain="0" ;; *) ;; esac - if [[ "$needs_toolchain" = 1 ]]; then + if [[ "$needs_toolchain" = "1" ]]; then # These are populated by setup_toolchain GHC="$toolchain/bin/ghc$exe" CABAL="$toolchain/bin/cabal$exe" @@ -185,9 +185,9 @@ function set_toolchain_paths() { # we provide these handy fallbacks in case the # script isn't run from within a GHC CI docker image. if [ -z "$GHC" ]; then GHC="$(which ghc)"; fi - if [ -z "$CABAL" ]; then GHC="$(which cabal)"; fi - if [ -z "$HAPPY" ]; then GHC="$(which happy)"; fi - if [ -z "$ALEX" ]; then GHC="$(which alex)"; fi + if [ -z "$CABAL" ]; then CABAL="$(which cabal)"; fi + if [ -z "$HAPPY" ]; then HAPPY="$(which happy)"; fi + if [ -z "$ALEX" ]; then ALEX="$(which alex)"; fi fi export GHC @@ -204,7 +204,7 @@ function setup() { cp -Rf cabal-cache/* "$cabal_dir" fi - if [[ -n "$needs_toolchain" ]]; then + if [[ "$needs_toolchain" = "1" ]]; then setup_toolchain fi case "$(uname)" in @@ -442,9 +442,6 @@ function test_make() { } function build_hadrian() { - if [ -z "$BUILD_FLAVOUR" ]; then - fail "BUILD_FLAVOUR not set" - fi if [ -z "$BIN_DIST_NAME" ]; then fail "BIN_DIST_NAME not set" fi @@ -506,6 +503,9 @@ function clean() { } function run_hadrian() { + if [ -z "$BUILD_FLAVOUR" ]; then + fail "BUILD_FLAVOUR not set" + fi if [ -z "$BIGNUM_BACKEND" ]; then BIGNUM_BACKEND="gmp"; fi if [ -n "$VERBOSE" ]; then HADRIAN_ARGS="$HADRIAN_ARGS -V"; fi run hadrian/build-cabal \ @@ -575,7 +575,7 @@ case $1 in test_hadrian || res=$? push_perf_notes exit $res ;; - run_hadrian) run_hadrian $@ ;; + run_hadrian) shift; run_hadrian $@ ;; perf_test) run_perf_test ;; clean) clean ;; shell) shell $@ ;; ===================================== compiler/GHC/Parser.y ===================================== @@ -1057,18 +1057,20 @@ importdecls_semi importdecl :: { LImportDecl GhcPs } : 'import' maybe_src maybe_safe optqualified maybe_pkg modid optqualified maybeas maybeimpspec {% do { - ; checkImportDecl $4 $7 - ; ams (L (comb4 $1 $6 (snd $8) $9) $ + ; let { ; mPreQual = unLoc $4 + ; mPostQual = unLoc $7 } + ; checkImportDecl mPreQual mPostQual + ; ams (L (comb5 $1 $6 $7 (snd $8) $9) $ ImportDecl { ideclExt = noExtField , ideclSourceSrc = snd $ fst $2 , ideclName = $6, ideclPkgQual = snd $5 , ideclSource = snd $2, ideclSafe = snd $3 - , ideclQualified = importDeclQualifiedStyle $4 $7 + , ideclQualified = importDeclQualifiedStyle mPreQual mPostQual , ideclImplicit = False , ideclAs = unLoc (snd $8) , ideclHiding = unLoc $9 }) - (mj AnnImport $1 : fst (fst $2) ++ fst $3 ++ fmap (mj AnnQualified) (maybeToList $4) - ++ fst $5 ++ fmap (mj AnnQualified) (maybeToList $7) ++ fst $8) + (mj AnnImport $1 : fst (fst $2) ++ fst $3 ++ fmap (mj AnnQualified) (maybeToList mPreQual) + ++ fst $5 ++ fmap (mj AnnQualified) (maybeToList mPostQual) ++ fst $8) } } @@ -1089,9 +1091,9 @@ maybe_pkg :: { ([AddAnn],Maybe StringLiteral) } ; return ([mj AnnPackageName $1], Just (StringLiteral (getSTRINGs $1) pkgFS)) } } | {- empty -} { ([],Nothing) } -optqualified :: { Maybe (Located Token) } - : 'qualified' { Just $1 } - | {- empty -} { Nothing } +optqualified :: { Located (Maybe (Located Token)) } + : 'qualified' { sL1 $1 (Just $1) } + | {- empty -} { noLoc Nothing } maybeas :: { ([AddAnn],Located (Maybe (Located ModuleName))) } : 'as' modid { ([mj AnnAs $1] @@ -3861,6 +3863,11 @@ comb4 a b c d = a `seq` b `seq` c `seq` d `seq` (combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $ combineSrcSpans (getLoc c) (getLoc d)) +comb5 :: Located a -> Located b -> Located c -> Located d -> Located e -> SrcSpan +comb5 a b c d e = a `seq` b `seq` c `seq` d `seq` e `seq` + (combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $ + combineSrcSpans (getLoc c) $ combineSrcSpans (getLoc d) (getLoc e)) + -- strict constructor version: {-# INLINE sL #-} sL :: SrcSpan -> a -> Located a ===================================== libraries/time ===================================== @@ -1 +1 @@ -Subproject commit c25d6a76702b454426e149fb590da5cb69f3bd0a +Subproject commit df292e1a74c6a87c2c1c889679074dd46ad39461 ===================================== testsuite/tests/module/all.T ===================================== @@ -268,6 +268,7 @@ test('mod181', normal, compile, ['']) test('mod182', normal, compile_fail, ['']) test('mod183', normal, compile_fail, ['']) test('mod184', normal, compile, ['-Wprepositive-qualified-module']) +test('mod185', normal, compile, ['-ddump-parsed-ast']) test('T1148', normal, compile, ['']) test('T1074', normal, compile, ['']) ===================================== testsuite/tests/module/mod185.hs ===================================== @@ -0,0 +1,5 @@ +{-# LANGUAGE ImportQualifiedPost #-} +-- The span of the import decl should include the 'qualified' keyword. +import Prelude qualified + +main = Prelude.undefined ===================================== testsuite/tests/module/mod185.stderr ===================================== @@ -0,0 +1,62 @@ +==================== Parser AST ==================== + +({ mod185.hs:1:1 } + (HsModule + (VirtualBraces + (1)) + (Nothing) + (Nothing) + [({ mod185.hs:3:1-24 } + (ImportDecl + (NoExtField) + (NoSourceText) + ({ mod185.hs:3:8-14 } + {ModuleName: Prelude}) + (Nothing) + (NotBoot) + (False) + (QualifiedPost) + (False) + (Nothing) + (Nothing)))] + [({ mod185.hs:5:1-24 } + (ValD + (NoExtField) + (FunBind + (NoExtField) + ({ mod185.hs:5:1-4 } + (Unqual + {OccName: main})) + (MG + (NoExtField) + ({ mod185.hs:5:1-24 } + [({ mod185.hs:5:1-24 } + (Match + (NoExtField) + (FunRhs + ({ mod185.hs:5:1-4 } + (Unqual + {OccName: main})) + (Prefix) + (NoSrcStrict)) + [] + (GRHSs + (NoExtField) + [({ mod185.hs:5:6-24 } + (GRHS + (NoExtField) + [] + ({ mod185.hs:5:8-24 } + (HsVar + (NoExtField) + ({ mod185.hs:5:8-24 } + (Qual + {ModuleName: Prelude} + {OccName: undefined}))))))] + ({ } + (EmptyLocalBinds + (NoExtField))))))]) + (FromSource)) + [])))] + (Nothing) + (Nothing))) ===================================== testsuite/tests/perf/compiler/T18923.hs ===================================== @@ -0,0 +1,16 @@ +module T18923 (mergeRec, Rec) where + +mayMerge :: Maybe b -> Maybe b -> Maybe b +mayMerge Nothing y = y +mayMerge x Nothing = x +mayMerge (Just x) (Just y) = Just y + +data Rec = Rec { v0,v1,v2,v3,v4,v5,v6,v7 :: !(Maybe Bool) } + +mergeRec :: Rec -> Rec -> Rec +mergeRec + (Rec a0 a1 a2 a3 a4 a5 a6 a7) + (Rec b0 b1 b2 b3 b4 b5 b6 b7) = + Rec (mayMerge a0 b0) (mayMerge a1 b1) (mayMerge a2 b2) (mayMerge a3 b3) + (mayMerge a4 b4) (mayMerge a5 b5) (mayMerge a6 b6) (mayMerge a7 b7) + ===================================== testsuite/tests/perf/compiler/all.T ===================================== @@ -434,3 +434,7 @@ test ('T18223', ], compile, ['-v0 -O']) +test ('T18923', + [ collect_compiler_stats('bytes allocated',2) ], + compile, + ['-v0 -O']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/027f49b680f6c0a300d3d27889fb709d57085b57...8bcdb940cd64709f2f5dd90128a20e61f5e5ccdb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/027f49b680f6c0a300d3d27889fb709d57085b57...8bcdb940cd64709f2f5dd90128a20e61f5e5ccdb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Dec 7 12:30:03 2020 From: gitlab at gitlab.haskell.org (Andreas Klebinger) Date: Mon, 07 Dec 2020 07:30:03 -0500 Subject: [Git][ghc/ghc][wip/andreask/opt_dumps] 86 commits: Add Addr# atomic primops (#17751) Message-ID: <5fce204b77915_6b2117f1704304474@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/opt_dumps at Glasgow Haskell Compiler / GHC Commits: 52114fa0 by Sylvain Henry at 2020-11-16T11:48:47+01:00 Add Addr# atomic primops (#17751) This reuses the codegen used for ByteArray#'s atomic primops. - - - - - 8150f654 by Sebastian Graf at 2020-11-18T23:38:40-05:00 PmCheck: Print types of uncovered patterns (#18932) In order to avoid confusion as in #18932, we display the type of the match variables in the non-exhaustiveness warning, e.g. ``` T18932.hs:14:1: warning: [-Wincomplete-patterns] Pattern match(es) are non-exhaustive In an equation for ‘g’: Patterns of type ‘T a’, ‘T a’, ‘T a’ not matched: (MkT2 _) (MkT1 _) (MkT1 _) (MkT2 _) (MkT1 _) (MkT2 _) (MkT2 _) (MkT2 _) (MkT1 _) (MkT2 _) (MkT2 _) (MkT2 _) ... | 14 | g (MkT1 x) (MkT1 _) (MkT1 _) = x | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ``` It also allows us to omit the type signature on wildcard matches which we previously showed in only some situations, particularly `-XEmptyCase`. Fixes #18932. - - - - - 165352a2 by Krzysztof Gogolewski at 2020-11-20T02:08:36-05:00 Export indexError from GHC.Ix (#18579) - - - - - b57845c3 by Kamil Dworakowski at 2020-11-20T02:09:16-05:00 Clarify interruptible FFI wrt masking state - - - - - 321d1bd8 by Sebastian Graf at 2020-11-20T02:09:51-05:00 Fix strictness signatures of `prefetchValue*#` primops Their strictness signatures said the primops are strict in their first argument, which is wrong: Handing it a thunk will prefetch the pointer to the thunk, but not evaluate it. Hence not strict. The regression test `T8256` actually tests for laziness in the first argument, so GHC apparently never exploited the strictness signature. See also https://gitlab.haskell.org/ghc/ghc/-/issues/8256#note_310867, where this came up. - - - - - 0aec78b6 by Sebastian Graf at 2020-11-20T02:09:51-05:00 Demand: Interleave usage and strictness demands (#18903) As outlined in #18903, interleaving usage and strictness demands not only means a more compact demand representation, but also allows us to express demands that we weren't easily able to express before. Call demands are *relative* in the sense that a call demand `Cn(cd)` on `g` says "`g` is called `n` times. *Whenever `g` is called*, the result is used according to `cd`". Example from #18903: ```hs h :: Int -> Int h m = let g :: Int -> (Int,Int) g 1 = (m, 0) g n = (2 * n, 2 `div` n) {-# NOINLINE g #-} in case m of 1 -> 0 2 -> snd (g m) _ -> uncurry (+) (g m) ``` Without the interleaved representation, we would just get `L` for the strictness demand on `g`. Now we are able to express that whenever `g` is called, its second component is used strictly in denoting `g` by `1C1(P(1P(U),SP(U)))`. This would allow Nested CPR to unbox the division, for example. Fixes #18903. While fixing regressions, I also discovered and fixed #18957. Metric Decrease: T13253-spj - - - - - 3a55b3a2 by Sebastian Graf at 2020-11-20T02:09:51-05:00 Update user's guide entry on demand analysis and worker/wrapper The demand signature notation has been undocumented for a long time. The only source to understand it, apart from reading the `Outputable` instance, has been an outdated wiki page. Since the previous commits have reworked the demand lattice, I took it as an opportunity to also write some documentation about notation. - - - - - fc963932 by Greg Steuck at 2020-11-20T02:10:31-05:00 Find hadrian location more reliably in cabal-install output Fix #18944 - - - - - 9f40cf6c by Ben Gamari at 2020-11-20T02:11:07-05:00 rts/linker: Align bssSize to page size when mapping symbol extras We place symbol_extras right after bss. We also need to ensure that symbol_extras can be mprotect'd independently from the rest of the image. To ensure this we round up the size of bss to a page boundary, thus ensuring that symbol_extras is also page-aligned. - - - - - b739c319 by Ben Gamari at 2020-11-20T02:11:43-05:00 gitlab-ci: Add usage message to ci.sh - - - - - 802e9180 by Ben Gamari at 2020-11-20T02:11:43-05:00 gitlab-ci: Add VERBOSE environment variable And change the make build system's default behavior to V=0, greatly reducing build log sizes. - - - - - 2a8a979c by Ben Gamari at 2020-11-21T01:13:26-05:00 users-guide: A bit of clean-up in profiling flag documentation - - - - - 56804e33 by Ben Gamari at 2020-11-21T01:13:26-05:00 testsuite: Refactor CountParserDeps - - - - - 53ad67ea by Ben Gamari at 2020-11-21T01:13:26-05:00 Introduce -fprof-callers flag This introducing a new compiler flag to provide a convenient way to introduce profiler cost-centers on all occurrences of the named identifier. Closes #18566. - - - - - ecfd0278 by Sylvain Henry at 2020-11-21T01:14:09-05:00 Move Plugins into HscEnv (#17957) Loaded plugins have nothing to do in DynFlags so this patch moves them into HscEnv (session state). "DynFlags plugins" become "Driver plugins" to still be able to register static plugins. Bump haddock submodule - - - - - 72f2257c by Sylvain Henry at 2020-11-21T01:14:09-05:00 Don't initialize plugins in the Core2Core pipeline Some plugins can be added via TH (cf addCorePlugin). Initialize them in the driver instead of in the Core2Core pipeline. - - - - - ddbeeb3c by Ryan Scott at 2020-11-21T01:14:44-05:00 Add regression test for #10504 This issue was fixed at some point between GHC 8.0 and 8.2. Let's add a regression test to ensure that it stays fixed. Fixes #10504. - - - - - a4a6dc2a by Ben Gamari at 2020-11-21T01:15:21-05:00 dwarf: Apply info table offset consistently Previously we failed to apply the info table offset to the aranges and DIEs, meaning that we often failed to unwind in gdb. For some reason this only seemed to manifest in the RTS's Cmm closures. Nevertheless, now we can unwind completely up to `main` - - - - - 69bfbc21 by Ben Gamari at 2020-11-21T01:15:56-05:00 hadrian: Disable stripping when debug information is enabled - - - - - 7e93ae8b by Ben Gamari at 2020-11-21T13:13:29-05:00 rts: Post ticky entry counts to the eventlog We currently only post the entry counters, not the other global counters as in my experience the former are more useful. We use the heap profiler's census period to decide when to dump. Also spruces up the documentation surrounding ticky-ticky a bit. - - - - - bc9c3916 by Ben Gamari at 2020-11-22T06:28:10-05:00 Implement -ddump-c-backend argument To dump output of the C backend. - - - - - 901bc220 by Ben Gamari at 2020-11-22T12:39:02-05:00 Bump time submodule to 1.11.1 Also bumps directory, Cabal, hpc, time, and unix submodules. Closes #18847. - - - - - 92c0afbf by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Dump STG when ticky is enabled This changes the "ticky" modifier to enable dumping of final STG as this is generally needed to make sense of the ticky profiles. - - - - - d23fef68 by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Introduce notion of flavour transformers This extends Hadrian's notion of "flavour", as described in #18942. - - - - - 179d0bec by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Add a viaLlvmBackend modifier Note that this also slightly changes the semantics of these flavours as we only use LLVM for >= stage1 builds. - - - - - d4d95e51 by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Add profiled_ghc and no_dynamic_ghc modifiers - - - - - 6815603f by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Drop redundant flavour definitions Drop the profiled, LLVM, and ThreadSanitizer flavour definitions as these can now be realized with flavour transformers. - - - - - f88f4339 by Ben Gamari at 2020-11-24T02:43:20-05:00 rts: Flush eventlog buffers from flushEventLog As noted in #18043, flushTrace failed flush anything beyond the writer. This means that a significant amount of data sitting in capability-local event buffers may never get flushed, despite the users' pleads for us to flush. Fix this by making flushEventLog flush all of the event buffers before flushing the writer. Fixes #18043. - - - - - 7c03cc50 by Ben Gamari at 2020-11-24T02:43:55-05:00 gitlab-ci: Run LLVM job on appropriately-labelled MRs Namely, those marked with the ~"LLVM backend" label - - - - - 9b95d815 by Ben Gamari at 2020-11-24T02:43:55-05:00 gitlab-ci: Run LLVM builds on Debian 10 The current Debian 9 image doesn't provide LLVM 7. - - - - - 2ed3e6c0 by Ben Gamari at 2020-11-24T02:43:55-05:00 CmmToLlvm: Declare signature for memcmp Otherwise `opt` fails with: error: use of undefined value '@memcmp$def' - - - - - be5d74ca by Moritz Angermann at 2020-11-26T16:00:32-05:00 [Sized Cmm] properly retain sizes. This replaces all Word<N> = W<N># Word# and Int<N> = I<N># Int# with Word<N> = W<N># Word<N># and Int<N> = I<N># Int<N>#, thus providing us with properly sized primitives in the codegenerator instead of pretending they are all full machine words. This came up when implementing darwinpcs for arm64. The darwinpcs reqires us to pack function argugments in excess of registers on the stack. While most procedure call standards (pcs) assume arguments are just passed in 8 byte slots; and thus the caller does not know the exact signature to make the call, darwinpcs requires us to adhere to the prototype, and thus have the correct sizes. If we specify CInt in the FFI call, it should correspond to the C int, and not just be Word sized, when it's only half the size. This does change the expected output of T16402 but the new result is no less correct as it eliminates the narrowing (instead of the `and` as was previously done). Bumps the array, bytestring, text, and binary submodules. Co-Authored-By: Ben Gamari <ben at well-typed.com> Metric Increase: T13701 T14697 - - - - - a84e53f9 by Andreas Klebinger at 2020-11-26T16:00:32-05:00 RTS: Fix failed inlining of copy_tag. On windows using gcc-10 gcc failed to inline copy_tag into evacuate. To fix this we now set the always_inline attribute for the various copy* functions in Evac.c. The main motivation here is not the overhead of the function call, but rather that this allows the code to "specialize" for the size of the closure we copy which is often known at compile time. An earlier commit also tried to avoid evacuate_large inlining. But didn't quite succeed. So I also marked evacuate_large as noinline. Fixes #12416 - - - - - cdbd16f5 by Sylvain Henry at 2020-11-26T16:00:33-05:00 Fix toArgRep to support 64-bit reps on all systems [This is @Ericson2314 writing a commit message for @hsyl20's patch.] (Progress towards #11953, #17377, #17375) `Int64Rep` and `Word64Rep` are currently broken on 64-bit systems. This is because they should use "native arg rep" but instead use "large arg rep" as they do on 32-bit systems, which is either a non-concept or a 128-bit rep depending on one's vantage point. Now, these reps currently aren't used during 64-bit compilation, so the brokenness isn't observed, but I don't think that constitutes reasons not to fix it. Firstly, the linked issues there is a clearly expressed desire to use explicit-bitwidth constructs in more places. Secondly, per [1], there are other bugs that *do* manifest from not threading explicit-bitwidth information all the way through the compilation pipeline. One can therefore view this as one piece of the larger effort to do that, improve ergnomics, and squash remaining bugs. Also, this is needed for !3658. I could just merge this as part of that, but I'm keen on merging fixes "as they are ready" so the fixes that aren't ready are isolated and easier to debug. [1]: https://mail.haskell.org/pipermail/ghc-devs/2020-October/019332.html - - - - - a9378e69 by Tim Barnes at 2020-11-26T16:00:34-05:00 Set dynamic users-guide TOC spacing (fixes #18554) - - - - - 86a59d93 by Ben Gamari at 2020-11-26T16:00:34-05:00 rts: Use RTS_LIKELY in CHECK Most compilers probably already infer that `barf` diverges but it nevertheless doesn't hurt to be explicit. - - - - - 5757e82b by Matthew Pickering at 2020-11-26T16:00:35-05:00 Remove special case for GHC.ByteCode.Instr This was added in https://github.com/nomeata/ghc-heap-view/commit/34935206e51b9c86902481d84d2f368a6fd93423 GHC.ByteCode.Instr.BreakInfo no longer exists so the special case is dead code. Any check like this can be easily dealt with in client code. - - - - - d9c8b5b4 by Matthew Pickering at 2020-11-26T16:00:35-05:00 Split Up getClosureDataFromHeapRep Motivation 1. Don't enforce the repeated decoding of an info table, when the client can cache it (ghc-debug) 2. Allow the constructor information decoding to be overridden, this casues segfaults in ghc-debug - - - - - 3e3555cc by Andreas Klebinger at 2020-11-26T16:00:35-05:00 RegAlloc: Add missing raPlatformfield to RegAllocStatsSpill Fixes #18994 Co-Author: Benjamin Maurer <maurer.benjamin at gmail.com> - - - - - a1a75aa9 by Ben Gamari at 2020-11-27T06:20:41-05:00 rts: Allocate MBlocks with MAP_TOP_DOWN on Windows As noted in #18991, we would previously allocate heap in low memory. Due to this the linker, which typically *needs* low memory, would end up competing with the heap. In longer builds we end up running out of low memory entirely, leading to linking failures. - - - - - 75fc1ed5 by Sylvain Henry at 2020-11-28T15:40:23-05:00 Hadrian: fix detection of ghc-pkg for cross-compilers - - - - - 7cb5df96 by Sylvain Henry at 2020-11-28T15:40:23-05:00 hadrian: fix ghc-pkg uses (#17601) Make sure ghc-pkg doesn't read the compiler "settings" file by passing --no-user-package-db. - - - - - e3fd4226 by Ben Gamari at 2020-11-28T15:40:23-05:00 gitlab-ci: Introduce a nightly cross-compilation job This adds a job to test cross-compilation from x86-64 to AArch64 with Hadrian. Fixes #18234 - - - - - 698d3d96 by Ben Gamari at 2020-11-28T15:41:00-05:00 gitlab-ci: Only deploy GitLab Pages in ghc/ghc> The deployments are quite large and yet are currently only served for the ghc/ghc> project. - - - - - 625726f9 by David Eichmann at 2020-11-28T15:41:37-05:00 ghc-heap: partial TSO/STACK decoding Co-authored-by: Sven Tennie <sven.tennie at gmail.com> Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> Co-authored-by: Ben Gamari <bgamari.foss at gmail.com> - - - - - 22ea9c29 by Andreas Klebinger at 2020-11-28T15:42:13-05:00 Small optimization to CmmSink. Inside `regsUsedIn` we can avoid some thunks by specializing the recursion. In particular we avoid the thunk for `(f e z)` in the MachOp/Load branches, where we know this will evaluate to z. Reduces allocations for T3294 by ~1%. - - - - - bba42c62 by John Ericson at 2020-11-28T15:42:49-05:00 Make primop handler indentation more consistent - - - - - c82bc8e9 by John Ericson at 2020-11-28T15:42:49-05:00 Cleanup some primop constructor names Harmonize the internal (big sum type) names of the native vs fixed-sized number primops a bit. (Mainly by renaming the former.) No user-facing names are changed. - - - - - ae14f160 by Ben Gamari at 2020-11-28T15:43:25-05:00 testsuite: Mark T14702 as fragile on Windows Due to #18953. - - - - - 1bc104b0 by Ben Gamari at 2020-11-29T15:33:18-05:00 withTimings: Emit allocations counter This will allow us to back out the allocations per compiler pass from the eventlog. Note that we dump the allocation counter rather than the difference since this will allow us to determine how much work is done *between* `withTiming` blocks. - - - - - e992ea84 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 ThreadPaused: Don't zero slop until free vars are pushed When threadPaused blackholes a thunk it calls `OVERWRITING_CLOSURE` to zero the slop for the benefit of the sanity checker. Previously this was done *before* pushing the thunk's free variables to the update remembered set. Consequently we would pull zero'd pointers to the update remembered set. - - - - - e82cd140 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Fix regression from TSAN work The TSAN rework (specifically aad1f803) introduced a subtle regression in GC.c, swapping `g0` in place of `gen`. Whoops! Fixes #18997. - - - - - 35a5207e by GHC GitLab CI at 2020-11-29T15:33:54-05:00 rts/Messages: Add missing write barrier in THROWTO message update After a THROWTO message has been handle the message closure is overwritten by a NULL message. We must ensure that the original closure's pointers continue to be visible to the nonmoving GC. - - - - - 0120829f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Add missing write barrier in shrinkSmallByteArray - - - - - 8a4d8fb6 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 Updates: Don't zero slop until closure has been pushed Ensure that the the free variables have been pushed to the update remembered set before we zero the slop. - - - - - 2793cfdc by GHC GitLab CI at 2020-11-29T15:33:54-05:00 OSThreads: Fix error code checking pthread_join returns its error code and apparently doesn't set errno. - - - - - e391a16f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Don't join to mark_thread on shutdown The mark thread is not joinable as we detach from it on creation. - - - - - 60d088ab by Ben Gamari at 2020-11-29T15:33:54-05:00 nonmoving: Add reference to Ueno 2016 - - - - - 3aa60362 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Ensure that evacuated large objects are marked See Note [Non-moving GC: Marking evacuated objects]. - - - - - 8d304a99 by Ben Gamari at 2020-11-30T10:15:22-05:00 rts/m32: Refactor handling of allocator seeding Previously, in an attempt to reduce fragmentation, each new allocator would map a region of M32_MAX_PAGES fresh pages to seed itself. However, this ends up being extremely wasteful since it turns out that we often use fewer than this. Consequently, these pages end up getting freed which, ends up fragmenting our address space more than than we would have if we had naively allocated pages on-demand. Here we refactor m32 to avoid this waste while achieving the fragmentation mitigation previously desired. In particular, we move all page allocation into the global m32_alloc_page, which will pull a page from the free page pool. If the free page pool is empty we then refill it by allocating a region of M32_MAP_PAGES and adding them to the pool. Furthermore, we do away with the initial seeding entirely. That is, the allocator starts with no active pages: pages are rather allocated on an as-needed basis. On the whole this ends up being a pleasingly simple change, simultaneously making m32 more efficient, more robust, and simpler. Fixes #18980. - - - - - b6629289 by Ben Gamari at 2020-11-30T10:15:58-05:00 rts: Use CHECK instead of assert Use the GHC wrappers instead of <assert.h>. - - - - - 9f4efa6a by Ben Gamari at 2020-11-30T10:15:58-05:00 rts/linker: Replace some ASSERTs with CHECK In the past some people have confused ASSERT, which is for checking internal invariants, which CHECK, which should be used when checking things that might fail due to bad input (and therefore should be enabled even in the release compiler). Change some of these cases in the linker to use CHECK. - - - - - 0f8a4655 by Ryan Scott at 2020-11-30T10:16:34-05:00 Allow deploy:pages job to fail See #18973. - - - - - 49ebe369 by chessai at 2020-11-30T19:47:40-05:00 Optimisations in Data.Foldable (T17867) This PR concerns the following functions from `Data.Foldable`: * minimum * maximum * sum * product * minimumBy * maximumBy - Default implementations of these functions now use `foldl'` or `foldMap'`. - All have been marked with INLINEABLE to make room for further optimisations. - - - - - 4d79ef65 by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - 6af074ce by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - ab334262 by Viktor Dukhovni at 2020-11-30T19:48:17-05:00 dirty MVAR after mutating TSO queue head While the original head and tail of the TSO queue may be in the same generation as the MVAR, interior elements of the queue could be younger after a GC run and may then be exposed by putMVar operation that updates the queue head. Resolves #18919 - - - - - 5eb163f3 by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Don't allow shared libraries to be loaded multiple times - - - - - 490aa14d by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Initialise CCSs from native shared objects - - - - - 6ac3db5f by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Move shared library loading logic into Elf.c - - - - - b6698d73 by GHC GitLab CI at 2020-11-30T19:48:53-05:00 rts/linker: Don't declare dynamic objects with image_mapped This previously resulted in warnings due to spurious unmap failures. - - - - - b94a65af by jneira at 2020-11-30T19:49:31-05:00 Include tried paths in findToolDir error - - - - - 72a87fbc by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Move core flattening algorithm to Core.Unify This sets the stage for a later change, where this algorithm will be needed from GHC.Core.InstEnv. This commit also splits GHC.Core.Map into GHC.Core.Map.Type and GHC.Core.Map.Expr, in order to avoid module import cycles with GHC.Core. - - - - - 0dd45d0a by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Bump the # of commits searched for perf baseline The previous value of 75 meant that a feature branch with more than 75 commits would get spurious CI passes. This affects #18692, but does not fix that ticket, because if a baseline cannot be found, we should fail, not succeed. - - - - - 8bb52d91 by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Remove flattening variables This patch redesigns the flattener to simplify type family applications directly instead of using flattening meta-variables and skolems. The key new innovation is the CanEqLHS type and the new CEqCan constraint (Ct). A CanEqLHS is either a type variable or exactly-saturated type family application; either can now be rewritten using a CEqCan constraint in the inert set. Because the flattener no longer reduces all type family applications to variables, there was some performance degradation if a lengthy type family application is now flattened over and over (not making progress). To compensate, this patch contains some extra optimizations in the flattener, leading to a number of performance improvements. Close #18875. Close #18910. There are many extra parts of the compiler that had to be affected in writing this patch: * The family-application cache (formerly the flat-cache) sometimes stores coercions built from Given inerts. When these inerts get kicked out, we must kick out from the cache as well. (This was, I believe, true previously, but somehow never caused trouble.) Kicking out from the cache requires adding a filterTM function to TrieMap. * This patch obviates the need to distinguish "blocking" coercion holes from non-blocking ones (which, previously, arose from CFunEqCans). There is thus some simplification around coercion holes. * Extra commentary throughout parts of the code I read through, to preserve the knowledge I gained while working. * A change in the pure unifier around unifying skolems with other types. Unifying a skolem now leads to SurelyApart, not MaybeApart, as documented in Note [Binding when looking up instances] in GHC.Core.InstEnv. * Some more use of MCoercion where appropriate. * Previously, class-instance lookup automatically noticed that e.g. C Int was a "unifier" to a target [W] C (F Bool), because the F Bool was flattened to a variable. Now, a little more care must be taken around checking for unifying instances. * Previously, tcSplitTyConApp_maybe would split (Eq a => a). This is silly, because (=>) is not a tycon in Haskell. Fixed now, but there are some knock-on changes in e.g. TrieMap code and in the canonicaliser. * New function anyFreeVarsOf{Type,Co} to check whether a free variable satisfies a certain predicate. * Type synonyms now remember whether or not they are "forgetful"; a forgetful synonym drops at least one argument. This is useful when flattening; see flattenView. * The pattern-match completeness checker invokes the solver. This invocation might need to look through newtypes when checking representational equality. Thus, the desugarer needs to keep track of the in-scope variables to know what newtype constructors are in scope. I bet this bug was around before but never noticed. * Extra-constraints wildcards are no longer simplified before printing. See Note [Do not simplify ConstraintHoles] in GHC.Tc.Solver. * Whether or not there are Given equalities has become slightly subtler. See the new HasGivenEqs datatype. * Note [Type variable cycles in Givens] in GHC.Tc.Solver.Canonical explains a significant new wrinkle in the new approach. * See Note [What might match later?] in GHC.Tc.Solver.Interact, which explains the fix to #18910. * The inert_count field of InertCans wasn't actually used, so I removed it. Though I (Richard) did the implementation, Simon PJ was very involved in design and review. This updates the Haddock submodule to avoid #18932 by adding a type signature. ------------------------- Metric Decrease: T12227 T5030 T9872a T9872b T9872c Metric Increase: T9872d ------------------------- - - - - - d66660ba by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Rename the flattener to become the rewriter. Now that flattening doesn't produce flattening variables, it's not really flattening anything: it's rewriting. This change also means that the rewriter can no longer be confused the core flattener (in GHC.Core.Unify), which is sometimes used during type-checking. - - - - - add0aeae by Ben Gamari at 2020-12-01T19:58:17-05:00 rts: Introduce mmapAnonForLinker Previously most of the uses of mmapForLinker were mapping anonymous memory, resulting in a great deal of unnecessary repetition. Factor this out into a new helper. Also fixes a few places where error checking was missing or suboptimal. - - - - - 97d71646 by Ben Gamari at 2020-12-01T19:58:17-05:00 rts/linker: Introduce munmapForLinker Consolidates munmap calls to ensure consistent error handling. - - - - - d8872af0 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/Linker: Introduce Windows implementations for mmapForLinker, et al. - - - - - c35d0e03 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/m32: Introduce NEEDS_M32 macro Instead of relying on RTS_LINKER_USE_MMAP - - - - - 41c64eb5 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/linker: Use m32 to allocate symbol extras in PEi386 - - - - - e0b08c5f by Ben Gamari at 2020-12-03T13:01:47-05:00 gitlab-ci: Fix copy-paste error Also be more consistent in quoting. - - - - - 33ec3a06 by Ben Gamari at 2020-12-03T23:11:31-05:00 gitlab-ci: Run linters through ci.sh Ensuring that the right toolchain is used. - - - - - 4a437bc1 by Shayne Fletcher at 2020-12-05T09:06:38-05:00 Fix bad span calculations of post qualified imports - - - - - 8fac4b93 by Ben Gamari at 2020-12-05T09:07:13-05:00 testsuite: Add a test for #18923 - - - - - 432bac85 by Andreas Klebinger at 2020-12-07T13:29:40+01:00 Optimize dumping of consecutive whitespace. The naive way of putting out n characters of indent would be something like `hPutStr hdl (replicate n ' ')`. However this is quite inefficient as we allocate an absurd number of strings consisting of simply spaces as we don't cache them. To improve on this we now track if we can simply write ascii spaces via hPutBuf instead. This is the case when running with -ddump-to-file where we force the encoding to be UTF8. This avoids both the cost of going through encoding as well as avoiding allocation churn from all the white space. Instead we simply use hPutBuf on a preallocated unlifted string. When dumping stg like this: > nofib/spectral/simple/Main.hs -fforce-recomp -ddump-stg-final -ddump-to-file -c +RTS -s Allocations went from 1,778 MB to 1,702MB. About a 4% reduction of allocation! I did not measure the difference in runtime but expect it to be similar. Bumps the haddock submodule since the interface of GHC's Pretty slightly changed. ------------------------- Metric Decrease: T12227 ------------------------- - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/Reg/Graph.hs - compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Axiom.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FamInstEnv.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/Lint.hs - + compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Map.hs → compiler/GHC/Core/Map/Type.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/19f77e98935d78f997eacb2e3eafa46328df3825...432bac851a6893b4455f517fd5bea72c508789fd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/19f77e98935d78f997eacb2e3eafa46328df3825...432bac851a6893b4455f517fd5bea72c508789fd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Dec 7 13:33:48 2020 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Mon, 07 Dec 2020 08:33:48 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/ghc-dynamic-census Message-ID: <5fce2f3c1bc0e_6b2113d8dc032134a@gitlab.mail> Matthew Pickering pushed new branch wip/ghc-dynamic-census at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/ghc-dynamic-census You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Dec 7 13:42:07 2020 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Mon, 07 Dec 2020 08:42:07 -0500 Subject: [Git][ghc/ghc][wip/ghc-dynamic-census] Profiling: Allow heap profiling to be controlled dynamically. Message-ID: <5fce312f3bbf3_6b2113d8dc03229a1@gitlab.mail> Matthew Pickering pushed to branch wip/ghc-dynamic-census at Glasgow Haskell Compiler / GHC Commits: c1a01933 by Matthew Pickering at 2020-12-07T13:41:55+00:00 Profiling: Allow heap profiling to be controlled dynamically. This patch exposes three new functions in `GHC.Profiling` which allow heap profiling to be enabled and disabled dynamically. 1. startHeapProfTimer - Starts heap profiling with the given RTS options 2. stopHeapProfTimer - Stops heap profiling 3. requestHeapCensus - Perform a heap census on the next context switch, regardless of whether the timer is enabled or not. - - - - - 12 changed files: - docs/users_guide/9.2.1-notes.rst - docs/users_guide/profiling.rst - includes/Rts.h - includes/rts/Flags.h - + includes/rts/prof/Heap.h - libraries/base/GHC/Profiling.hs - libraries/base/GHC/RTS/Flags.hsc - rts/Proftimer.c - rts/Proftimer.h - rts/RtsFlags.c - rts/Schedule.c - rts/rts.cabal.in Changes: ===================================== docs/users_guide/9.2.1-notes.rst ===================================== @@ -47,7 +47,13 @@ Compiler - There is a significant refactoring in the solver; any type-checker plugins will have to be updated, as GHC no longer uses flattening skolems or flattening metavariables. - + +- The heap profiler can now be controlled from within a Haskell program using + functions in ``GHC.Profiling``. Profiling can be started and stopped or a heap + census requested at a specific point in the program. + There is a new RTS flag :rts-flag:`--no-automatic-heap-samples` which can be + used to stop heap profiling starting when a program starts. + ``ghc-prim`` library ~~~~~~~~~~~~~~~~~~~~ ===================================== docs/users_guide/profiling.rst ===================================== @@ -459,7 +459,7 @@ compiled program. :type: dynamic Deprecated alias for :ghc-flag:`-fprof-auto-exported` - + .. ghc-flag:: -caf-all :shortdesc: *(deprecated)* Alias for :ghc-flag:`-fprof-cafs` :type: dynamic @@ -885,6 +885,12 @@ There are three more options which relate to heap profiling: profiles are always sampled with the frequency of the RTS clock. See :ref:`prof-time-options` for changing that. +.. rts-flag:: --no-automatic-heap-samples + + Don't start heap profiling from the start of program executation. If this + option is enabled, it's expected that the user will manually start heap + profiling or request specific samples using functions from ``GHC.Profiling``. + .. rts-flag:: -xt Include the memory occupied by threads in a heap profile. Each ===================================== includes/Rts.h ===================================== @@ -194,6 +194,7 @@ void _assertFail(const char *filename, unsigned int linenum) /* Profiling information */ #include "rts/prof/CCS.h" +#include "rts/prof/Heap.h" #include "rts/prof/LDV.h" /* Parallel information */ ===================================== includes/rts/Flags.h ===================================== @@ -145,6 +145,7 @@ typedef struct _PROFILING_FLAGS { Time heapProfileInterval; /* time between samples */ uint32_t heapProfileIntervalTicks; /* ticks between samples (derived) */ bool includeTSOs; + bool startHeapProfileAtStartup; /* true if we start profiling from program startup */ bool showCCSOnException; ===================================== includes/rts/prof/Heap.h ===================================== @@ -0,0 +1,24 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The University of Glasgow, 2009 + * + * Heap Census Profiling + * + * Do not #include this file directly: #include "Rts.h" instead. + * + * To understand the structure of the RTS headers, see the wiki: + * https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes + * + * ---------------------------------------------------------------------------*/ + +#pragma once + +/* ----------------------------------------------------------------------------- + * Fine-grained control over heap census profiling which can be called from + * Haskell to restrict the profile to portion(s) of the execution. + * See the module GHC.Profiling. + * ---------------------------------------------------------------------------*/ + +void requestHeapCensus ( void ); +void startHeapProfTimer ( void ); +void stopHeapProfTimer ( void ); ===================================== libraries/base/GHC/Profiling.hs ===================================== @@ -2,7 +2,14 @@ {-# LANGUAGE NoImplicitPrelude #-} -- | @since 4.7.0.0 -module GHC.Profiling where +module GHC.Profiling ( -- * Cost Centre Profiling + startProfTimer + , stopProfTimer + -- * Heap Profiling + , startHeapProfTimer + , stopHeapProfTimer + , requestHeapCensus + )where import GHC.Base @@ -17,3 +24,19 @@ foreign import ccall stopProfTimer :: IO () -- -- @since 4.7.0.0 foreign import ccall startProfTimer :: IO () + +-- | Request a heap census on the next context switch. +-- +-- @since 4.16.0.0 +foreign import ccall requestHeapCensus :: IO () + +-- | Start heap profiling. This is called normally by the RTS on start-up, +-- but can be disabled using the rts flag `--no-automatic-gc-intervals` +-- +-- @since 4.16.0.0 +foreign import ccall startHeapProfTimer :: IO () + +-- | Stop heap profiling. +-- +-- @since 4.16.0.0 +foreign import ccall stopHeapProfTimer :: IO () ===================================== libraries/base/GHC/RTS/Flags.hsc ===================================== @@ -289,6 +289,7 @@ data ProfFlags = ProfFlags , heapProfileInterval :: RtsTime -- ^ time between samples , heapProfileIntervalTicks :: Word -- ^ ticks between samples (derived) , includeTSOs :: Bool + , startHeapProfileAtStartup :: Bool , showCCSOnException :: Bool , maxRetainerSetSize :: Word , ccsLength :: Word @@ -586,6 +587,8 @@ getProfFlags = do <*> #{peek PROFILING_FLAGS, heapProfileIntervalTicks} ptr <*> (toBool <$> (#{peek PROFILING_FLAGS, includeTSOs} ptr :: IO CBool)) + <*> (toBool <$> + (#{peek PROFILING_FLAGS, startHeapProfileAtStartup} ptr :: IO CBool)) <*> (toBool <$> (#{peek PROFILING_FLAGS, showCCSOnException} ptr :: IO CBool)) <*> #{peek PROFILING_FLAGS, maxRetainerSetSize} ptr ===================================== rts/Proftimer.c ===================================== @@ -18,7 +18,12 @@ static bool do_prof_ticks = false; // enable profiling ticks #endif -static bool do_heap_prof_ticks = false; // enable heap profiling ticks +static bool do_heap_prof_ticks = false; // Whether the timer is currently ticking down +static bool heap_prof_timer_active = false; // Whether the timer is enabled at all + +/* The heap_prof_timer_active flag controls whether heap profiling is enabled +at all, once it is enabled, the `do_heap_prof_ticks` flag controls whether the +counter is currently counting down. This is paused, for example, in Schedule.c. */ // Sampling of Ticky-Ticky profiler to eventlog #if defined(TICKY_TICKY) && defined(TRACING) @@ -51,18 +56,36 @@ startProfTimer( void ) void stopHeapProfTimer( void ) { - RELAXED_STORE(&do_heap_prof_ticks, false); + heap_prof_timer_active = false; + pauseHeapProfTimer(); } void startHeapProfTimer( void ) { + heap_prof_timer_active = true; + resumeHeapProfTimer(); +} + +void +pauseHeapProfTimer ( void ) { + RELAXED_STORE(&do_heap_prof_ticks, false); +} + + +void +resumeHeapProfTimer ( void ) { if (RtsFlags.ProfFlags.doHeapProfile && RtsFlags.ProfFlags.heapProfileIntervalTicks > 0) { do_heap_prof_ticks = true; } } +void +requestHeapCensus( void ) +{ performHeapProfile = true; +} + void initProfTimer( void ) { @@ -70,7 +93,12 @@ initProfTimer( void ) ticks_to_heap_profile = RtsFlags.ProfFlags.heapProfileIntervalTicks; - startHeapProfTimer(); + /* This might look a bit strange but the heap profile timer can + be toggled on/off from within Haskell by calling the startHeapProf + function from within Haskell */ + if (RtsFlags.ProfFlags.startHeapProfileAtStartup){ + startHeapProfTimer(); + } } uint32_t total_ticks = 0; @@ -99,7 +127,7 @@ handleProfTick(void) } #endif - if (RELAXED_LOAD(&do_heap_prof_ticks)) { + if (RELAXED_LOAD(&do_heap_prof_ticks) && heap_prof_timer_active) { ticks_to_heap_profile--; if (ticks_to_heap_profile <= 0) { ticks_to_heap_profile = RtsFlags.ProfFlags.heapProfileIntervalTicks; ===================================== rts/Proftimer.h ===================================== @@ -12,9 +12,8 @@ void initProfTimer ( void ); void handleProfTick ( void ); - -void stopHeapProfTimer ( void ); -void startHeapProfTimer ( void ); +void pauseHeapProfTimer ( void ); +void resumeHeapProfTimer ( void ); extern bool performHeapProfile; extern bool performTickySample; ===================================== rts/RtsFlags.c ===================================== @@ -211,6 +211,7 @@ void initRtsFlagsDefaults(void) RtsFlags.ProfFlags.doHeapProfile = false; RtsFlags.ProfFlags.heapProfileInterval = USToTime(100000); // 100ms + RtsFlags.ProfFlags.startHeapProfileAtStartup = true; #if defined(PROFILING) RtsFlags.ProfFlags.includeTSOs = false; @@ -390,6 +391,10 @@ usage_text[] = { " -hT Produce a heap profile grouped by closure type", #endif /* PROFILING */ +" -i Time between heap profile samples (seconds, default: 0.1)", +" --no-automatic-heap-samples Do not start the heap profile interval time", +" rely on the user to trigger samples from their application", + #if defined(TRACING) "", " -ol Send binary eventlog to (default: .eventlog)", @@ -415,7 +420,6 @@ usage_text[] = { " the initial enabled event classes are 'sgpu'", #endif -" -i Time between heap profile samples (seconds, default: 0.1)", "", #if defined(TICKY_TICKY) " -r Produce ticky-ticky statistics (with -rstderr for stderr)", @@ -1080,6 +1084,12 @@ error = true; } break; } + else if (strequal("no-automatic-heap-samples", + &rts_argv[arg][2])) { + OPTION_SAFE; + RtsFlags.ProfFlags.startHeapProfileAtStartup = false; + break; + } else { OPTION_SAFE; errorBelch("unknown RTS option: %s",rts_argv[arg]); ===================================== rts/Schedule.c ===================================== @@ -415,7 +415,7 @@ run_thread: // that. cap->r.rCurrentTSO = t; - startHeapProfTimer(); + resumeHeapProfTimer(); // ---------------------------------------------------------------------- // Run the current thread @@ -533,7 +533,7 @@ run_thread: // ---------------------------------------------------------------------- // Costs for the scheduler are assigned to CCS_SYSTEM - stopHeapProfTimer(); + pauseHeapProfTimer(); #if defined(PROFILING) cap->r.rCCCS = CCS_SYSTEM; #endif ===================================== rts/rts.cabal.in ===================================== @@ -180,6 +180,7 @@ library rts/Types.h rts/Utils.h rts/prof/CCS.h + rts/prof/Heap.h rts/prof/LDV.h rts/storage/Block.h rts/storage/ClosureMacros.h View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c1a01933d75a6322b03a02cb8f7d49dc6d69f26f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c1a01933d75a6322b03a02cb8f7d49dc6d69f26f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Dec 7 13:50:53 2020 From: gitlab at gitlab.haskell.org (Danya Rogozin) Date: Mon, 07 Dec 2020 08:50:53 -0500 Subject: [Git][ghc/ghc][wip/ghc-11342-char-kind] the char kind: type families, functionality, and submodule updates Message-ID: <5fce333d43746_6b21125154c32474e@gitlab.mail> Danya Rogozin pushed to branch wip/ghc-11342-char-kind at Glasgow Haskell Compiler / GHC Commits: 23a76c72 by Daniel Rogozin at 2020-12-07T16:50:15+03:00 the char kind: type families, functionality, and submodule updates Co-authored-by: Rinat Stryungis <rinat.stryungis at serokell.io> Metric Decrease: T5205 Metric Increase: Naperian T13035 - - - - - 30 changed files: - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Types/Literals.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/Type.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Data/FastString.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Parser.y - compiler/GHC/Rename/HsType.hs - compiler/GHC/StgToCmm/Closure.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Instance/Typeable.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/Binary/Typeable.hs - libraries/base/Data/Typeable/Internal.hs - libraries/base/GHC/TypeLits.hs - libraries/binary The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/23a76c720af496004d499f89a46de1a089a2bdbd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/23a76c720af496004d499f89a46de1a089a2bdbd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Dec 7 14:03:39 2020 From: gitlab at gitlab.haskell.org (Danya Rogozin) Date: Mon, 07 Dec 2020 09:03:39 -0500 Subject: [Git][ghc/ghc][wip/ghc-11342-char-kind] the char kind: type families, functionality, and submodule updates Message-ID: <5fce363b9ad56_6b2117f170432569b@gitlab.mail> Danya Rogozin pushed to branch wip/ghc-11342-char-kind at Glasgow Haskell Compiler / GHC Commits: 4ec9fad0 by Daniel Rogozin at 2020-12-07T17:03:15+03:00 the char kind: type families, functionality, and submodule updates Co-authored-by: Rinat Stryungis <rinat.stryungis at serokell.io> Metric Decrease: T5205 Metric Increase: Naperian T13035 - - - - - 30 changed files: - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Types/Literals.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/Type.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Data/FastString.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Parser.y - compiler/GHC/Rename/HsType.hs - compiler/GHC/StgToCmm/Closure.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Instance/Typeable.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/Binary/Typeable.hs - libraries/base/Data/Typeable/Internal.hs - libraries/base/GHC/TypeLits.hs - libraries/binary The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4ec9fad01301e5b78c969fa8d15fea4ef13326da -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4ec9fad01301e5b78c969fa8d15fea4ef13326da You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Dec 7 15:03:19 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 07 Dec 2020 10:03:19 -0500 Subject: [Git][ghc/ghc][wip/bump-text] 1572 commits: Changing Thread IDs from 32 bits to 64 bits. Message-ID: <5fce44378b9e7_6b21a31a383565be@gitlab.mail> Ben Gamari pushed to branch wip/bump-text at Glasgow Haskell Compiler / GHC Commits: e57b7cc6 by Roland Zumkeller at 2019-11-19T20:39:19-05:00 Changing Thread IDs from 32 bits to 64 bits. - - - - - d1f3c637 by Roland Zumkeller at 2019-11-19T20:39:19-05:00 Use pointer equality in Eq/Ord for ThreadId Changes (==) to use only pointer equality. This is safe because two threads are the same iff they have the same id. Changes `compare` to check pointer equality first and fall back on ids only in case of inequality. See discussion in #16761. - - - - - ef8a08e0 by Alexey Kuleshevich at 2019-11-19T20:39:20-05:00 hpc: Fix encoding issues. Add test for and fix #17073 * Make sure files are being read/written in UTF-8. Set encoding while writing HTML output. Also set encoding while writing and reading .tix files although we don't yet have a ticket complaining that this poses problems. * Set encoding in html header to utf8 * Upgrade to new version of 'hpc' library and reuse `readFileUtf8` and `writeFileUtf8` functions * Update git submodule for `hpc` * Bump up `hpc` executable version Co-authored-by: Ben Gamari <ben at smart-cactus.org> - - - - - b79e46d6 by Vladislav Zavialov at 2019-11-19T20:39:20-05:00 Strip parentheses in expressions contexts in error messages This makes error messages a tad less noisy. - - - - - 13bbde77 by Ben Gamari at 2019-11-21T13:56:56-05:00 Bump hsc2hs submodule Including Phyx's backport of the process changes fixing #17480. - - - - - d4d10501 by Ben Gamari at 2019-11-23T09:42:38-05:00 Bump hsc2hs submodule again This fixes the Darwin build. - - - - - 889d475b by nineonine at 2019-11-23T18:53:29-05:00 Fix typo in Note reference [skip ci] - - - - - 8a33abfc by Ryan Scott at 2019-11-23T18:54:05-05:00 Target the IsList instance for ZipList at base-4.14.0.0 (#17489) This moves the changelog entry about the instance from `base-4.15.0.0` to `base-4.14.0.0`. This accomplishes part (1) from #17489. [ci skip] - - - - - e43e6ece by Ben Gamari at 2019-11-23T18:54:41-05:00 rts: Expose interface for configuring EventLogWriters This exposes a set of interfaces from the GHC API for configuring EventLogWriters. These can be used by consumers like [ghc-eventlog-socket](https://github.com/bgamari/ghc-eventlog-socket). - - - - - de6bbdf2 by Matheus Magalhães de Alcantara at 2019-11-23T18:55:23-05:00 Take care to not eta-reduce jumps in CorePrep CorePrep already had a check to prevent it from eta-reducing Ids that respond true to hasNoBinding (foreign calls, constructors for unboxed sums and products, and Ids with compulsory unfoldings). It did not, however, consider join points as ids that 'must be saturated'. Checking whether the Id responds True to 'isJoinId' should prevent CorePrep from turning saturated jumps like the following (from #17429) into undersaturated ones: (\ eta_XP -> join { mapped_s1vo _ = lvl_s1vs } in jump mapped_s1vo eta_XP) - - - - - 4a1e7e47 by Matheus Magalhães de Alcantara at 2019-11-23T18:55:23-05:00 Make CorePrep.tryEtaReducePrep and CoreUtils.tryEtaReduce line up Simon PJ says he prefers this fix to #17429 over banning eta-reduction for jumps entirely. Sure enough, this also works. Test case: simplCore/should_compile/T17429.hs - - - - - 15f1dc33 by Ryan Scott at 2019-11-23T18:56:00-05:00 Prevent -optc arguments from being duplicated in reverse order (#17471) This reverts a part of commit 7bc5d6c6578ab9d60a83b81c7cc14819afef32ba that causes all arguments to `-optc` (and `-optcxx`) to be passed twice to the C/C++ compiler, once in reverse order and then again in the correct order. While passing duplicate arguments is usually harmless it can cause breakage in this pattern, which is employed by Hackage libraries in the wild: ``` ghc Foo.hs foo.c -optc-D -optcFOO ``` As `FOO -D -D FOO` will cause compilers to error. Fixes #17471. - - - - - e85c9b22 by Ben Gamari at 2019-11-23T18:56:36-05:00 Bump ghc version to 8.11 - - - - - 0e6c2045 by Ben Gamari at 2019-11-23T18:57:12-05:00 rts: Consolidate spinlock implementation Previously we had two distinct implementations: one with spinlock profiling and another without. This seems like needless duplication. - - - - - cb11fcb5 by Ben Gamari at 2019-11-23T18:57:49-05:00 Packages: Don't use expectJust Throw a slightly more informative error on failure. Motivated by the errors seen in !2160. - - - - - 5747ebe9 by Sebastian Graf at 2019-11-23T18:58:25-05:00 Stricten functions ins GHC.Natural This brings `Natural` on par with `Integer` and fixes #17499. Also does some manual CSE for 0 and 1 literals. - - - - - c14b723f by Ömer Sinan Ağacan at 2019-11-23T18:59:06-05:00 Bump exceptions submodule Adds a few files generated by GHC's configure script to .gitignore - - - - - 7b4c7b75 by Brian Wignall at 2019-11-23T19:04:52-05:00 Fix typos - - - - - 6008206a by Viktor Dukhovni at 2019-11-24T14:33:18-05:00 On FreeBSD 12 sys/sysctl.h requires sys/types.h Else build fails with: In file included from ExecutablePath.hsc:42: /usr/include/sys/sysctl.h:1062:25: error: unknown type name 'u_int'; did you mean 'int'? int sysctl(const int *, u_int, void *, size_t *, const void *, size_t); ^~~~~ int compiling libraries/base/dist-install/build/System/Environment/ExecutablePath_hsc_make.c failed (exit code 1) Perhaps also also other FreeBSD releases, but additional include will no harm even if not needed. - - - - - b694b566 by Ben Gamari at 2019-11-24T14:33:54-05:00 configure: Fix HAVE_C11_ATOMICS macro Previously we were using AC_DEFINE instead of AC_DEFINE_UNQUOTED, resulted in the variable not being interpolated. Fixes #17505. - - - - - 8b8dc366 by Krzysztof Gogolewski at 2019-11-25T14:37:38+01:00 Remove prefix arrow support for GADTs (#17211) This reverts the change in #9096. The specialcasing done for prefix (->) is brittle and does not support VTA, type families, type synonyms etc. - - - - - 5a08f7d4 by Sebastian Graf at 2019-11-27T00:14:59-05:00 Make warnings for TH splices opt-in In #17270 we have the pattern-match checker emit incorrect warnings. The reason for that behavior is ultimately an inconsistency in whether we treat TH splices as written by the user (`FromSource :: Origin`) or as generated code (`Generated`). This was first reported in #14838. The current solution is to TH splices as `Generated` by default and only treat them as `FromSource` when the user requests so (-fenable-th-splice-warnings). There are multiple reasons for opt-in rather than opt-out: * It's not clear that the user that compiles a splice is the author of the code that produces the warning. Think of the situation where she just splices in code from a third-party library that produces incomplete pattern matches. In this scenario, the user isn't even able to fix that warning. * Gathering information for producing the warnings (pattern-match check warnings in particular) is costly. There's no point in doing so if the user is not interested in those warnings. Fixes #17270, but not #14838, because the proper solution needs a GHC proposal extending the TH AST syntax. - - - - - 8168b42a by Vladislav Zavialov at 2019-11-27T11:32:18+03:00 Whitespace-sensitive bang patterns (#1087, #17162) This patch implements a part of GHC Proposal #229 that covers five operators: * the bang operator (!) * the tilde operator (~) * the at operator (@) * the dollar operator ($) * the double dollar operator ($$) Based on surrounding whitespace, these operators are disambiguated into bang patterns, lazy patterns, strictness annotations, type applications, splices, and typed splices. This patch doesn't cover the (-) operator or the -Woperator-whitespace warning, which are left as future work. - - - - - 9e5477c4 by Ryan Scott at 2019-11-27T20:01:50-05:00 Fix @since annotations for isResourceVanishedError and friends (#17488) - - - - - e122ba33 by Sergei Trofimovich at 2019-11-27T20:02:29-05:00 .gitmodules: tweak 'exception' URL to avoid redirection warnings Avoid initial close warning of form: ``` Cloning into 'exceptions'... warning: redirecting to https://gitlab.haskell.org/ghc/packages/exceptions.git/ ``` Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - 5f84b52a by Philipp Krüger at 2019-11-28T02:54:05-05:00 Reduce boolean blindness in OccInfo(OneOcc) #17482 * Transformed the type aliases `InterestingCxt`, `InsideLam` and `OneBranch` into data types. * Added Semigroup and Monoid instances for use in orOccInfo in OccurAnal.hs * Simplified some usage sites by using pattern matching instead of boolean algebra. Metric Increase: T12150 This increase was on a Mac-build of exactly 1%. This commit does *not* re-intruduce the asymptotic memory usage described in T12150. - - - - - 3748ba3a by Brian Wignall at 2019-11-28T02:54:52-05:00 Fix typos, using Wikipedia list of common typos - - - - - 6c59cc71 by Stefan Schulze Frielinghaus at 2019-11-28T02:55:33-05:00 Fix endian handling of LLVM backend Get rid of CPP macro WORDS_BIGENDIAN which is not defined anymore, and replace it by DynFlag. This fixes partially #17337. - - - - - 6985e0fc by Vladislav Zavialov at 2019-11-28T15:47:53+03:00 Factor out HsSCC/HsCoreAnn/HsTickPragma into HsPragE This is a refactoring with no user-visible changes (except for GHC API users). Consider the HsExpr constructors that correspond to user-written pragmas: HsSCC representing {-# SCC ... #-} HsCoreAnn representing {-# CORE ... #-} HsTickPragma representing {-# GENERATED ... #-} We can factor them out into a separate datatype, HsPragE. It makes the code a bit tidier, especially in the parser. Before this patch: hpc_annot :: { Located ( (([AddAnn],SourceText),(StringLiteral,(Int,Int),(Int,Int))), ((SourceText,SourceText),(SourceText,SourceText)) ) } After this patch: prag_hpc :: { Located ([AddAnn], HsPragE GhcPs) } - - - - - 7f695a20 by Ömer Sinan Ağacan at 2019-11-29T08:25:28-05:00 Pass ModDetails with (partial) ModIface in HscStatus (Partial) ModIface and ModDetails are generated at the same time, but they're passed differently: ModIface is passed in HscStatus consturctors while ModDetails is returned in a tuple. This refactors ModDetails passing so that it's passed around with ModIface in HscStatus constructors. This makes the code more consistent and hopefully easier to understand: ModIface and ModDetails are really very closely related. It makes sense to treat them the same way. - - - - - e921c90f by Ömer Sinan Ağacan at 2019-11-29T08:26:07-05:00 Improve few Foreign.Marshal.Utils docs In copyBytes and moveBytes mention which argument is source and which is destination. Also fixes some of the crazy indentation in the module and cleans trailing whitespace. - - - - - 316f2431 by Sebastian Graf at 2019-11-30T02:57:58-05:00 Hadrian docs: Rename the second "validate" entry to "slow-validate" [ci skip] That would be in line with the implementation. - - - - - 5aba5d32 by Vladislav Zavialov at 2019-11-30T02:58:34-05:00 Remove HasSrcSpan (#17494) Metric Decrease: haddock.compiler - - - - - d1de5c22 by Sylvain Henry at 2019-11-30T02:59:13-05:00 Use Hadrian by default in validate script (#17527) - - - - - 3a96a0b6 by Sebastian Graf at 2019-11-30T02:59:55-05:00 Simpler Semigroup instance for InsideLam and InterestingCtxt This mirrors the definition of `(&&)` and `(||)` now, relieving the Simplifier of a marginal amount of pressure. - - - - - f8cfe81a by Roland Senn at 2019-11-30T20:33:49+01:00 Improve tests for #17171 While backporting MR !1806 to 8.8.2 (!1885) I learnt the following: * Tests with `expect_fail` do not compare `*.stderr` output files. So a test using `expect_fail` will not detect future regressions on the `stderr` output. * To compare the `*.stderr` output files, I have to use the `exit_code(n)` function. * When a release is made, tests with `makefile_test` are converted to use `run_command`. * For the test `T17171a` the return code is `1` when running `makefile_test`, however it's `2` when running `run_command`. Therefore I decided: * To improve my tests for #17171 * To change test T17171a from `expect_fail` to `exit_code(2)` * To change both tests from `makefile_test` to `run_command` - - - - - 2b113fc9 by Vladislav Zavialov at 2019-12-01T08:17:05-05:00 Update DisambECP-related comments - - - - - beed7c3e by Ben Gamari at 2019-12-02T03:41:37-05:00 testsuite: Fix location of typing_stubs module This should fix the build on Debian 8. - - - - - 53251413 by Ben Gamari at 2019-12-02T03:42:14-05:00 testsuite: Don't override LD_LIBRARY_PATH, only prepend NixOS development environments often require that LD_LIBRARY_PATH be set in order to find system libraries. T1407 was overriding LD_LIBRARY_PATH, dropping these directories. Now it merely prepends, its directory. - - - - - 65400314 by Krzysztof Gogolewski at 2019-12-02T03:42:57-05:00 Convert warnings into assertions Since the invariants always hold in the testsuite, we can convert them to asserts. - - - - - 18baed64 by Alan Zimmerman at 2019-12-02T03:43:37-05:00 API Annotations: Unicode '->' on HsForallTy The code fragment type family Proxy2' ∷ ∀ k → k → Type where Proxy2' = Proxy' Generates AnnRarrow instead of AnnRarrowU for the first →. Fixes #17519 - - - - - 717f3236 by Brian Wignall at 2019-12-02T03:44:16-05:00 Fix more typos - - - - - bde48f8e by Ben Gamari at 2019-12-02T11:55:34-05:00 More Haddock syntax in GHC.Hs.Utils As suggested by RyanGlScott in !2163. - - - - - 038bedbc by Ben Gamari at 2019-12-02T11:56:18-05:00 Simplify: Fix pretty-printing of strictness A colleague recently hit the panic in Simplify.addEvals and I noticed that the message is quite unreadable due to incorrect pretty-printing. Fix this. - - - - - c500f652 by Ben Gamari at 2019-12-02T11:56:54-05:00 gitlab-ci: Fix changelog linting logic - - - - - 8ead967d by Ben Gamari at 2019-12-02T11:56:54-05:00 win32-init: Drop workaround for #17480 The `process` changes have now been merged into `hsc2hs`. (cherry picked from commit fa029f53132ad59f847ed012d3b835452cf16615) - - - - - d402209a by Ben Gamari at 2019-12-02T11:56:54-05:00 gitlab-ci: Disable Sphinx build on Debian 8 The docutils version available appears to be too old to support the `table` directive's `:widths:` options. (cherry picked from commit 75764487a96a7a026948b5af5022781872d12baa) - - - - - f1f68824 by Ben Gamari at 2019-12-02T11:56:54-05:00 base: Fix <unistd.h> #include Previously we were including <sys/unistd.h> which is available on glibc but not musl. (cherry picked from commit e44b695ca7cb5f3f99eecfba05c9672c6a22205e) - - - - - 37eb94b3 by Ben Gamari at 2019-12-02T11:56:54-05:00 gitlab-ci: Bump Docker images Installs pxz on Centos7 (cherry picked from commit 86960e691f7a600be247c32a7cf795bf9abf7cc4) - - - - - aec98a79 by Ben Gamari at 2019-12-02T11:56:54-05:00 gitlab-ci: pxz is unavailable on CentOS 7 Fall back to xz - - - - - 6708b8e5 by Ben Gamari at 2019-12-02T11:56:54-05:00 gitlab-ci: Set LANG on CentOS 7 It otherwise seems to default to ascii - - - - - 470ef0e7 by Ben Gamari at 2019-12-02T11:56:54-05:00 gitlab-ci: Consolidate release build configuration - - - - - 38338757 by Ben Gamari at 2019-12-02T11:56:54-05:00 gitlab-ci: Add Debian 10 builds - - - - - 012f13b5 by Ben Gamari at 2019-12-02T11:56:54-05:00 gitlab-ci: Fix Windows bindist collection Apparently variable interpolation in the `artifacts.paths` key of `gitlab-ci.yml` doesn't work on Windows as it does on WIndows. (cherry picked from commit 100cc756faa4468ed6950116bae30609c1c3468b) - - - - - a0f09e23 by Ben Gamari at 2019-12-02T11:56:54-05:00 testsuite: Simplify Python <3.5 fallback for TextIO (cherry picked from commit d092d8598694c23bc07cdcc504dff52fa5f33be1) - - - - - 2b2370ec by Ben Gamari at 2019-12-02T11:56:54-05:00 gitlab-ci: Add release-x86_64-linux-deb9 job (cherry picked from commit cbedb3c4a90649f474cb716842ba53afc5a642ca) - - - - - b1c206fd by Ben Gamari at 2019-12-02T11:56:54-05:00 gitlab-ci: Always build source tarball (cherry picked from commit 67b5de88ef923971f1980335137e3c7193213abd) - - - - - 4cbd5b47 by Sergei Trofimovich at 2019-12-02T11:57:33-05:00 configure.ac: make cross-compiler detection stricter Be more precise at detecting cross-compilation case. Before the change configuration $ ./configure --host=x86_64-pc-linux-gnu --target=x86_64-gentoo-linux-musl was not considered a cross-target. Even though libcs are different (`glibc` vs. `musl`). Without this patch build fails as: ``` "inplace/bin/ghc-cabal" check libraries/integer-gmp "inplace/bin/ghc-cabal" configure libraries/integer-gmp dist-install \ --with-ghc="/home/slyfox/dev/git/ghc/inplace/bin/ghc-stage1" \ --with-ghc-pkg="/home/slyfox/dev/git/ghc/inplace/bin/ghc-pkg" \ --disable-library-for-ghci --enable-library-vanilla --enable-library-for-ghci \ --enable-library-profiling --enable-shared --with-hscolour="/usr/bin/HsColour" \ --configure-option=CFLAGS="-Wall \ -Werror=unused-but-set-variable -Wno-error=inline \ -iquote /home/slyfox/dev/git/ghc/libraries/integer-gmp" \ --configure-option=LDFLAGS=" " --configure-option=CPPFLAGS=" \ " --gcc-options="-Wall -Werror=unused-but-set-variable -Wno-error=inline -iquote /home/slyfox/dev/git/ghc/libraries/integer-gmp \ " --with-gcc="x86_64-gentoo-linux-musl-gcc" --with-ld="x86_64-gentoo-linux-musl-ld.gold" --with-ar="x86_64-gentoo-linux-musl-ar" \ --with-alex="/usr/bin/alex" --with-happy="/usr/bin/happy" Configuring integer-gmp-1.0.2.0... configure: WARNING: unrecognized options: --with-compiler checking build system type... x86_64-pc-linux-gnu checking host system type... x86_64-pc-linux-gnu checking target system type... x86_64-pc-linux-gnu checking for gcc... /usr/lib/ccache/bin/x86_64-gentoo-linux-musl-gcc checking whether the C compiler works... yes checking for C compiler default output file name... a.out checking for suffix of executables... checking whether we are cross compiling... configure: error: in `/home/slyfox/dev/git/ghc/libraries/integer-gmp/dist-install/build': configure: error: cannot run C compiled programs. If you meant to cross compile, use `--host'. See `config.log' for more details make[1]: *** [libraries/integer-gmp/ghc.mk:5: libraries/integer-gmp/dist-install/package-data.mk] Error 1 make: *** [Makefile:126: all] Error 2 ``` Note: here `ghc-stage1` is assumed to target `musl` target but is passed `glibc` toolchain. It happens because initial ./configure phase did not detect host/target as different. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - 5f7cb423 by Sylvain Henry at 2019-12-02T23:59:29-05:00 Add `timesInt2#` primop - - - - - fbbe18a2 by Sylvain Henry at 2019-12-02T23:59:29-05:00 Use the new timesInt2# primop in integer-gmp (#9431) - - - - - 5a4b8d0c by Athas at 2019-12-03T00:00:09-05:00 Document RTS behaviour upon encountering '--'. - - - - - 705a16df by Ben Gamari at 2019-12-03T07:11:33-05:00 Make BCO# lifted In #17424 Simon PJ noted that there is a potentially unsafe occurrence of unsafeCoerce#, coercing from an unlifted to lifted type. However, nowhere in the compiler do we assume that a BCO# is not a thunk. Moreover, in the case of a CAF the result returned by `createBCO` *will* be a thunk (as noted in [Updatable CAF BCOs]). Consequently it seems better to rather make BCO# a lifted type and rename it to BCO. - - - - - 35afe4f3 by Sylvain Henry at 2019-12-03T07:12:13-05:00 Use Int# primops in `Bits Int{8,16,32,64}` instances - - - - - 7a51b587 by Sylvain Henry at 2019-12-03T07:12:13-05:00 Add constant folding rule (#16402) narrowN (x .&. m) m .&. (2^N-1) = 2^N-1 ==> narrowN x e.g. narrow16 (x .&. 0x12FFFF) ==> narrow16 x - - - - - 10caee7f by Ben Gamari at 2019-12-03T21:04:50-05:00 users-guide: Add 8.12.1 release notes - - - - - 25019d18 by Ben Gamari at 2019-12-03T21:04:50-05:00 Drop Uniquable constraint for AnnTarget This relied on deriveUnique, which was far too subtle to be safely applied. Thankfully the instance doesn't appear to be used so let's just drop it. - - - - - 78b67ad0 by Ben Gamari at 2019-12-03T21:04:50-05:00 Simplify uniqAway This does two things: * Eliminate all uses of Unique.deriveUnique, which was quite easy to mis-use and extremely subtle. * Rename the previous "derived unique" notion to "local unique". This is possible because the only places where `uniqAway` can be safely used are those where local uniqueness (with respect to some InScopeSet) is sufficient. * Rework the implementation of VarEnv.uniqAway, as discussed in #17462. This should make the operation significantly more efficient than its previous iterative implementation.. Metric Decrease: T9872c T12227 T9233 T14683 T5030 T12545 hie002 Metric Increase: T9961 - - - - - f03a41d4 by Ben Gamari at 2019-12-03T21:05:27-05:00 Elf: Fix link info note generation Previously we would use the `.int` assembler directive to generate 32-bit words in the note section. However, `.int` is note guaranteed to produce 4-bytes; in fact, on some platforms (e.g. AArch64) it produces 8-bytes. Use the `.4bytes` directive to avoid this. Moreover, we used the `.align` directive, which is quite platform dependent. On AArch64 it appears to not even be idempotent (despite what the documentation claims). `.balign` is consequentially preferred as it offers consistent behavior across platforms. - - - - - 84585e5e by Vladislav Zavialov at 2019-12-05T16:07:44-05:00 Meaning-preserving SCC annotations (#15730) This patch implements GHC Proposal #176: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0176-scc-parsing.rst Before the change: 1 / 2 / 2 = 0.25 1 / {-# SCC "name" #-} 2 / 2 = 1.0 After the change: 1 / 2 / 2 = 0.25 1 / {-# SCC "name" #-} 2 / 2 = parse error - - - - - e49e5470 by Vladislav Zavialov at 2019-12-05T16:07:44-05:00 Improve error messages for SCC pragmas - - - - - a2b535d9 by Ben Gamari at 2019-12-05T16:07:45-05:00 users guide: Try to silence underfull \hbox warnings We use two tricks, as suggested here [1]: * Use microtype to try to reduce the incidence of underfull boxes * Bump up \hbadness to eliminate the warnings - - - - - 4e47217f by Bodigrim at 2019-12-05T16:07:47-05:00 Make sameNat and sameSymbol proxy-polymorphic - - - - - 8324f0b7 by Bodigrim at 2019-12-05T16:07:47-05:00 Test proxy-polymorphic sameNat and sameSymbol - - - - - 69001f54 by Ben Gamari at 2019-12-05T16:07:48-05:00 nonmoving: Clear segment bitmaps during sweep Previously we would clear the bitmaps of segments which we are going to sweep during the preparatory pause. However, this is unnecessary: the existence of the mark epoch ensures that the sweep will correctly identify non-reachable objects, even if we do not clear the bitmap. We now defer clearing the bitmap to sweep, which happens concurrently with mutation. - - - - - 58a9c429 by Ben Gamari at 2019-12-05T16:07:48-05:00 testsuite: Disable divByZero on non-NCG targets The LLVM backend does not guarantee any particular semantics for division by zero, making this test unreliable across platforms. - - - - - 8280bd8a by Ben Gamari at 2019-12-05T16:07:49-05:00 testsuite: Factor out terminal coloring - - - - - 92a52aaa by Ben Gamari at 2019-12-05T16:07:49-05:00 testsuite: Make performance metric summary more readable Along with some refactoring. - - - - - c4ca29c7 by Ben Gamari at 2019-12-05T16:07:49-05:00 testsuite: Use colors more consistently - - - - - 3354c68e by Vladislav Zavialov at 2019-12-05T16:07:49-05:00 Pretty-printing of the * kind Before this patch, GHC always printed the * kind unparenthesized. This led to two issues: 1. Sometimes GHC printed invalid or incorrect code. For example, GHC would print: type F @* x = x when it meant to print: type F @(*) x = x In the former case, instead of a kind application we were getting a type operator (@*). 2. Sometimes GHC printed kinds that were correct but hard to read. Should Either * Int be read as Either (*) Int or as (*) Either Int ? This depends on whether -XStarIsType is enabled, but it would be easier if we didn't have to check for the flag when reading the code. We can solve both problems by assigning (*) a different precedence. Note that Haskell98 kinds are not affected: ((* -> *) -> *) -> * does NOT become (((*) -> (*)) -> (*)) -> (*) The parentheses are added when (*) is used in a function argument position: F * * * becomes F (*) (*) (*) F A * B becomes F A (*) B Proxy * becomes Proxy (*) a * -> * becomes a (*) -> * - - - - - 70dd0e4b by Vladislav Zavialov at 2019-12-05T16:07:49-05:00 Parenthesize the * kind in TH.Ppr - - - - - a7a4efbf by Ben Gamari at 2019-12-05T16:07:49-05:00 rts/NonMovingSweep: Fix locking of new mutable list allocation Previously we used allocBlockOnNode_sync in nonmovingSweepMutLists despite the fact that we aren't in the GC and therefore the allocation spinlock isn't in use. This meant that sweep would end up spinning until the next minor GC, when the SM lock was moved away from the SM_MUTEX to the spinlock. This isn't a correctness issue but it sure isn't good for performance. Found thanks for Ward. Fixes #17539. - - - - - f171b358 by Matthias Braun at 2019-12-05T16:07:51-05:00 Fix typo in documentation of Base.hs. - - - - - 9897e8c8 by Gabor Greif at 2019-12-06T21:20:38-05:00 Implement pointer tagging for big families (#14373) Formerly we punted on these and evaluated constructors always got a tag of 1. We now cascade switches because we have to check the tag first and when it is MAX_PTR_TAG then get the precise tag from the info table and switch on that. The only technically tricky part is that the default case needs (logical) duplication. To do this we emit an extra label for it and branch to that from the second switch. This avoids duplicated codegen. Here's a simple example of the new code gen: data D = D1 | D2 | D3 | D4 | D5 | D6 | D7 | D8 On a 64-bit system previously all constructors would be tagged 1. With the new code gen D7 and D8 are tagged 7: [Lib.D7_con_entry() { ... {offset c1eu: // global R1 = R1 + 7; call (P64[Sp])(R1) args: 8, res: 0, upd: 8; } }] [Lib.D8_con_entry() { ... {offset c1ez: // global R1 = R1 + 7; call (P64[Sp])(R1) args: 8, res: 0, upd: 8; } }] When switching we now look at the info table only when the tag is 7. For example, if we derive Enum for the type above, the Cmm looks like this: c2Le: _s2Js::P64 = R1; _c2Lq::P64 = _s2Js::P64 & 7; switch [1 .. 7] _c2Lq::P64 { case 1 : goto c2Lk; case 2 : goto c2Ll; case 3 : goto c2Lm; case 4 : goto c2Ln; case 5 : goto c2Lo; case 6 : goto c2Lp; case 7 : goto c2Lj; } // Read info table for tag c2Lj: _c2Lv::I64 = %MO_UU_Conv_W32_W64(I32[I64[_s2Js::P64 & (-8)] - 4]); if (_c2Lv::I64 != 6) goto c2Lu; else goto c2Lt; Generated Cmm sizes do not change too much, but binaries are very slightly larger, due to the fact that the new instructions are longer in encoded form. E.g. previously entry code for D8 above would be 00000000000001c0 <Lib_D8_con_info>: 1c0: 48 ff c3 inc %rbx 1c3: ff 65 00 jmpq *0x0(%rbp) With this patch 00000000000001d0 <Lib_D8_con_info>: 1d0: 48 83 c3 07 add $0x7,%rbx 1d4: ff 65 00 jmpq *0x0(%rbp) This is one byte longer. Secondly, reading info table directly and then switching is shorter _c1co: movq -1(%rbx),%rax movl -4(%rax),%eax // Switch on info table tag jmp *_n1d5(,%rax,8) than doing the same switch, and then for the tag 7 doing another switch: // When tag is 7 _c1ct: andq $-8,%rbx movq (%rbx),%rax movl -4(%rax),%eax // Switch on info table tag ... Some changes of binary sizes in actual programs: - In NoFib the worst case is 0.1% increase in benchmark "parser" (see NoFib results below). All programs get slightly larger. - Stage 2 compiler size does not change. - In "containers" (the library) size of all object files increases 0.0005%. Size of the test program "bitqueue-properties" increases 0.03%. nofib benchmarks kindly provided by Ömer (@osa1): NoFib Results ============= -------------------------------------------------------------------------------- Program Size Allocs Instrs Reads Writes -------------------------------------------------------------------------------- CS +0.0% 0.0% -0.0% -0.0% -0.0% CSD +0.0% 0.0% 0.0% +0.0% +0.0% FS +0.0% 0.0% 0.0% +0.0% 0.0% S +0.0% 0.0% -0.0% 0.0% 0.0% VS +0.0% 0.0% -0.0% +0.0% +0.0% VSD +0.0% 0.0% -0.0% +0.0% -0.0% VSM +0.0% 0.0% 0.0% 0.0% 0.0% anna +0.0% 0.0% +0.1% -0.9% -0.0% ansi +0.0% 0.0% -0.0% +0.0% +0.0% atom +0.0% 0.0% 0.0% 0.0% 0.0% awards +0.0% 0.0% -0.0% +0.0% 0.0% banner +0.0% 0.0% -0.0% +0.0% 0.0% bernouilli +0.0% 0.0% +0.0% +0.0% +0.0% binary-trees +0.0% 0.0% -0.0% -0.0% -0.0% boyer +0.0% 0.0% +0.0% 0.0% -0.0% boyer2 +0.0% 0.0% +0.0% 0.0% -0.0% bspt +0.0% 0.0% +0.0% +0.0% 0.0% cacheprof +0.0% 0.0% +0.1% -0.8% 0.0% calendar +0.0% 0.0% -0.0% +0.0% -0.0% cichelli +0.0% 0.0% +0.0% 0.0% 0.0% circsim +0.0% 0.0% -0.0% -0.1% -0.0% clausify +0.0% 0.0% +0.0% +0.0% 0.0% comp_lab_zift +0.0% 0.0% +0.0% 0.0% -0.0% compress +0.0% 0.0% +0.0% +0.0% 0.0% compress2 +0.0% 0.0% 0.0% 0.0% 0.0% constraints +0.0% 0.0% -0.0% -0.0% -0.0% cryptarithm1 +0.0% 0.0% +0.0% 0.0% 0.0% cryptarithm2 +0.0% 0.0% +0.0% -0.0% 0.0% cse +0.0% 0.0% +0.0% +0.0% 0.0% digits-of-e1 +0.0% 0.0% -0.0% -0.0% -0.0% digits-of-e2 +0.0% 0.0% +0.0% -0.0% -0.0% dom-lt +0.0% 0.0% +0.0% +0.0% 0.0% eliza +0.0% 0.0% -0.0% +0.0% 0.0% event +0.0% 0.0% -0.0% -0.0% -0.0% exact-reals +0.0% 0.0% +0.0% +0.0% +0.0% exp3_8 +0.0% 0.0% -0.0% -0.0% -0.0% expert +0.0% 0.0% +0.0% +0.0% +0.0% fannkuch-redux +0.0% 0.0% +0.0% 0.0% 0.0% fasta +0.0% 0.0% -0.0% -0.0% -0.0% fem +0.0% 0.0% +0.0% +0.0% +0.0% fft +0.0% 0.0% +0.0% -0.0% -0.0% fft2 +0.0% 0.0% +0.0% +0.0% +0.0% fibheaps +0.0% 0.0% +0.0% +0.0% 0.0% fish +0.0% 0.0% +0.0% +0.0% 0.0% fluid +0.0% 0.0% +0.0% +0.0% +0.0% fulsom +0.0% 0.0% +0.0% -0.0% +0.0% gamteb +0.0% 0.0% +0.0% -0.0% -0.0% gcd +0.0% 0.0% +0.0% +0.0% 0.0% gen_regexps +0.0% 0.0% +0.0% -0.0% -0.0% genfft +0.0% 0.0% -0.0% -0.0% -0.0% gg +0.0% 0.0% 0.0% -0.0% 0.0% grep +0.0% 0.0% +0.0% +0.0% +0.0% hidden +0.0% 0.0% +0.0% -0.0% -0.0% hpg +0.0% 0.0% +0.0% -0.1% -0.0% ida +0.0% 0.0% +0.0% -0.0% -0.0% infer +0.0% 0.0% -0.0% -0.0% -0.0% integer +0.0% 0.0% -0.0% -0.0% -0.0% integrate +0.0% 0.0% 0.0% +0.0% 0.0% k-nucleotide +0.0% 0.0% -0.0% -0.0% -0.0% kahan +0.0% 0.0% -0.0% -0.0% -0.0% knights +0.0% 0.0% +0.0% -0.0% -0.0% lambda +0.0% 0.0% +1.2% -6.1% -0.0% last-piece +0.0% 0.0% +0.0% -0.0% -0.0% lcss +0.0% 0.0% +0.0% -0.0% -0.0% life +0.0% 0.0% +0.0% -0.0% -0.0% lift +0.0% 0.0% +0.0% +0.0% 0.0% linear +0.0% 0.0% +0.0% +0.0% +0.0% listcompr +0.0% 0.0% -0.0% -0.0% -0.0% listcopy +0.0% 0.0% -0.0% -0.0% -0.0% maillist +0.0% 0.0% +0.0% -0.0% -0.0% mandel +0.0% 0.0% +0.0% +0.0% +0.0% mandel2 +0.0% 0.0% +0.0% +0.0% -0.0% mate +0.0% 0.0% +0.0% +0.0% +0.0% minimax +0.0% 0.0% -0.0% +0.0% -0.0% mkhprog +0.0% 0.0% +0.0% +0.0% +0.0% multiplier +0.0% 0.0% 0.0% +0.0% -0.0% n-body +0.0% 0.0% +0.0% -0.0% -0.0% nucleic2 +0.0% 0.0% +0.0% +0.0% -0.0% para +0.0% 0.0% +0.0% +0.0% +0.0% paraffins +0.0% 0.0% +0.0% +0.0% +0.0% parser +0.1% 0.0% +0.4% -1.7% -0.0% parstof +0.0% 0.0% -0.0% -0.0% -0.0% pic +0.0% 0.0% +0.0% 0.0% -0.0% pidigits +0.0% 0.0% -0.0% -0.0% -0.0% power +0.0% 0.0% +0.0% -0.0% -0.0% pretty +0.0% 0.0% +0.0% +0.0% +0.0% primes +0.0% 0.0% +0.0% 0.0% 0.0% primetest +0.0% 0.0% +0.0% +0.0% +0.0% prolog +0.0% 0.0% +0.0% +0.0% +0.0% puzzle +0.0% 0.0% +0.0% +0.0% +0.0% queens +0.0% 0.0% 0.0% +0.0% +0.0% reptile +0.0% 0.0% +0.0% +0.0% 0.0% reverse-complem +0.0% 0.0% -0.0% -0.0% -0.0% rewrite +0.0% 0.0% +0.0% 0.0% -0.0% rfib +0.0% 0.0% +0.0% +0.0% +0.0% rsa +0.0% 0.0% +0.0% +0.0% +0.0% scc +0.0% 0.0% +0.0% +0.0% +0.0% sched +0.0% 0.0% +0.0% +0.0% +0.0% scs +0.0% 0.0% +0.0% +0.0% 0.0% simple +0.0% 0.0% +0.0% +0.0% +0.0% solid +0.0% 0.0% +0.0% +0.0% 0.0% sorting +0.0% 0.0% +0.0% -0.0% 0.0% spectral-norm +0.0% 0.0% -0.0% -0.0% -0.0% sphere +0.0% 0.0% +0.0% -1.0% 0.0% symalg +0.0% 0.0% +0.0% +0.0% +0.0% tak +0.0% 0.0% +0.0% +0.0% +0.0% transform +0.0% 0.0% +0.4% -1.3% +0.0% treejoin +0.0% 0.0% +0.0% -0.0% 0.0% typecheck +0.0% 0.0% -0.0% +0.0% 0.0% veritas +0.0% 0.0% +0.0% -0.1% +0.0% wang +0.0% 0.0% +0.0% +0.0% +0.0% wave4main +0.0% 0.0% +0.0% 0.0% -0.0% wheel-sieve1 +0.0% 0.0% +0.0% +0.0% +0.0% wheel-sieve2 +0.0% 0.0% +0.0% +0.0% 0.0% x2n1 +0.0% 0.0% +0.0% +0.0% 0.0% -------------------------------------------------------------------------------- Min +0.0% 0.0% -0.0% -6.1% -0.0% Max +0.1% 0.0% +1.2% +0.0% +0.0% Geometric Mean +0.0% -0.0% +0.0% -0.1% -0.0% NoFib GC Results ================ -------------------------------------------------------------------------------- Program Size Allocs Instrs Reads Writes -------------------------------------------------------------------------------- circsim +0.0% 0.0% -0.0% -0.0% -0.0% constraints +0.0% 0.0% -0.0% 0.0% -0.0% fibheaps +0.0% 0.0% 0.0% -0.0% -0.0% fulsom +0.0% 0.0% 0.0% -0.6% -0.0% gc_bench +0.0% 0.0% 0.0% 0.0% -0.0% hash +0.0% 0.0% -0.0% -0.0% -0.0% lcss +0.0% 0.0% 0.0% -0.0% 0.0% mutstore1 +0.0% 0.0% 0.0% -0.0% -0.0% mutstore2 +0.0% 0.0% +0.0% -0.0% -0.0% power +0.0% 0.0% -0.0% 0.0% -0.0% spellcheck +0.0% 0.0% -0.0% -0.0% -0.0% -------------------------------------------------------------------------------- Min +0.0% 0.0% -0.0% -0.6% -0.0% Max +0.0% 0.0% +0.0% 0.0% 0.0% Geometric Mean +0.0% +0.0% +0.0% -0.1% +0.0% Fixes #14373 These performance regressions appear to be a fluke in CI. See the discussion in !1742 for details. Metric Increase: T6048 T12234 T12425 Naperian T12150 T5837 T13035 - - - - - ee07421f by Simon Peyton Jones at 2019-12-06T21:21:14-05:00 Work in progress on coercionLKind, coercionRKind This is a preliminary patch for #17515 - - - - - 0a4ca9eb by Simon Peyton Jones at 2019-12-06T21:21:14-05:00 Split up coercionKind This patch implements the idea in #17515, splitting `coercionKind` into: * `coercion{Left,Right}Kind`, which computes the left/right side of the pair * `coercionKind`, which computes the pair of coercible types This is reduces allocation since we frequently only need only one side of the pair. Specifically, we see the following improvements on x86-64 Debian 9: | test | new | old | relative chg. | | :------- | ---------: | ------------: | ------------: | | T5030 | 695537752 | 747641152.0 | -6.97% | | T5321Fun | 449315744 | 474009040.0 | -5.21% | | T9872a | 2611071400 | 2645040952.0 | -1.28% | | T9872c | 2957097904 | 2994260264.0 | -1.24% | | T12227 | 773435072 | 812367768.0 | -4.79% | | T12545 | 3142687224 | 3215714752.0 | -2.27% | | T14683 | 9392407664 | 9824775000.0 | -4.40% | Metric Decrease: T12545 T9872a T14683 T5030 T12227 T9872c T5321Fun T9872b - - - - - d46a72e1 by Gabor Greif at 2019-12-09T12:05:15-05:00 Fix comment typos The below is only necessary to fix the CI perf fluke that happened in 9897e8c8ef0b19a9571ef97a1d9bb050c1ee9121: ------------------------- Metric Decrease: T5837 T6048 T9020 T12425 T12234 T13035 T12150 Naperian ------------------------- - - - - - e3bba7e4 by Micha Wiedenmann at 2019-12-10T19:52:44-05:00 users guide: Motivation of DefaultSignatures - - - - - 843ceb38 by Ben Gamari at 2019-12-10T19:53:54-05:00 rts: Add a long form flag to enable the non-moving GC The old flag, `-xn`, was quite cryptic. Here we add `--nonmoving-gc` in addition. - - - - - 921d3238 by Ryan Scott at 2019-12-10T19:54:34-05:00 Ignore unary constraint tuples during typechecking (#17511) We deliberately avoid defining a magical `Unit%` class, for reasons that I have expounded upon in the newly added `Note [Ignore unary constraint tuples]` in `TcHsType`. However, a sneaky user could try to insert `Unit%` into their program by way of Template Haskell, leading to the interface-file error observed in #17511. To avoid this, any time we encounter a unary constraint tuple during typechecking, we drop the surrounding constraint tuple application. This is safe to do since `Unit% a` and `a` would be semantically equivalent (unlike other forms of unary tuples). Fixes #17511. - - - - - 436ec9f3 by Ben Gamari at 2019-12-10T19:55:37-05:00 gitlab-ci: Move changelog linting logic to shell script Allowing it to be easily used locally. - - - - - 2f6b434f by Ben Gamari at 2019-12-10T19:55:37-05:00 gitlab-ci: Move changelog linting logic to shell script Allowing it to be easily used locally. - - - - - 7a5a6e07 by Ben Gamari at 2019-12-10T19:56:25-05:00 base: Fix incorrect @since in GHC.Natural Fixes #17547. - - - - - 2bbfaf8a by Ben Gamari at 2019-12-10T19:57:01-05:00 hadrian: AArch64 supports the GHCi interpreter and SMP I'm not sure how this was omitted from the list of supported architectures. - - - - - 8f1ceb67 by John Ericson at 2019-12-10T19:57:39-05:00 Move Int# section of primops.txt.pp This matches the organization of the fixed-sized ones, and keeps each Int* next to its corresponding Word*. - - - - - 7a823b0f by John Ericson at 2019-12-10T19:57:39-05:00 Move Int64# and Word64# sections of primops.txt.pp This way it is next to the other fixed-sized ones. - - - - - 8dd9929a by Ben Gamari at 2019-12-10T19:58:19-05:00 testsuite: Add (broken) test for #17510 - - - - - 6e47a76a by Ben Gamari at 2019-12-10T19:58:59-05:00 Re-layout validate script This script was previously a whitespace nightmare. - - - - - f80c4a66 by Crazycolorz5 at 2019-12-11T14:12:17-05:00 rts: Specialize hashing at call site rather than in struct. Separate word and string hash tables on the type level, and do not store the hashing function. Thus when a different hash function is desire it is provided upon accessing the table. This is worst case the same as before the change, and in the majority of cases is better. Also mark the functions for aggressive inlining to improve performance. {F1686506} Reviewers: bgamari, erikd, simonmar Subscribers: rwbarton, thomie, carter GHC Trac Issues: #13165 Differential Revision: https://phabricator.haskell.org/D4889 - - - - - 2d1b9619 by Richard Eisenberg at 2019-12-11T14:12:55-05:00 Warn on inferred polymorphic recursion Silly users sometimes try to use visible dependent quantification and polymorphic recursion without a CUSK or SAK. This causes unexpected errors. So we now adjust expectations with a bit of helpful messaging. Closes #17541 and closes #17131. test cases: dependent/should_fail/T{17541{,b},17131} - - - - - 4dde485e by Oleg Grenrus at 2019-12-12T02:24:46-05:00 Add --show-unit-ids flag to ghc-pkg I only added it into --simple-output and ghc-pkg check output; there are probably other places where it can be adopted. - - - - - e6e1ec08 by Ben Gamari at 2019-12-12T02:25:33-05:00 testsuite: Simplify and clarify performance test baseline search The previous implementation was extremely complicated, seemingly to allow the local and CI namespaces to be searched incrementally. However, it's quite unclear why this is needed and moreover the implementation seems to have had quadratic runtime cost in the search depth(!). - - - - - 29c4609c by Ben Gamari at 2019-12-12T02:26:19-05:00 testsuite: Add test for #17549 - - - - - 9f0ee253 by Ben Gamari at 2019-12-12T02:26:56-05:00 gitlab-ci: Move -dwarf and -debug jobs to full-build stage This sacrifices some precision in favor of improving parallelism. - - - - - 7179b968 by Ben Gamari at 2019-12-12T02:27:34-05:00 Revert "rts: Drop redundant flags for libffi" This seems to have regressed builds using `--with-system-libffi` (#17520). This reverts commit 3ce18700f80a12c48a029b49c6201ad2410071bb. - - - - - cc7d5650 by Oleg Grenrus at 2019-12-16T10:20:56+02:00 Having no shake upper bound is irresposible Given that shake is far from "done" API wise, and is central component to the build system. - - - - - 9431f905 by Oleg Grenrus at 2019-12-16T10:55:50+02:00 Add index-state to hadrian/cabal.project Then one is freer to omit upper bounds, as we won't pick any new entries on Hackage while building hadrian itself. - - - - - 3e17a866 by Krzysztof Gogolewski at 2019-12-16T19:31:44-05:00 Remove dataConSig As suggested in #17291 - - - - - 75355fde by Krzysztof Gogolewski at 2019-12-16T19:31:44-05:00 Use "OrCoVar" functions less As described in #17291, we'd like to separate coercions and expressions in a more robust fashion. This is a small step in this direction. - `mkLocalId` now panicks on a covar. Calls where this was not the case were changed to `mkLocalIdOrCoVar`. - Don't use "OrCoVar" functions in places where we know the type is not a coercion. - - - - - f9686e13 by Richard Eisenberg at 2019-12-16T19:32:21-05:00 Do more validity checks for quantified constraints Close #17583. Test case: typecheck/should_fail/T17563 - - - - - af763765 by Ben Gamari at 2019-12-16T19:33:01-05:00 gitlab-ci: Fix Windows artifact collection Variable interpolation in gitlab-ci.yml apparently doesn't work. Sigh. - - - - - e6d4b902 by Ben Gamari at 2019-12-16T19:33:01-05:00 gitlab-ci: Use xz --threads on Debian 10 - - - - - 8ba650e9 by Ben Gamari at 2019-12-16T19:33:01-05:00 gitlab-ci: Allow debian 8 build to fail The python release shipped with deb8 (3.3) is too old for our testsuite driver. - - - - - ac25a3f6 by Ben Gamari at 2019-12-16T19:33:01-05:00 gitlab-ci: Use xz --threads on Alpine - - - - - cc628088 by Ben Gamari at 2019-12-16T19:33:01-05:00 gitlab-ci: Another approach for xz detection - - - - - 37d788ab by Ben Gamari at 2019-12-16T19:33:01-05:00 gitlab-ci: Re-add release-x86_64-deb9 job Also eliminate some redundancy. - - - - - f8279138 by Ben Gamari at 2019-12-16T19:33:01-05:00 gitlab-ci: Drop redundant release-x86_64-linux-deb9 job - - - - - 8148ff06 by Ben Gamari at 2019-12-17T07:24:40-05:00 testsuite: Mark cgrun057 as broken on ARMv7 Due to #17554. It's very surprising that this only occurs on ARMv7 but this is the only place I've seen this failure thusfar. - - - - - 85e5696d by Ben Gamari at 2019-12-17T07:24:40-05:00 testsuite: Mark prog001 as fragile on ARMv7 Due to #17555. - - - - - a5f0aab0 by Ben Gamari at 2019-12-17T07:24:40-05:00 testsuite: Mark T10272 as broken on ARMv7 Due to #17556. - - - - - 1e6827c6 by Ben Gamari at 2019-12-17T07:24:40-05:00 testsuite: Mark T13825-debugger as broken on ARMv7 Due to #17557. - - - - - 7cef0b7d by Ben Gamari at 2019-12-17T07:24:40-05:00 testsuite: Mark T14028 as broken on ARMv7 Due to #17558. - - - - - 6ea4eb4b by Ben Gamari at 2019-12-17T07:24:40-05:00 testsuite: Make ghc_built_by_llvm check more precise Previously it would hackily look at the flavour name to determine whether LLVM was used to build stage2 ghc. However, this didn't work at all with Hadrian and would miss cases like ARM where we use the LLVM backend by default. See #16087 for the motivation for why ghc_built_by_llvm is needed at all. This should catch one of the ARMv7 failures described in #17555. - - - - - c3e82bf7 by Ben Gamari at 2019-12-17T07:24:40-05:00 testsuite: Mark T5435_* tests as broken on ARM `T5435_v_asm_a`, `T5435_v_asm_b`, and `T5435_v_gcc` all fail on ARMv7. See #17559. - - - - - eb2aa851 by Ben Gamari at 2019-12-17T07:24:40-05:00 gitlab-ci: Don't allow armv7 jobs to fail - - - - - efc92216 by Ben Gamari at 2019-12-17T07:24:40-05:00 Revert "testsuite: Mark cgrun057 as broken on ARMv7" This reverts commit 6cfc47ec8a478e1751cb3e7338954da1853c3996. - - - - - 1d2bb9eb by Ben Gamari at 2019-12-17T07:24:40-05:00 testsuite: Mark print002 as fragile on ARM Due to #17557. Also accepting spurious performance change. Metric Decrease: T1969 - - - - - 41f4e4fb by Josh Meredith at 2019-12-17T07:25:17-05:00 Fix ambiguous occurence error when building Hadrian - - - - - 4374983a by Josh Meredith at 2019-12-17T07:25:17-05:00 Rename SphinxMode constructors - - - - - a8f7ecd5 by Josh Meredith at 2019-12-17T07:25:17-05:00 Use *Mode suffix instead of *M - - - - - 58655b9d by Sylvain Henry at 2019-12-18T13:43:37+01:00 Add GHC-API logging hooks * Add 'dumpAction' hook to DynFlags. It allows GHC API users to catch dumped intermediate codes and information. The format of the dump (Core, Stg, raw text, etc.) is now reported allowing easier automatic handling. * Add 'traceAction' hook to DynFlags. Some dumps go through the trace mechanism (for instance unfoldings that have been considered for inlining). This is problematic because: 1) dumps aren't written into files even with -ddump-to-file on 2) dumps are written on stdout even with GHC API 3) in this specific case, dumping depends on unsafe globally stored DynFlags which is bad for GHC API users We introduce 'traceAction' hook which allows GHC API to catch those traces and to avoid using globally stored DynFlags. * Avoid dumping empty logs via dumpAction/traceAction (but still write empty files to keep the existing behavior) - - - - - fad866e0 by Moritz Kiefer at 2019-12-19T11:15:39-05:00 Avoid race condition in hDuplicateTo In our codebase we have some code along the lines of ``` newStdout <- hDuplicate stdout stderr `hDuplicateTo` stdout ``` to avoid stray `putStrLn`s from corrupting a protocol (LSP) that is run over stdout. On CI we have seen a bunch of issues where `dup2` returned `EBUSY` so this fails with `ResourceExhausted` in Haskell. I’ve spent some time looking at the docs for `dup2` and the code in `base` and afaict the following race condition is being triggered here: 1. The user calls `hDuplicateTo stderr stdout`. 2. `hDuplicateTo` calls `hClose_help stdout_`, this closes the file handle for stdout. 3. The file handle for stdout is now free, so another thread allocating a file might get stdout. 4. If `dup2` is called while `stdout` (now pointing to something else) is half-open, it returns EBUSY. I think there might actually be an even worse case where `dup2` is run after FD 1 is fully open again. In that case, you will end up not just redirecting the original stdout to stderr but also the whatever resulted in that file handle being allocated. As far as I can tell, `dup2` takes care of closing the file handle itself so there is no reason to do this in `hDuplicateTo`. So this PR replaces the call to `hClose_help` by the only part of `hClose_help` that we actually care about, namely, `flushWriteBuffer`. I tested this on our codebase fairly extensively and haven’t been able to reproduce the issue with this patch. - - - - - 0c114c65 by Sylvain Henry at 2019-12-19T11:16:17-05:00 Handle large ARR_WORDS in heap census (fix #17572) We can do a heap census with a non-profiling RTS. With a non-profiling RTS we don't zero superfluous bytes of shrunk arrays hence a need to handle the case specifically to avoid a crash. Revert part of a586b33f8e8ad60b5c5ef3501c89e9b71794bbed - - - - - 1a0d1a65 by John Ericson at 2019-12-20T10:50:22-05:00 Deduplicate copied monad failure handler code - - - - - 70e56b27 by Ryan Scott at 2019-12-20T10:50:57-05:00 lookupBindGroupOcc: recommend names in the same namespace (#17593) Previously, `lookupBindGroupOcc`'s error message would recommend all similar names in scope, regardless of whether they were type constructors, data constructors, or functions, leading to the confusion witnessed in #17593. This is easily fixed by only recommending names in the same namespace, using the `nameSpacesRelated` function. Fixes #17593. - - - - - 3c12355e by Stefan Schulze Frielinghaus at 2019-12-24T01:03:44-05:00 Fix endian handling w.r.t. CPP macro WORDS_BIGENDIAN Include header file `ghcautoconf.h` where the CPP macro `WORDS_BIGENDIAN` is defined. This finally fixes #17337 (in conjunction with commit 6c59cc71dc). - - - - - 11f8eef5 by Stefan Schulze Frielinghaus at 2019-12-24T01:03:44-05:00 fixup! Fix endian handling w.r.t. CPP macro WORDS_BIGENDIAN - - - - - 40327b03 by Sylvain Henry at 2019-12-24T01:04:24-05:00 Remove outdated comment - - - - - aeea92ef by Sylvain Henry at 2019-12-25T19:23:54-05:00 Switch to ReadTheDocs theme for the user-guide - - - - - 26493eab by Gabor Greif at 2019-12-25T19:24:32-05:00 Fix copy-paste error in comment - - - - - 776df719 by Gabor Greif at 2019-12-25T19:24:32-05:00 Fix comment about minimal gcc version to be consistent what FP_GCC_VERSION requires - - - - - 3b17114d by Ömer Sinan Ağacan at 2019-12-26T14:09:11-05:00 Minor refactor in ghc.cabal.in: - Remove outdated comments - Move cutils.c from parser to cbits - Remove unused cutils.h - - - - - 334290b6 by Ryan Scott at 2019-12-26T14:09:48-05:00 Replace panic/notHandled with noExtCon in DsMeta There are many spots in `DsMeta` where `panic` or `notHandled` is used after pattern-matching on a TTG extension constructor. This is overkill, however, as using `noExtCon` would work just as well. This patch switches out these panics for `noExtCon`. - - - - - 68252aa3 by Ben Gamari at 2019-12-27T15:11:38-05:00 testsuite: Skip T17499 when built against integer-simple Since it routinely times out in CI. - - - - - 0c51aeeb by Gabor Greif at 2019-12-27T15:12:17-05:00 suppress popup dialog about missing Xcode at configure tested with `bash` and `zsh`. - - - - - 8d76bcc2 by Gabor Greif at 2019-12-27T15:12:17-05:00 while at it rename XCode to the official Xcode - - - - - 47a68205 by Ben Gamari at 2019-12-27T15:12:55-05:00 testsuite: Mark cgrun057 as fragile on ARM As reported in #17554. Only marking on ARM for now although there is evidence to suggest that the issue may occur on other platforms as well. - - - - - d03dec8f by Gabor Greif at 2019-12-27T15:13:32-05:00 use shell variable CcLlvmBackend for test Previously we used `AC_DEFINE`d variable `CC_LLVM_BACKEND` which has an empty shell expansion. - - - - - 2528e684 by Ben Gamari at 2019-12-30T06:51:32-05:00 driver: Include debug level in the recompilation check hash Fixes #17586. - - - - - f14bb50b by Ben Gamari at 2019-12-30T06:52:09-05:00 rts: Ensure that nonmoving gc isn't used with profiling - - - - - b426de37 by Ben Gamari at 2019-12-30T06:52:45-05:00 llvmGen: Ensure that entry labels don't have predecessors The LLVM IR forbids the entry label of a procedure from having any predecessors. In the case of a simple looping function the LLVM code generator broke this invariant, as noted in #17589. Fix this by moving the function prologue to its own basic block, as suggested by @kavon in #11649. Fixes #11649 and #17589. - - - - - 613f7265 by Ben Gamari at 2019-12-30T06:52:45-05:00 llvmGen: Drop old fix for #11649 This was a hack which is no longer necessary now since we introduce a dedicated entry block for each procedure. - - - - - fdeffa5e by Ben Gamari at 2019-12-30T06:53:23-05:00 rts: Error on invalid --numa flags Previously things like `+RTS --numa-debug` would enable NUMA support, despite being an invalid flag. - - - - - 9ce3ba68 by Ben Gamari at 2019-12-30T06:53:23-05:00 rts: Fix --debug-numa mode under Docker As noted in #17606, Docker disallows the get_mempolicy syscall by default. This caused numerous tests to fail under CI in the `debug_numa` way. Avoid this by disabling the NUMA probing logic when --debug-numa is in use, instead setting n_numa_nodes in RtsFlags.c. Fixes #17606. - - - - - 5baa2a43 by Ben Gamari at 2019-12-30T06:54:01-05:00 testsuite: Disable derefnull when built with LLVM LLVM does not guarantee any particular semantics when dereferencing null pointers. Consequently, this test actually passes when built with the LLVM backend. - - - - - bd544d3d by Ben Gamari at 2019-12-30T06:54:38-05:00 hadrian: Track hash of Cabal Setup builder arguments Lest we fail to rebuild when they change. Fixes #17611. - - - - - 6e2c495e by Ben Gamari at 2019-12-30T06:55:19-05:00 TcIface: Fix inverted logic in typechecking of source ticks Previously we would throw away source ticks when the debug level was non-zero. This is precisely the opposite of what was intended. Fixes #17616. Metric Decrease: T13056 T9020 T9961 T12425 - - - - - 7fad387d by Ben Gamari at 2019-12-30T06:55:55-05:00 perf_notes: Add --zero-y argument This makes it easier to see the true magnitude of fluctuations. Also do some house-keeping in the argument parsing department. - - - - - 0d42b287 by Ben Gamari at 2019-12-30T06:55:55-05:00 testsuite: Enlarge acceptance window for T1969 As noted in #17624, it's quite unstable, especially, for some reason, on i386 and armv7 (something about 32-bit platforms perhaps?). Metric Increase: T1969 - - - - - eb608235 by Sylvain Henry at 2019-12-31T14:22:32-05:00 Module hierarchy (#13009): Stg - - - - - d710fd66 by Vladislav Zavialov at 2019-12-31T14:23:10-05:00 Testsuite: update some Haddock tests Fixed tests: * haddockA039: added to all.T * haddockE004: replaced with T17561 (marked as expect_broken) New tests: * haddockA040: deriving clause for a data instance * haddockA041: haddock and CPP #include - - - - - 859ebdd4 by Kevin Buhr at 2019-12-31T23:44:39-05:00 Add "-Iw" RTS flag for minimum wait between idle GCs (#11134) - - - - - dd4b6551 by Kevin Buhr at 2019-12-31T23:44:39-05:00 Add additional Note explaining the -Iw flag - - - - - c4279ff1 by Kevin Buhr at 2019-12-31T23:44:39-05:00 Fix some sloppy indentation - - - - - b84c09d5 by Ömer Sinan Ağacan at 2019-12-31T23:45:19-05:00 Tweak Cmm dumps to avoid generating sections for empty groups When dumping Cmm groups check if the group is empty, to avoid generating empty sections in dump files like ==================== Output Cmm ==================== [] Also fixes a few bad indentation in the code around changes. - - - - - b2e0323f by Gabor Greif at 2020-01-03T21:22:36-05:00 Simplify mrStr - - - - - 3c9dc06b by Brian Wignall at 2020-01-04T15:55:06-05:00 Fix typos, via a Levenshtein-style corrector - - - - - d561c8f6 by Sylvain Henry at 2020-01-04T15:55:46-05:00 Add Cmm related hooks * stgToCmm hook * cmmToRawCmm hook These hooks are used by Asterius and could be useful to other clients of the GHC API. It increases the Parser dependencies (test CountParserDeps) to 184. It's still less than 200 which was the initial request (cf https://mail.haskell.org/pipermail/ghc-devs/2019-September/018122.html) so I think it's ok to merge this. - - - - - ae6b6276 by Oleg Grenrus at 2020-01-04T15:56:22-05:00 Update to Cabal submodule to v3.2.0.0-alpha3 Metric Increase: haddock.Cabal - - - - - 073f7cfd by Vladislav Zavialov at 2020-01-04T15:56:59-05:00 Add lexerDbg to dump the tokens fed to the parser This a small utility function that comes in handy when debugging the lexer and the parser. - - - - - 558d4d4a by Sylvain Henry at 2020-01-04T15:57:38-05:00 Split integerGmpInternals test in several parts This is to prepare for ghc-bignum which implements some but not all of gmp functions. - - - - - 4056b966 by Ben Gamari at 2020-01-04T15:58:15-05:00 testsuite: Mark cgrun057 as fragile on all platforms I have seen this fail both on x86-64/Debian 9 and armv7/Debian 9 See #17554. - - - - - 5ffea0c6 by Tamar Christina at 2020-01-06T18:38:37-05:00 Fix overflow. - - - - - 99a9f51b by Sylvain Henry at 2020-01-06T18:39:22-05:00 Module hierarchy: Iface (cf #13009) - - - - - 7aa4a061 by Ben Gamari at 2020-01-07T13:11:48-05:00 configure: Only check GCC version if CC is GCC Also refactor FP_GCC_EXTRA_FLAGS in a few ways: * We no longer support compilers which lack support for -fno-builtin and -fwrapv so remove the condition on GccVersion * These flags are only necessary when using the via-C backend so make them conditional on Unregisterised. Fixes #15742. - - - - - 0805ed7e by John Ericson at 2020-01-07T13:12:25-05:00 Use non-empty lists to remove partiality in matching code - - - - - 7844f3a8 by Ben Gamari at 2020-01-07T13:13:02-05:00 testsuite: Mark T17073 as broken on Windows Due to #17607. - - - - - acf40cae by Ben Gamari at 2020-01-07T13:13:02-05:00 gitlab-ci: Disallow Windows from failing - - - - - 34bc02c7 by Ben Gamari at 2020-01-07T13:13:02-05:00 configure: Find Python3 for testsuite In addition, we prefer the Mingw64 Python distribution on Windows due to #17483. - - - - - e35fe8d5 by Ben Gamari at 2020-01-07T13:13:02-05:00 testsuite: Fix Windows platform test Previously we used platform.system() and while this worked fine (e.g. returned `Windows`, as expected) locally under both msys and MingW64 Python distributions, it inexplicably returned `MINGW64_NT-10.0` under MingW64 Python on CI. It seems os.name is more reliable so we now use that instead.. - - - - - 48ef6217 by Ben Gamari at 2020-01-07T13:13:39-05:00 gitlab-ci: Rename push-test-metrics.sh to test-metrics.sh Refactoring to follow. - - - - - 2234fa92 by Ben Gamari at 2020-01-07T13:13:39-05:00 gitlab-ci: Pull test metrics before running testsuite Otherwise the testsuite driver may not have an up-to-date baseline. - - - - - 1ca9adbc by Sylvain Henry at 2020-01-07T13:14:18-05:00 Remove `parallel` check from configure.ac `parallel` is no longer a submodule since 3cb063c805ec841ca33b8371ef8aba9329221b6c - - - - - b69a3460 by Ryan Scott at 2020-01-07T13:14:57-05:00 Monomorphize HsModule to GhcPs (#17642) Analyzing the call sites for `HsModule` reveals that it is only ever used with parsed code (i.e., `GhcPs`). This simplifies `HsModule` by concretizing its `pass` parameter to always be `GhcPs`. Fixes #17642. - - - - - d491a679 by Sylvain Henry at 2020-01-08T06:16:31-05:00 Module hierarchy: Renamer (cf #13009) - - - - - d589410f by Ben Gamari at 2020-01-08T06:17:09-05:00 Bump haskeline submodule to 0.8.0.1 (cherry picked from commit feb3b955402d53c3875dd7a9a39f322827e5bd69) - - - - - 923a1272 by Ryan Scott at 2020-01-08T06:17:47-05:00 Print Core type applications with no whitespace after @ (#17643) This brings the pretty-printer for Core in line with how visible type applications are normally printed: namely, with no whitespace after the `@` character (i.e., `f @a` instead of `f @ a`). While I'm in town, I also give the same treatment to type abstractions (i.e., `\(@a)` instead of `\(@ a)`) and coercion applications (i.e., `f @~x` instead of `f @~ x`). Fixes #17643. - - - - - 49f83a0d by Adam Sandberg Eriksson at 2020-01-12T21:28:09-05:00 improve docs for HeaderInfo.getImports [skip ci] - - - - - 9129210f by Matthew Pickering at 2020-01-12T21:28:47-05:00 Overloaded Quotation Brackets (#246) This patch implements overloaded quotation brackets which generalise the desugaring of all quotation forms in terms of a new minimal interface. The main change is that a quotation, for example, [e| 5 |], will now have type `Quote m => m Exp` rather than `Q Exp`. The `Quote` typeclass contains a single method for generating new names which is used when desugaring binding structures. The return type of functions from the `Lift` type class, `lift` and `liftTyped` have been restricted to `forall m . Quote m => m Exp` rather than returning a result in a Q monad. More details about the feature can be read in the GHC proposal. https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0246-overloaded-bracket.rst - - - - - 350e2b78 by Richard Eisenberg at 2020-01-12T21:29:27-05:00 Don't zap to Any; error instead This changes GHC's treatment of so-called Naughty Quantification Candidates to issue errors, instead of zapping to Any. Close #16775. No new test cases, because existing ones cover this well. - - - - - 0b5ddc7f by Brian Wignall at 2020-01-12T21:30:08-05:00 Fix more typos, via an improved Levenshtein-style corrector - - - - - f732dbec by Ben Gamari at 2020-01-12T21:30:49-05:00 gitlab-ci: Retain bindists used by head.hackage for longer Previously we would keep them for two weeks. However, on the stable branches two weeks can easily elapse with no pushes. - - - - - c8636da5 by Sylvain Henry at 2020-01-12T21:31:30-05:00 Fix LANG=C for readelf invocation in T14999 The test fails when used with LANG=fr_FR.UTF-8 - - - - - 077a88de by Jean-Baptiste Mazon at 2020-01-12T21:32:08-05:00 users-guide/debug-info: typo “behivior” - - - - - 61916c5d by Simon Peyton Jones at 2020-01-12T21:32:44-05:00 Add comments about TH levels - - - - - 1fd766ca by Simon Peyton Jones at 2020-01-12T21:32:44-05:00 Comments about constraint floating - - - - - de01427e by Simon Peyton Jones at 2020-01-12T21:32:45-05:00 Minor refactor around quantified constraints This patch clarifies a dark corner of quantified constraints. * See Note [Yukky eq_sel for a HoleDest] in TcSMonad * Minor refactor, breaking out new function TcInteract.doTopReactEqPred - - - - - 30be3bf1 by Simon Peyton Jones at 2020-01-12T21:32:45-05:00 Comments in TcHsType - - - - - c5977d4d by Sebastian Graf at 2020-01-16T05:58:58-05:00 Better documentation for mkEtaWW [skip ci] So that hopefully I understand it faster next time. Also got rid of the confusing `orig_expr`, which makes the call site in `etaExpand` look out of sync with the passed `n` (which is not the original `n`). - - - - - 22c0bdc3 by John Ericson at 2020-01-16T05:59:37-05:00 Handle TagToEnum in the same big case as the other primops Before, it was a panic because it was handled above. But there must have been an error in my reasoning (another caller?) because #17442 reported the panic was hit. But, rather than figuring out what happened, I can just make it impossible by construction. By adding just a bit more bureaucracy in the return types, I can handle TagToEnum in the same case as all the others, so the big case is is now total, and the panic is removed. Fixes #17442 - - - - - ee5d63f4 by John Ericson at 2020-01-16T05:59:37-05:00 Get rid of OpDest `OpDest` was basically a defunctionalization. Just turn the code that cased on it into those functions, and call them directly. - - - - - 1ff55226 by John Ericson at 2020-01-16T06:00:16-05:00 Remove special case case of bool during STG -> C-- Allow removing the no longer needed cgPrimOp, getting rid of a small a small layer violation too. Change which made the special case no longer needed was #6135 / 6579a6c73082387f82b994305011f011d9d8382b, which dates back to 2013, making me feel better. - - - - - f416fe64 by Adam Wespiser at 2020-01-16T06:00:53-05:00 replace dead html link (fixes #17661) - - - - - f6bf2ce8 by Sebastian Graf at 2020-01-16T06:01:32-05:00 Revert "`exprOkForSpeculation` for Note [IO hack in the demand analyser]" This reverts commit ce64b397777408731c6dd3f5c55ea8415f9f565b on the grounds of the regression it would introduce in a couple of packages. Fixes #17653. Also undoes a slight metric increase in #13701 introduced by that commit that we didn't see prior to !1983. Metric Decrease: T13701 - - - - - a71323ff by Ben Gamari at 2020-01-17T08:43:16-05:00 gitlab-ci: Don't FORCE_SYMLINKS on Windows Not all runners have symlink permissions enabled. - - - - - 0499e3bc by Ömer Sinan Ağacan at 2020-01-20T15:31:33-05:00 Fix +RTS -Z flag documentation Stack squeezing is done on context switch, not on GC or stack overflow. Fix the documentation. Fixes #17685 [ci skip] - - - - - a661df91 by Ömer Sinan Ağacan at 2020-01-20T15:32:13-05:00 Document Stg.FVs module Fixes #17662 [ci skip] - - - - - db24e480 by Ben Gamari at 2020-01-20T15:32:52-05:00 llvmGen: Don't trash STG registers Fixes #13904. - - - - - f3d7fdb3 by Ben Gamari at 2020-01-20T15:32:52-05:00 llvmGen: Fix typo in readnone attribute - - - - - 442751c6 by Ben Gamari at 2020-01-20T15:32:52-05:00 llvmGen: Add lower-expect to the -O0 optimisation set @kavon says that this will improve block layout for stack checks. - - - - - e90ecc93 by Ben Gamari at 2020-01-20T15:32:52-05:00 llvmGen: Fix #14251 Fixes the calling convention for functions passing raw SSE-register values by adding padding as needed to get the values in the right registers. This problem cropped up when some args were unused an dropped from the live list. This folds together 2e23e1c7de01c92b038e55ce53d11bf9db993dd4 and 73273be476a8cc6c13368660b042b3b0614fd928 previously from @kavon. Metric Increase: T12707 ManyConstructors - - - - - 66e511a4 by Ben Gamari at 2020-01-20T15:33:28-05:00 testsuite: Preserve more information in framework failures Namely print the entire exception in hopes that this will help track down #17649. - - - - - b62b8cea by Ömer Sinan Ağacan at 2020-01-20T15:34:06-05:00 Remove deprecated -smp flag It was deprecated in 2012 with 46258b40 - - - - - 0c04a86a by Ben Gamari at 2020-01-20T15:34:43-05:00 gitlab-ci: Reenable submodule linter - - - - - 2bfabd22 by Ben Gamari at 2020-01-20T15:34:43-05:00 gitlab-ci: Allow submodule cleaning to fail on Windows Currently CI is inexplicably failing with ``` $ git submodule foreach git clean -xdf fatal: not a git repository: libffi-tarballs/../.git/modules/libffi-tarballs ``` I have no idea how this working tree got into such a state but we do need to fail more gracefully when it happens. Consequently, we allow the cleaning step to fail. - - - - - 14bced99 by Xavier Denis at 2020-01-20T15:35:21-05:00 Put the docs for :instances in alphabetical position - - - - - 7e0bb82b by Ben Gamari at 2020-01-20T15:35:57-05:00 Add missing Note [Improvement from Ground Wanteds] Closes #17659. - - - - - 17e43a7c by Ben Gamari at 2020-01-20T15:36:32-05:00 unregisterised: Fix declaration for stg_NO_FINALIZER Previously it had a redundant _entry suffix. We never noticed this previously presumably because we never generated references to it (however hard to believe this may be). However, it did start failing in !1304. - - - - - 3dae006f by PHO at 2020-01-20T15:37:08-05:00 Avoid ./configure failure on NetBSD - - - - - 738e2912 by Ben Gamari at 2020-01-24T13:42:56-05:00 testsuite: Widen acceptance window of T1969 I have seen >20% fluctuations in this number, leading to spurious failures. - - - - - ad4eb7a7 by Gabor Greif at 2020-01-25T05:19:07-05:00 Document the fact, that openFileBlocking can consume an OS thread indefinitely. Also state that a deadlock can happen with the non-threaded runtime. [ci skip] - - - - - be910728 by Sebastian Graf at 2020-01-25T05:19:46-05:00 `-ddump-str-signatures` dumps Text, not STG [skip ci] - - - - - 0e57d8a1 by Ömer Sinan Ağacan at 2020-01-25T05:20:27-05:00 Fix chaining tagged and untagged ptrs in compacting GC Currently compacting GC has the invariant that in a chain all fields are tagged the same. However this does not really hold: root pointers are not tagged, so when we thread a root we initialize a chain without a tag. When the pointed objects is evaluated and we have more pointers to it from the heap, we then add *tagged* fields to the chain (because pointers to it from the heap are tagged), ending up chaining fields with different tags (pointers from roots are NOT tagged, pointers from heap are). This breaks the invariant and as a result compacting GC turns tagged pointers into non-tagged. This later causes problem in the generated code where we do reads assuming that the pointer is aligned, e.g. 0x7(%rax) -- assumes that pointer is tagged 1 which causes misaligned reads. This caused #17088. We fix this using the "pointer tagging for large families" patch (#14373, !1742): - With the pointer tagging patch the GC can know what the tagged pointer to a CONSTR should be (previously we'd need to know the family size -- large families are always tagged 1, small families are tagged depending on the constructor). - Since we now know what the tags should be we no longer need to store the pointer tag in the info table pointers when forming chains in the compacting GC. As a result we no longer need to tag pointers in chains with 1/2 depending on whether the field points to an info table pointer, or to another field: an info table pointer is always tagged 0, everything else in the chain is tagged 1. The lost tags in pointers can be retrieved by looking at the info table. Finally, instead of using tag 1 for fields and tag 0 for info table pointers, we use two different tags for fields: - 1 for fields that have untagged pointers - 2 for fields that have tagged pointers When unchaining we then look at the pointer to a field, and depending on its tag we either leave a tagged pointer or an untagged pointer in the field. This allows chaining untagged and tagged fields together in compacting GC. Fixes #17088 Nofib results ------------- Binaries are smaller because of smaller `Compact.c` code. make mode=fast EXTRA_RUNTEST_OPTS="-cachegrind" EXTRA_HC_OPTS="-with-rtsopts=-c" NoFibRuns=1 -------------------------------------------------------------------------------- Program Size Allocs Instrs Reads Writes -------------------------------------------------------------------------------- CS -0.3% 0.0% +0.0% +0.0% +0.0% CSD -0.3% 0.0% +0.0% +0.0% +0.0% FS -0.3% 0.0% +0.0% -0.0% -0.0% S -0.3% 0.0% +5.4% +0.8% +3.9% VS -0.3% 0.0% +0.0% -0.0% -0.0% VSD -0.3% 0.0% -0.0% -0.0% -0.2% VSM -0.3% 0.0% +0.0% +0.0% +0.0% anna -0.1% 0.0% +0.0% +0.0% +0.0% ansi -0.3% 0.0% +0.1% +0.0% +0.0% atom -0.2% 0.0% +0.0% +0.0% +0.0% awards -0.2% 0.0% +0.0% 0.0% -0.0% banner -0.3% 0.0% +0.0% +0.0% +0.0% bernouilli -0.3% 0.0% +0.1% +0.0% +0.0% binary-trees -0.2% 0.0% +0.0% 0.0% +0.0% boyer -0.3% 0.0% +0.2% +0.0% +0.0% boyer2 -0.2% 0.0% +0.2% +0.1% +0.0% bspt -0.2% 0.0% +0.0% +0.0% +0.0% cacheprof -0.2% 0.0% +0.0% +0.0% +0.0% calendar -0.3% 0.0% +0.0% +0.0% +0.0% cichelli -0.3% 0.0% +1.1% +0.2% +0.5% circsim -0.2% 0.0% +0.0% -0.0% -0.0% clausify -0.3% 0.0% +0.0% -0.0% -0.0% comp_lab_zift -0.2% 0.0% +0.0% +0.0% +0.0% compress -0.3% 0.0% +0.0% +0.0% +0.0% compress2 -0.3% 0.0% +0.0% -0.0% -0.0% constraints -0.3% 0.0% +0.2% +0.1% +0.1% cryptarithm1 -0.3% 0.0% +0.0% -0.0% 0.0% cryptarithm2 -0.3% 0.0% +0.0% +0.0% +0.0% cse -0.3% 0.0% +0.0% +0.0% +0.0% digits-of-e1 -0.3% 0.0% +0.0% +0.0% +0.0% digits-of-e2 -0.3% 0.0% +0.0% +0.0% -0.0% dom-lt -0.2% 0.0% +0.0% +0.0% +0.0% eliza -0.2% 0.0% +0.0% +0.0% +0.0% event -0.3% 0.0% +0.1% +0.0% -0.0% exact-reals -0.2% 0.0% +0.0% +0.0% +0.0% exp3_8 -0.3% 0.0% +0.0% +0.0% +0.0% expert -0.2% 0.0% +0.0% +0.0% +0.0% fannkuch-redux -0.3% 0.0% -0.0% -0.0% -0.0% fasta -0.3% 0.0% +0.0% +0.0% +0.0% fem -0.2% 0.0% +0.1% +0.0% +0.0% fft -0.2% 0.0% +0.0% -0.0% -0.0% fft2 -0.2% 0.0% +0.0% -0.0% +0.0% fibheaps -0.3% 0.0% +0.0% -0.0% -0.0% fish -0.3% 0.0% +0.0% +0.0% +0.0% fluid -0.2% 0.0% +0.4% +0.1% +0.1% fulsom -0.2% 0.0% +0.0% +0.0% +0.0% gamteb -0.2% 0.0% +0.1% +0.0% +0.0% gcd -0.3% 0.0% +0.0% +0.0% +0.0% gen_regexps -0.3% 0.0% +0.0% -0.0% -0.0% genfft -0.3% 0.0% +0.0% +0.0% +0.0% gg -0.2% 0.0% +0.7% +0.3% +0.2% grep -0.2% 0.0% +0.0% +0.0% +0.0% hidden -0.2% 0.0% +0.0% +0.0% +0.0% hpg -0.2% 0.0% +0.1% +0.0% +0.0% ida -0.3% 0.0% +0.0% +0.0% +0.0% infer -0.2% 0.0% +0.0% -0.0% -0.0% integer -0.3% 0.0% +0.0% +0.0% +0.0% integrate -0.2% 0.0% +0.0% +0.0% +0.0% k-nucleotide -0.2% 0.0% +0.0% +0.0% -0.0% kahan -0.3% 0.0% -0.0% -0.0% -0.0% knights -0.3% 0.0% +0.0% -0.0% -0.0% lambda -0.3% 0.0% +0.0% -0.0% -0.0% last-piece -0.3% 0.0% +0.0% +0.0% +0.0% lcss -0.3% 0.0% +0.0% +0.0% 0.0% life -0.3% 0.0% +0.0% -0.0% -0.0% lift -0.2% 0.0% +0.0% +0.0% +0.0% linear -0.2% 0.0% +0.0% +0.0% +0.0% listcompr -0.3% 0.0% +0.0% +0.0% +0.0% listcopy -0.3% 0.0% +0.0% +0.0% +0.0% maillist -0.3% 0.0% +0.0% -0.0% -0.0% mandel -0.2% 0.0% +0.0% +0.0% +0.0% mandel2 -0.3% 0.0% +0.0% +0.0% +0.0% mate -0.2% 0.0% +0.0% +0.0% +0.0% minimax -0.3% 0.0% +0.0% +0.0% +0.0% mkhprog -0.2% 0.0% +0.0% +0.0% +0.0% multiplier -0.3% 0.0% +0.0% -0.0% -0.0% n-body -0.2% 0.0% -0.0% -0.0% -0.0% nucleic2 -0.2% 0.0% +0.0% +0.0% +0.0% para -0.2% 0.0% +0.0% -0.0% -0.0% paraffins -0.3% 0.0% +0.0% -0.0% -0.0% parser -0.2% 0.0% +0.0% +0.0% +0.0% parstof -0.2% 0.0% +0.8% +0.2% +0.2% pic -0.2% 0.0% +0.1% -0.1% -0.1% pidigits -0.3% 0.0% +0.0% +0.0% +0.0% power -0.2% 0.0% +0.0% -0.0% -0.0% pretty -0.3% 0.0% -0.0% -0.0% -0.1% primes -0.3% 0.0% +0.0% +0.0% -0.0% primetest -0.2% 0.0% +0.0% -0.0% -0.0% prolog -0.3% 0.0% +0.0% -0.0% -0.0% puzzle -0.3% 0.0% +0.0% +0.0% +0.0% queens -0.3% 0.0% +0.0% +0.0% +0.0% reptile -0.2% 0.0% +0.2% +0.1% +0.0% reverse-complem -0.3% 0.0% +0.0% +0.0% +0.0% rewrite -0.3% 0.0% +0.0% -0.0% -0.0% rfib -0.2% 0.0% +0.0% +0.0% -0.0% rsa -0.2% 0.0% +0.0% +0.0% +0.0% scc -0.3% 0.0% -0.0% -0.0% -0.1% sched -0.3% 0.0% +0.0% +0.0% +0.0% scs -0.2% 0.0% +0.1% +0.0% +0.0% simple -0.2% 0.0% +3.4% +1.0% +1.8% solid -0.2% 0.0% +0.0% +0.0% +0.0% sorting -0.3% 0.0% +0.0% +0.0% +0.0% spectral-norm -0.2% 0.0% -0.0% -0.0% -0.0% sphere -0.2% 0.0% +0.0% +0.0% +0.0% symalg -0.2% 0.0% +0.0% +0.0% +0.0% tak -0.3% 0.0% +0.0% +0.0% -0.0% transform -0.2% 0.0% +0.2% +0.1% +0.1% treejoin -0.3% 0.0% +0.2% -0.0% -0.1% typecheck -0.3% 0.0% +0.0% +0.0% +0.0% veritas -0.1% 0.0% +0.0% +0.0% +0.0% wang -0.2% 0.0% +0.0% -0.0% -0.0% wave4main -0.3% 0.0% +0.0% -0.0% -0.0% wheel-sieve1 -0.3% 0.0% +0.0% -0.0% -0.0% wheel-sieve2 -0.3% 0.0% +0.0% -0.0% -0.0% x2n1 -0.3% 0.0% +0.0% +0.0% +0.0% -------------------------------------------------------------------------------- Min -0.3% 0.0% -0.0% -0.1% -0.2% Max -0.1% 0.0% +5.4% +1.0% +3.9% Geometric Mean -0.3% -0.0% +0.1% +0.0% +0.1% -------------------------------------------------------------------------------- Program Size Allocs Instrs Reads Writes -------------------------------------------------------------------------------- circsim -0.2% 0.0% +1.6% +0.4% +0.7% constraints -0.3% 0.0% +4.3% +1.5% +2.3% fibheaps -0.3% 0.0% +3.5% +1.2% +1.3% fulsom -0.2% 0.0% +3.6% +1.2% +1.8% gc_bench -0.3% 0.0% +4.1% +1.3% +2.3% hash -0.3% 0.0% +6.6% +2.2% +3.6% lcss -0.3% 0.0% +0.7% +0.2% +0.7% mutstore1 -0.3% 0.0% +4.8% +1.4% +2.8% mutstore2 -0.3% 0.0% +3.4% +1.0% +1.7% power -0.2% 0.0% +2.7% +0.6% +1.9% spellcheck -0.3% 0.0% +1.1% +0.4% +0.4% -------------------------------------------------------------------------------- Min -0.3% 0.0% +0.7% +0.2% +0.4% Max -0.2% 0.0% +6.6% +2.2% +3.6% Geometric Mean -0.3% +0.0% +3.3% +1.0% +1.8% Metric changes -------------- While it sounds ridiculous, this change causes increased allocations in the following tests. We concluded that this change can't cause a difference in allocations and decided to land this patch. Fluctuations in "bytes allocated" metric is tracked in #17686. Metric Increase: Naperian T10547 T12150 T12234 T12425 T13035 T5837 T6048 - - - - - 8038cbd9 by Sebastian Graf at 2020-01-25T05:21:05-05:00 PmCheck: Formulate as translation between Clause Trees We used to check `GrdVec`s arising from multiple clauses and guards in isolation. That resulted in a split between `pmCheck` and `pmCheckGuards`, the implementations of which were similar, but subtly different in detail. Also the throttling mechanism described in `Note [Countering exponential blowup]` ultimately got quite complicated because it had to cater for both checking functions. This patch realises that pattern match checking doesn't just consider single guarded RHSs, but that it's always a whole set of clauses, each of which can have multiple guarded RHSs in turn. We do so by translating a list of `Match`es to a `GrdTree`: ```haskell data GrdTree = Rhs !RhsInfo | Guard !PmGrd !GrdTree -- captures lef-to-right match semantics | Sequence !GrdTree !GrdTree -- captures top-to-bottom match semantics | Empty -- For -XEmptyCase, neutral element of Sequence ``` Then we have a function `checkGrdTree` that matches a given `GrdTree` against an incoming set of values, represented by `Deltas`: ```haskell checkGrdTree :: GrdTree -> Deltas -> CheckResult ... ``` Throttling is isolated to the `Sequence` case and becomes as easy as one would expect: When the union of uncovered values becomes too big, just return the original incoming `Deltas` instead (which is always a superset of the union, thus a sound approximation). The returned `CheckResult` contains two things: 1. The set of values that were not covered by any of the clauses, for exhaustivity warnings. 2. The `AnnotatedTree` that enriches the syntactic structure of the input program with divergence and inaccessibility information. This is `AnnotatedTree`: ```haskell data AnnotatedTree = AccessibleRhs !RhsInfo | InaccessibleRhs !RhsInfo | MayDiverge !AnnotatedTree | SequenceAnn !AnnotatedTree !AnnotatedTree | EmptyAnn ``` Crucially, `MayDiverge` asserts that the tree may force diverging values, so not all of its wrapped clauses can be redundant. While the set of uncovered values can be used to generate the missing equations for warning messages, redundant and proper inaccessible equations can be extracted from `AnnotatedTree` by `redundantAndInaccessibleRhss`. For this to work properly, the interface to the Oracle had to change. There's only `addPmCts` now, which takes a bag of `PmCt`s. There's a whole bunch of `PmCt` variants to replace the different oracle functions from before. The new `AnnotatedTree` structure allows for more accurate warning reporting (as evidenced by a number of changes spread throughout GHC's code base), thus we fix #17465. Fixes #17646 on the go. Metric Decrease: T11822 T9233 PmSeriesS haddock.compiler - - - - - 86966d48 by Sebastian Graf at 2020-01-25T05:21:05-05:00 PmCheck: Properly handle constructor-bound type variables In https://gitlab.haskell.org/ghc/ghc/merge_requests/2192#note_246551 Simon convinced me that ignoring type variables existentially bound by data constructors have to be the same way as value binders. Sadly I couldn't think of a regression test, but I'm confident that this change strictly improves on the status quo. - - - - - c3fde723 by Ryan Scott at 2020-01-25T05:21:40-05:00 Handle local fixity declarations in DsMeta properly `DsMeta.rep_sig` used to skip over `FixSig` entirely, which had the effect of causing local fixity declarations to be dropped when quoted in Template Haskell. But there is no good reason for this state of affairs, as the code in `DsMeta.repFixD` (which handles top-level fixity declarations) handles local fixity declarations just fine. This patch factors out the necessary parts of `repFixD` so that they can be used in `rep_sig` as well. There was one minor complication: the fixity signatures for class methods in each `HsGroup` were stored both in `FixSig`s _and_ the list of `LFixitySig`s for top-level fixity signatures, so I needed to take action to prevent fixity signatures for class methods being converted to `Dec`s twice. I tweaked `RnSource.add` to avoid putting these fixity signatures in two places and added `Note [Top-level fixity signatures in an HsGroup]` in `GHC.Hs.Decls` to explain the new design. Fixes #17608. Bumps the Haddock submodule. - - - - - 6e2d9ee2 by Sylvain Henry at 2020-01-25T05:22:20-05:00 Module hierarchy: Cmm (cf #13009) - - - - - 8b726534 by PHO at 2020-01-25T05:23:01-05:00 Fix rts allocateExec() on NetBSD Similar to SELinux, NetBSD "PaX mprotect" prohibits marking a page mapping both writable and executable at the same time. Use libffi which knows how to work around it. - - - - - 6eb566a0 by Xavier Denis at 2020-01-25T05:23:39-05:00 Add ghc-in-ghci for stack based builds - - - - - b1a32170 by Xavier Denis at 2020-01-25T05:23:39-05:00 Create ghci.cabal.sh - - - - - 0a5e4f5f by Sylvain Henry at 2020-01-25T05:24:19-05:00 Split glasgow_exts into several files (#17316) - - - - - b3e5c678 by Ben Gamari at 2020-01-25T05:24:57-05:00 hadrian: Throw error on duplicate-named flavours Throw an error if the user requests a flavour for which there is more than one match. Fixes #17156. - - - - - 0940b59a by Ryan Scott at 2020-01-25T08:15:05-05:00 Do not bring visible foralls into scope in hsScopedTvs Previously, `hsScopedTvs` (and its cousin `hsWcScopedTvs`) pretended that visible dependent quantification could not possibly happen at the term level, and cemented that assumption with an `ASSERT`: ```hs hsScopedTvs (HsForAllTy { hst_fvf = vis_flag, ... }) = ASSERT( vis_flag == ForallInvis ) ... ``` It turns out that this assumption is wrong. You can end up tripping this `ASSERT` if you stick it to the man and write a type for a term that uses visible dependent quantification anyway, like in this example: ```hs {-# LANGUAGE ScopedTypeVariables #-} x :: forall a -> a -> a x = x ``` That won't typecheck, but that's not the point. Before the typechecker has a chance to reject this, the renamer will try to use `hsScopedTvs` to bring `a` into scope over the body of `x`, since `a` is quantified by a `forall`. This, in turn, causes the `ASSERT` to fail. Bummer. Instead of walking on this dangerous ground, this patch makes GHC adopt a more hardline stance by pattern-matching directly on `ForallInvis` in `hsScopedTvs`: ```hs hsScopedTvs (HsForAllTy { hst_fvf = ForallInvis, ... }) = ... ``` Now `a` will not be brought over the body of `x` at all (which is how it should be), there's no chance of the `ASSERT` failing anymore (as it's gone), and best of all, the behavior of `hsScopedTvs` does not change. Everyone wins! Fixes #17687. - - - - - 1132602f by Ryan Scott at 2020-01-27T10:03:42-05:00 Use splitLHs{ForAll,Sigma}TyInvis throughout the codebase Richard points out in #17688 that we use `splitLHsForAllTy` and `splitLHsSigmaTy` in places that we ought to be using the corresponding `-Invis` variants instead, identifying two bugs that are caused by this oversight: * Certain TH-quoted type signatures, such as those that appear in quoted `SPECIALISE` pragmas, silently turn visible `forall`s into invisible `forall`s. * When quoted, the type `forall a -> (a ~ a) => a` will turn into `forall a -> a` due to a bug in `DsMeta.repForall` that drops contexts that follow visible `forall`s. These are both ultimately caused by the fact that `splitLHsForAllTy` and `splitLHsSigmaTy` split apart visible `forall`s in addition to invisible ones. This patch cleans things up: * We now use `splitLHsForAllTyInvis` and `splitLHsSigmaTyInvis` throughout the codebase. Relatedly, the `splitLHsForAllTy` and `splitLHsSigmaTy` have been removed, as they are easy to misuse. * `DsMeta.repForall` now only handles invisible `forall`s to reduce the chance for confusion with visible `forall`s, which need to be handled differently. I also renamed it from `repForall` to `repForallT` to emphasize that its distinguishing characteristic is the fact that it desugars down to `L.H.TH.Syntax.ForallT`. Fixes #17688. - - - - - 97d0b0a3 by Matthew Pickering at 2020-01-27T10:04:19-05:00 Make Block.h compile with c++ compilers - - - - - 4bada77d by Tom Ellis at 2020-01-27T12:30:46-05:00 Disable two warnings for files that trigger them incomplete-uni-patterns and incomplete-record-updates will be in -Wall at a future date, so prepare for that by disabling those warnings on files that trigger them. - - - - - 0188404a by Tom Ellis at 2020-01-27T12:30:46-05:00 Add two warnings to stage 2 build - - - - - acae02c1 by Tom Ellis at 2020-01-27T12:30:46-05:00 Add two warnings to Hadrian - - - - - bf38a20e by Sylvain Henry at 2020-01-31T02:46:15-05:00 Call `interpretPackageEnv` from `setSessionDynFlags` interpretPackageEnv modifies the flags by reading the dreaded package environments. It is much less surprising to call it from `setSessionDynFlags` instead of reading package environments as a side-effect of `initPackages`. - - - - - 29c701c1 by Sylvain Henry at 2020-01-31T02:46:15-05:00 Refactor package related code The package terminology is a bit of a mess. Cabal packages contain components. Instances of these components when built with some flags/options/dependencies are called units. Units are registered into package databases and their metadata are called PackageConfig. GHC only knows about package databases containing units. It is a sad mismatch not fixed by this patch (we would have to rename parameters such as `package-id <unit-id>` which would affect users). This patch however fixes the following internal names: - Renames PackageConfig into UnitInfo. - Rename systemPackageConfig into globalPackageDatabase[Path] - Rename PkgConfXX into PkgDbXX - Rename pkgIdMap into unitIdMap - Rename ModuleToPkgDbAll into ModuleNameProvidersMap - Rename lookupPackage into lookupUnit - Add comments on DynFlags package related fields It also introduces a new `PackageDatabase` datatype instead of explicitly passing the following tuple: `(FilePath,[PackageConfig])`. The `pkgDatabase` field in `DynFlags` now contains the unit info for each unit of each package database exactly as they have been read from disk. Previously the command-line flag `-distrust-all-packages` would modify these unit info. Now this flag only affects the "dynamic" consolidated package state found in `pkgState` field. It makes sense because `initPackages` could be called first with this `distrust-all-packages` flag set and then again (using ghc-api) without and it should work (package databases are not read again from disk when `initPackages` is called the second time). Bump haddock submodule - - - - - 942c7148 by Ben Gamari at 2020-01-31T02:46:54-05:00 rename: Eliminate usage of mkVarOccUnique Replacing it with `newSysName`. Fixes #17061. - - - - - 41117d71 by Ben Gamari at 2020-01-31T02:47:31-05:00 base: Use one-shot kqueue on macOS The underlying reason requiring that one-shot usage be disabled (#13903) has been fixed. Closes #15768. - - - - - 01b15b83 by Ben Gamari at 2020-01-31T02:48:08-05:00 testsuite: Don't crash on encoding failure in print If the user doesn't use a Unicode locale then the testsuite driver would previously throw framework failures due to encoding failures. We now rather use the `replace` error-handling strategy. - - - - - c846618a by Ömer Sinan Ağacan at 2020-01-31T12:21:10+03:00 Do CafInfo/SRT analysis in Cmm This patch removes all CafInfo predictions and various hacks to preserve predicted CafInfos from the compiler and assigns final CafInfos to interface Ids after code generation. SRT analysis is extended to support static data, and Cmm generator is modified to allow generating static_link fields after SRT analysis. This also fixes `-fcatch-bottoms`, which introduces error calls in case expressions in CorePrep, which runs *after* CoreTidy (which is where we decide on CafInfos) and turns previously non-CAFFY things into CAFFY. Fixes #17648 Fixes #9718 Evaluation ========== NoFib ----- Boot with: `make boot mode=fast` Run: `make mode=fast EXTRA_RUNTEST_OPTS="-cachegrind" NoFibRuns=1` -------------------------------------------------------------------------------- Program Size Allocs Instrs Reads Writes -------------------------------------------------------------------------------- CS -0.0% 0.0% -0.0% -0.0% -0.0% CSD -0.0% 0.0% -0.0% -0.0% -0.0% FS -0.0% 0.0% -0.0% -0.0% -0.0% S -0.0% 0.0% -0.0% -0.0% -0.0% VS -0.0% 0.0% -0.0% -0.0% -0.0% VSD -0.0% 0.0% -0.0% -0.0% -0.5% VSM -0.0% 0.0% -0.0% -0.0% -0.0% anna -0.1% 0.0% -0.0% -0.0% -0.0% ansi -0.0% 0.0% -0.0% -0.0% -0.0% atom -0.0% 0.0% -0.0% -0.0% -0.0% awards -0.0% 0.0% -0.0% -0.0% -0.0% banner -0.0% 0.0% -0.0% -0.0% -0.0% bernouilli -0.0% 0.0% -0.0% -0.0% -0.0% binary-trees -0.0% 0.0% -0.0% -0.0% -0.0% boyer -0.0% 0.0% -0.0% -0.0% -0.0% boyer2 -0.0% 0.0% -0.0% -0.0% -0.0% bspt -0.0% 0.0% -0.0% -0.0% -0.0% cacheprof -0.0% 0.0% -0.0% -0.0% -0.0% calendar -0.0% 0.0% -0.0% -0.0% -0.0% cichelli -0.0% 0.0% -0.0% -0.0% -0.0% circsim -0.0% 0.0% -0.0% -0.0% -0.0% clausify -0.0% 0.0% -0.0% -0.0% -0.0% comp_lab_zift -0.0% 0.0% -0.0% -0.0% -0.0% compress -0.0% 0.0% -0.0% -0.0% -0.0% compress2 -0.0% 0.0% -0.0% -0.0% -0.0% constraints -0.0% 0.0% -0.0% -0.0% -0.0% cryptarithm1 -0.0% 0.0% -0.0% -0.0% -0.0% cryptarithm2 -0.0% 0.0% -0.0% -0.0% -0.0% cse -0.0% 0.0% -0.0% -0.0% -0.0% digits-of-e1 -0.0% 0.0% -0.0% -0.0% -0.0% digits-of-e2 -0.0% 0.0% -0.0% -0.0% -0.0% dom-lt -0.0% 0.0% -0.0% -0.0% -0.0% eliza -0.0% 0.0% -0.0% -0.0% -0.0% event -0.0% 0.0% -0.0% -0.0% -0.0% exact-reals -0.0% 0.0% -0.0% -0.0% -0.0% exp3_8 -0.0% 0.0% -0.0% -0.0% -0.0% expert -0.0% 0.0% -0.0% -0.0% -0.0% fannkuch-redux -0.0% 0.0% -0.0% -0.0% -0.0% fasta -0.0% 0.0% -0.0% -0.0% -0.0% fem -0.0% 0.0% -0.0% -0.0% -0.0% fft -0.0% 0.0% -0.0% -0.0% -0.0% fft2 -0.0% 0.0% -0.0% -0.0% -0.0% fibheaps -0.0% 0.0% -0.0% -0.0% -0.0% fish -0.0% 0.0% -0.0% -0.0% -0.0% fluid -0.1% 0.0% -0.0% -0.0% -0.0% fulsom -0.0% 0.0% -0.0% -0.0% -0.0% gamteb -0.0% 0.0% -0.0% -0.0% -0.0% gcd -0.0% 0.0% -0.0% -0.0% -0.0% gen_regexps -0.0% 0.0% -0.0% -0.0% -0.0% genfft -0.0% 0.0% -0.0% -0.0% -0.0% gg -0.0% 0.0% -0.0% -0.0% -0.0% grep -0.0% 0.0% -0.0% -0.0% -0.0% hidden -0.0% 0.0% -0.0% -0.0% -0.0% hpg -0.1% 0.0% -0.0% -0.0% -0.0% ida -0.0% 0.0% -0.0% -0.0% -0.0% infer -0.0% 0.0% -0.0% -0.0% -0.0% integer -0.0% 0.0% -0.0% -0.0% -0.0% integrate -0.0% 0.0% -0.0% -0.0% -0.0% k-nucleotide -0.0% 0.0% -0.0% -0.0% -0.0% kahan -0.0% 0.0% -0.0% -0.0% -0.0% knights -0.0% 0.0% -0.0% -0.0% -0.0% lambda -0.0% 0.0% -0.0% -0.0% -0.0% last-piece -0.0% 0.0% -0.0% -0.0% -0.0% lcss -0.0% 0.0% -0.0% -0.0% -0.0% life -0.0% 0.0% -0.0% -0.0% -0.0% lift -0.0% 0.0% -0.0% -0.0% -0.0% linear -0.1% 0.0% -0.0% -0.0% -0.0% listcompr -0.0% 0.0% -0.0% -0.0% -0.0% listcopy -0.0% 0.0% -0.0% -0.0% -0.0% maillist -0.0% 0.0% -0.0% -0.0% -0.0% mandel -0.0% 0.0% -0.0% -0.0% -0.0% mandel2 -0.0% 0.0% -0.0% -0.0% -0.0% mate -0.0% 0.0% -0.0% -0.0% -0.0% minimax -0.0% 0.0% -0.0% -0.0% -0.0% mkhprog -0.0% 0.0% -0.0% -0.0% -0.0% multiplier -0.0% 0.0% -0.0% -0.0% -0.0% n-body -0.0% 0.0% -0.0% -0.0% -0.0% nucleic2 -0.0% 0.0% -0.0% -0.0% -0.0% para -0.0% 0.0% -0.0% -0.0% -0.0% paraffins -0.0% 0.0% -0.0% -0.0% -0.0% parser -0.1% 0.0% -0.0% -0.0% -0.0% parstof -0.1% 0.0% -0.0% -0.0% -0.0% pic -0.0% 0.0% -0.0% -0.0% -0.0% pidigits -0.0% 0.0% -0.0% -0.0% -0.0% power -0.0% 0.0% -0.0% -0.0% -0.0% pretty -0.0% 0.0% -0.3% -0.4% -0.4% primes -0.0% 0.0% -0.0% -0.0% -0.0% primetest -0.0% 0.0% -0.0% -0.0% -0.0% prolog -0.0% 0.0% -0.0% -0.0% -0.0% puzzle -0.0% 0.0% -0.0% -0.0% -0.0% queens -0.0% 0.0% -0.0% -0.0% -0.0% reptile -0.0% 0.0% -0.0% -0.0% -0.0% reverse-complem -0.0% 0.0% -0.0% -0.0% -0.0% rewrite -0.0% 0.0% -0.0% -0.0% -0.0% rfib -0.0% 0.0% -0.0% -0.0% -0.0% rsa -0.0% 0.0% -0.0% -0.0% -0.0% scc -0.0% 0.0% -0.3% -0.5% -0.4% sched -0.0% 0.0% -0.0% -0.0% -0.0% scs -0.0% 0.0% -0.0% -0.0% -0.0% simple -0.1% 0.0% -0.0% -0.0% -0.0% solid -0.0% 0.0% -0.0% -0.0% -0.0% sorting -0.0% 0.0% -0.0% -0.0% -0.0% spectral-norm -0.0% 0.0% -0.0% -0.0% -0.0% sphere -0.0% 0.0% -0.0% -0.0% -0.0% symalg -0.0% 0.0% -0.0% -0.0% -0.0% tak -0.0% 0.0% -0.0% -0.0% -0.0% transform -0.0% 0.0% -0.0% -0.0% -0.0% treejoin -0.0% 0.0% -0.0% -0.0% -0.0% typecheck -0.0% 0.0% -0.0% -0.0% -0.0% veritas -0.0% 0.0% -0.0% -0.0% -0.0% wang -0.0% 0.0% -0.0% -0.0% -0.0% wave4main -0.0% 0.0% -0.0% -0.0% -0.0% wheel-sieve1 -0.0% 0.0% -0.0% -0.0% -0.0% wheel-sieve2 -0.0% 0.0% -0.0% -0.0% -0.0% x2n1 -0.0% 0.0% -0.0% -0.0% -0.0% -------------------------------------------------------------------------------- Min -0.1% 0.0% -0.3% -0.5% -0.5% Max -0.0% 0.0% -0.0% -0.0% -0.0% Geometric Mean -0.0% -0.0% -0.0% -0.0% -0.0% -------------------------------------------------------------------------------- Program Size Allocs Instrs Reads Writes -------------------------------------------------------------------------------- circsim -0.1% 0.0% -0.0% -0.0% -0.0% constraints -0.0% 0.0% -0.0% -0.0% -0.0% fibheaps -0.0% 0.0% -0.0% -0.0% -0.0% gc_bench -0.0% 0.0% -0.0% -0.0% -0.0% hash -0.0% 0.0% -0.0% -0.0% -0.0% lcss -0.0% 0.0% -0.0% -0.0% -0.0% power -0.0% 0.0% -0.0% -0.0% -0.0% spellcheck -0.0% 0.0% -0.0% -0.0% -0.0% -------------------------------------------------------------------------------- Min -0.1% 0.0% -0.0% -0.0% -0.0% Max -0.0% 0.0% -0.0% -0.0% -0.0% Geometric Mean -0.0% +0.0% -0.0% -0.0% -0.0% Manual inspection of programs in testsuite/tests/programs --------------------------------------------------------- I built these programs with a bunch of dump flags and `-O` and compared STG, Cmm, and Asm dumps and file sizes. (Below the numbers in parenthesis show number of modules in the program) These programs have identical compiler (same .hi and .o sizes, STG, and Cmm and Asm dumps): - Queens (1), andre_monad (1), cholewo-eval (2), cvh_unboxing (3), andy_cherry (7), fun_insts (1), hs-boot (4), fast2haskell (2), jl_defaults (1), jq_readsPrec (1), jules_xref (1), jtod_circint (4), jules_xref2 (1), lennart_range (1), lex (1), life_space_leak (1), bargon-mangler-bug (7), record_upd (1), rittri (1), sanders_array (1), strict_anns (1), thurston-module-arith (2), okeefe_neural (1), joao-circular (6), 10queens (1) Programs with different compiler outputs: - jl_defaults (1): For some reason GHC HEAD marks a lot of top-level `[Int]` closures as CAFFY for no reason. With this patch we no longer make them CAFFY and generate less SRT entries. For some reason Main.o is slightly larger with this patch (1.3%) and the executable sizes are the same. (I'd expect both to be smaller) - launchbury (1): Same as jl_defaults: top-level `[Int]` closures marked as CAFFY for no reason. Similarly `Main.o` is 1.4% larger but the executable sizes are the same. - galois_raytrace (13): Differences are in the Parse module. There are a lot, but some of the changes are caused by the fact that for some reason (I think a bug) GHC HEAD marks the dictionary for `Functor Identity` as CAFFY. Parse.o is 0.4% larger, the executable size is the same. - north_array: We now generate less SRT entries because some of array primops used in this program like `NewArrayOp` get eliminated during Stg-to-Cmm and turn some CAFFY things into non-CAFFY. Main.o gets 24% larger (9224 bytes from 9000 bytes), executable sizes are the same. - seward-space-leak: Difference in this program is better shown by this smaller example: module Lib where data CDS = Case [CDS] [(Int, CDS)] | Call CDS CDS instance Eq CDS where Case sels1 rets1 == Case sels2 rets2 = sels1 == sels2 && rets1 == rets2 Call a1 b1 == Call a2 b2 = a1 == a2 && b1 == b2 _ == _ = False In this program GHC HEAD builds a new SRT for the recursive group of `(==)`, `(/=)` and the dictionary closure. Then `/=` points to `==` in its SRT field, and `==` uses the SRT object as its SRT. With this patch we use the closure for `/=` as the SRT and add `==` there. Then `/=` gets an empty SRT field and `==` points to `/=` in its SRT field. This change looks fine to me. Main.o gets 0.07% larger, executable sizes are identical. head.hackage ------------ head.hackage's CI script builds 428 packages from Hackage using this patch with no failures. Compiler performance -------------------- The compiler perf tests report that the compiler allocates slightly more (worst case observed so far is 4%). However most programs in the test suite are small, single file programs. To benchmark compiler performance on something more realistic I build Cabal (the library, 236 modules) with different optimisation levels. For the "max residency" row I run GHC with `+RTS -s -A100k -i0 -h` for more accurate numbers. Other rows are generated with just `-s`. (This is because `-i0` causes running GC much more frequently and as a result "bytes copied" gets inflated by more than 25x in some cases) * -O0 | | GHC HEAD | This MR | Diff | | --------------- | -------------- | -------------- | ------ | | Bytes allocated | 54,413,350,872 | 54,701,099,464 | +0.52% | | Bytes copied | 4,926,037,184 | 4,990,638,760 | +1.31% | | Max residency | 421,225,624 | 424,324,264 | +0.73% | * -O1 | | GHC HEAD | This MR | Diff | | --------------- | --------------- | --------------- | ------ | | Bytes allocated | 245,849,209,992 | 246,562,088,672 | +0.28% | | Bytes copied | 26,943,452,560 | 27,089,972,296 | +0.54% | | Max residency | 982,643,440 | 991,663,432 | +0.91% | * -O2 | | GHC HEAD | This MR | Diff | | --------------- | --------------- | --------------- | ------ | | Bytes allocated | 291,044,511,408 | 291,863,910,912 | +0.28% | | Bytes copied | 37,044,237,616 | 36,121,690,472 | -2.49% | | Max residency | 1,071,600,328 | 1,086,396,256 | +1.38% | Extra compiler allocations -------------------------- Runtime allocations of programs are as reported above (NoFib section). The compiler now allocates more than before. Main source of allocation in this patch compared to base commit is the new SRT algorithm (GHC.Cmm.Info.Build). Below is some of the extra work we do with this patch, numbers generated by profiled stage 2 compiler when building a pathological case (the test 'ManyConstructors') with '-O2': - We now sort the final STG for a module, which means traversing the entire program, generating free variable set for each top-level binding, doing SCC analysis, and re-ordering the program. In ManyConstructors this step allocates 97,889,952 bytes. - We now do SRT analysis on static data, which in a program like ManyConstructors causes analysing 10,000 bindings that we would previously just skip. This step allocates 70,898,352 bytes. - We now maintain an SRT map for the entire module as we compile Cmm groups: data ModuleSRTInfo = ModuleSRTInfo { ... , moduleSRTMap :: SRTMap } (SRTMap is just a strict Map from the 'containers' library) This map gets an entry for most bindings in a module (exceptions are THUNKs and CAFFY static functions). For ManyConstructors this map gets 50015 entries. - Once we're done with code generation we generate a NameSet from SRTMap for the non-CAFFY names in the current module. This set gets the same number of entries as the SRTMap. - Finally we update CafInfos in ModDetails for the non-CAFFY Ids, using the NameSet generated in the previous step. This usually does the least amount of allocation among the work listed here. Only place with this patch where we do less work in the CAF analysis in the tidying pass (CoreTidy). However that doesn't save us much, as the pass still needs to traverse the whole program and update IdInfos for other reasons. Only thing we don't here do is the `hasCafRefs` pass over the RHS of bindings, which is a stateless pass that returns a boolean value, so it doesn't allocate much. (Metric changes blow are all increased allocations) Metric changes -------------- Metric Increase: ManyAlternatives ManyConstructors T13035 T14683 T1969 T9961 - - - - - 2a87a565 by Andreas Klebinger at 2020-01-31T12:21:10+03:00 A few optimizations in STG and Cmm parts: (Guided by the profiler output) - Add a few bang patterns, INLINABLE annotations, and a seqList in a few places in Cmm and STG parts. - Do not add external variables as dependencies in STG dependency analysis (GHC.Stg.DepAnal). - - - - - bef704b6 by Simon Peyton Jones at 2020-02-01T02:28:45-05:00 Improve skolemisation This patch avoids skolemiseUnboundMetaTyVar making up a fresh Name when it doesn't need to. See Note [Skolemising and identity] Improves error messsages for partial type signatures. - - - - - cd110423 by Simon Peyton Jones at 2020-02-01T02:28:45-05:00 Improve pretty-printing for TyConBinders In particular, show their kinds. - - - - - 913287a0 by Simon Peyton Jones at 2020-02-01T02:28:45-05:00 Fix scoping of TyCon binders in TcTyClsDecls This patch fixes #17566 by refactoring the way we decide the final identity of the tyvars in the TyCons of a possibly-recursive nest of type and class decls, possibly with associated types. It's all laid out in Note [Swizzling the tyvars before generaliseTcTyCon] Main changes: * We have to generalise each decl (with its associated types) all at once: TcTyClsDecls.generaliseTyClDecl * The main new work is done in TcTyClsDecls.swizzleTcTyConBndrs * The mysterious TcHsSyn.zonkRecTyVarBndrs dies altogether Other smaller things: * A little refactoring, moving bindTyClTyVars from tcTyClDecl1 to tcDataDefn, tcSynRhs, etc. Clearer, reduces the number of parameters * Reduce the amount of swizzling required. Specifically, bindExplicitTKBndrs_Q_Tv doesn't need to clone a new Name for the TyVarTv, and not cloning means that in the vasly common case, swizzleTyConBndrs is a no-op In detail: Rename newTyVarTyVar --> cloneTyVarTyVar Add newTyVarTyTyVar that doesn't clone Use the non-cloning newTyVarTyVar in bindExplicitTKBndrs_Q_Tv Rename newFlexiKindedTyVarTyVar --> cloneFlexiKindedTyVarTyVar * Define new utility function and use it HsDecls.familyDeclName :: FamilyDecl (GhcPass p) -> IdP (GhcPass p) Updates haddock submodule. - - - - - 58ed6c4a by Ben Gamari at 2020-02-01T02:29:23-05:00 rts/M32Alloc: Don't attempt to unmap non-existent pages The m32 allocator's `pages` list may contain NULLs in the case that the page was flushed. Some `munmap` implementations (e.g. FreeBSD's) don't like it if we pass them NULL. Don't do that. - - - - - 859db7d6 by Ömer Sinan Ağacan at 2020-02-01T14:18:49+03:00 Improve/fix -fcatch-bottoms documentation Old documentation suggests that -fcatch-bottoms only adds a default alternative to bottoming case expression, but that's not true. We use a very simplistic "is exhaustive" check and add default alternatives to any case expression that does not cover all constructors of the type. In case of GADTs this simple check assumes all constructors should be covered, even the ones ruled out by the type of the scrutinee. Update the documentation to reflect this. (Originally noticed in #17648) [ci skip] - - - - - 54dfa94a by John Ericson at 2020-02-03T21:14:24-05:00 Fix docs for FrontendResult Other variant was removed in ac1a379363618a6f2f17fff65ce9129164b6ef30 but docs were no changed. - - - - - 5e63d9c0 by John Ericson at 2020-02-03T21:15:02-05:00 Refactor HscMain.finish I found the old control flow a bit hard to follow; I rewrote it to first decide whether to desugar, and then use that choice when computing whether to simplify / what sort of interface file to write. I hope eventually we will always write post-tc interface files, which will make the logic of this function even simpler, and continue the thrust of this refactor. - - - - - e580e5b8 by Stefan Schulze Frielinghaus at 2020-02-04T09:29:00-05:00 Do not build StgCRunAsm.S for unregisterised builds For unregisterised builds StgRun/StgReturn are implemented via a mini interpreter in StgCRun.c and therefore would collide with the implementations in StgCRunAsm.S. - - - - - e3b0bd97 by Stefan Schulze Frielinghaus at 2020-02-04T09:29:00-05:00 fixup! fixup! Do not build StgCRunAsm.S for unregisterised builds - - - - - eb629fab by John Ericson at 2020-02-04T09:29:38-05:00 Delete some superfluous helper functions in HscMain The driver code is some of the nastiest in GHC, and I am worried about being able to untangle all the tech debt. In `HscMain` we have a number of helpers which are either not-used or little used. I delete them so we can reduce cognative load, distilling the essential complexity away from the cruft. - - - - - c90eca55 by Sebastian Graf at 2020-02-05T09:21:29-05:00 PmCheck: Record type constraints arising from existentials in `PmCoreCt`s In #17703 (a follow-up of !2192), we established that contrary to my belief, type constraints arising from existentials in code like ```hs data Ex where Ex :: a -> Ex f _ | let x = Ex @Int 15 = case x of Ex -> ... ``` are in fact useful. This commit makes a number of refactorings and improvements to comments, but fundamentally changes `addCoreCt.core_expr` to record the type constraint `a ~ Int` in addition to `x ~ Ex @a y` and `y ~ 15`. Fixes #17703. - - - - - 6d3b5d57 by Ömer Sinan Ağacan at 2020-02-05T09:22:10-05:00 testlib: Extend existing *_opts in extra_*_opts Previously we'd override the existing {run,hc} opts in extra_{run,hc}_opts, which caused flakiness in T1969, see #17712. extra_{run,hc}_opts now extends {run,hc} opts, instead of overriding. Also we shrank the allocation area for T1969 in order to increase residency sampling frequency. Fixes #17712 - - - - - 9c89a48d by Ömer Sinan Ağacan at 2020-02-05T09:22:52-05:00 Remove CafInfo-related code from STG lambda lift pass After c846618ae0 we don't have accurate CafInfos for Ids in the current module and we're free to introduce new CAFFY or non-CAFFY bindings or change CafInfos of existing binders; so no we no longer need to maintain CafInfos in Core or STG passes. - - - - - 70ddb8bf by Ryan Scott at 2020-02-05T09:23:30-05:00 Add regression test for #17773 - - - - - e8004e5d by Ben Gamari at 2020-02-05T13:55:19-05:00 gitlab-ci: Allow Windows builds to fail again Due to T7702 and the process issues described in #17777. - - - - - 29b72c00 by Ben Gamari at 2020-02-06T11:55:41-05:00 VarSet: Introduce nonDetFoldVarSet - - - - - c4e6b35d by Ben Gamari at 2020-02-06T11:55:41-05:00 Move closeOverKinds and friends to TyCoFVs - - - - - ed2f0e5c by Simon Peyton Jones at 2020-02-06T11:55:41-05:00 Reform the free variable finders for types This patch delivers on (much of) #17509. * Introduces the shallow vs deep free variable distinction * Introduce TyCoRep.foldType, foldType :: Monoid a => TyCoFolder env a -> env -> Type -> a and use it in the free variable finders. * Substitution in TyCoSubst * ASSERTs are on for checkValidSubst * checkValidSubst uses shallowTyCoVarsOfTypes etc Quite a few things still to do * We could use foldType in lots of other places * We could use mapType for substitution. (Check that we get good code!) * Some (but not yet all) clients of substitution can now save time by using shallowTyCoVarsOfTypes * All calls to tyCoVarsOfTypes should be inspected; most of them should be shallow. Maybe. * Currently shallowTyCoVarsOfTypes still returns unification variables, but not CoVarHoles. Reason: we need to return unification variables in some of the calls in TcSimplify, eg when promoting. * We should do the same thing for tyCoFVsOfTypes, which is currently unchanged. * tyCoFVsOfTypes returns CoVarHoles, because of the use in TcSimplify.mkResidualConstraints. See Note [Emitting the residual implication in simplifyInfer] * #17509 talks about "relevant" variables too. - - - - - 01a1f4fb by Simon Peyton Jones at 2020-02-06T11:55:41-05:00 Use foldTyCo for noFreeVarsOfType - - - - - 0e59afd6 by Simon Peyton Jones at 2020-02-06T11:55:41-05:00 Simplify closeOverKinds - - - - - 9ca5c88e by Simon Peyton Jones at 2020-02-06T11:55:41-05:00 Use foldTyCo for coVarsOfType - - - - - 5541b87c by Simon Peyton Jones at 2020-02-06T11:55:41-05:00 Use foldTyCo for exactTyCoVarsOfType This entailed * Adding a tcf_view field to TyCoFolder * Moving exactTyCoVarsOtType to TcType. It properly belongs there, since only the typechecker calls this function. But it also means that we can "see" and inline tcView. Metric Decrease: T14683 - - - - - 7c122851 by Simon Peyton Jones at 2020-02-06T11:56:02-05:00 Comments only - - - - - 588acb99 by Adam Sandberg Eriksson at 2020-02-08T10:15:38-05:00 slightly better named cost-centres for simple pattern bindings #17006 ``` main = do print $ g [1..100] a where g xs x = map (`mod` x) xs a :: Int = 324 ``` The above program previously attributed the cost of computing 324 to a cost centre named `(...)`, with this change the cost is attributed to `a` instead. This change only affects simple pattern bindings (decorated variables: type signatures, parens, ~ annotations and ! annotations). - - - - - 309f8cfd by Richard Eisenberg at 2020-02-08T10:16:33-05:00 Remove unnecessary parentheses - - - - - 7755ffc2 by Richard Eisenberg at 2020-02-08T10:16:33-05:00 Introduce IsPass; refactor wrappers. There are two main payloads of this patch: 1. This introduces IsPass, which allows e.g. printing code to ask what pass it is running in (Renamed vs Typechecked) and thus print extension fields. See Note [IsPass] in Hs.Extension 2. This moves the HsWrap constructor into an extension field, where it rightly belongs. This is done for HsExpr and HsCmd, but not for HsPat, which is left as an exercise for the reader. There is also some refactoring around SyntaxExprs, but this is really just incidental. This patch subsumes !1721 (sorry @chreekat). Along the way, there is a bit of refactoring in GHC.Hs.Extension, including the removal of NameOrRdrName in favor of NoGhcTc. This meant that we had no real need for GHC.Hs.PlaceHolder, so I got rid of it. Updates haddock submodule. ------------------------- Metric Decrease: haddock.compiler ------------------------- - - - - - 7d452be4 by Dylan Yudaken at 2020-02-08T10:17:17-05:00 Fix hs_try_putmvar losing track of running cap If hs_try_putmvar was called through an unsafe import, it would lose track of the running cap causing a deadlock - - - - - c2e301ae by Ben Gamari at 2020-02-08T10:17:55-05:00 compiler: Qualify imports of Data.List - - - - - aede171a by Ben Gamari at 2020-02-08T10:17:55-05:00 testsuite: Fix -Wcompat-unqualified-imports issues - - - - - 4435a8e0 by Ben Gamari at 2020-02-08T10:17:55-05:00 Introduce -Wcompat-unqualified-imports This implements the warning proposed in option (B) of the Data.List.singleton CLC [discussion][]. This warning, which is included in `-Wcompat` is intended to help users identify imports of modules that will change incompatibly in future GHC releases. This currently only includes `Data.List` due to the expected specialisation and addition of `Data.List.singleton`. Fixes #17244. [discussion]: https://groups.google.com/d/msg/haskell-core-libraries/q3zHLmzBa5E/PmlAs_kYAQAJ - - - - - 28b5349a by Ben Gamari at 2020-02-08T10:17:55-05:00 Bump stm and process submodules - - - - - 7d04b9f2 by Ben Gamari at 2020-02-08T10:18:31-05:00 hadrian: Allow override of Cabal configuration in hadrian.settings Fixes #17612 by adding a `cabal.configure.opts` key for `hadrian.settings`. - - - - - 88bf81aa by Andreas Klebinger at 2020-02-08T10:19:10-05:00 Optimize unpackCString# to allocate less. unpackCString# is a recursive function which for each iteration returns a Cons cell containing the current Char, and a thunk for unpacking the rest of the string. In this patch we change from storing addr + offset inside this thunk to storing only the addr, simply incrementing the address on each iteration. This saves one word of allocation per unpacked character. For a program like "main = print "<largishString>" this amounts to 2-3% fewer % in bytes allocated. I also removed the now redundant local unpack definitions. This removes one call per unpack operation. - - - - - bec76733 by Ben Gamari at 2020-02-08T10:19:57-05:00 Fix GhcThreaded setting This adopts a patch from NetBSD's packaging fixing the `GhcThreaded` option of the make build system. In addition we introduce a `ghcThreaded` option in hadrian's `Flavour` type. Also fix Hadrian's treatment of the `Use Threaded` entry in `settings`. Previously it would incorrectly claim `Use Threaded = True` if we were building the `threaded` runtime way. However, this is inconsistent with the `make` build system, which defines it to be whether the `ghc` executable is linked against the threaded runtime. Fixes #17692. - - - - - 545cf1e1 by Ben Gamari at 2020-02-08T10:20:37-05:00 hadrian: Depend upon libray dependencies when configuring packages This will hopefully fix #17631. - - - - - 047d3d75 by Ben Gamari at 2020-02-08T10:21:16-05:00 testsuite: Add test for #15316 This is the full testcase for T15316. - - - - - 768e5866 by Julien Debon at 2020-02-08T10:22:07-05:00 doc(Data.List): Add some examples to Data.List - - - - - 3900cb83 by Julien Debon at 2020-02-08T10:22:07-05:00 Apply suggestion to libraries/base/GHC/List.hs - - - - - bd666766 by Ben Gamari at 2020-02-08T10:22:45-05:00 users-guide: Clarify that bundled patsyns were introduced in GHC 8.0 Closes #17094. - - - - - 95741ea1 by Pepe Iborra at 2020-02-08T10:23:23-05:00 Update to hie-bios 0.3.2 style program cradle - - - - - fb5c1912 by Sylvain Henry at 2020-02-08T10:24:07-05:00 Remove redundant case This alternative is redundant and triggers no warning when building with 8.6.5 - - - - - 5d83d948 by Matthew Pickering at 2020-02-08T10:24:43-05:00 Add mkHieFileWithSource which doesn't read the source file from disk cc/ @pepeiborra - - - - - dfdae56d by Andreas Klebinger at 2020-02-08T10:25:20-05:00 Rename ghcAssert to stgAssert in hp2ps/Main.h. This fixes #17763 - - - - - 658f7ac6 by Ben Gamari at 2020-02-08T10:26:00-05:00 includes: Avoid using single-line comments in HsFFI.h While single-line comments are supported by C99, dtrace on SmartOS apparently doesn't support them yet. - - - - - c95920a6 by Ömer Sinan Ağacan at 2020-02-08T10:26:42-05:00 Import qualified Prelude in parser This is in preparation of backwards-incompatible changes in happy. See https://github.com/simonmar/happy/issues/166 - - - - - b6dc319a by Ömer Sinan Ağacan at 2020-02-08T10:27:23-05:00 Add regression test for #12760 The bug seems to be fixed in the meantime, make sure it stays fixed. Closes #12760 - - - - - b3857b62 by Ben Gamari at 2020-02-08T10:28:03-05:00 base: Drop out-of-date comment The comment in GHC.Base claimed that ($) couldn't be used in that module as it was wired-in. However, this is no longer true; ($) is merely known key and is defined in Haskell (with a RuntimeRep-polymorphic type) in GHC.Base. The one piece of magic that ($) retains is that it a special typing rule to allow type inference with higher-rank types (e.g. `runST $ blah`; see Note [Typing rule for ($)] in TcExpr). - - - - - 1183ae94 by Daniel Gröber at 2020-02-08T10:29:00-05:00 rts: Fix Arena blocks accounting for MBlock sized allocations When requesting more than BLOCKS_PER_MBLOCK blocks allocGroup can return a different number of blocks than requested. Here we use the number of requested blocks, however arenaFree will subtract the actual number of blocks we got from arena_blocks (possibly) resulting in a negative value and triggering ASSERT(arena_blocks >= 0). - - - - - 97d59db5 by Daniel Gröber at 2020-02-08T10:29:48-05:00 rts: Fix need_prealloc being reset when retainer profiling is on - - - - - 1f630025 by Krzysztof Gogolewski at 2020-02-09T02:52:27-05:00 Add a test for #15712 - - - - - 2ac784ab by Ben Gamari at 2020-02-09T02:53:05-05:00 hadrian: Add --test-metrics argument Allowing the test metric output to be captured to a file, a la the METRIC_FILE environment variable of the make build system. - - - - - f432d8c6 by Ben Gamari at 2020-02-09T02:53:05-05:00 hadrian: Fix --test-summary argument This appears to be a cut-and-paste error. - - - - - a906595f by Arnaud Spiwack at 2020-02-09T02:53:50-05:00 Fix an outdated note link This link appears to have been forgotten in 0dad81ca5fd1f63bf8a3b6ad09787559e8bd05c0 . - - - - - 3ae83da1 by Alp Mestanogullari at 2020-02-09T02:54:28-05:00 hadrian: Windows fixes (bindists, CI) This commit implements a few Windows-specific fixes which get us from a CI job that can't even get as far as starting the testsuite driver, to a state where we can run the entire testssuite (but have test failures to fix). - Don't forget about a potential extension for the haddock program, when preparing the bindist. - Build the timeout program, used by the testsuite driver on Windows in place of the Python script used elsewhere, using the boot compiler. We could alternatively build it with the compiler that we're going to test but this would be a lot more tedious to write. - Implement a wrapper-script less installation procedure for Windows, in `hadrian/bindist/Makefile. - Make dependencies a bit more accurate in the aforementioned Makefile. - Update Windows/Hadrian CI job accordingly. This patch fixes #17486. - - - - - 82f9be8c by Roland Senn at 2020-02-09T02:55:06-05:00 Fix #14628: Panic (No skolem Info) in GHCi This patch implements the [sugggestion from Simon (PJ)](https://gitlab.haskell.org/ghc/ghc/issues/14628#note_146559): - Make `TcErrors.getSkolemInfo` return a `SkolemInfo` rather than an `Implication`. - If `getSkolemInfo` gets `RuntimeUnk`s, just return a new data constructor in `SkolemInfo`, called `RuntimeUnkSkol`. - In `TcErrors.pprSkols` print something sensible for a `RuntimeUnkSkol`. The `getSkolemInfo` function paniced while formating suggestions to add type annotations (subfunction `suggestAddSig`) to a *"Couldn't match type ‘x’ with ‘y’"* error message. The `getSkolemInfo` function didn't find any Implication value and paniced. With this patch the `getSkolemInfo` function does no longer panic, if it finds `RuntimeUnkSkol`s. As the panic occured while processing an error message, we don't need to implement any new error message! - - - - - b2e18e26 by Andreas Klebinger at 2020-02-09T02:55:46-05:00 Fix -ddump-stg-final. Once again make sure this dumps the STG used for codegen. - - - - - 414e2f62 by Sylvain Henry at 2020-02-09T02:56:26-05:00 Force -fPIC for intree GMP (fix #17799) Configure intree GMP with `--with-pic` instead of patching it. Moreover the correct patching was only done for x86_64/darwin (see #17799). - - - - - f0fd72ee by Sebastian Graf at 2020-02-09T17:22:38-05:00 8.10 Release notes for improvements to the pattern-match checker [skip ci] A little late to the game, but better late than never. - - - - - 00dc0f7e by Ömer Sinan Ağacan at 2020-02-09T17:23:17-05:00 Add regression test for #13142 Closes #13142 - - - - - f3e737bb by Sebastian Graf at 2020-02-10T20:04:09-05:00 Fix long distance info for record updates For record updates where the `record_expr` is a variable, as in #17783: ```hs data PartialRec = No | Yes { a :: Int, b :: Bool } update No = No update r@(Yes {}) = r { b = False } ``` We should make use of long distance info in `-Wincomplete-record-updates` checking. But the call to `matchWrapper` in the `RecUpd` case didn't specify a scrutinee expression, which would correspond to the `record_expr` `r` here. That is fixed now. Fixes #17783. - - - - - 5670881d by Tamar Christina at 2020-02-10T20:05:04-05:00 Fs: Fix UNC remapping code. - - - - - 375b3c45 by Oleg Grenrus at 2020-02-11T05:07:30-05:00 Add singleton to Data.OldList - - - - - de32beff by Richard Eisenberg at 2020-02-11T05:08:10-05:00 Do not create nested quantified constraints Previously, we would accidentally make constraints like forall a. C a => forall b. D b => E a b c as we traversed superclasses. No longer! This patch also expands Note [Eagerly expand given superclasses] to work over quantified constraints; necessary for T16502b. Close #17202 and #16502. test cases: typecheck/should_compile/T{17202,16502{,b}} - - - - - e319570e by Ben Gamari at 2020-02-11T05:08:47-05:00 rts: Use nanosleep instead of usleep usleep was removed in POSIX.1-2008. - - - - - b75e7486 by Ben Gamari at 2020-02-11T05:09:24-05:00 rts: Remove incorrect assertions around MSG_THROWTO messages Previously we would assert that threads which are sending a `MSG_THROWTO` message must have their blocking status be blocked on the message. In the usual case of a thread throwing to another thread this is guaranteed by `stg_killThreadzh`. However, `throwToSelf`, used by the GC to kill threads which ran out of heap, failed to guarantee this. Noted while debugging #17785. - - - - - aba51b65 by Sylvain Henry at 2020-02-11T05:10:04-05:00 Add arithmetic exception primops (#14664) - - - - - b157399f by Ben Gamari at 2020-02-11T05:10:40-05:00 configure: Don't assume Gnu linker on Solaris Compl Yue noticed that the linker was dumping the link map on SmartOS. This is because Smartos uses the Solaris linker, which uses the `-64` flag, not `-m64` like Gnu ld, to indicate that it should link for 64-bits. Fix the configure script to handle the Solaris linker correctly. - - - - - d8d73d77 by Simon Peyton Jones at 2020-02-11T05:11:18-05:00 Notes only: telescopes This documentation-only patch fixes #17793 - - - - - 58a4ddef by Alp Mestanogullari at 2020-02-11T05:12:17-05:00 hadrian: build (and ship) iserv on Windows - - - - - 82023524 by Matthew Pickering at 2020-02-11T18:04:17-05:00 TemplateHaskellQuotes: Allow nested splices There is no issue with nested splices as they do not require any compile time code execution. All execution is delayed until the top-level splice. - - - - - 50e24edd by Ömer Sinan Ağacan at 2020-02-11T18:04:57-05:00 Remove Hadrian's copy of (Data.Functor.<&>) The function was added to base with base-4.11 (GHC 8.4) - - - - - f82a2f90 by Sylvain Henry at 2020-02-12T01:56:46-05:00 Document GMP build [skip ci] - - - - - da7f7479 by Sylvain Henry at 2020-02-12T01:57:27-05:00 Module hierarchy: ByteCode and Runtime (cf #13009) Update haddock submodule - - - - - 04f51297 by Ömer Sinan Ağacan at 2020-02-12T01:58:11-05:00 Fix naming of tests for #12923 - - - - - 31fc3321 by Ömer Sinan Ağacan at 2020-02-12T01:58:11-05:00 Add regression test for #12926 Closes #12926 - - - - - f0c0ee7d by Krzysztof Gogolewski at 2020-02-12T01:58:51-05:00 Fix order of arguments in specializer (#17801) See https://gitlab.haskell.org/ghc/ghc/issues/17801#note_253330 No regression test, as it's hard to trigger. - - - - - 059c3c9d by Sebastian Graf at 2020-02-12T11:00:58+01:00 Separate CPR analysis from the Demand analyser The reasons for that can be found in the wiki: https://gitlab.haskell.org/ghc/ghc/wikis/nested-cpr/split-off-cpr We now run CPR after demand analysis (except for after the final demand analysis run just before code gen). CPR got its own dump flags (`-ddump-cpr-anal`, `-ddump-cpr-signatures`), but not its own flag to activate/deactivate. It will run with `-fstrictness`/`-fworker-wrapper`. As explained on the wiki page, this step is necessary for a sane Nested CPR analysis. And it has quite positive impact on compiler performance: Metric Decrease: T9233 T9675 T9961 T15263 - - - - - f5ffd8d9 by Ben Gamari at 2020-02-12T17:22:37-05:00 base: Expose GHC.Unicode.unicodeVersion This exposes a Data.Version.Version representing the version of the Unicode database used by `base`. This should clear up some confusion I have seen in tickets regarding with which Unicode versions a given GHC can be expected to work. While in town I also regenerated (but did not update) the Unicode database with database 12.0.0. Strangely, the file cited in the README no longer existed. Consequently, I used https://www.unicode.org/Public/12.0.0/ucd/UnicodeData.txt and was slightly surprised to find that there were a few changes. - - - - - 6c2585e0 by Ben Gamari at 2020-02-12T17:22:37-05:00 base: Update Unicode database to 12.1.0 Using `curl https://www.unicode.org/Public/12.1.0/ucd/UnicodeData.txt | libraries/base/cbits/ubconfc 12.1.0`. - - - - - df084681 by Krzysztof Gogolewski at 2020-02-12T23:58:52+01:00 Always display inferred variables using braces We now always show "forall {a}. T" for inferred variables, previously this was controlled by -fprint-explicit-foralls. This implements part 1 of https://github.com/ghc-proposals/ghc-proposals/pull/179. Part of GHC ticket #16320. Furthermore, when printing a levity restriction error, we now display the HsWrap of the expression. This lets users see the full elaboration with -fprint-typechecker-elaboration (see also #17670) - - - - - 16d643cf by Sylvain Henry at 2020-02-13T09:16:04-05:00 Remove -ddump-srts flag This flag is deemed not useful. - - - - - fa28ae95 by Sylvain Henry at 2020-02-13T09:16:04-05:00 Fix flag documentation (#17826) - - - - - 1bfd8259 by Sylvain Henry at 2020-02-13T09:16:43-05:00 Ensure that Hadrian is built correctly before using it When Hadrian failed to build, the script would pick a previously built Hadrian (if available) instead of failing. - - - - - cd6e786a by Ömer Sinan Ağacan at 2020-02-14T05:29:56-05:00 Add test for #17648 - - - - - 9f2c3677 by Sylvain Henry at 2020-02-14T05:30:39-05:00 GMP expects the Target platform as --host parameter - - - - - aa6086fd by Oleg Grenrus at 2020-02-14T05:31:16-05:00 Add explicit LANGUAGE Safe to template-haskell (cherry picked from commit a5e0f376821ca882880b03b07b451aa574e289ec) - - - - - af6a0c36 by Ben Gamari at 2020-02-14T05:31:53-05:00 hadrian: Add execution and target architecture to stage-compilation figure - - - - - cf739945 by Sylvain Henry at 2020-02-14T05:32:37-05:00 Module hierarchy: HsToCore (cf #13009) - - - - - 719db318 by Simon Peyton Jones at 2020-02-14T05:33:16-05:00 De-duplicate overlapping Notes Documentation only. Fixes #17827 - - - - - 7550417a by Sylvain Henry at 2020-02-14T05:33:56-05:00 Hadrian: drop Sphinx flag checking for PDF documentation (#17825) It seems that Sphinx produces the ghc-flags.txt in doc/users_guide/_build rather than pdfRoot. We could copy ghc-flags.txt into pdfRoot (like happens naturally in the HTML case) but the benefit is pretty small. Let's just only check the HTML case. - - - - - 813842f4 by Ben Gamari at 2020-02-14T10:16:36-05:00 make: Be more selective in building windows-extra-src tarball - - - - - 0725f4bb by Ben Gamari at 2020-02-14T10:16:36-05:00 Rework handling of win32 toolchain tarballs - - - - - 565ce7ae by Ben Gamari at 2020-02-14T10:16:36-05:00 gitlab-ci: Consolidate CI logic This moves nearly all of the CI logic to .gitlab/ci.sh. This improves things in a number of ways: * it's harder for inconsistencies to arise between architectures * it's easier to share logic between architectures * on Windows, it's easier to ensure that all CI steps are executed from within a properly initialized mingw session. While in town I also add a FreeBSD build job and update the Windows job to use the gitlab-runner PowerShell executor, since cmd.exe will be deprecated soon (fixing #17699). - - - - - 9cbace74 by Ben Gamari at 2020-02-14T10:16:36-05:00 gitlab-ci: Deduplicate nightly job configuration - - - - - 6e837144 by Ben Gamari at 2020-02-14T10:16:36-05:00 integer-gmp: Fix unused command-line argument -L is only needed during linking. - - - - - e5ee07ab by Ben Gamari at 2020-02-14T10:16:36-05:00 testsuite: Don't ask sed to operate in-place on symlinks Some sed implementations (e.g. FreeBSD) refuse to operate in-place on symlinks. - - - - - 71e5e68f by Ben Gamari at 2020-02-14T10:16:36-05:00 testsuite: Disable tests that assume name of libstdc++ on FreeBSD - - - - - 7b2da0f4 by Ben Gamari at 2020-02-14T10:16:36-05:00 testsuite: Mark T6132 as broken on FreeBSD - - - - - 8ef7a15a by Ben Gamari at 2020-02-14T10:16:36-05:00 testsuite/T16930: Don't rely on gnu grep specific --include In BSD grep this flag only affects directory recursion. - - - - - 6060003e by Ben Gamari at 2020-02-14T10:16:36-05:00 Pass -Wno-unused-command-line-arguments during link on FreeBSD FreeBSD cc throws a warning if we pass -pthread without actually using any pthread symbols. - - - - - 97497bae by Ben Gamari at 2020-02-14T10:16:36-05:00 base: Always clamp reads/writes to 2GB in length Previously we did this only on Darwin due to #17414. However, even on other platforms >2GB writes are on shaky ground. POSIX explicitly says that the result is implementation-specified and Linux will write at most 0x7ffff000, even on 64-bit platforms. Moreover, getting the sign of the syscall result correct is tricky, as demonstrated by the fact that T17414 currently fails on FreeBSD. For simplicity we now just uniformly clamp to 0x7ffff000 on all platforms. - - - - - 49be2a3f by Ben Gamari at 2020-02-14T10:16:36-05:00 configure: Fix sphinx version test The check for the "v" prefix is redundant. - - - - - f7f7a556 by Ben Gamari at 2020-02-14T10:16:37-05:00 users-guide: Fix unknown link targets - - - - - a204102c by Ben Gamari at 2020-02-14T10:16:37-05:00 docs/compare-flags: Don't use python f-strings - - - - - 92e15a37 by Ben Gamari at 2020-02-14T10:16:37-05:00 gitlab-ci: Fix various shellcheck warnings - - - - - 459f7c6e by Ben Gamari at 2020-02-14T10:16:37-05:00 hadrian: Drop empty arguments from target list Fixes #17748. - - - - - c06df28d by Ben Gamari at 2020-02-14T10:16:37-05:00 users-guide: Fix "invalid file" failure I have no idea how this worked previously. Different Python version? - - - - - 3fe8444f by Ben Gamari at 2020-02-14T10:16:59-05:00 testsuite: Mark T7702 as fragile on Windows Due to #16799. There was previously an attempt to mark it as broken but the `opsys` name was incorrect. - - - - - fe02f781 by Ben Gamari at 2020-02-14T10:16:59-05:00 testsuite: Assert the opsys names are known Previously opsys would take any string. This meant it was very easy for a typo to silently render the predicate ineffective. Fix this by checking the given operating system name against a list of known values. - - - - - 149e2a3a by Ben Gamari at 2020-02-14T10:16:59-05:00 compare-flags: Don't rely on encoding flag of subprocess.check_output Apparently it isn't supported by some slightly older Python versions. - - - - - 798d59f6 by Ben Gamari at 2020-02-14T10:16:59-05:00 rts: Add more debug output to failed path in onIOComplete This will help track down #17035. - - - - - e35f3f98 by Ben Gamari at 2020-02-14T10:16:59-05:00 gitlab-ci: Allow i386 Windows builds to fail again Due to the resistance of #17736 to resolution. - - - - - 261a3cf8 by Ben Gamari at 2020-02-14T10:17:00-05:00 gitlab-ci: Build integer-simple job in the validate flavour - - - - - b613a961 by Ben Gamari at 2020-02-14T10:17:00-05:00 gitlab-ci: Always use mingw64 python on Windows - - - - - 1bc8c8cd by Ben Gamari at 2020-02-14T10:17:00-05:00 gitlab-ci: Allow Windows build to fail due to #17777 The fact that `exec` isn't POSIX compliant means that things can break in arbitrarily bad ways. Sometimes things happen to work correctly but sadly this isn't always the case. - - - - - ac63020d by Ben Gamari at 2020-02-14T10:17:00-05:00 gitlab-ci: Drop unnecessary GHC_VERSION check - - - - - 6926f369 by Ben Gamari at 2020-02-14T10:17:00-05:00 Bump process submodule Folds in the second part of Phyx's Windows process exit fixes [1], hopefully finally resolving issue #17480. [1] https://github.com/haskell/process/pull/160 - - - - - 584eee71 by Tamar Christina at 2020-02-14T10:17:00-05:00 SysTools: Use "process job" when spawning processes on Windows GHC should make calls using process jobs when calling out to GCC and LD. The reason is these use the exec () family of posix functions. Window's process model doesn't allow replacement of processes so this is emulated by creating a new process and immediately exiting the old one. Because of this when using normal Windows wait functions you would return even without the child process having finished. In this case if you are depending on data from the child you will enter a race condition. The usual fix for this is to use process jobs and wait for the termination of all children that have ever been spawn by the process you called. But also waiting for the freeing of all resources. - - - - - ecabfa28 by Tamar Christina at 2020-02-14T10:17:00-05:00 Revert "compiler: Disable atomic renaming on Windows" The original reason this was disabled should be fixed by the previous commit. This reverts commit 1c1b63d63efe8b0f789aa7d5b87cfac3edd213eb. - - - - - 06d60c66 by Ben Gamari at 2020-02-14T10:17:00-05:00 Bump Cabal submodule - - - - - 8cabb384 by Ben Gamari at 2020-02-14T10:17:00-05:00 compare-flags: Fix output - - - - - 8cf646d3 by Ben Gamari at 2020-02-14T10:17:00-05:00 users-guide: Document -ddump-srts - - - - - 932307a5 by Ben Gamari at 2020-02-14T10:17:00-05:00 users-guide: Fix broken reference - - - - - e77818de by Ben Gamari at 2020-02-15T09:26:55-05:00 Accept performance changes These manifested in the integer-simple job. Metric Decrease: T12227 T5549 T14936 T4830 Conversions T5237 T8766 T4801 T10359 Metric Increase: T12234 T6048 T3294 T14683 T3064 T9872b T9872c T783 T5837 T10678 T14697 T5631 T9203 T13719 T12707 T13056 T9630 T10547 T9872d T1969 WWRec T10370 T5321FD haddock.Cabal T5642 T9872a T15263 T12425 MultiLayerModules T5205 T9233 T13379 haddock.base T9020 T13035 T12150 T9961 - - - - - 785008c1 by Ben Gamari at 2020-02-15T09:30:13-05:00 testsuite: Sort test names in expected change output - - - - - 9e851472 by Ömer Sinan Ağacan at 2020-02-16T10:38:41+03:00 Revert "users-guide: Document -ddump-srts" This reverts commit 8cf646d36b02b8ea1c289cb52781c9171853b514. The flag was removed by 16d643cf. [ci skip] - - - - - 9792c816 by Ben Gamari at 2020-02-16T09:47:08-05:00 testsuite: Probe whether symlinks are usable on Windows Closes #17706. - - - - - ee1e5342 by Vladislav Zavialov at 2020-02-16T09:47:44-05:00 Fix the "unused terminals: 2" warning in Parser.y - - - - - b4a8ce52 by Roland Senn at 2020-02-18T20:14:42-05:00 If a :reload finds syntax errors in the module graph, remove the loaded modules. (Fixes #17549) The processing in `compiler/main/GhcMake.hs` computes the ModuleGraph. If it finds errors in the module header or in the import specifications, then the new module graph is incomplete and should not be used. The code before #17549 just reported the errors and left the old ModuleGraph in place. The new code of this MR replaces the old ModuleGraph with an empty one. - - - - - d7029cc0 by Sylvain Henry at 2020-02-18T20:15:30-05:00 Hadrian: refactor GMP in-tree build support (#17756) * Hadrian doesn't use integer-gmp/config.mk file anymore to determine if building GMP in-tree is required. "config.mk" is created by Cabal when the integer-gmp package is configured and this file is still untracked by Hadrian. This led to a tricky configure "race" because "config.mk" is built by the "setup-config" rule, but this rule is also used to find dependencies, in particular the "ghc-gmp.h" header, but the creation of this file was depending (without being tracked) on "config.mk". Now Hadrian only builds in-tree GMP if `--with-intree-gmp` is passed to the top-level configure script. * in-tree GMP isn't built once for all in a fixed stage (Stage1) anymore. It is built per stage which is required if we build a cross-compiler * switching between in-tree and external GMP is now supported without having to clean the build directory first. * "wrappers.c" now includes "ghc-gmp.h" instead of "ghc.h". It helps ensuring that the build system generates "ghc-gmp.h". * build in-tree GMP in "<root>/stageN/gmp/gmpbuild" and produce useful artefacts (libgmp.a, gmp.h, objs/*.o) in "<root>/stageN/gmp" - - - - - 40d917fb by Vladislav Zavialov at 2020-02-18T20:16:07-05:00 Remove the MonadFail P instance There were two issues with this instance: * its existence meant that a pattern match failure in the P monad would produce a user-visible parse error, but the error message would not be helpful to the user * due to the MFP migration strategy, we had to use CPP in Lexer.x, and that created issues for #17750 Updates haddock submodule. - - - - - 5a1ce45d by Joshua Price at 2020-02-18T20:16:47-05:00 Fix unboxed tuple size limit (#17837) - - - - - 192caf58 by Vladislav Zavialov at 2020-02-18T20:17:24-05:00 Fix testsuite driver output (#17847) - - - - - 1500f089 by Sylvain Henry at 2020-02-18T20:18:12-05:00 Modules: Llvm (#13009) - - - - - d53e81c0 by Niklas Hambüchen at 2020-02-20T10:36:22-05:00 8.10 Release notes for atomic .o writes [skip ci] - - - - - 19680ee5 by Niklas Hambüchen at 2020-02-20T10:37:53-05:00 8.10 Release notes for --disable-delayed-os-memory-return [skip ci] - - - - - 74ad75e8 by Simon Peyton Jones at 2020-02-20T21:17:57-05:00 Re-implement unsafe coercions in terms of unsafe equality proofs (Commit message written by Omer, most of the code is written by Simon and Richard) See Note [Implementing unsafeCoerce] for how unsafe equality proofs and the new unsafeCoerce# are implemented. New notes added: - [Checking for levity polymorphism] in CoreLint.hs - [Implementing unsafeCoerce] in base/Unsafe/Coerce.hs - [Patching magic definitions] in Desugar.hs - [Wiring in unsafeCoerce#] in Desugar.hs Only breaking change in this patch is unsafeCoerce# is not exported from GHC.Exts, instead of GHC.Prim. Fixes #17443 Fixes #16893 NoFib ----- -------------------------------------------------------------------------------- Program Size Allocs Instrs Reads Writes -------------------------------------------------------------------------------- CS -0.1% 0.0% -0.0% -0.0% -0.0% CSD -0.1% 0.0% -0.0% -0.0% -0.0% FS -0.1% 0.0% -0.0% -0.0% -0.0% S -0.1% 0.0% -0.0% -0.0% -0.0% VS -0.1% 0.0% -0.0% -0.0% -0.0% VSD -0.1% 0.0% -0.0% -0.0% -0.1% VSM -0.1% 0.0% -0.0% -0.0% -0.0% anna -0.0% 0.0% -0.0% -0.0% -0.0% ansi -0.1% 0.0% -0.0% -0.0% -0.0% atom -0.1% 0.0% -0.0% -0.0% -0.0% awards -0.1% 0.0% -0.0% -0.0% -0.0% banner -0.1% 0.0% -0.0% -0.0% -0.0% bernouilli -0.1% 0.0% -0.0% -0.0% -0.0% binary-trees -0.1% 0.0% -0.0% -0.0% -0.0% boyer -0.1% 0.0% -0.0% -0.0% -0.0% boyer2 -0.1% 0.0% -0.0% -0.0% -0.0% bspt -0.1% 0.0% -0.0% -0.0% -0.0% cacheprof -0.1% 0.0% -0.0% -0.0% -0.0% calendar -0.1% 0.0% -0.0% -0.0% -0.0% cichelli -0.1% 0.0% -0.0% -0.0% -0.0% circsim -0.1% 0.0% -0.0% -0.0% -0.0% clausify -0.1% 0.0% -0.0% -0.0% -0.0% comp_lab_zift -0.1% 0.0% -0.0% -0.0% -0.0% compress -0.1% 0.0% -0.0% -0.0% -0.0% compress2 -0.1% 0.0% -0.0% -0.0% -0.0% constraints -0.1% 0.0% -0.0% -0.0% -0.0% cryptarithm1 -0.1% 0.0% -0.0% -0.0% -0.0% cryptarithm2 -0.1% 0.0% -0.0% -0.0% -0.0% cse -0.1% 0.0% -0.0% -0.0% -0.0% digits-of-e1 -0.1% 0.0% -0.0% -0.0% -0.0% digits-of-e2 -0.1% 0.0% -0.0% -0.0% -0.0% dom-lt -0.1% 0.0% -0.0% -0.0% -0.0% eliza -0.1% 0.0% -0.0% -0.0% -0.0% event -0.1% 0.0% -0.0% -0.0% -0.0% exact-reals -0.1% 0.0% -0.0% -0.0% -0.0% exp3_8 -0.1% 0.0% -0.0% -0.0% -0.0% expert -0.1% 0.0% -0.0% -0.0% -0.0% fannkuch-redux -0.1% 0.0% -0.0% -0.0% -0.0% fasta -0.1% 0.0% -0.5% -0.3% -0.4% fem -0.1% 0.0% -0.0% -0.0% -0.0% fft -0.1% 0.0% -0.0% -0.0% -0.0% fft2 -0.1% 0.0% -0.0% -0.0% -0.0% fibheaps -0.1% 0.0% -0.0% -0.0% -0.0% fish -0.1% 0.0% -0.0% -0.0% -0.0% fluid -0.1% 0.0% -0.0% -0.0% -0.0% fulsom -0.1% 0.0% +0.0% +0.0% +0.0% gamteb -0.1% 0.0% -0.0% -0.0% -0.0% gcd -0.1% 0.0% -0.0% -0.0% -0.0% gen_regexps -0.1% 0.0% -0.0% -0.0% -0.0% genfft -0.1% 0.0% -0.0% -0.0% -0.0% gg -0.1% 0.0% -0.0% -0.0% -0.0% grep -0.1% 0.0% -0.0% -0.0% -0.0% hidden -0.1% 0.0% -0.0% -0.0% -0.0% hpg -0.1% 0.0% -0.0% -0.0% -0.0% ida -0.1% 0.0% -0.0% -0.0% -0.0% infer -0.1% 0.0% -0.0% -0.0% -0.0% integer -0.1% 0.0% -0.0% -0.0% -0.0% integrate -0.1% 0.0% -0.0% -0.0% -0.0% k-nucleotide -0.1% 0.0% -0.0% -0.0% -0.0% kahan -0.1% 0.0% -0.0% -0.0% -0.0% knights -0.1% 0.0% -0.0% -0.0% -0.0% lambda -0.1% 0.0% -0.0% -0.0% -0.0% last-piece -0.1% 0.0% -0.0% -0.0% -0.0% lcss -0.1% 0.0% -0.0% -0.0% -0.0% life -0.1% 0.0% -0.0% -0.0% -0.0% lift -0.1% 0.0% -0.0% -0.0% -0.0% linear -0.1% 0.0% -0.0% -0.0% -0.0% listcompr -0.1% 0.0% -0.0% -0.0% -0.0% listcopy -0.1% 0.0% -0.0% -0.0% -0.0% maillist -0.1% 0.0% -0.0% -0.0% -0.0% mandel -0.1% 0.0% -0.0% -0.0% -0.0% mandel2 -0.1% 0.0% -0.0% -0.0% -0.0% mate -0.1% 0.0% -0.0% -0.0% -0.0% minimax -0.1% 0.0% -0.0% -0.0% -0.0% mkhprog -0.1% 0.0% -0.0% -0.0% -0.0% multiplier -0.1% 0.0% -0.0% -0.0% -0.0% n-body -0.1% 0.0% -0.0% -0.0% -0.0% nucleic2 -0.1% 0.0% -0.0% -0.0% -0.0% para -0.1% 0.0% -0.0% -0.0% -0.0% paraffins -0.1% 0.0% -0.0% -0.0% -0.0% parser -0.1% 0.0% -0.0% -0.0% -0.0% parstof -0.1% 0.0% -0.0% -0.0% -0.0% pic -0.1% 0.0% -0.0% -0.0% -0.0% pidigits -0.1% 0.0% -0.0% -0.0% -0.0% power -0.1% 0.0% -0.0% -0.0% -0.0% pretty -0.1% 0.0% -0.1% -0.1% -0.1% primes -0.1% 0.0% -0.0% -0.0% -0.0% primetest -0.1% 0.0% -0.0% -0.0% -0.0% prolog -0.1% 0.0% -0.0% -0.0% -0.0% puzzle -0.1% 0.0% -0.0% -0.0% -0.0% queens -0.1% 0.0% -0.0% -0.0% -0.0% reptile -0.1% 0.0% -0.0% -0.0% -0.0% reverse-complem -0.1% 0.0% -0.0% -0.0% -0.0% rewrite -0.1% 0.0% -0.0% -0.0% -0.0% rfib -0.1% 0.0% -0.0% -0.0% -0.0% rsa -0.1% 0.0% -0.0% -0.0% -0.0% scc -0.1% 0.0% -0.1% -0.1% -0.1% sched -0.1% 0.0% -0.0% -0.0% -0.0% scs -0.1% 0.0% -0.0% -0.0% -0.0% simple -0.1% 0.0% -0.0% -0.0% -0.0% solid -0.1% 0.0% -0.0% -0.0% -0.0% sorting -0.1% 0.0% -0.0% -0.0% -0.0% spectral-norm -0.1% 0.0% -0.0% -0.0% -0.0% sphere -0.1% 0.0% -0.0% -0.0% -0.0% symalg -0.1% 0.0% -0.0% -0.0% -0.0% tak -0.1% 0.0% -0.0% -0.0% -0.0% transform -0.1% 0.0% -0.0% -0.0% -0.0% treejoin -0.1% 0.0% -0.0% -0.0% -0.0% typecheck -0.1% 0.0% -0.0% -0.0% -0.0% veritas -0.0% 0.0% -0.0% -0.0% -0.0% wang -0.1% 0.0% -0.0% -0.0% -0.0% wave4main -0.1% 0.0% -0.0% -0.0% -0.0% wheel-sieve1 -0.1% 0.0% -0.0% -0.0% -0.0% wheel-sieve2 -0.1% 0.0% -0.0% -0.0% -0.0% x2n1 -0.1% 0.0% -0.0% -0.0% -0.0% -------------------------------------------------------------------------------- Min -0.1% 0.0% -0.5% -0.3% -0.4% Max -0.0% 0.0% +0.0% +0.0% +0.0% Geometric Mean -0.1% -0.0% -0.0% -0.0% -0.0% Test changes ------------ - break006 is marked as broken, see #17833 - The compiler allocates less when building T14683 (an unsafeCoerce#- heavy happy-generated code) on 64-platforms. Allocates more on 32-bit platforms. - Rest of the increases are tiny amounts (still enough to pass the threshold) in micro-benchmarks. I briefly looked at each one in a profiling build: most of the increased allocations seem to be because of random changes in the generated code. Metric Decrease: T14683 Metric Increase: T12150 T12234 T12425 T13035 T14683 T5837 T6048 Co-Authored-By: Richard Eisenberg <rae at cs.brynmawr.edu> Co-Authored-By: Ömer Sinan Ağacan <omeragacan at gmail.com> - - - - - 6880d6aa by Sylvain Henry at 2020-02-20T21:18:48-05:00 Disentangle DynFlags and SDoc Remove several uses of `sdocWithDynFlags`. The remaining ones are mostly CodeGen related (e.g. depend on target platform constants) and will be fixed separately. Metric Decrease: T12425 T9961 WWRec T1969 T14683 - - - - - 70a90110 by Julien Debon at 2020-02-20T21:19:27-05:00 doc(List): Add examples to GHC.List * Add examples * Cleanup documentation * Clarify merge process and Marge bot - - - - - c8439fc7 by Peter Trommler at 2020-02-20T21:20:05-05:00 Fix testsuite on powerpc64le Remove expect broken on recomp tests, #11260 was closed by !2264 and #11323 most likely by !2264 as well. GHCi scripts tests work on GHCi but not the external interpreter, adjust test configuration accordingly. Fixes unexpected passes. Mark test requiring DWARF expect fail on powerpc64[le] for #11261. - - - - - 65b7256a by Ömer Sinan Ağacan at 2020-02-20T21:20:45-05:00 Use concatMap(M) instead of `concat . map` and the monadic variant - - - - - 8b76d457 by Roland Senn at 2020-02-20T21:21:28-05:00 Fix #17832: Weird handling of exports named main in 8.10-rc1 Switching from `lookupGlobalOccRn_maybe` to `lookupInfoOccRn` to check whether a `main` function is in scope. Unfortunately `lookupGlobalOccRn_maybe` complains if there are multiple `main` functions in scope. - - - - - 466e1ad5 by Krzysztof Gogolewski at 2020-02-20T21:22:11-05:00 Use TTG for HsSplicedT constructor The constructor HsSplicedT occurs only in the GhcTc pass. This enforces this fact statically via TTG. - - - - - 4e622fca by Alexis King at 2020-02-20T21:22:49-05:00 Normalize types when dropping absent arguments from workers fixes #17852 - - - - - a533e547 by Adam Sandberg Eriksson at 2020-02-20T21:23:31-05:00 Mention users guide and release notes in merge request template - - - - - 05251b17 by Ben Gamari at 2020-02-20T21:24:08-05:00 gitlab-ci: Fix typo in BIN_DIST_PREP_TAR_COMP variable name - - - - - f44c7e67 by Ben Gamari at 2020-02-20T21:24:46-05:00 gitlab-ci: Avoid duplicating ~/.cabal contents with every build Previously our attempt to cache the cabal store would `cp cabal-cache ~/.cabal`. However, if the latter already existed this meant that we would end up with ~/.cabal/cabal-cache. Not only would this not help caching but it would exponentially grow the size of ~/.cabal. Not good! - - - - - c5ec9965 by Ben Gamari at 2020-02-20T21:56:13-05:00 GHC.Hs.Extension: Use Type instead of * - - - - - 89cb4cc4 by Ben Gamari at 2020-02-20T21:56:13-05:00 Use Type instead of * in GHC - - - - - 04eb0d6c by Ben Gamari at 2020-02-20T21:56:13-05:00 Enable -Wstar-is-type in -Wall As noted in [proposal 0143][proposal] this is supposed to happen in 8.12. Also fix an incorrect claim in the users guide that -Wstar-is-type is enabled by default. [proposal]: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0143-remove-star-kind.rst - - - - - 6de966f1 by Andreas Klebinger at 2020-02-20T21:56:15-05:00 Fix #17724 by having occAnal preserve used bindings. It sometimes happened that occAnal would remove bindings as dead code by relying on bindings to be in dependency order. The fix was contributed by SPJ. - - - - - abd7f962 by Ben Gamari at 2020-02-20T21:56:15-05:00 users-guide: Mention dependency on `exceptions` in release notes Fixes #17845. - - - - - 58175379 by Sylvain Henry at 2020-02-20T21:56:20-05:00 Hadrian: minor GMP refactoring Somehow I forgot to totally remove `gmpContext` in d7029cc09edc052c2f97effe33233c53340fcce0. This patch fixes it and adds some additional comments. - - - - - 33fa8d94 by Ryan Scott at 2020-02-20T21:56:21-05:00 Generalize liftData to work over any Quote (#17857) The Overloaded Quotations proposal generalized the type of `lift` to work over any `Quote`, but not the type of `liftData`, leading to #17857. Thankfully, generalizing `liftData` is extremely straightforward. Fixes #17857. - - - - - 3cea6795 by Sylvain Henry at 2020-02-20T21:56:23-05:00 Make: fix sdist target (#17848) - - - - - e2cce997 by Sylvain Henry at 2020-02-20T21:56:23-05:00 Hadrian: fix source-dist target (#17849) - - - - - 0a4c89b2 by Matthew Pickering at 2020-02-21T20:44:45-05:00 Special case `mkTyConApp liftedTypeKind []` We really need to make sure that these are shared because otherwise GHC will allocate thousands of identical `TyConApp` nodes. See #17292 ------------------------- Metric Decrease: haddock.Cabal T14683 ------------------------- - - - - - 0482f58a by Matthew Pickering at 2020-02-21T20:45:21-05:00 TH: wrapGenSyns, don't split the element type too much The invariant which allowed the pervious method of splitting the type of the body to find the type of the elements didn't work in the new overloaded quotation world as the type can be something like `WriterT () m a` rather than `Q a` like before. Fixes #17839 - - - - - be7068a6 by Vladislav Zavialov at 2020-02-21T20:45:59-05:00 Parser API annotations: RealSrcLoc During parsing, GHC collects lexical information about AST nodes and stores it in a map. It is needed to faithfully restore original source code, e.g. compare these expressions: a = b a = b The position of the equality sign is not recorded in the AST, so it must be stored elsewhere. This system is described in Note [Api annotations]. Before this patch, the mapping was represented by: Map (SrcSpan, AnnKeywordId) SrcSpan After this patch, the mapping is represented by: Map (RealSrcSpan, AnnKeywordId) RealSrcSpan The motivation behind this change is to avoid using the Ord SrcSpan instance (required by Map here), as it interferes with #17632 (see the discussion there). SrcSpan is isomorphic to Either String RealSrcSpan, but we shouldn't use those strings as Map keys. Those strings are intended as hints to the user, e.g. "<interactive>" or "<compiler-generated code>", so they are not a valid way to identify nodes in the source code. - - - - - 240f5bf6 by Sylvain Henry at 2020-02-21T20:46:40-05:00 Modules: Driver (#13009) submodule updates: nofib, haddock - - - - - 9d094111 by Sylvain Henry at 2020-02-21T20:47:19-05:00 Hadrian: `docs` rule needs `configure` (#17840) - - - - - 1674353a by Ben Gamari at 2020-02-23T17:31:19-05:00 fs: Port fixes from ghc-jailbreak repository * Override rename, unlink, and remove * Factor out wchar conversion - - - - - 853210f2 by Adam Sandberg Ericsson at 2020-02-23T17:32:03-05:00 show gcc linker options in configure summary - - - - - 2831544a by Adam Sandberg Ericsson at 2020-02-23T17:32:44-05:00 hadrian: docs depend on stage1 ghc - - - - - 1d9df9e0 by Adam Sandberg Ericsson at 2020-02-23T17:33:23-05:00 ci: after 5ce63d52fed the linux bindist for doc-tarball has changed name - - - - - 26e8fff3 by Vladislav Zavialov at 2020-02-24T02:05:30-05:00 Remove Ord SrcLoc, Ord SrcSpan Before this patch, GHC relied on Ord SrcSpan to identify source elements, by using SrcSpan as Map keys: blackList :: Map SrcSpan () -- compiler/GHC/HsToCore/Coverage.hs instanceMap :: Map SrcSpan Name -- compiler/GHC/HsToCore/Docs.hs Firstly, this design is not valid in presence of UnhelpfulSpan, as it distinguishes between UnhelpfulSpan "X" and UnhelpfulSpan "Y", but those strings are messages for the user, unfit to serve as identifiers for source elements. Secondly, this design made it hard to extend SrcSpan with additional data. Recall that the definition of SrcSpan is: data SrcSpan = RealSrcSpan !RealSrcSpan | UnhelpfulSpan !FastString Say we want to extend the RealSrcSpan constructor with additional information: data SrcSpan = RealSrcSpan !RealSrcSpan !AdditionalInformation | UnhelpfulSpan !FastString getAdditionalInformation :: SrcSpan -> AdditionalInformation getAdditionalInformation (RealSrcSpan _ a) = a Now, in order for Map SrcSpan to keep working correctly, we must *ignore* additional information when comparing SrcSpan values: instance Ord SrcSpan where compare (RealSrcSpan r1 _) (RealSrcSpan r2 _) = compare r1 r2 ... However, this would violate an important law: a == b therefore f a == f b Ignoring AdditionalInformation in comparisons would mean that with f=getAdditionalInformation, the law above does not hold. A more robust design is to avoid Ord SrcSpan altogether, which is what this patch implements. The mappings are changed to use RealSrcSpan instead: blackList :: Set RealSrcSpan -- compiler/GHC/HsToCore/Coverage.hs instanceMap :: Map RealSrcSpan Name -- compiler/GHC/HsToCore/Docs.hs All SrcSpan comparisons are now done with explicit comparison strategies: SrcLoc.leftmost_smallest SrcLoc.leftmost_largest SrcLoc.rightmost_smallest These strategies are not subject to the law mentioned above and can easily discard both the string stored in UnhelpfulSpan and AdditionalInformation. Updates haddock submodule. - - - - - 5aa6c188 by Ben Gamari at 2020-02-24T02:06:09-05:00 users-guide: Shuffle text - - - - - e3f17413 by Ben Gamari at 2020-02-24T02:06:09-05:00 users-guide: Drop old release notes - - - - - 84dd9610 by Ben Gamari at 2020-02-24T02:06:09-05:00 Bump directory submodule to 1.3.6.0 - - - - - e295a024 by Stefan Pavikevik at 2020-02-24T20:53:44-05:00 check for safe arguments, raising error when invalid (fix #17720) - - - - - 354e2787 by Krzysztof Gogolewski at 2020-02-24T20:54:35-05:00 Comments, small refactor * Remove outdated Note [HsForAllTy tyvar binders] and [Context quantification]. Since the wildcard refactor 1e041b7382, HsForAllTy no longer has an flag controlling explicity. The field `hsq_implicit` is gone too. The current situation is covered by Note [HsType binders] which is already linked from LHsQTyVars. * Small refactor in CoreLint, extracting common code to a function * Remove "not so sure about WpFun" in TcEvidence, per Richard's comment https://gitlab.haskell.org/ghc/ghc/merge_requests/852#note_223226 * Use mkIfThenElse in Foreign/Call, as it does exactly what we need. - - - - - 1b1067d1 by Sylvain Henry at 2020-02-24T20:55:25-05:00 Modules: CmmToAsm (#13009) - - - - - 621468f6 by Alexis King at 2020-02-26T15:08:09-05:00 Treat coercions as arguments for floating and inlining This reverts commit 8924224ecfa065ebc67b96a90d01cf9d2edd0e77 and fixes #17787. - - - - - def486c9 by Ben Gamari at 2020-02-26T15:08:47-05:00 hadrian: Allow libnuma library path to be specified - - - - - ed03d4e7 by Ben Gamari at 2020-02-26T15:08:47-05:00 hadrian: Refactor gmp arguments Move the gmp configuration to its own binding. - - - - - 09b88384 by Ben Gamari at 2020-02-26T15:08:47-05:00 hadrian: Tell Cabal about integer-gmp library location - - - - - 161e08c5 by Krzysztof Gogolewski at 2020-02-26T15:09:30-05:00 Remove dead code * FailablePattern can no longer be created since ab51bee40c82 Therefore, Opt_WarnMissingMonadFailInstances has no effect anymore. * XWrap is no longer used, it was moved to an extension field - - - - - e0d09db3 by Ben Gamari at 2020-02-26T15:10:09-05:00 gitlab-ci: Use 8.8.3 to bootstrap on Windows This should fix #17861. - - - - - 972bcf3a by Ben Gamari at 2020-02-26T15:10:09-05:00 testsuite: Fix symlink test Needs to `write` bytes, not str. - - - - - 273e60de by Ben Gamari at 2020-02-26T15:10:09-05:00 gitlab-ci: Add shell subcommand for debugging within CI environment - - - - - 43b13ed3 by Ben Gamari at 2020-02-26T15:10:09-05:00 gitlab-ci: Fix colors on Darwin Darwin sh doesn't support \e. - - - - - 217546a7 by Ben Gamari at 2020-02-26T15:10:09-05:00 testsuite: Flush stdout buffers in InitEventLogging Otherwise we are sensitive to libc's buffering strategy. Similar to the issue fixed in 543dfaab166c81f46ac4af76918ce32190aaab22. - - - - - c7d4fa55 by Ben Gamari at 2020-02-26T15:10:09-05:00 gitlab-ci: Add run_hadrian subcommand I've ruined two trees already by failing to pass --flavour to hadrian. Let's factor this out so it can be reused during troubleshooting. - - - - - 7dc54873 by Ben Gamari at 2020-02-26T15:10:09-05:00 testsuite: Allow tests to be marked as broken on the command line This allows us to work-around distribution-specific breakage easily. - - - - - 25e2458e by Ben Gamari at 2020-02-26T15:10:09-05:00 hadrian: Add --broken-test flag This exposes the flag of the same name supported by the testsuite driver. - - - - - 55769996 by Ben Gamari at 2020-02-26T15:10:09-05:00 gitlab-ci: Mark some tests as broken on Alpine - - - - - 9ee7f87d by Ben Gamari at 2020-02-26T15:10:09-05:00 SysTools: Don't use process jobs if they are broken - - - - - bfaa3961 by Ben Gamari at 2020-02-26T15:10:09-05:00 Bump hsc2hs submodule Fixes name of C compiler. - - - - - b2b49a0a by Ben Gamari at 2020-02-26T15:10:09-05:00 testsuite: Make hasMetricsFile RHS more descriptive - - - - - 817f93ea by Sylvain Henry at 2020-02-26T15:10:58-05:00 Modules: Core (#13009) Update haddock submodule - - - - - 74311e10 by Sebastian Graf at 2020-02-27T16:22:45-05:00 PmCheck: Implement Long-distance information with Covered sets Consider ```hs data T = A | B | C f :: T -> Int f A = 1 f x = case x of A -> 2 B -> 3 C -> 4 ``` Clearly, the RHS returning 2 is redundant. But we don't currently see that, because our approximation to the covered set of the inner case expression just picks up the positive information from surrounding pattern matches. It lacks the context sensivity that `x` can't be `A` anymore! Therefore, we adopt the conceptually and practically superior approach of reusing the covered set of a particular GRHS from an outer pattern match. In this case, we begin checking the `case` expression with the covered set of `f`s second clause, which encodes the information that `x` can't be `A` anymore. After this MR, we will successfully warn about the RHS returning 2 being redundant. Perhaps surprisingly, this was a great simplification to the code of both the coverage checker and the desugarer. Found a redundant case alternative in `unix` submodule, so we have to bump it with a fix. Metric Decrease: T12227 - - - - - 59c023ba by Adam Sandberg Ericsson at 2020-02-27T16:23:25-05:00 configure: correctly generate LIBRARY_template_haskell_VERSION - - - - - 9be82389 by Krzysztof Gogolewski at 2020-02-28T02:35:35-05:00 boot: Remove remote origin check Previously, we used relative paths in submodules. When cloning from GitHub, they had to be manually tweaked. Since a76b233d we use absolute paths, so this workaround can be removed. - - - - - f4b6b594 by Ben Gamari at 2020-02-28T02:36:12-05:00 nonmoving: Fix marking in compact regions Previously we were tracing the object we were asked to mark, even if it lives in a compact region. However, there is no need to do this; we need only to mark the region itself as live. I have seen a segfault due to this due to the concurrent mark seeing a an object in the process of being compacted by the mutator. - - - - - f97d1fb6 by Alp Mestanogullari at 2020-02-28T02:36:59-05:00 base: use an explicit import list in System.Environment.ExecutablePath This was making -Werror builds fail on Windows (at least with Hadrian). - - - - - 66f5d6d6 by Simon Peyton Jones at 2020-02-28T22:03:23-05:00 Improve error handling for VTA + deferred type errors This fixes #17792 See Note [VTA for out-of-scope functions] in TcExpr - - - - - 37f12603 by Ilias Tsitsimpis at 2020-02-28T22:04:04-05:00 llvm-targets: Add arm-unknown-linux-gnueabi Add arm-unknown-linux-gnueabi, which is used by Debian's ARM EABI port (armel), as an LLVM target. - - - - - 327b29e1 by Vladislav Zavialov at 2020-02-29T05:06:31-05:00 Monotonic locations (#17632) When GHC is parsing a file generated by a tool, e.g. by the C preprocessor, the tool may insert #line pragmas to adjust the locations reported to the user. As the result, the locations recorded in RealSrcLoc are not monotonic. Elements that appear later in the StringBuffer are not guaranteed to have a higher line/column number. In fact, there are no guarantees whatsoever, as #line pragmas can arbitrarily modify locations. This lack of guarantees makes ideas such as #17544 infeasible. This patch adds an additional bit of information to every SrcLoc: newtype BufPos = BufPos { bufPos :: Int } A BufPos represents the location in the StringBuffer, unaffected by any pragmas. Updates haddock submodule. Metric Increase: haddock.Cabal haddock.base haddock.compiler MultiLayerModules Naperian parsing001 T12150 - - - - - 99d2de86 by Ben Gamari at 2020-02-29T05:07:10-05:00 plugins: Ensure that loadInterface plugins can see annotations loadInterface replaces the `mi_decls`, `mi_insts`, `mi_fam_insts`, `mi_rules`, `mi_anns` fields of ModIface with `undefined` before inserting the interface into the EPS. However, we still want to give loadInterface plugins access to these fields. Consequently, we want to pass the unmodified `ModIface` the plugin. - - - - - a999ee96 by Xavier Denis at 2020-02-29T05:07:50-05:00 Rename ghci.sh and build.sh to ghci and build respectively Convert hadrian buildscripts to unsuffixed, dashed form final cleanups - - - - - b5fb58fd by Ömer Sinan Ağacan at 2020-02-29T05:08:36-05:00 Document and refactor a few things around bitmap scavenging - Added a few comments in StgPAP - Added a few comments and assertions in scavenge_small_bitmap and walk_large_bitmap - Did tiny refactor in GHC.Data.Bitmap: added some comments, deleted dead code, used PlatformWordSize type. - - - - - 18757cab by Sylvain Henry at 2020-02-29T05:09:25-05:00 Refactor runtime interpreter code In #14335 we want to be able to use both the internal interpreter (for the plugins) and the external interpreter (for TH and GHCi) at the same time. This patch performs some preliminary refactoring: the `hsc_interp` field of HscEnv replaces `hsc_iserv` and is now used to indicate which interpreter (internal, external) to use to execute TH and GHCi. Opt_ExternalInterpreter flag and iserv options in DynFlags are now queried only when we set the session DynFlags. It should help making GHC multi-target in the future by selecting an interpreter according to the selected target. - - - - - b86a6395 by Adam Sandberg Ericsson at 2020-02-29T05:10:06-05:00 docs: correct relative links to haddocks from users guide (fixes #17866) - - - - - 0f55df7f by Adam Sandberg Ericsson at 2020-02-29T05:10:06-05:00 docs: correct link to th haddocks from users guide - - - - - 252e5117 by Jean-Baptiste Mazon at 2020-02-29T05:10:46-05:00 rts: enforce POSIX numeric locale for heap profiles - - - - - 34c7d230 by Sylvain Henry at 2020-02-29T05:11:27-05:00 Fix Hadrian's ``--configure`` (fix #17883) - - - - - 04d30137 by Ömer Sinan Ağacan at 2020-02-29T05:12:06-05:00 Simplify IfaceIdInfo type IfaceIdInfo type is confusing: there's practically no difference between `NoInfo` and `HasInfo []`. The comments say NoInfo is used when -fomit-interface-pragmas is enabled, but we don't need to distinguish `NoInfo` from `HasInfo []` in when reading the interface so the distinction is not important. This patch simplifies the type by removing NoInfo. When we have no info we use an empty list. With this change we no longer read the info list lazily when reading an IfaceInfoItem, but when reading an IfaceId the ifIdInfo field is read lazily, so I doubt this is going to be a problem. - - - - - 3979485b by Roland Senn at 2020-02-29T17:36:59+01:00 Show breakpoint locations of breakpoints which were ignored during :force (#2950) GHCi is split up into 2 major parts: The user-interface (UI) and the byte-code interpreter. With `-fexternal-interpreter` they even run in different processes. Communication between the UI and the Interpreter (called `iserv`) is done using messages over a pipe. This is called `Remote GHCI` and explained in the Note [Remote GHCi] in `compiler/ghci/GHCi.hs`. To process a `:force` command the UI sends a `Seq` message to the `iserv` process. Then `iserv` does the effective evaluation of the value. When during this process a breakpoint is hit, the `iserv` process has no additional information to enhance the `Ignoring breakpoint` output with the breakpoint location. To be able to print additional breakpoint information, there are 2 possible implementation choices: 1. Store the needed information in the `iserv` process. 2. Print the `Ignoring breakpoint` from the UI process. For option 1 we need to store the breakpoint info redundantely in 2 places and this is bad. Therfore option 2 was implemented in this MR: - The user enters a `force` command - The UI sends a `Seq` message to the `iserv` process. - If processing of the `Seq` message hits a breakpoint, the `iserv` process returns control to the UI process. - The UI looks up the source location of the breakpoint, and prints the enhanced `Ignoring breakpoint` output. - The UI sends a `ResumeSeq` message to the `iserv` process, to continue forcing. - - - - - 3cf7303b by Krzysztof Gogolewski at 2020-03-02T01:18:33-05:00 Remove dead code * The names in PrelName and THNames are no longer used since TH merged types and kinds, Typeable is kind-polymorphic, .net support was removed * unqualQuasiQuote no longer used since 6f8ff0bbad3b9fa3 - - - - - dbea7e9d by Ilias Tsitsimpis at 2020-03-02T01:19:12-05:00 Do not define hs_atomic{read,write}64() on non-64bit Do not define hs_atomicread64() and hs_atomicwrite64() on machines where WORD_SIZE_IN_BITS is less than 64, just like we do with the rest of the atomic functions which work on 64-bit values. Without this, compilation fails on MIPSel and PowerPC with the following error: /usr/bin/ld: /<<PKGBUILDDIR>>/libraries/ghc-prim/dist-install/build/libHSghc-prim-0.5.3_p.a(atomic.p_o): in function `hs_atomicread64': atomic.c:(.text.hs_atomicread64+0x8): undefined reference to `__sync_add_and_fetch_8' /usr/bin/ld: /<<PKGBUILDDIR>>/libraries/ghc-prim/dist-install/build/libHSghc-prim-0.5.3_p.a(atomic.p_o): in function `hs_atomicwrite64': atomic.c:(.text.hs_atomicwrite64+0x38): undefined reference to `__sync_bool_compare_and_swap_8' Fixes #17886. - - - - - 7c0c76fb by Roland Senn at 2020-03-02T17:13:55-05:00 Set `ImpredicativeTypes` during :print command. (#14828) If ImpredicativeTypes is not enabled, then `:print <term>` will fail if the type of <term> has nested `forall`s or `=>`s. This is because the GHCi debugger's internals will attempt to unify a metavariable with the type of <term> and then display the result, but if the type has nested `forall`s or `=>`s, then unification will fail. As a result, `:print` will bail out and the unhelpful result will be `<term> = (_t1::t1)` (where `t1` is a metavariable). Beware: <term> can have nested `forall`s even if its definition doesn't use RankNTypes! Here is an example from #14828: class Functor f where fmap :: (a -> b) -> f a -> f b Somewhat surprisingly, `:print fmap` considers the type of fmap to have nested foralls. This is because the GHCi debugger sees the type `fmap :: forall f. Functor f => forall a b. (a -> b) -> f a -> f b`. We could envision deeply instantiating this type to get the type `forall f a b. Functor f => (a -> b) -> f a -> f b`, but this trick wouldn't work for higher-rank types. Instead, we adopt a simpler fix: enable `ImpredicativeTypes` when using `:print` and friends in the GHCi debugger. This is allows metavariables to unify with types that have nested (or higher-rank) `forall`s/`=>`s, which makes `:print fmap` display as `fmap = (_t1::forall a b. Functor f => (a -> b) -> f a -> f b)`, as expected. Although ImpredicativeTypes is a somewhat unpredictable from a type inference perspective, there is no danger in using it in the GHCi debugger, since all of the terms that the GHCi debugger deals with have already been typechecked. - - - - - 2a2f51d7 by Sylvain Henry at 2020-03-02T17:14:38-05:00 Use configure script to detect that we should use in-tree GMP on Windows - - - - - 8c663c2c by Andreas Klebinger at 2020-03-04T16:12:14+01:00 Be explicit about how stack usage of mvar primops are covered. This fixes #17893 [skip-ci] - - - - - cedd6f30 by Ben Gamari at 2020-03-05T14:53:12-05:00 rts: Add getCurrentThreadCPUTime helper - - - - - ace618cd by Ben Gamari at 2020-03-05T14:53:12-05:00 nonmoving-gc: Track time usage of nonmoving marking - - - - - 022b5ad5 by Ben Gamari at 2020-03-05T14:53:12-05:00 Stats: Add sync pauses to +RTS -S output - - - - - 06763234 by Ben Gamari at 2020-03-05T14:53:12-05:00 rts: Report nonmoving collector statistics in machine-readable output - - - - - 70d2b995 by Ben Gamari at 2020-03-09T06:10:52-04:00 nonmoving: Fix collection of sparks Previously sparks living in the non-moving heap would be promptly GC'd by the minor collector since pruneSparkQueue uses the BF_EVACUATED flag, which non-moving heap blocks do not have set. Fix this by implementing proper support in pruneSparkQueue for determining reachability in the non-moving heap. The story is told in Note [Spark management in the nonmoving heap]. - - - - - 9668781a by Ben Gamari at 2020-03-09T06:11:30-04:00 gitlab-ci: Disable Sphinx documentation in Alpine build - - - - - 8eb2c263 by Jean-Baptiste Mazon at 2020-03-09T16:33:37-04:00 Fix Windows breakage by not touching locales on Windows - - - - - b8dab057 by Jean-Baptiste Mazon at 2020-03-09T16:33:37-04:00 rts: ensure C numerics in heap profiles using Windows locales if needed - - - - - 7d95260f by Jean-Baptiste Mazon at 2020-03-09T16:33:37-04:00 rts: refactor and comment profile locales - - - - - 5b627813 by Ryan Scott at 2020-03-09T16:34:14-04:00 Use InstanceSigs in GND/DerivingVia-generated code (#17899) Aside from making the generated code easier to read when `-ddump-deriv` is enabled, this makes the error message in `T15073` substantially simpler (see the updated `T15073` expected stderr). Fixes #17899. - - - - - 70b50778 by Ben Gamari at 2020-03-10T02:05:42-04:00 SysTools: Ensure that error parser can handle absolute paths on Windows This fixes #17786, where the error parser fails to correctly handle the drive name in absolute Windows paths. Unfortunately I couldn't find a satisfactory way to test this. - - - - - 85b861d8 by Ben Gamari at 2020-03-10T02:05:42-04:00 testsuite: Add test for #17786 This isn't pretty but it's perhaps better than nothing. - - - - - ee2c50cb by Sylvain Henry at 2020-03-10T02:06:33-04:00 Hadrian: track missing configure results - - - - - ca8f51d4 by Ömer Sinan Ağacan at 2020-03-10T02:07:22-04:00 Add regression test for T17904 Closes #17904 - - - - - 5fa9cb82 by Richard Eisenberg at 2020-03-10T12:29:46-04:00 anyRewritableTyVar now looks in RuntimeReps Previously, anyRewritableTyVar looked only at the arg and res of `arg -> res`, but their RuntimeReps are also subject to rewriting. Easy to fix. Test case: typecheck/should_compile/T17024 Fixes #17024. - - - - - 5ba01d83 by Ben Price at 2020-03-10T12:30:27-04:00 Clarify a Lint message When developing a plugin I had a shadowing problem, where I generated code app = \f{v r7B} x{v r7B} -> f{v r7B} x{v r7B} This is obviously wrong, since the occurrence of `f` to the right of the arrow refers to the `x` binder (they share a Unique). However, it is rather confusing when Lint reports Mismatch in type between binder and occurrence Var: x{v rB7} since it is printing the binder, rather than the occurrence. It is rather easy to read this as claiming there is something wrong with the `x` occurrence! We change the report to explicitly print both the binder and the occurrence variables. - - - - - 7b2c827b by Simon Peyton Jones at 2020-03-10T12:31:15-04:00 Comments only Clarify code added in #17852 and MR !2724 - - - - - 3300eeac by Krzysztof Gogolewski at 2020-03-10T12:31:54-04:00 Misc cleanup - Remove Note [Existentials in shift_con_pat]. The function shift_con_pat has been removed 15 years ago in 23f40f0e9be6d4. - Remove kcLookupTcTyCon - it's the same as tcLookupTcTyCon - Remove ASSERT in tyConAppArgN. It's already done by getNth, and it's the only reason getNth exists. - Remove unused function nextRole - - - - - abf5736b by Krzysztof Gogolewski at 2020-03-10T18:05:01+01:00 Typos in comments [skip ci] - - - - - bb586f89 by Ben Gamari at 2020-03-11T00:14:59-04:00 rts: Prefer darwin-specific getCurrentThreadCPUTime macOS Catalina now supports a non-POSIX-compliant version of clock_gettime which cannot use the clock_gettime codepath. Fixes #17906. - - - - - 20800b9a by Sylvain Henry at 2020-03-11T08:17:19-04:00 Split GHC.Iface.Utils module * GHC.Iface.Recomp: recompilation avoidance stuff * GHC.Iface.Make: mkIface* Moved `writeIfaceFile` into GHC.Iface.Load alongside `readIface` and renamed it `writeIface` for consistency. - - - - - 1daa2029 by Greg Steuck at 2020-03-11T08:17:56-04:00 Fixed a minor typo in codegen.rst - - - - - 0bc23338 by Ryan Scott at 2020-03-11T08:18:32-04:00 Re-quantify when generalising over rewrite rule types Previously, `tcRules` would check for naughty quantification candidates (see `Note [Naughty quantification candidates]` in `TcMType`) when generalising over the type of a rewrite rule. This caused sensible-looking rewrite rules (like those in #17710) to be rejected. A more permissing (and easier-to-implement) approach is to do what is described in `Note [Generalising in tcTyFamInstEqnGuts]` in `TcTyClsDecls`: just re-quantify all the type variable binders, regardless of the order in which the user specified them. After all, the notion of type variable specificity has no real meaning in rewrite rules, since one cannot "visibly apply" a rewrite rule. I have written up this wisdom in `Note [Re-quantify type variables in rules]` in `TcRules`. As a result of this patch, compiling the `ExplicitForAllRules1` test case now generates one fewer warning than it used to. As far as I can tell, this is benign, since the thing that the disappearing warning talked about was also mentioned in an entirely separate warning. Fixes #17710. - - - - - 336eac7e by Ben Gamari at 2020-03-11T08:19:08-04:00 testsuite: Mark ghci056 and ghcilink004 as fragile in unreg As noted in #17018. Also fix fragile declaration of T13786, which only runs in the normal way. - - - - - c61b9b02 by Simon Peyton Jones at 2020-03-11T08:19:44-04:00 Deepen call stack for isIn I see quite a few warnings like: WARNING: file compiler/utils/Util.hs, line 593 Over-long elem in unionLists But the call stack is uninformative. Better to add HasDebugCallStack to isIn. Ditto isn'tIn. - - - - - 3aa9b35f by Ömer Sinan Ağacan at 2020-03-11T08:20:27-04:00 Zero any slop after compaction in compacting GC In copying GC, with the relevant debug flags enabled, we release the old blocks after a GC, and the block allocator zeroes the space before releasing a block. This effectively zeros the old heap. In compacting GC we reuse the blocks and previously we didn't zero the unused space in a compacting generation after compaction. With this patch we zero the slop between the free pointer and the end of the block when we're done with compaction and when switching to a new block (because the current block doesn't have enough space for the next object we're shifting). - - - - - 8e6febce by Sylvain Henry at 2020-03-11T20:33:37-04:00 Refactor GHC.Driver.Session (Ways and Flags) * extract flags and ways into their own modules (with some renaming) * remove one SOURCE import of GHC.Driver.Session from GHC.Driver.Phases * when GHC uses dynamic linking (WayDyn), `interpWays` was only reporting WayDyn even if the host was profiled (WayProf). Now it returns both as expected (might fix #16803). * `mkBuildTag :: [Way] -> String` wasn't reporting a canonical tag for differently ordered lists. Now we sort and nub the list to fix this. - - - - - bc41e471 by Sylvain Henry at 2020-03-11T20:33:37-04:00 Refactor interpreterDynamic and interpreterProfiled * `interpreterDynamic` and `interpreterProfiled` now take `Interp` parameters instead of DynFlags * slight refactoring of `ExternalInterp` so that we can read the iserv configuration (which is pure) without reading an MVar. - - - - - a6989971 by Sylvain Henry at 2020-03-11T20:33:37-04:00 Use a Set to represent Ways Should make `member` queries faster and avoid messing up with missing `nubSort`. Metric Increase: hie002 - - - - - cb93a1a4 by Ryan Scott at 2020-03-11T20:34:14-04:00 Make DeriveFunctor-generated code require fewer beta reductions Issue #17880 demonstrates that `DeriveFunctor`-generated code is surprisingly fragile when rank-_n_ types are involved. The culprit is that `$fmap` (the algorithm used to generate `fmap` implementations) was too keen on applying arguments with rank-_n_ types to lambdas, which fail to typecheck more often than not. In this patch, I change `$fmap` (both the specification and the implementation) to produce code that avoids creating as many lambdas, avoiding problems when rank-_n_ field types arise. See the comments titled "Functor instances" in `TcGenFunctor` for a more detailed description. Not only does this fix #17880, but it also ensures that the code that `DeriveFunctor` generates will continue to work after simplified subsumption is implemented (see #17775). What is truly amazing is that #17880 is actually a regression (introduced in GHC 7.6.3) caused by commit 49ca2a37bef18aa57235ff1dbbf1cc0434979b1e, the fix #7436. Prior to that commit, the version of `$fmap` that was used was almost identical to the one used in this patch! Why did that commit change `$fmap` then? It was to avoid severe performance issues that would arise for recursive `fmap` implementations, such as in the example below: ```hs data List a = Nil | Cons a (List a) deriving Functor -- ===> instance Functor List where fmap f Nil = Nil fmap f (Cons x xs) = Cons (f x) (fmap (\y -> f y) xs) ``` The fact that `\y -> f y` was eta expanded caused significant performance overheads. Commit 49ca2a37bef18aa57235ff1dbbf1cc0434979b1e fixed this performance issue, but it went too far. As a result, this patch partially reverts 49ca2a37bef18aa57235ff1dbbf1cc0434979b1e. To ensure that the performance issues pre-#7436 do not resurface, I have taken some precautionary measures: * I have added a special case to `$fmap` for situations where the last type variable in an application of some type occurs directly. If this special case fires, we avoid creating a lambda expression. This ensures that we generate `fmap f (Cons x xs) = Cons (f x) (fmap f xs)` in the derived `Functor List` instance above. For more details, see `Note [Avoid unnecessary eta expansion in derived fmap implementations]` in `TcGenFunctor`. * I have added a `T7436b` test case to ensure that the performance of this derived `Functor List`-style code does not regress. When implementing this, I discovered that `$replace`, the algorithm which generates implementations of `(<$)`, has a special case that is very similar to the `$fmap` special case described above. `$replace` marked this special case with a custom `Replacer` data type, which was a bit overkill. In order to use the same machinery for both `Functor` methods, I ripped out `Replacer` and instead implemented a simple way to detect the special case. See the updated commentary in `Note [Deriving <$]` for more details. - - - - - 1f9db3e7 by Kirill Elagin at 2020-03-12T09:45:51-04:00 pretty-printer: Properly parenthesise LastStmt After ApplicatveDo strips the last `return` during renaming, the pretty printer has to restore it. However, if the return was followed by `$`, the dollar was stripped too and not restored. For example, the last stamement in: ``` foo = do x <- ... ... return $ f x ``` would be printed as: ``` return f x ``` This commit preserved the dolar, so it becomes: ``` return $ f x ``` - - - - - 5cb93af7 by Kirill Elagin at 2020-03-12T09:45:51-04:00 pretty-printer: Do not print ApplicativeDo join * Do not print `join` in ApplictiveStmt, unless ppr-debug * Print parens around multiple parallel binds When ApplicativeDo is enabled, the renamer analyses the statements of a `do` block and in certain cases marks them as needing to be rewritten using `join`. For example, if you have: ``` foo = do a <- e1 b <- e2 doSomething a b ``` it will be desugared into: ``` foo = join (doSomething <$> e1 <*> e2) ``` After renaming but before desugaring the expression is stored essentially as: ``` foo = do [will need join] (a <- e1 | b <- e2) [no return] doSomething a b ``` Before this change, the pretty printer would print a call to `join`, even though it is not needed at this stage at all. The expression will be actually rewritten into one using join only at desugaring, at which point a literal call to join will be inserted. - - - - - 3a259092 by Simon Peyton Jones at 2020-03-12T09:46:29-04:00 Expose compulsory unfoldings always The unsafeCoerce# patch requires that unsafeCoerce# has a compulsory unfolding that is always available. So we have to be careful to expose compulsory unfoldings unconditionally and consistently. We didn't get this quite right: #17871. This patch fixes it. No real surprises here. See Note [Always expose compulsory unfoldings] in GHC.Iface.Tidy - - - - - 6a65b8c2 by Alp Mestanogullari at 2020-03-13T02:29:20-04:00 hadrian: improve dependency tracking for the check-* programs The code in Rules.Register responsible for finding all the build artifacts that Cabal installs when registering a library (static/shared libs, .hi files, ...) was looking in the wrong place. This patch fixes that logic and makes sure we gather all those artifacts in a list to declare that the rule for a given `.conf` file, our proxy for "Hadrian, please install this package in the package db for this stage", also produces those artifacts under the said package database. We also were completely missing some logic to declare that the check-* programs have dependencies besides their source code, at least when testing an in-tree compiler. Finally, this patch also removes redundant packages from 'testsuitePackages', since they should already be covered by the stage<N>Packages lists from Settings.Default. With this patch, after a complete build and freezing stage 1, a change to `compiler/parser/Parser.y` results in rebuilding the ghc lib, reinstalling it, and rebuilding the few programs that depend on it, _including_ `check-ppr` and `check-api-annotations` (therefore fixing #17273). - - - - - 44fad4a9 by Sylvain Henry at 2020-03-13T02:30:22-04:00 Rename isDllName I wanted to fix the dangling comment in `isDllName` ("This is the cause of #", #8696 is already mentioned earlier). I took the opportunity to change the function name to better reflect what it does. - - - - - 2f292db8 by Paavo at 2020-03-13T02:31:03-04:00 Update documentation for closureSize - - - - - f124ff0d by Ben Gamari at 2020-03-13T02:31:40-04:00 gitlab-ci: Rework triggering of release builds Use a push option instead of tagging. - - - - - 7f25557a by Ben Gamari at 2020-03-13T10:38:09-04:00 gitlab-ci: Distinguish integer-simple test envs Previously two integer-simple jobs declared the same test environment. One (the nightly job) was built in the perf way, the other in the validate way. Consequently they had appreciably different performance characteristics, causing in the nightly job to spuriously fail with performance changes. - - - - - c12a2ec5 by Simon Peyton Jones at 2020-03-14T05:25:30-04:00 Fix Lint Ticket #17590 pointed out a bug in the way the linter dealt with type lets, exposed by the new uniqAway story. The fix is described in Note [Linting type lets]. I ended up putting the in-scope Ids in a different env field, le_ids, rather than (as before) sneaking them into the TCvSubst. Surprisingly tiresome, but done. Metric Decrease: hie002 - - - - - b989845e by Sylvain Henry at 2020-03-14T05:26:11-04:00 Hadrian: fix absolute buildroot support (#17822) Shake's "**" wildcard doesn't match absolute root. We must use "//" instead. - - - - - 4f117135 by Sylvain Henry at 2020-03-14T05:26:49-04:00 Make: refactor GMP rules Document and use simpler rules for the ghc-gmp.h header. - - - - - 7432b327 by Sylvain Henry at 2020-03-14T05:27:28-04:00 Use correct option name (-opti) (fix #17314) s/pgmo/opti - - - - - 8f7dd571 by Judah Jacobson at 2020-03-14T05:28:07-04:00 Allow overriding LD_STAGE0 and AR_STAGE0 in the configure script. Previously it was possible to override the stage0 C compiler via `CC_STAGE0`, but you couldn't override `ld` or `ar` in stage0. This change allows overriding them by setting `LD_STAGE0` or `AR_STAGE0`, respectively. Our team uses this feature internally to take more control of our GHC build and make it run more hermetically. - - - - - 7c3e39a9 by Judah Jacobson at 2020-03-14T05:28:07-04:00 Use AC_ARG_VAR for LD_STAGE0 and AR_STAGE0. - - - - - 20d4d676 by Ben Gamari at 2020-03-14T05:28:43-04:00 nonmoving: Don't traverse filled segment list in pause The non-moving collector would previously walk the entire filled segment list during the preparatory pause. However, this is far more work than is strictly necessary. We can rather get away with merely collecting the allocators' filled segment list heads and process the lists themselves during the concurrent phase. This can significantly reduce the maximum gen1 GC pause time in programs with high rates of long-lived allocations. - - - - - fdfa2d01 by Ben Gamari at 2020-03-14T05:29:18-04:00 nonmoving: Remove redundant bitmap clearing nonmovingSweep already clears the bitmap in the sweep loop. There is no reason to do so a second time. - - - - - 2f8c7767 by Simon Peyton Jones at 2020-03-14T05:29:55-04:00 Simple refactor of cheapEqExpr No change in functionality. Just seems tidier (and signficantly more efficient) to deal with ticks directly than to call stripTicksTopE. - - - - - 88f7a762 by Simon Peyton Jones at 2020-03-14T05:29:55-04:00 Improve CSE.combineAlts This patch improves the way that CSE combines identical alternatives. See #17901. I'm still not happy about the duplication between CSE.combineAlts and GHC.Core.Utils.combineIdenticalAlts; see the Notes with those functions. But this patch is a step forward. Metric Decrease: T12425 T5642 - - - - - 8b95ddd3 by Ben Gamari at 2020-03-14T05:30:31-04:00 gitlab-ci: Add integer-simple release build for Windows Closes #16144. - - - - - e3c374cc by Simon Peyton Jones at 2020-03-14T05:31:07-04:00 Wrap an implication around class-sig kind errors Ticket #17841 showed that we can get a kind error in a class signature, but lack an enclosing implication that binds its skolems. This patch * Adds the wrapping implication: the new call to checkTvConstraints in tcClassDecl1 * Simplifies the API to checkTvConstraints, which was not otherwise called at all. * Simplifies TcErrors.report_unsolved by *not* initialising the TidyEnv from the typechecker lexical envt. It's enough to do so from the free vars of the unsolved constraints; and we get silly renamings if we add variables twice: once from the lexical scope and once from the implication constraint. - - - - - 73133a3b by Simon Peyton Jones at 2020-03-14T05:31:07-04:00 Refactoring in TcSMonad This patch is just refactoring: no change in behaviour. I removed the rather complicated checkConstraintsTcS checkTvConstraintsTcS in favour of simpler functions emitImplicationTcS emitTvImplicationTcS pushLevelNoWorkList The last of these is a little strange, but overall it's much better I think. - - - - - 93c88c26 by Ben Gamari at 2020-03-14T05:31:42-04:00 base: Make `open` calls interruptible As noted in #17912, `open` system calls were `safe` rather than `interruptible`. Consequently, the program could not be interrupted with SIGINT if stuck in a slow open operation. Fix this by marking `c_safe_open` as interruptible. - - - - - bee4cdad by Vladislav Zavialov at 2020-03-14T05:32:18-04:00 Remove second tcLookupTcTyCon in tcDataDefn Before this patch, tcDataDefn used to call tcLookupTcTyCon twice in a row: 1. in bindTyClTyVars itself 2. in the continuation passed to it Now bindTyClTyVars passes the TcTyCon to the continuation, making the second lookup unnecessary. - - - - - 3f116d35 by Cale Gibbard at 2020-03-14T19:34:42-04:00 Enable stage1 build of haddock The submodule has already been bumped to contain the fix. - - - - - 49e9d739 by Ömer Sinan Ağacan at 2020-03-14T19:35:24-04:00 rts: Fix printClosure when printing fwd ptrs - - - - - 1de3ab4a by Krzysztof Gogolewski at 2020-03-14T19:36:04-04:00 Remove unused field var_inline (#17915) - - - - - d30aeb4b by Krzysztof Gogolewski at 2020-03-15T03:57:41-04:00 Document restriction on SCC pragma syntax Currently, the names of cost centres must be quoted or be lowercase identifiers. Fixes #17916. - - - - - b4774598 by Brian Foley at 2020-03-15T03:58:18-04:00 Remove some dead code >From the notes.ghc.drop list found using weeder in #17713 - - - - - dd6ffe6b by Viktor Dukhovni at 2020-03-15T03:58:55-04:00 Note platform-specific Foreign.C.Types in context Also fix the markup in the general note at the top of the module. Haddock (usability trade-off), does not support multi-line emphasised text. - - - - - 2e82465f by Sylvain Henry at 2020-03-15T10:57:10-04:00 Refactor CmmToAsm (disentangle DynFlags) This patch disentangles a bit more DynFlags from the native code generator (CmmToAsm). In more details: - add a new NCGConfig datatype in GHC.CmmToAsm.Config which contains the configuration of a native code generation session - explicitly pass NCGConfig/Platform arguments when necessary - as a consequence `sdocWithPlatform` is gone and there are only a few `sdocWithDynFlags` left - remove the use of `unsafeGlobalDynFlags` from GHC.CmmToAsm.CFG - remove `sdocDebugLevel` (now we pass the debug level via NCGConfig) There are still some places where DynFlags is used, especially because of pretty-printing (CLabel), because of Cmm helpers (such as `cmmExprType`) and because of `Outputable` instance for the instructions. These are left for future refactoring as this patch is already big. - - - - - c35c545d by Judah Jacobson at 2020-03-15T10:57:48-04:00 Add a -no-haddock flag. This flag undoes the effect of a previous "-haddock" flag. Having both flags makes it easier for build systems to enable Haddock parsing in a set of global flags, but then disable it locally for specific targets (e.g., third-party packages whose comments don't pass the validation in the latest GHC). I added the flag to expected-undocumented-flags.txt since `-haddock` was alreadyin that list. - - - - - cfcc3c9a by Ömer Sinan Ağacan at 2020-03-15T10:58:27-04:00 Fix global_link of TSOs for threads reachable via dead weaks Fixes #17785 Here's how the problem occurs: - In generation 0 we have a TSO that is finished (i.e. it has no more work to do or it is killed). - The TSO only becomes reachable after collectDeadWeakPtrs(). - After collectDeadWeakPtrs() we switch to WeakDone phase where we don't move TSOs to different lists anymore (like the next gen's thread list or the resurrected_threads list). - So the TSO will never be moved to a generation's thread list, but it will be promoted to generation 1. - Generation 1 collected via mark-compact, and because the TSO is reachable it is marked, and its `global_link` field, which is bogus at this point (because the TSO is not in a list), will be threaded. - Chaos ensues. In other words, when these conditions hold: - A TSO is reachable only after collectDeadWeakPtrs() - It's finished (what_next is ThreadComplete or ThreadKilled) - It's retained by mark-compact collector (moving collector doesn't evacuate the global_list field) We end up doing random mutations on the heap because the TSO's global_list field is not valid, but it still looks like a heap pointer so we thread it during compacting GC. The fix is simple: when we traverse old_threads lists to resurrect unreachable threads the threads that won't be resurrected currently stays on the old_threads lists. Those threads will never be visited again by MarkWeak so we now reset the global_list fields. This way compacting GC does not thread pointers to nowhere. Testing ------- The reproducer in #17785 is quite large and hard to build, because of the dependencies, so I'm not adding a regression test. In my testing the reproducer would take a less than 5 seconds to run, and once in every ~5 runs would fail with a segfault or an assertion error. In other cases it also fails with a test failure. Because the tests never fail with the bug fix, assuming the code is correct, this also means that this bug can sometimes lead to incorrect runtime results. After the fix I was able to run the reproducer repeatedly for about an hour, with no runtime crashes or test failures. To run the reproducer clone the git repo: $ git clone https://github.com/osa1/streamly --branch ghc-segfault Then clone primitive and atomic-primops from their git repos and point to the clones in cabal.project.local. The project should then be buildable using GHC HEAD. Run the executable `properties` with `+RTS -c -DZ`. In addition to the reproducer above I run the test suite using: $ make slowtest EXTRA_HC_OPTS="-debug -with-rtsopts=-DS \ -with-rtsopts=-c +RTS -c -RTS" SKIPWAY='nonmoving nonmoving_thr' This enables compacting GC always in both GHC when building the test programs and when running the test programs, and also enables sanity checking when running the test programs. These set of flags are not compatible for all tests so there are some failures, but I got the same set of failures with this patch compared to GHC HEAD. - - - - - 818b3c38 by Lysxia at 2020-03-16T23:52:42-04:00 base: add strict IO functions: readFile', getContents', hGetContents' - - - - - 18a346a4 by Sylvain Henry at 2020-03-16T23:53:24-04:00 Modules: Core (#13009) Update submodule: haddock - - - - - 92327e3a by Ömer Sinan Ağacan at 2020-03-16T23:54:04-04:00 Update sanity checking for TSOs: - Remove an invalid assumption about GC checking what_next field. The GC doesn't care about what_next at all, if a TSO is reachable then all its pointers are followed (other than global_tso, which is only followed by compacting GC). - Remove checkSTACK in checkTSO: TSO stacks will be visited in checkHeapChain, or checkLargeObjects etc. - Add an assertion in checkTSO to check that the global_link field is sane. - Did some refactor to remove forward decls in checkGlobalTSOList and added braces around single-statement if statements. - - - - - e1aa4052 by PHO at 2020-03-17T07:36:09-04:00 Don't use non-portable operator "==" in configure.ac The test operator "==" is a Bash extension and produces a wrong result if /bin/sh is not Bash. - - - - - 89f034dd by Maximilian Tagher at 2020-03-17T07:36:48-04:00 Document the units of -ddump-timings Right now, in the output of -ddump-timings to a file, you can't tell what the units are: ``` CodeGen [TemplateTestImports]: alloc=22454880 time=14.597 ``` I believe bytes/milliseconds are the correct units, but confirmation would be appreciated. I'm basing it off of this snippet from `withTiming'`: ``` when (verbosity dflags >= 2 && prtimings == PrintTimings) $ liftIO $ logInfo dflags (defaultUserStyle dflags) (text "!!!" <+> what <> colon <+> text "finished in" <+> doublePrec 2 time <+> text "milliseconds" <> comma <+> text "allocated" <+> doublePrec 3 (realToFrac alloc / 1024 / 1024) <+> text "megabytes") ``` which implies time is in milliseconds, and allocations in bytes (which divided by 1024 would be KB, and again would be MB) - - - - - beffa147 by Simon Peyton Jones at 2020-03-17T07:37:25-04:00 Implement mapTyCo like foldTyCo This patch makes mapType use the successful idiom described in TyCoRep Note [Specialising foldType] I have not yet changed any functions to use mapType, though there may be some suitable candidates. This patch should be a no-op in terms of functionality but, because it inlines the mapper itself, I'm hoping that there may be some modest perf improvements. Metric Decrease: T5631 T5642 T3064 T9020 T14683 hie002 haddock.Cabal haddock.base haddock.compiler - - - - - 5800ebfe by Ömer Sinan Ağacan at 2020-03-17T07:38:08-04:00 Don't update ModDetails with CafInfos when opts are disabled This is consistent with the interface file behavior where we omit HsNoCafRefs annotations with -fomit-interface-pragmas (implied by -O0). ModDetails and ModIface are just different representations of the same thing, so they really need to be in sync. This patch does the right thing and does not need too much explanation, but here's an example of a problem not doing this causes in !2842: -- MyInteger.hs module MyInteger ( MyInteger (MyInteger) , ToMyInteger (toMyInteger) ) where newtype MyInteger = MyInteger Integer class ToMyInteger a where toMyInteger :: a -> MyInteger instance ToMyInteger Integer where toMyInteger = MyInteger {- . succ -} -- Main.hs module Main ( main ) where import MyInteger (MyInteger (MyInteger), toMyInteger) main :: IO () main = do let (MyInteger i) = (id . toMyInteger) (41 :: Integer) print i If I build this with -O0, without this fix, we generate a ModDetails with accurate LFInfo for toMyInteger (MyInteger.$fToMyIntegerInteger) which says that it's a LFReEntrant with arity 1. This means in the use site (Main) we tag the value: R3 = MyInteger.$fToMyIntegerInteger_closure + 1; R2 = GHC.Base.id_closure; R1 = GHC.Base.._closure; Sp = Sp - 16; call stg_ap_ppp_fast(R4, R3, R2, R1) args: 24, res: 0, upd: 24; Now we change the definition by uncommenting the `succ` part and it becomes a thunk: MyInteger.$fToMyIntegerInteger [InlPrag=INLINE (sat-args=0)] :: MyInteger.ToMyInteger GHC.Integer.Type.Integer [GblId[DFunId(nt)]] = {} \u [] $ctoMyInteger_rEA; and its LFInfo is now LFThunk. This change in LFInfo makes a difference in the use site: we can no longer tag it. But becuase the interface fingerprint does not change (because ModIface does not change) we don't rebuild Main and tag the thunk. (1.2% increase in allocations when building T12545 on armv7 because we generate more code without CafInfos) Metric Increase: T12545 - - - - - 5b632dad by Paavo at 2020-03-17T07:38:48-04:00 Add example for Data.Semigroup.diff - - - - - 4d85d68b by Paavo at 2020-03-17T07:38:48-04:00 Clean up - - - - - 75168d07 by Paavo at 2020-03-17T07:38:48-04:00 Make example collapsible - - - - - 53ff2cd0 by Richard Eisenberg at 2020-03-17T13:46:57+00:00 Fix #17021 by checking more return kinds All the details are in new Note [Datatype return kinds] in TcTyClsDecls. Test case: typecheck/should_fail/T17021{,b} typecheck/should_compile/T17021a Updates haddock submodule - - - - - 528df8ec by Sylvain Henry at 2020-03-18T10:06:43-04:00 Modules: Core operations (#13009) - - - - - 4e8a71c1 by Richard Eisenberg at 2020-03-18T10:07:19-04:00 Add release note about fix to #16502. We thought we needed to update the manual, but the fix for #16502 actually brings the implementation in line with the manual. So we just alert users of how to update their code. - - - - - 5cbf9934 by Andreas Klebinger at 2020-03-19T00:39:27-04:00 Update "GHC differences to the FFI Chapter" in user guide. The old entry had a heavy focus on how things had been. Which is not what I generally look for in a user guide. I also added a small section on behaviour of nested safe ffi calls. [skip-ci] - - - - - b03fd3bc by Sebastian Graf at 2020-03-19T00:40:06-04:00 PmCheck: Use ConLikeSet to model negative info In #17911, Simon recognised many warnings stemming from over-long list unions while coverage checking Cabal's `LicenseId` module. This patch introduces a new `PmAltConSet` type which uses a `UniqDSet` instead of an association list for `ConLike`s. For `PmLit`s, it will still use an assocation list, though, because a similar map data structure would entail a lot of busy work. Fixes #17911. - - - - - 64f20756 by Sylvain Henry at 2020-03-19T12:16:49-04:00 Refactoring: use Platform instead of DynFlags when possible Metric Decrease: ManyConstructors T12707 T13035 T1969 - - - - - cb1785d9 by Ömer Sinan Ağacan at 2020-03-19T12:16:54-04:00 FastString: fix eager reading of string ptr in hashStr This read causes NULL dereferencing when len is 0. Fixes #17909 In the reproducer in #17909 this bug is triggered as follows: - SimplOpt.dealWithStringLiteral is called with a single-char string ("=" in #17909) - tailFS gets called on the FastString of the single-char string. - tailFS checks the length of the string, which is 1, and calls mkFastStringByteString on the tail of the ByteString, which is an empty ByteString as the original ByteString has only one char. - ByteString's unsafeUseAsCStringLen returns (NULL, 0) for the empty ByteString, which is passed to mkFastStringWith. - mkFastStringWith gets hash of the NULL pointer via hashStr, which fails on empty strings because of this bug. - - - - - 73a7383e by Richard Eisenberg at 2020-03-20T20:42:56-04:00 Simplify treatment of heterogeneous equality Previously, if we had a [W] (a :: k1) ~ (rhs :: k2), we would spit out a [D] k1 ~ k2 and part the W as irreducible, hoping for a unification. But we needn't do this. Instead, we now spit out a [W] co :: k2 ~ k1 and then use co to cast the rhs of the original Wanted. This means that we retain the connection between the spat-out constraint and the original. The problem with this new approach is that we cannot use the casted equality for substitution; it's too like wanteds-rewriting- wanteds. So, we forbid CTyEqCans that mention coercion holes. All the details are in Note [Equalities with incompatible kinds] in TcCanonical. There are a few knock-on effects, documented where they occur. While debugging an error in this patch, Simon and I ran into infelicities in how patterns and matches are printed; we made small improvements. This patch includes mitigations for #17828, which causes spurious pattern-match warnings. When #17828 is fixed, these lines should be removed. - - - - - faa36e5b by Sylvain Henry at 2020-03-20T20:43:41-04:00 Hadrian: ignore in-tree GMP objects with ``--lint`` - - - - - 9a96ff6b by Richard Eisenberg at 2020-03-20T20:44:17-04:00 Update core spec to reflect changes to Core. Key changes: * Adds a new rule for forall-coercions over coercion variables, which was implemented but conspicuously missing from the spec. * Adds treatment for FunCo. * Adds treatment for ForAllTy over coercion variables. * Improves commentary (including restoring a Note lost in 03d4852658e1b7407abb4da84b1b03bfa6f6db3b) in the source. No changes to running code. - - - - - 7e0451c6 by Sergej Jaskiewicz at 2020-03-20T20:44:55-04:00 Fix event message in withTiming' This typo caused generating 'end' events without the corresponding 'begin' events. - - - - - 1542a626 by Ben Gamari at 2020-03-22T22:37:47-04:00 fs.h: Add missing declarations on Windows - - - - - 3bcf2ccd by Ben Gamari at 2020-03-22T22:37:47-04:00 Bump process submodule Avoids redundant case alternative warning. - - - - - 3b363ef9 by Ben Gamari at 2020-03-22T22:37:47-04:00 testsuite: Normalize slashes in ghc-api annotations output Enable `normalise_slashes` on `annotations`, `listcomps`, and `parseTree` to fix Windows failures. - - - - - 25fc9429 by Ben Gamari at 2020-03-22T22:37:47-04:00 testsuite: Update expected output on Windows - - - - - 7f58ec6d by Ben Gamari at 2020-03-22T22:37:47-04:00 testsuite: Fix TOP of T17786 - - - - - aadcd909 by GHC GitLab CI at 2020-03-22T22:37:47-04:00 testsuite: Update expected output on Windows - - - - - dc1eb10d by GHC GitLab CI at 2020-03-22T22:37:47-04:00 hadrian: Fix executable extension passed to testsuite driver - - - - - 58f62e2c by GHC GitLab CI at 2020-03-22T22:37:47-04:00 gitlab-ci: Require that Windows-hadrian job passes - - - - - 8dd2415d by Ben Gamari at 2020-03-22T22:37:47-04:00 hadrian: Eliminate redundant .exe from GHC path Previously we were invoking: bash -c "c:/GitLabRunner/builds/eEQrxK4p/0/ghc/ghc/toolchain/bin/ghc.exe.exe testsuite/mk/ghc-config.hs -o _build/test/bin/ghc-config.exe" - - - - - 373621f6 by Ben Gamari at 2020-03-22T22:37:47-04:00 Bump hsc2hs submodule - - - - - abc02b40 by Hécate at 2020-03-22T22:38:33-04:00 Annotate the non-total function in Data.Foldable as such - - - - - 19f12557 by Josef Svenningsson at 2020-03-23T14:05:33-04:00 Fix ApplicativeDo regression #17835 A previous fix for #15344 made sure that monadic 'fail' is used properly when translating ApplicativeDo. However, it didn't properly account for when a 'fail' will be inserted which resulted in some programs failing with a type error. - - - - - 2643ba46 by Paavo at 2020-03-24T08:31:32-04:00 Add example and doc for Arg (Fixes #17153) - - - - - 703221f4 by Roland Senn at 2020-03-25T14:45:04-04:00 Use export list of Main module in function TcRnDriver.hs:check_main (Fix #16453) - Provide the export list of the `Main` module as parameter to the `compiler/typecheck/TcRnDriver.hs:check_main` function. - Instead of `lookupOccRn_maybe` call the function `lookupInfoOccRn`. It returns the list `mains_all` of all the main functions in scope. - Select from this list `mains_all` all `main` functions that are in the export list of the `Main` module. - If this new list contains exactly one single `main` function, then typechecking continues. - Otherwise issue an appropriate error message. - - - - - 3e27205a by Sebastian Graf at 2020-03-25T14:45:40-04:00 Remove -fkill-absence and -fkill-one-shot flags They seem to be a benchmarking vestige of the Cardinality paper and probably shouldn't have been merged to HEAD in the first place. - - - - - 262e42aa by Peter Trommler at 2020-03-25T22:41:39-04:00 Do not panic on linker errors - - - - - 0de03cd7 by Sylvain Henry at 2020-03-25T22:42:02-04:00 DynFlags refactoring III Use Platform instead of DynFlags when possible: * `tARGET_MIN_INT` et al. replaced with `platformMinInt` et al. * no more DynFlags in PreRules: added a new `RuleOpts` datatype * don't use `wORD_SIZE` in the compiler * make `wordAlignment` use `Platform` * make `dOUBLE_SIZE` a constant Metric Decrease: T13035 T1969 - - - - - 7a04920b by Tristan Cacqueray at 2020-03-25T22:42:06-04:00 Base: fix a typo in liftA doc This change removes an extra '|' that should not be rendered in the liftA documentation. Tracking: #17929 - - - - - 1c5a15f7 by Tristan Cacqueray at 2020-03-25T22:42:06-04:00 Base: add Control.Applicative optional example This change adds an optional example. Tracking: #17929 - - - - - 6d172e63 by Tristan Cacqueray at 2020-03-25T22:42:06-04:00 Base: add markup around Except - - - - - eb2162c8 by John Ericson at 2020-03-26T12:37:08-04:00 Remove unused `ghciTablesNextToCode` from compiler proper - - - - - f51efc4b by Joachim Breitner at 2020-03-26T12:37:09-04:00 Prepare to use run-time tablesNextToCode in compiler exclusively Factor out CPP as much as possible to prepare for runtime determinattion. Progress towards #15548 - - - - - 1c446220 by Joachim Breitner at 2020-03-26T12:37:09-04:00 Use run-time tablesNextToCode in compiler exclusively (#15548) Summary: - There is no more use of the TABLES_NEXT_TO_CODE CPP macro in `compiler/`. GHCI_TABLES_NEXT_TO_CODE is also removed entirely. The field within `PlatformMisc` within `DynFlags` is used instead. - The field is still not exposed as a CLI flag. We might consider some way to ensure the right RTS / libraries are used before doing that. Original reviewers: Original subscribers: TerrorJack, rwbarton, carter Original Differential Revision: https://phabricator.haskell.org/D5082 - - - - - 1941ef4f by Sylvain Henry at 2020-03-29T17:28:51-04:00 Modules: Types (#13009) Update Haddock submodule Metric Increase: haddock.compiler - - - - - 1c7c6f1a by Sylvain Henry at 2020-03-29T17:28:51-04:00 Remove GHC.Types.Unique.Map module This module isn't used anywhere in GHC. - - - - - f1a6c73d by Sylvain Henry at 2020-03-29T17:28:51-04:00 Merge GHC.Types.CostCentre.Init into GHC.Driver.CodeOutput - - - - - 54250f2d by Simon Peyton Jones at 2020-03-29T17:29:30-04:00 Demand analysis: simplify the demand for a RHS Ticket #17932 showed that we were using a stupid demand for the RHS of a let-binding, when the result is a product. This was the result of a "fix" in 2013, which (happily) turns out to no longer be necessary. So I just deleted the code, which simplifies the demand analyser, and fixes #17932. That in turn uncovered that the anticipation of worker/wrapper in CPR analysis was inaccurate, hence the logic that decides whether to unbox an argument in WW was extracted into a function `wantToUnbox`, now consulted by CPR analysis. I tried nofib, and got 0.0% perf changes. All this came up when messing about with !2873 (ticket #17917), but is idependent of it. Unfortunately, this patch regresses #4267 and realised that it is now blocked on #16335. - - - - - 03060b2f by Ben Gamari at 2020-03-29T17:30:05-04:00 testsuite: Fix T17786 on Windows Fixes line ending normalization issue. - - - - - 1f7995ba by Ben Gamari at 2020-03-29T17:30:05-04:00 testsuite: Fix T17786 Fix missing quoting and expected exit code. - - - - - ef9c608e by Ben Gamari at 2020-03-29T17:30:05-04:00 testsuite: Mark T12971 as broken on Windows Due to #17945. - - - - - e54500c1 by Sylvain Henry at 2020-03-29T17:30:47-04:00 Store ComponentId details As far as GHC is concerned, installed package components ("units") are identified by an opaque ComponentId string provided by Cabal. But we don't want to display it to users (as it contains a hash) so GHC queries the database to retrieve some infos about the original source package (name, version, component name). This patch caches these infos in the ComponentId itself so that we don't need to provide DynFlags (which contains installed package informations) to print a ComponentId. In the future we want GHC to support several independent package states (e.g. for plugins and for target code), hence we need to avoid implicitly querying a single global package state. - - - - - 7e7cb714 by Marius Bakke at 2020-03-29T17:31:27-04:00 testsuite: Remove test that dlopens a PIE object. glibc 2.30 disallowed dlopening PIE objects, so just remove the test. Fixes #17952. - - - - - 6c8f80d8 by Andreas Klebinger at 2020-03-29T17:32:04-04:00 Correct haddocks for testBit in Data.Bits It conflated the nth bit with the bit at offset n. Now we instead give the definition in terms of `bit and `.&.` on top of clearer phrasing. - - - - - c916f190 by Andreas Klebinger at 2020-03-29T17:32:04-04:00 Apply suggestion to libraries/base/Data/Bits.hs - - - - - 64bf7f51 by Ben Gamari at 2020-03-29T17:32:41-04:00 gitlab-ci: Add FreeBSD release job - - - - - a0d8e92e by Ryan Scott at 2020-03-29T17:33:20-04:00 Run checkNewDataCon before constraint-solving newtype constructors Within `checkValidDataCon`, we used to run `checkValidType` on the argument types of a newtype constructor before running `checkNewDataCon`, which ensures that the user does not attempt non-sensical things such as newtypes with multiple arguments or constraints. This works out in most situations, but this falls over on a corner case revealed in #17955: ```hs newtype T = Coercible () T => T () ``` `checkValidType`, among other things, peforms an ambiguity check on the context of a data constructor, and that it turn invokes the constraint solver. It turns out that there is a special case in the constraint solver for representational equalities (read: `Coercible` constraints) that causes newtypes to be unwrapped (see `Note [Unwrap newtypes first]` in `TcCanonical`). This special case does not know how to cope with an ill formed newtype like `T`, so it ends up panicking. The solution is surprisingly simple: just invoke `checkNewDataCon` before `checkValidType` to ensure that the illicit newtype constructor context is detected before the constraint solver can run amok with it. Fixes #17955. - - - - - 45eb9d8c by Krzysztof Gogolewski at 2020-03-29T17:33:59-04:00 Minor cleanup - Simplify mkBuildExpr, the function newTyVars was called only on a one-element list. - TTG: use noExtCon in more places. This is more future-proof. - In zonkExpr, panic instead of printing a warning. - - - - - f024b6e3 by Sylvain Henry at 2020-03-30T12:48:39+02:00 Expect T4267 to pass Since 54250f2d8de910b094070c1b48f086030df634b1 we expected T4267 to fail, but it passes on CI. - - - - - 57b888c0 by Ryan Scott at 2020-03-31T10:54:20-04:00 Require GHC 8.8 as the minimum compiler for bootstrapping This allows us to remove several bits of CPP that are either always true or no longer reachable. As an added bonus, we no longer need to worry about importing `Control.Monad.Fail.fail` qualified to avoid clashing with `Control.Monad.fail`, since the latter is now the same as the former. - - - - - 33f09551 by Ryan Scott at 2020-03-31T10:54:57-04:00 Add regression test for #17963 The panic in #17963 happened to be fixed by commit e3c374cc5bd7eb49649b9f507f9f7740697e3f70. This patch adds a regression test to ensure that it remains fixed. Fixes #17963. - - - - - 09a36e80 by Ömer Sinan Ağacan at 2020-03-31T10:55:37-04:00 Simplify stderrSupportsAnsiColors The combinator andM is used only once, and the code is shorter and simpler if you inline it. - - - - - 95bccdd0 by Ben Gamari at 2020-03-31T10:56:19-04:00 base: Ensure that encoding global variables aren't inlined As noted in #17970, these (e.g. `getFileSystemEncoding` and `setFileSystemEncoding`) previously had unfoldings, which would break their global-ness. While not strictly necessary, I also add a NOINLINE on `initLocaleEncoding` since it is used in `System.IO`, ensuring that we only system's query the locale encoding once. Fixes #17970. - - - - - 982aaa83 by Andreas Klebinger at 2020-03-31T10:56:55-04:00 Update hadrian index revision. Required in order to build hadrian using ghc-8.10 - - - - - 4b9c5864 by Ben Gamari at 2020-03-31T10:57:32-04:00 integer-gmp: Bump version and add changelog entry - - - - - 9b39f2e6 by Ryan Scott at 2020-04-01T01:20:00-04:00 Clean up "Eta reduction for data families" Notes Before, there were two distinct Notes named "Eta reduction for data families". This renames one of them to "Implementing eta reduction for data families" to disambiguate the two and fixes references in other parts of the codebase to ensure that they are pointing to the right place. Fixes #17313. [ci skip] - - - - - 7627eab5 by Ryan Scott at 2020-04-01T01:20:38-04:00 Fix the changelog/@since information for hGetContents'/getContents'/readFile' Fixes #17979. [ci skip] - - - - - 0002db1b by Sylvain Henry at 2020-04-01T01:21:27-04:00 Kill wORDS_BIGENDIAN and replace it with platformByteOrder (#17957) Metric Decrease: T13035 T1969 - - - - - 7b217179 by Sebastian Graf at 2020-04-01T15:03:24-04:00 PmCheck: Adjust recursion depth for inhabitation test In #17977, we ran into the reduction depth limit of the typechecker. That was only a symptom of a much broader issue: The recursion depth of the coverage checker for trying to instantiate strict fields in the `nonVoid` test was far too high (100, the `defaultMaxTcBound`). As a result, we were performing quite poorly on `T17977`. Short of a proper termination analysis to prove emptyness of a type, we just arbitrarily default to a much lower recursion limit of 3. Fixes #17977. - - - - - 3c09f636 by Andreas Klebinger at 2020-04-01T15:03:59-04:00 Make hadrian pass on the no-colour setting to GHC. Fixes #17983. - - - - - b943b25d by Simon Peyton Jones at 2020-04-02T01:45:58-04:00 Re-engineer the binder-swap transformation The binder-swap transformation is implemented by the occurrence analyser -- see Note [Binder swap] in OccurAnal. However it had a very nasty corner in it, for the case where the case scrutinee was a GlobalId. This led to trouble and hacks, and ultimately to #16296. This patch re-engineers how the occurrence analyser implements the binder-swap, by actually carrying out a substitution rather than by adding a let-binding. It's all described in Note [The binder-swap substitution]. I did a few other things along the way * Fix a bug in StgCse, which could allow a loop breaker to be CSE'd away. See Note [Care with loop breakers] in StgCse. I think it can only show up if occurrence analyser sets up bad loop breakers, but still. * Better commenting in SimplUtils.prepareAlts * A little refactoring in CoreUnfold; nothing significant e.g. rename CoreUnfold.mkTopUnfolding to mkFinalUnfolding * Renamed CoreSyn.isFragileUnfolding to hasCoreUnfolding * Move mkRuleInfo to CoreFVs We observed respectively 4.6% and 5.9% allocation decreases for the following tests: Metric Decrease: T9961 haddock.base - - - - - 42d68364 by Sebastian Graf at 2020-04-02T01:46:34-04:00 Preserve precise exceptions in strictness analysis Fix #13380 and #17676 by 1. Changing `raiseIO#` to have `topDiv` instead of `botDiv` 2. Give it special treatment in `Simplifier.Util.mkArgInfo`, treating it as if it still had `botDiv`, to recover dead code elimination. This is the first commit of the plan outlined in https://gitlab.haskell.org/ghc/ghc/-/merge_requests/2525#note_260886. - - - - - 0a88dd11 by Ömer Sinan Ağacan at 2020-04-02T01:47:25-04:00 Fix a pointer format string in RTS - - - - - 5beac042 by Ömer Sinan Ağacan at 2020-04-02T01:48:05-04:00 Remove unused closure stg_IND_direct - - - - - 88f38b03 by Ben Gamari at 2020-04-02T01:48:42-04:00 Session: Memoize stderrSupportsAnsiColors Not only is this a reasonable efficiency measure but it avoids making reentrant calls into ncurses, which is not thread-safe. See #17922. - - - - - 27740f24 by Ryan Scott at 2020-04-02T01:49:21-04:00 Make Hadrian build with Cabal-3.2 GHC 8.10 ships with `Cabal-3.2.0.0`, so it would be convenient to make Hadrian supporting building against 3.2.* instead of having to rebuild the entirety of `Cabal-3.0.0.0`. There is one API change in `Cabal-3.2.*` that affects Hadrian: the `synopsis` and `description` functions now return `ShortText` instead of `String`. Since Hadrian manipulates these `String`s in various places, I found that the simplest fix was to use CPP to convert `ShortText` to `String`s where appropriate. - - - - - 49802002 by Sylvain Henry at 2020-04-02T01:50:00-04:00 Update Stack resolver for hadrian/build-stack Broken by 57b888c0e90be7189285a6b078c30b26d0923809 - - - - - 30a63e79 by Ryan Scott at 2020-04-02T01:50:36-04:00 Fix two ASSERT buglets in reifyDataCon Two `ASSERT`s in `reifyDataCon` were always using `arg_tys`, but `arg_tys` is not meaningful for GADT constructors. In fact, it's worse than non-meaningful, since using `arg_tys` when reifying a GADT constructor can lead to failed `ASSERT`ions, as #17305 demonstrates. This patch applies the simplest possible fix to the immediate problem. The `ASSERT`s now use `r_arg_tys` instead of `arg_tys`, as the former makes sure to give something meaningful for GADT constructors. This makes the panic go away at the very least. There is still an underlying issue with the way the internals of `reifyDataCon` work, as described in https://gitlab.haskell.org/ghc/ghc/issues/17305#note_227023, but we leave that as future work, since fixing the underlying issue is much trickier (see https://gitlab.haskell.org/ghc/ghc/issues/17305#note_227087). - - - - - ef7576c4 by Zubin Duggal at 2020-04-03T06:24:56-04:00 Add outputable instances for the types in GHC.Iface.Ext.Types, add -ddump-hie flag to dump pretty printed contents of the .hie file Metric Increase: hie002 Because of the regression on i386: compile_time/bytes allocated increased from i386-linux-deb9 baseline @ HEAD~10: Expected hie002 (normal) compile_time/bytes allocated: 583014888.0 +/-10% Lower bound hie002 (normal) compile_time/bytes allocated: 524713399 Upper bound hie002 (normal) compile_time/bytes allocated: 641316377 Actual hie002 (normal) compile_time/bytes allocated: 877986292 Deviation hie002 (normal) compile_time/bytes allocated: 50.6 % *** unexpected stat test failure for hie002(normal) - - - - - 9462452a by Andreas Klebinger at 2020-04-03T06:25:33-04:00 Improve and refactor StgToCmm codegen for DataCons. We now differentiate three cases of constructor bindings: 1)Bindings which we can "replace" with a reference to an existing closure. Reference the replacement closure when accessing the binding. 2)Bindings which we can "replace" as above. But we still generate a closure which will be referenced by modules importing this binding. 3)For any other binding generate a closure. Then reference it. Before this patch 1) did only apply to local bindings and we didn't do 2) at all. - - - - - a214d214 by Moritz Bruder at 2020-04-03T06:26:11-04:00 Add singleton to NonEmpty in libraries/base This adds a definition to construct a singleton non-empty list (Data.List.NonEmpty) according to issue #17851. - - - - - f7597aa0 by Sylvain Henry at 2020-04-03T06:26:54-04:00 Testsuite: measure compiler stats for T16190 We were mistakenly measuring program stats - - - - - a485c3c4 by Sylvain Henry at 2020-04-03T06:26:54-04:00 Move blob handling into StgToCmm Move handling of big literal strings from CmmToAsm to StgToCmm. It avoids the use of `sdocWithDynFlags` (cf #10143). We might need to move this handling even higher in the pipeline in the future (cf #17960): this patch will make it easier. - - - - - cc2918a0 by Sylvain Henry at 2020-04-03T06:26:54-04:00 Refactor CmmStatics In !2959 we noticed that there was some redundant code (in GHC.Cmm.Utils and GHC.Cmm.StgToCmm.Utils) used to deal with `CmmStatics` datatype (before SRT generation) and `RawCmmStatics` datatype (after SRT generation). This patch removes this redundant code by using a single GADT for (Raw)CmmStatics. - - - - - 9e60273d by Maxim Koltsov at 2020-04-03T06:27:32-04:00 Fix haddock formatting in Control.Monad.ST.Lazy.Imp.hs - - - - - 1b7e8a94 by Andreas Klebinger at 2020-04-03T06:28:08-04:00 Turn newlines into spaces for hadrian/ghci. The newlines break the command on windows. - - - - - 4291bdda by Simon Peyton Jones at 2020-04-03T06:28:44-04:00 Major improvements to the specialiser This patch is joint work of Alexis King and Simon PJ. It does some significant refactoring of the type-class specialiser. Main highlights: * We can specialise functions with types like f :: Eq a => a -> Ord b => b => blah where the classes aren't all at the front (#16473). Here we can correctly specialise 'f' based on a call like f @Int @Bool dEqInt x dOrdBool This change really happened in an earlier patch commit 2d0cf6252957b8980d89481ecd0b79891da4b14b Author: Sandy Maguire <sandy at sandymaguire.me> Date: Thu May 16 12:12:10 2019 -0400 work that this new patch builds directly on that work, and refactors it a bit. * We can specialise functions with implicit parameters (#17930) g :: (?foo :: Bool, Show a) => a -> String Previously we could not, but now they behave just like a non-class argument as in 'f' above. * We can specialise under-saturated calls, where some (but not all of the dictionary arguments are provided (#17966). For example, we can specialise the above 'f' based on a call map (f @Int dEqInt) xs even though we don't (and can't) give Ord dictionary. This may sound exotic, but #17966 is a program from the wild, and showed significant perf loss for functions like f, if you need saturation of all dictionaries. * We fix a buglet in which a floated dictionary had a bogus demand (#17810), by using zapIdDemandInfo in the NonRec case of specBind. * A tiny side benefit: we can drop dead arguments to specialised functions; see Note [Drop dead args from specialisations] * Fixed a bug in deciding what dictionaries are "interesting"; see Note [Keep the old dictionaries interesting] This is all achieved by by building on Sandy Macguire's work in defining SpecArg, which mkCallUDs uses to describe the arguments of the call. Main changes: * Main work is in specHeader, which marched down the [InBndr] from the function definition and the [SpecArg] from the call site, together. * specCalls no longer has an arity check; the entire mechanism now handles unders-saturated calls fine. * mkCallUDs decides on an argument-by-argument basis whether to specialise a particular dictionary argument; this is new. See mk_spec_arg in mkCallUDs. It looks as if there are many more lines of code, but I think that all the extra lines are comments! - - - - - 40a85563 by Ömer Sinan Ağacan at 2020-04-03T18:26:19+03:00 Revert accidental change in 9462452 [ci skip] - - - - - bd75e5da by Ryan Scott at 2020-04-04T07:07:58-04:00 Enable ImpredicativeTypes internally when typechecking selector bindings This is necessary for certain record selectors with higher-rank types, such as the examples in #18005. See `Note [Impredicative record selectors]` in `TcTyDecls`. Fixes #18005. - - - - - dcfe29c8 by Ömer Sinan Ağacan at 2020-04-06T13:16:08-04:00 Don't override proc CafInfos in ticky builds Fixes #17947 When we have a ticky label for a proc, IdLabels for the ticky counter and proc entry share the same Name. This caused overriding proc CafInfos with the ticky CafInfos (i.e. NoCafRefs) during SRT analysis. We now ignore the ticky labels when building SRTMaps. This makes sense because: - When building the current module they don't need to be in SRTMaps as they're initialized as non-CAFFY (see mkRednCountsLabel), so they don't take part in the dependency analysis and they're never added to SRTs. (Reminder: a "dependency" in the SRT analysis is a CAFFY dependency, non-CAFFY uses are not considered as dependencies for the algorithm) - They don't appear in the interfaces as they're not exported, so it doesn't matter for cross-module concerns whether they're in the SRTMap or not. See also the new Note [Ticky labels in SRT analysis]. - - - - - cec2c71f by Simon Peyton Jones at 2020-04-06T13:16:44-04:00 Fix an tricky specialiser loop Issue #17151 was a very tricky example of a bug in which the specialiser accidentally constructs a recurive dictionary, so that everything turns into bottom. I have fixed variants of this bug at least twice before: see Note [Avoiding loops]. It was a bit of a struggle to isolate the problem, greatly aided by the work that Alexey Kuleshevich did in distilling a test case. Once I'd understood the problem, it was not difficult to fix, though it did lead me a bit of refactoring in specImports. - - - - - e850d14f by Simon Peyton Jones at 2020-04-06T13:16:44-04:00 Refactoring only This refactors DictBinds into a data type rather than a pair. No change in behaviour, just better code - - - - - f38e8d61 by Daniel Gröber at 2020-04-07T02:00:05-04:00 rts: ProfHeap: Fix memory leak when not compiled with profiling If we're doing heap profiling on an unprofiled executable we keep allocating new space in initEra via nextEra on each profiler run but we don't have a corresponding freeEra call. We do free the last era in endHeapProfiling but previous eras will have been overwritten by initEra and will never get free()ed. Metric Decrease: space_leak_001 - - - - - bcd66859 by Sebastian Graf at 2020-04-07T02:00:41-04:00 Re-export GHC.Magic.noinline from base - - - - - 3d2991f8 by Ben Gamari at 2020-04-07T18:36:09-04:00 simplifier: Kill off ufKeenessFactor We used to have another factor, ufKeenessFactor, which would scale the discounts before they were subtracted from the size. This was justified with the following comment: -- We multiple the raw discounts (args_discount and result_discount) -- ty opt_UnfoldingKeenessFactor because the former have to do with -- *size* whereas the discounts imply that there's some extra -- *efficiency* to be gained (e.g. beta reductions, case reductions) -- by inlining. However, this is highly suspect since it means that we subtract a *scaled* size from an absolute size, resulting in crazy (e.g. negative) scores in some cases (#15304). We consequently killed off ufKeenessFactor and bumped up the ufUseThreshold to compensate. Adjustment of unfolding use threshold ===================================== Since this removes a discount from our inlining heuristic, I revisited our default choice of -funfolding-use-threshold to minimize the change in overall inlining behavior. Specifically, I measured runtime allocations and executable size of nofib and the testsuite performance tests built using compilers (and core libraries) built with several values of -funfolding-use-threshold. This comes as a result of a quantitative comparison of testsuite performance and code size as a function of ufUseThreshold, comparing GHC trees using values of 50, 60, 70, 80, 90, and 100. The test set consisted of nofib and the testsuite performance tests. A full summary of these measurements are found in the description of !2608 Comparing executable sizes (relative to the base commit) across all nofib tests, we see that sizes are similar to the baseline: gmean min max median thresh 50 -6.36% -7.04% -4.82% -6.46% 60 -5.04% -5.97% -3.83% -5.11% 70 -2.90% -3.84% -2.31% -2.92% 80 -0.75% -2.16% -0.42% -0.73% 90 +0.24% -0.41% +0.55% +0.26% 100 +1.36% +0.80% +1.64% +1.37% baseline +0.00% +0.00% +0.00% +0.00% Likewise, looking at runtime allocations we see that 80 gives slightly better optimisation than the baseline: gmean min max median thresh 50 +0.16% -0.16% +4.43% +0.00% 60 +0.09% -0.00% +3.10% +0.00% 70 +0.04% -0.09% +2.29% +0.00% 80 +0.02% -1.17% +2.29% +0.00% 90 -0.02% -2.59% +1.86% +0.00% 100 +0.00% -2.59% +7.51% -0.00% baseline +0.00% +0.00% +0.00% +0.00% Finally, I had to add a NOINLINE in T4306 to ensure that `upd` is worker-wrappered as the test expects. This makes me wonder whether the inlining heuristic is now too liberal as `upd` is quite a large function. The same measure was taken in T12600. Wall clock time compiling Cabal with -O0 thresh 50 60 70 80 90 100 baseline build-Cabal 93.88 89.58 92.59 90.09 100.26 94.81 89.13 Also, this change happens to avoid the spurious test output in `plugin-recomp-change` and `plugin-recomp-change-prof` (see #17308). Metric Decrease: hie002 T12234 T13035 T13719 T14683 T4801 T5631 T5642 T9020 T9872d T9961 Metric Increase: T12150 T12425 T13701 T14697 T15426 T1969 T3064 T5837 T6048 T9203 T9872a T9872b T9872c T9872d haddock.Cabal haddock.base haddock.compiler - - - - - 255418da by Sylvain Henry at 2020-04-07T18:36:49-04:00 Modules: type-checker (#13009) Update Haddock submodule - - - - - 04b6cf94 by Ryan Scott at 2020-04-07T19:43:20-04:00 Make NoExtCon fields strict This changes every unused TTG extension constructor to be strict in its field so that the pattern-match coverage checker is smart enough any such constructors are unreachable in pattern matches. This lets us remove nearly every use of `noExtCon` in the GHC API. The only ones we cannot remove are ones underneath uses of `ghcPass`, but that is only because GHC 8.8's and 8.10's coverage checkers weren't smart enough to perform this kind of reasoning. GHC HEAD's coverage checker, on the other hand, _is_ smart enough, so we guard these uses of `noExtCon` with CPP for now. Bumps the `haddock` submodule. Fixes #17992. - - - - - 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. - - - - - ce481361 by Ben Gamari at 2020-04-09T16:17:21-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. - - - - - fa66f143 by Ben Gamari at 2020-04-09T16:17:21-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. - - - - - 39075176 by Ömer Sinan Ağacan at 2020-04-09T16:18:00-04:00 Fix CNF handling in compacting GC Fixes #17937 Previously compacting GC simply ignored CNFs. This is mostly fine as most (see "What about small compacts?" below) CNF objects don't have outgoing pointers, and are "large" (allocated in large blocks) and large objects are not moved or compacted. However if we do GC *during* sharing-preserving compaction then the CNF will have a hash table mapping objects that have been moved to the CNF to their location in the CNF, to be able to preserve sharing. This case is handled in the copying collector, in `scavenge_compact`, where we evacuate hash table entries and then rehash the table. Compacting GC ignored this case. We now visit CNFs in all generations when threading pointers to the compacted heap and thread hash table keys. A visited CNF is added to the list `nfdata_chain`. After compaction is done, we re-visit the CNFs in that list and rehash the tables. The overhead is minimal: the list is static in `Compact.c`, and link field is added to `StgCompactNFData` closure. Programs that don't use CNFs should not be affected. To test this CNF tests are now also run in a new way 'compacting_gc', which just passes `-c` to the RTS, enabling compacting GC for the oldest generation. Before this patch the result would be: Unexpected failures: compact_gc.run compact_gc [bad exit code (139)] (compacting_gc) compact_huge_array.run compact_huge_array [bad exit code (1)] (compacting_gc) With this patch all tests pass. I can also pass `-c -DS` without any failures. What about small compacts? Small CNFs are still not handled by the compacting GC. However so far I'm unable to write a test that triggers a runtime panic ("update_fwd: unknown/strange object") by allocating a small CNF in a compated heap. It's possible that I'm missing something and it's not possible to have a small CNF. NoFib Results: -------------------------------------------------------------------------------- Program Size Allocs Instrs Reads Writes -------------------------------------------------------------------------------- CS +0.1% 0.0% 0.0% +0.0% +0.0% CSD +0.1% 0.0% 0.0% 0.0% 0.0% FS +0.1% 0.0% 0.0% 0.0% 0.0% S +0.1% 0.0% 0.0% 0.0% 0.0% VS +0.1% 0.0% 0.0% 0.0% 0.0% VSD +0.1% 0.0% +0.0% +0.0% -0.0% VSM +0.1% 0.0% +0.0% -0.0% 0.0% anna +0.0% 0.0% -0.0% -0.0% -0.0% ansi +0.1% 0.0% +0.0% +0.0% +0.0% atom +0.1% 0.0% +0.0% +0.0% +0.0% awards +0.1% 0.0% +0.0% +0.0% +0.0% banner +0.1% 0.0% +0.0% +0.0% +0.0% bernouilli +0.1% 0.0% 0.0% -0.0% +0.0% binary-trees +0.1% 0.0% -0.0% -0.0% 0.0% boyer +0.1% 0.0% +0.0% +0.0% +0.0% boyer2 +0.1% 0.0% +0.0% +0.0% +0.0% bspt +0.1% 0.0% -0.0% -0.0% -0.0% cacheprof +0.1% 0.0% -0.0% -0.0% -0.0% calendar +0.1% 0.0% +0.0% +0.0% +0.0% cichelli +0.1% 0.0% +0.0% +0.0% +0.0% circsim +0.1% 0.0% +0.0% +0.0% +0.0% clausify +0.1% 0.0% -0.0% +0.0% +0.0% comp_lab_zift +0.1% 0.0% +0.0% +0.0% +0.0% compress +0.1% 0.0% +0.0% +0.0% 0.0% compress2 +0.1% 0.0% -0.0% 0.0% 0.0% constraints +0.1% 0.0% +0.0% +0.0% +0.0% cryptarithm1 +0.1% 0.0% +0.0% +0.0% +0.0% cryptarithm2 +0.1% 0.0% +0.0% +0.0% +0.0% cse +0.1% 0.0% +0.0% +0.0% +0.0% digits-of-e1 +0.1% 0.0% +0.0% -0.0% -0.0% digits-of-e2 +0.1% 0.0% -0.0% -0.0% -0.0% dom-lt +0.1% 0.0% +0.0% +0.0% +0.0% eliza +0.1% 0.0% +0.0% +0.0% +0.0% event +0.1% 0.0% +0.0% +0.0% +0.0% exact-reals +0.1% 0.0% +0.0% +0.0% +0.0% exp3_8 +0.1% 0.0% +0.0% -0.0% 0.0% expert +0.1% 0.0% +0.0% +0.0% +0.0% fannkuch-redux +0.1% 0.0% -0.0% 0.0% 0.0% fasta +0.1% 0.0% -0.0% +0.0% +0.0% fem +0.1% 0.0% -0.0% +0.0% 0.0% fft +0.1% 0.0% -0.0% +0.0% +0.0% fft2 +0.1% 0.0% +0.0% +0.0% +0.0% fibheaps +0.1% 0.0% +0.0% +0.0% +0.0% fish +0.1% 0.0% +0.0% +0.0% +0.0% fluid +0.0% 0.0% +0.0% +0.0% +0.0% fulsom +0.1% 0.0% -0.0% +0.0% 0.0% gamteb +0.1% 0.0% +0.0% +0.0% 0.0% gcd +0.1% 0.0% +0.0% +0.0% +0.0% gen_regexps +0.1% 0.0% -0.0% +0.0% 0.0% genfft +0.1% 0.0% +0.0% +0.0% +0.0% gg +0.1% 0.0% 0.0% +0.0% +0.0% grep +0.1% 0.0% -0.0% +0.0% +0.0% hidden +0.1% 0.0% +0.0% -0.0% 0.0% hpg +0.1% 0.0% -0.0% -0.0% -0.0% ida +0.1% 0.0% +0.0% +0.0% +0.0% infer +0.1% 0.0% +0.0% 0.0% -0.0% integer +0.1% 0.0% +0.0% +0.0% +0.0% integrate +0.1% 0.0% -0.0% -0.0% -0.0% k-nucleotide +0.1% 0.0% +0.0% +0.0% 0.0% kahan +0.1% 0.0% +0.0% +0.0% +0.0% knights +0.1% 0.0% -0.0% -0.0% -0.0% lambda +0.1% 0.0% +0.0% +0.0% -0.0% last-piece +0.1% 0.0% +0.0% 0.0% 0.0% lcss +0.1% 0.0% +0.0% +0.0% 0.0% life +0.1% 0.0% -0.0% +0.0% +0.0% lift +0.1% 0.0% +0.0% +0.0% +0.0% linear +0.1% 0.0% -0.0% +0.0% 0.0% listcompr +0.1% 0.0% +0.0% +0.0% +0.0% listcopy +0.1% 0.0% +0.0% +0.0% +0.0% maillist +0.1% 0.0% +0.0% -0.0% -0.0% mandel +0.1% 0.0% +0.0% +0.0% 0.0% mandel2 +0.1% 0.0% +0.0% +0.0% +0.0% mate +0.1% 0.0% +0.0% 0.0% +0.0% minimax +0.1% 0.0% -0.0% 0.0% -0.0% mkhprog +0.1% 0.0% +0.0% +0.0% +0.0% multiplier +0.1% 0.0% +0.0% 0.0% 0.0% n-body +0.1% 0.0% +0.0% +0.0% +0.0% nucleic2 +0.1% 0.0% +0.0% +0.0% +0.0% para +0.1% 0.0% 0.0% +0.0% +0.0% paraffins +0.1% 0.0% +0.0% -0.0% 0.0% parser +0.1% 0.0% -0.0% -0.0% -0.0% parstof +0.1% 0.0% +0.0% +0.0% +0.0% pic +0.1% 0.0% -0.0% -0.0% 0.0% pidigits +0.1% 0.0% +0.0% -0.0% -0.0% power +0.1% 0.0% +0.0% +0.0% +0.0% pretty +0.1% 0.0% -0.0% -0.0% -0.1% primes +0.1% 0.0% -0.0% -0.0% -0.0% primetest +0.1% 0.0% -0.0% -0.0% -0.0% prolog +0.1% 0.0% -0.0% -0.0% -0.0% puzzle +0.1% 0.0% -0.0% -0.0% -0.0% queens +0.1% 0.0% +0.0% +0.0% +0.0% reptile +0.1% 0.0% -0.0% -0.0% +0.0% reverse-complem +0.1% 0.0% +0.0% 0.0% -0.0% rewrite +0.1% 0.0% -0.0% -0.0% -0.0% rfib +0.1% 0.0% +0.0% +0.0% +0.0% rsa +0.1% 0.0% -0.0% +0.0% -0.0% scc +0.1% 0.0% -0.0% -0.0% -0.1% sched +0.1% 0.0% +0.0% +0.0% +0.0% scs +0.1% 0.0% +0.0% +0.0% +0.0% simple +0.1% 0.0% -0.0% -0.0% -0.0% solid +0.1% 0.0% +0.0% +0.0% +0.0% sorting +0.1% 0.0% -0.0% -0.0% -0.0% spectral-norm +0.1% 0.0% +0.0% +0.0% +0.0% sphere +0.1% 0.0% -0.0% -0.0% -0.0% symalg +0.1% 0.0% -0.0% -0.0% -0.0% tak +0.1% 0.0% +0.0% +0.0% +0.0% transform +0.1% 0.0% +0.0% +0.0% +0.0% treejoin +0.1% 0.0% +0.0% -0.0% -0.0% typecheck +0.1% 0.0% +0.0% +0.0% +0.0% veritas +0.0% 0.0% +0.0% +0.0% +0.0% wang +0.1% 0.0% 0.0% +0.0% +0.0% wave4main +0.1% 0.0% +0.0% +0.0% +0.0% wheel-sieve1 +0.1% 0.0% +0.0% +0.0% +0.0% wheel-sieve2 +0.1% 0.0% +0.0% +0.0% +0.0% x2n1 +0.1% 0.0% +0.0% +0.0% +0.0% -------------------------------------------------------------------------------- Min +0.0% 0.0% -0.0% -0.0% -0.1% Max +0.1% 0.0% +0.0% +0.0% +0.0% Geometric Mean +0.1% -0.0% -0.0% -0.0% -0.0% Bumping numbers of nonsensical perf tests: Metric Increase: T12150 T12234 T12425 T13035 T5837 T6048 It's simply not possible for this patch to increase allocations, and I've wasted enough time on these test in the past (see #17686). I think these tests should not be perf tests, but for now I'll bump the numbers. - - - - - dce50062 by Sylvain Henry at 2020-04-09T16:18:44-04:00 Rts: show errno on failure (#18033) - - - - - 045139f4 by Hécate at 2020-04-09T23:10:44-04:00 Add an example to liftIO and explain its purpose - - - - - 101fab6e by Sebastian Graf at 2020-04-09T23:11:21-04:00 Special case `isConstraintKindCon` on `AlgTyCon` Previously, the `tyConUnique` record selector would unfold into a huge case expression that would be inlined in all call sites, such as the `INLINE`-annotated `coreView`, see #18026. `constraintKindTyConKey` only occurs as the `Unique` of an `AlgTyCon` anyway, so we can make the code a lot more compact, but have to move it to GHC.Core.TyCon. Metric Decrease: T12150 T12234 - - - - - f5212dfc by Sebastian Graf at 2020-04-09T23:11:57-04:00 DmdAnal: No need to attach a StrictSig to DataCon workers In GHC.Types.Id.Make we were giving a strictness signature to every data constructor wrapper Id that we weren't looking at in demand analysis anyway. We used to use its CPR info, but that has its own CPR signature now. `Note [Data-con worker strictness]` then felt very out of place, so I moved it to GHC.Core.DataCon. - - - - - 75a185dc by Sylvain Henry at 2020-04-09T23:12:37-04:00 Hadrian: fix --summary - - - - - 723062ed by Ömer Sinan Ağacan at 2020-04-10T09:18:14+03:00 testsuite: Move no_lint to the top level, tweak hie002 - We don't want to benchmark linting so disable lints in hie002 perf test - Move no_lint to the top-level to be able to use it in tests other than those in `testsuite/tests/perf/compiler`. - Filter out -dstg-lint in no_lint. - hie002 allocation numbers on 32-bit are unstable, so skip it on 32-bit Metric Decrease: hie002 ManyConstructors T12150 T12234 T13035 T1969 T4801 T9233 T9961 - - - - - bcafaa82 by Peter Trommler at 2020-04-10T19:29:33-04:00 Testsuite: mark T11531 fragile The test depends on a link editor allowing undefined symbols in an ELF shared object. This is the standard but it seems some distributions patch their link editor. See the report by @hsyl20 in #11531. Fixes #11531 - - - - - 0889f5ee by Takenobu Tani at 2020-04-12T11:44:52+09:00 testsuite: Fix comment for a language extension [skip ci] - - - - - cd4f92b5 by Simon Peyton Jones at 2020-04-12T11:20:58-04:00 Significant refactor of Lint This refactoring of Lint was triggered by #17923, which is fixed by this patch. The main change is this. Instead of lintType :: Type -> LintM LintedKind we now have lintType :: Type -> LintM LintedType Previously, all of typeKind was effectively duplicate in lintType. Moreover, since we have an ambient substitution, we still had to apply the substition here and there, sometimes more than once. It was all very tricky, in the end, and made my head hurt. Now, lintType returns a fully linted type, with all substitutions performed on it. This is much simpler. The same thing is needed for Coercions. Instead of lintCoercion :: OutCoercion -> LintM (LintedKind, LintedKind, LintedType, LintedType, Role) we now have lintCoercion :: Coercion -> LintM LintedCoercion Much simpler! The code is shorter and less bug-prone. There are a lot of knock on effects. But life is now better. Metric Decrease: T1969 - - - - - 0efaf301 by Josh Meredith at 2020-04-12T11:21:34-04:00 Implement extensible interface files - - - - - 54ca66a7 by Ryan Scott at 2020-04-12T11:22:10-04:00 Use conLikeUserTyVarBinders to quantify field selector types This patch: 1. Writes up a specification for how the types of top-level field selectors should be determined in a new section of the GHC User's Guide, and 2. Makes GHC actually implement that specification by using `conLikeUserTyVarBinders` in `mkOneRecordSelector` to preserve the order and specificity of type variables written by the user. Fixes #18023. - - - - - 35799dda by Ben Gamari at 2020-04-12T11:22:50-04:00 hadrian: Don't --export-dynamic on Darwin When fixing #17962 I neglected to consider that --export-dynamic is only supported on ELF platforms. - - - - - e8029816 by Alexis King at 2020-04-12T11:23:27-04:00 Add an INLINE pragma to Control.Category.>>> This fixes #18013 by adding INLINE pragmas to both Control.Category.>>> and GHC.Desugar.>>>. The functional change in this patch is tiny (just two lines of pragmas!), but an accompanying Note explains in gory detail what’s going on. - - - - - 0da186c1 by Krzysztof Gogolewski at 2020-04-14T07:55:20-04:00 Change zipWith to zipWithEqual in a few places - - - - - 074c1ccd by Andreas Klebinger at 2020-04-14T07:55:55-04:00 Small change to the windows ticker. We already have a function to go from time to ms so use it. Also expand on the state of timer resolution. - - - - - b69cc884 by Alp Mestanogullari at 2020-04-14T07:56:38-04:00 hadrian: get rid of unnecessary levels of nesting in source-dist - - - - - d0c3b069 by Julien Debon at 2020-04-14T07:57:16-04:00 doc (Foldable): Add examples to Data.Foldable See #17929 - - - - - 5b08e0c0 by Ben Gamari at 2020-04-14T23:28:20-04:00 StgCRun: Enable unwinding only on Linux It's broken on macOS due and SmartOS due to assembler differences (#15207) so let's be conservative in enabling it. Also, refactor things to make the intent clearer. - - - - - 27cc2e7b by Ben Gamari at 2020-04-14T23:28:57-04:00 rts: Don't mark evacuate_large as inline This function has two callsites and is quite large. GCC consequently decides not to inline and warns instead. Given the situation, I can't blame it. Let's just remove the inline specifier. - - - - - 9853fc5e by Ben Gamari at 2020-04-14T23:29:48-04:00 base: Enable large file support for OFD locking impl. Not only is this a good idea in general but this should also avoid issue #17950 by ensuring that off_t is 64-bits. - - - - - 7b41f21b by Matthew Pickering at 2020-04-14T23:30:24-04:00 Hadrian: Make -i paths absolute The primary reason for this change is that ghcide does not work with relative paths. It also matches what cabal and stack do, they always pass absolute paths. - - - - - 41230e26 by Daniel Gröber at 2020-04-14T23:31:01-04:00 Zero out pinned block alignment slop when profiling The heap profiler currently cannot traverse pinned blocks because of alignment slop. This used to just be a minor annoyance as the whole block is accounted into a special cost center rather than the respective object's CCS, cf. #7275. However for the new root profiler we would like to be able to visit _every_ closure on the heap. We need to do this so we can get rid of the current 'flip' bit hack in the heap traversal code. Since info pointers are always non-zero we can in principle skip all the slop in the profiler if we can rely on it being zeroed. This assumption caused problems in the past though, commit a586b33f8e ("rts: Correct handling of LARGE ARR_WORDS in LDV profiler"), part of !1118, tried to use the same trick for BF_LARGE objects but neglected to take into account that shrink*Array# functions don't ensure that slop is zeroed when not compiling with profiling. Later, commit 0c114c6599 ("Handle large ARR_WORDS in heap census (fix as we will only be assuming slop is zeroed when profiling is on. This commit also reduces the ammount of slop we introduce in the first place by calculating the needed alignment before doing the allocation for small objects where we know the next available address. For large objects we don't know how much alignment we'll have to do yet since those details are hidden behind the allocateMightFail function so there we continue to allocate the maximum additional words we'll need to do the alignment. So we don't have to duplicate all this logic in the cmm code we pull it into the RTS allocatePinned function instead. Metric Decrease: T7257 haddock.Cabal haddock.base - - - - - 15fa9bd6 by Daniel Gröber at 2020-04-14T23:31:01-04:00 rts: Expand and add more notes regarding slop - - - - - caf3f444 by Daniel Gröber at 2020-04-14T23:31:01-04:00 rts: allocatePinned: Fix confusion about word/byte units - - - - - c3c0f662 by Daniel Gröber at 2020-04-14T23:31:01-04:00 rts: Underline some Notes as is conventional - - - - - e149dea9 by Daniel Gröber at 2020-04-14T23:31:38-04:00 rts: Fix nomenclature in OVERWRITING_CLOSURE macros The additional commentary introduced by commit 8916e64e5437 ("Implement shrinkSmallMutableArray# and resizeSmallMutableArray#.") unfortunately got this wrong. We set 'prim' to true in overwritingClosureOfs because we _don't_ want to call LDV_recordDead(). The reason is because of this "inherently used" distinction made in the LDV profiler so I rename the variable to be more appropriate. - - - - - 1dd3d18c by Daniel Gröber at 2020-04-14T23:31:38-04:00 Remove call to LDV_RECORD_CREATE for array resizing - - - - - 19de2fb0 by Daniel Gröber at 2020-04-14T23:31:38-04:00 rts: Assert LDV_recordDead is not called for inherently used closures The comments make it clear LDV_recordDead should not be called for inhererently used closures, so add an assertion to codify this fact. - - - - - 0b934e30 by Ryan Scott at 2020-04-14T23:32:14-04:00 Bump template-haskell version to 2.17.0.0 This requires bumping the `exceptions` and `text` submodules to bring in commits that bump their respective upper version bounds on `template-haskell`. Fixes #17645. Fixes #17696. Note that the new `text` commit includes a fair number of additions to the Haddocks in that library. As a result, Haddock has to do more work during the `haddock.Cabal` test case, increasing the number of allocations it requires. Therefore, ------------------------- Metric Increase: haddock.Cabal ------------------------- - - - - - 22cc8e51 by Ryan Scott at 2020-04-15T17:48:47-04:00 Fix #18052 by using pprPrefixOcc in more places This fixes several small oversights in the choice of pretty-printing function to use. Fixes #18052. - - - - - ec77b2f1 by Daniel Gröber at 2020-04-15T17:49:24-04:00 rts: ProfHeap: Fix wrong time in last heap profile sample We've had this longstanding issue in the heap profiler, where the time of the last sample in the profile is sometimes way off causing the rendered graph to be quite useless for long runs. It seems to me the problem is that we use mut_user_time() for the last sample as opposed to getRTSStats(), which we use when calling heapProfile() in GC.c. The former is equivalent to getProcessCPUTime() but the latter does some additional stuff: getProcessCPUTime() - end_init_cpu - stats.gc_cpu_ns - stats.nonmoving_gc_cpu_ns So to fix this just use getRTSStats() in both places. - - - - - 85fc32f0 by Sylvain Henry at 2020-04-17T12:45:25-04:00 Hadrian: fix dyn_o/dyn_hi rule (#17534) - - - - - bfde3b76 by Ryan Scott at 2020-04-17T12:46:02-04:00 Fix #18065 by fixing an InstCo oversight in Core Lint There was a small thinko in Core Lint's treatment of `InstCo` coercions that ultimately led to #18065. The fix: add an apostrophe. That's it! Fixes #18065. Co-authored-by: Simon Peyton Jones <simonpj at microsoft.com> - - - - - a05348eb by Cale Gibbard at 2020-04-17T13:08:47-04:00 Change the fail operator argument of BindStmt to be a Maybe Don't use noSyntaxExpr for it. There is no good way to defensively case on that, nor is it clear one ought to do so. - - - - - 79e27144 by John Ericson at 2020-04-17T13:08:47-04:00 Use trees that grow for rebindable operators for `<-` binds Also add more documentation. - - - - - 18bc16ed by Cale Gibbard at 2020-04-17T13:08:47-04:00 Use FailOperator in more places, define a couple datatypes (XBindStmtRn and XBindStmtTc) to help clarify the meaning of XBindStmt in the renamer and typechecker - - - - - 84cc8394 by Simon Peyton Jones at 2020-04-18T13:20:29-04:00 Add a missing zonk in tcHsPartialType I omitted a vital zonk when refactoring tcHsPartialType in commit 48fb3482f8cbc8a4b37161021e846105f980eed4 Author: Simon Peyton Jones <simonpj at microsoft.com> Date: Wed Jun 5 08:55:17 2019 +0100 Fix typechecking of partial type signatures This patch fixes it and adds commentary to explain why. Fixes #18008 - - - - - 2ee96ac1 by Ben Gamari at 2020-04-18T13:21:05-04:00 gitlab-ci: Bump FreeBSD bootstrap compiler to 8.10.1 - - - - - 434312e5 by Ben Gamari at 2020-04-18T13:21:05-04:00 gitlab-ci: Enable FreeBSD job for so-labelled MRs - - - - - ddffb227 by Ben Gamari at 2020-04-18T13:21:05-04:00 gitlab-ci: Use rules syntax for conditional jobs - - - - - e2586828 by Ben Gamari at 2020-04-18T13:21:05-04:00 Bump hsc2hs submodule - - - - - 15ab6cd5 by Ömer Sinan Ağacan at 2020-04-18T13:21:44-04:00 Improve prepForeignCall error reporting Show parameters and description of the error code when ffi_prep_cif fails. This may be helpful for debugging #17018. - - - - - 3ca52151 by Sylvain Henry at 2020-04-18T20:04:14+02:00 GHC.Core.Opt renaming * GHC.Core.Op => GHC.Core.Opt * GHC.Core.Opt.Simplify.Driver => GHC.Core.Opt.Driver * GHC.Core.Opt.Tidy => GHC.Core.Tidy * GHC.Core.Opt.WorkWrap.Lib => GHC.Core.Opt.WorkWrap.Utils As discussed in: * https://mail.haskell.org/pipermail/ghc-devs/2020-April/018758.html * https://gitlab.haskell.org/ghc/ghc/issues/13009#note_264650 - - - - - 15312bbb by Sylvain Henry at 2020-04-18T20:04:46+02:00 Modules (#13009) * SysTools * Parser * GHC.Builtin * GHC.Iface.Recomp * Settings Update Haddock submodule Metric Decrease: Naperian parsing001 - - - - - eaed0a32 by Alexis King at 2020-04-19T03:16:44-04:00 Add missing addInScope call for letrec binders in OccurAnal This fixes #18044, where a shadowed variable was incorrectly substituted by the binder swap on the RHS of a floated-in letrec. This can only happen when the uniques line up *just* right, so writing a regression test would be very difficult, but at least the fix is small and straightforward. - - - - - 36882493 by Shayne Fletcher at 2020-04-20T04:36:43-04:00 Derive Ord instance for Extension Metric Increase: T12150 T12234 - - - - - b43365ad by Simon Peyton Jones at 2020-04-20T04:37:20-04:00 Fix a buglet in redundant-constraint warnings Ticket #18036 pointed out that we were reporting a redundant constraint when it really really wasn't. Turned out to be a buglet in the SkolemInfo for the relevant implication constraint. Easily fixed! - - - - - d5fae7da by Ömer Sinan Ağacan at 2020-04-20T14:39:28-04:00 Mark T12010 fragile on 32-bit - - - - - bca02fca by Adam Sandberg Ericsson at 2020-04-21T06:38:45-04:00 docs: drop note about not supporting shared libraries on unix systems [skip ci] - - - - - 6655f933 by Sylvain Henry at 2020-04-21T06:39:32-04:00 Use ParserFlags in GHC.Runtime.Eval (#17957) Instead of passing `DynFlags` to functions such as `isStmt` and `hasImport` in `GHC.Runtime.Eval` we pass `ParserFlags`. It's a much simpler structure that can be created purely with `mkParserFlags'`. - - - - - 70be0fbc by Sylvain Henry at 2020-04-21T06:39:32-04:00 GHC.Runtime: avoid DynFlags (#17957) * add `getPlatform :: TcM Platform` helper * remove unused `DynFlags` parameter from `emptyPLS` - - - - - 35e43d48 by Sylvain Henry at 2020-04-21T06:39:32-04:00 Avoid DynFlags in Ppr code (#17957) * replace `DynFlags` parameters with `SDocContext` parameters for a few Ppr related functions: `bufLeftRenderSDoc`, `printSDoc`, `printSDocLn`, `showSDocOneLine`. * remove the use of `pprCols :: DynFlags -> Int` in Outputable. We already have the information via `sdocLineLength :: SDocContext -> Int` - - - - - ce5c2999 by Sylvain Henry at 2020-04-21T06:39:32-04:00 Avoid using sdocWithDynFlags (#17957) Remove one use of `sdocWithDynFlags` from `GHC.CmmToLlvm.llvmCodeGen'` and from `GHC.Driver.CodeOutput.profilingInitCode` - - - - - f2a98996 by Sylvain Henry at 2020-04-21T06:39:32-04:00 Avoid `sdocWithDynFlags` in `pprCLbl` (#17957) * add a `DynFlags` parameter to `pprCLbl` * put `maybe_underscore` and `pprAsmCLbl` in a `where` clause to avoid `DynFlags` parameters - - - - - 747093b7 by Sylvain Henry at 2020-04-21T06:39:32-04:00 CmmToAsm DynFlags refactoring (#17957) * Remove `DynFlags` parameter from `isDynLinkName`: `isDynLinkName` used to test the global `ExternalDynamicRefs` flag. Now we test it outside of `isDynLinkName` * Add new fields into `NCGConfig`: current unit id, sse/bmi versions, externalDynamicRefs, etc. * Replace many uses of `DynFlags` by `NCGConfig` * Moved `BMI/SSE` datatypes into `GHC.Platform` - - - - - ffd7eef2 by Takenobu Tani at 2020-04-22T23:09:50-04:00 stg-spec: Modify file paths according to new module hierarchy This patch updates file paths according to new module hierarchy [1]: * GHC/Stg/Syntax.hs <= stgSyn/StgSyn.hs * GHC/Types/Literal.hs <= basicTypes/Literal.hs * GHC/Types/CostCentre.hs <= profiling/CostCentre.hs This patch also updates old file path [2]: * utils/genapply/Main.hs <= utils/genapply/GenApply.hs [1]: https://gitlab.haskell.org/ghc/ghc/-/wikis/Make-GHC-codebase-more-modular [2]: commit 0cc4aad36f [skip ci] - - - - - e8a5d81b by Jonathan DK Gibbons at 2020-04-22T23:10:28-04:00 Refactor the `MatchResult` type in the desugarer This way, it does a better job of proving whether or not the fail operator is used. - - - - - dcb7fe5a by John Ericson at 2020-04-22T23:10:28-04:00 Remove panic in dsHandleMonadicFailure Rework dsHandleMonadicFailure to be correct by construction instead of using an unreachable panic. - - - - - cde23cd4 by John Ericson at 2020-04-22T23:10:28-04:00 Inline `adjustMatchResult` It is just `fmap` - - - - - 72cb6bcc by John Ericson at 2020-04-22T23:10:28-04:00 Generalize type of `matchCanFail` - - - - - 401f7bb3 by John Ericson at 2020-04-22T23:10:28-04:00 `MatchResult'` -> `MatchResult` Inline `MatchResult` alias accordingly. - - - - - 6c9fae23 by Alexis King at 2020-04-22T23:11:12-04:00 Mark DataCon wrappers CONLIKE Now that DataCon wrappers don’t inline until phase 0 (see commit b78cc64e923716ac0512c299f42d4d0012306c05), it’s important that case-of-known-constructor and RULE matching be able to see saturated applications of DataCon wrappers in unfoldings. Making them conlike is a natural way to do it, since they are, in fact, precisely the sort of thing the CONLIKE pragma exists to solve. Fixes #18012. This also bumps the version of the parsec submodule to incorporate a patch that avoids a metric increase on the haddock perf tests. The increase was not really a flaw in this patch, as parsec was implicitly relying on inlining heuristics. The patch to parsec just adds some INLINABLE pragmas, and we get a nice performance bump out of it (well beyond the performance we lost from this patch). Metric Decrease: T12234 WWRec haddock.Cabal haddock.base haddock.compiler - - - - - 48b8951e by Roland Senn at 2020-04-22T23:11:51-04:00 Fix tab-completion for :break (#17989) In tab-completion for the `:break` command, only those identifiers should be shown, that are accepted in the `:break` command. Hence these identifiers must be - defined in an interpreted module - top-level - currently in scope - listed in a `ModBreaks` value as a possible breakpoint. The identifiers my be qualified or unqualified. To get all possible top-level breakpoints for tab-completeion with the correct qualification do: 1. Build the list called `pifsBreaks` of all pairs of (Identifier, module-filename) from the `ModBreaks` values. Here all identifiers are unqualified. 2. Build the list called `pifInscope` of all pairs of (Identifiers, module-filename) with identifiers from the `GlobalRdrEnv`. Take only those identifiers that are in scope and have the correct prefix. Here the identifiers may be qualified. 3. From the `pifInscope` list seclect all pairs that can be found in the `pifsBreaks` list, by comparing only the unqualified part of the identifier. The remaining identifiers can be used for tab-completion. This ensures, that we show only identifiers, that can be used in a `:break` command. - - - - - 34a45ee6 by Peter Trommler at 2020-04-22T23:12:27-04:00 PPC NCG: Add DWARF constants and debug labels Fixes #11261 - - - - - ffde2348 by Simon Peyton Jones at 2020-04-22T23:13:06-04:00 Do eager instantation in terms This patch implements eager instantiation, a small but critical change to the type inference engine, #17173. The main change is this: When inferring types, always return an instantiated type (for now, deeply instantiated; in future shallowly instantiated) There is more discussion in https://www.tweag.io/posts/2020-04-02-lazy-eager-instantiation.html There is quite a bit of refactoring in this patch: * The ir_inst field of GHC.Tc.Utils.TcType.InferResultk has entirely gone. So tcInferInst and tcInferNoInst have collapsed into tcInfer. * Type inference of applications, via tcInferApp and tcInferAppHead, are substantially refactored, preparing the way for Quick Look impredicativity. * New pure function GHC.Tc.Gen.Expr.collectHsArgs and applyHsArgs are beatifully dual. We can see the zipper! * GHC.Tc.Gen.Expr.tcArgs is now much nicer; no longer needs to return a wrapper * In HsExpr, HsTypeApp now contains the the actual type argument, and is used in desugaring, rather than putting it in a mysterious wrapper. * I struggled a bit with good error reporting in Unify.matchActualFunTysPart. It's a little bit simpler than before, but still not great. Some smaller things * Rename tcPolyExpr --> tcCheckExpr tcMonoExpr --> tcLExpr * tcPatSig moves from GHC.Tc.Gen.HsType to GHC.Tc.Gen.Pat Metric Decrease: T9961 Reduction of 1.6% in comiler allocation on T9961, I think. - - - - - 6f84aca3 by Ben Gamari at 2020-04-22T23:13:43-04:00 rts: Ensure that sigaction structs are initialized I noticed these may have uninitialized fields when looking into #18037. The reporter says that zeroing them doesn't fix the MSAN failures they observe but zeroing them is the right thing to do regardless. - - - - - c29f0fa6 by Andreas Klebinger at 2020-04-22T23:14:21-04:00 Add "ddump-cmm-opt" as alias for "ddump-opt-cmm". - - - - - 4b4a8b60 by Ben Gamari at 2020-04-22T23:14:57-04:00 llvmGen: Remove -fast-llvm flag Issue #18076 drew my attention to the undocumented `-fast-llvm` flag for the LLVM code generator introduced in 22733532171330136d87533d523f565f2a4f102f. Speaking to Moritz about this, the motivation for this flag was to avoid potential incompatibilities between LLVM and the assembler/linker toolchain by making LLVM responsible for machine-code generation. Unfortunately, this cannot possibly work: the LLVM backend's mangler performs a number of transforms on the assembler generated by LLVM that are necessary for correctness. These are currently: * mangling Haskell functions' symbol types to be `object` instead of `function` on ELF platforms (necessary for tables-next-to-code) * mangling AVX instructions to ensure that we don't assume alignment (which LLVM otherwise does) * mangling Darwin's subsections-via-symbols directives Given that these are all necessary I don't believe that we can support `-fast-llvm`. Let's rather remove it. - - - - - 831b6642 by Moritz Angermann at 2020-04-22T23:15:33-04:00 Fix build warning; add more informative information to the linker; fix linker for empty sections - - - - - c409961a by Ryan Scott at 2020-04-22T23:16:12-04:00 Update commentary and slightly refactor GHC.Tc.Deriv.Infer There was some out-of-date commentary in `GHC.Tc.Deriv.Infer` that has been modernized. Along the way, I removed the `bad` constraints in `simplifyDeriv`, which did not serve any useful purpose (besides being printed in debugging output). Fixes #18073. - - - - - 125aa2b8 by Ömer Sinan Ağacan at 2020-04-22T23:16:51-04:00 Remove leftover comment in tcRnModule', redundant bind The code for the comment was moved in dc8c03b2a5c but the comment was forgotten. - - - - - 8ea37b01 by Sylvain Henry at 2020-04-22T23:17:34-04:00 RTS: workaround a Linux kernel bug in timerfd Reading a timerfd may return 0: https://lkml.org/lkml/2019/8/16/335. This is currently undocumented behavior and documentation "won't happen anytime soon" (https://lkml.org/lkml/2020/2/13/295). With this patch, we just ignore the result instead of crashing. It may fix #18033 but we can't be sure because we don't have enough information. See also this discussion about the kernel bug: https://github.com/Azure/sonic-swss-common/pull/302/files/1f070e7920c2e5d63316c0105bf4481e73d72dc9 - - - - - cd8409c2 by Ryan Scott at 2020-04-23T11:39:24-04:00 Create di_scoped_tvs for associated data family instances properly See `Note [Associated data family instances and di_scoped_tvs]` in `GHC.Tc.TyCl.Instance`, which explains all of the moving parts. Fixes #18055. - - - - - 339e8ece by Ben Gamari at 2020-04-23T11:40:02-04:00 hadrian/ghci: Allow arguments to be passed to GHCi Previously the arguments passed to hadrian/ghci were passed both to `hadrian` and GHCi. This is rather odd given that there are essentially not arguments in the intersection of the two. Let's just pass them to GHCi; this allows `hadrian/ghci -Werror`. - - - - - 5946c85a by Ben Gamari at 2020-04-23T11:40:38-04:00 testsuite: Don't attempt to read .std{err,out} files if they don't exist Simon reports that he was previously seeing framework failures due to an attempt to read the non-existing T13456.stderr. While I don't know exactly what this is due to, it does seem like a non-existing .std{out,err} file should be equivalent to an empty file. Teach the testsuite driver to treat it as such. - - - - - c42754d5 by John Ericson at 2020-04-23T18:32:43-04:00 Trees That Grow refactor for `ConPat` and `CoPat` - `ConPat{In,Out}` -> `ConPat` - `CoPat` -> `XPat (CoPat ..)` Note that `GHC.HS.*` still uses `HsWrap`, but only when `p ~ GhcTc`. After this change, moving the type family instances out of `GHC.HS.*` is sufficient to break the cycle. Add XCollectPat class to decide how binders are collected from XXPat based on the pass. Previously we did this with IsPass, but that doesn't work for Haddock's DocNameI, and the constraint doesn't express what actual distinction is being made. Perhaps a class for collecting binders more generally is in order, but we haven't attempted this yet. Pure refactor of code around ConPat - InPat/OutPat synonyms removed - rename several identifiers - redundant constraints removed - move extension field in ConPat to be first - make ConPat use record syntax more consistently Fix T6145 (ConPatIn became ConPat) Add comments from SPJ. Add comment about haddock's use of CollectPass. Updates haddock submodule. - - - - - 72da0c29 by mniip at 2020-04-23T18:33:21-04:00 Add :doc to GHC.Prim - - - - - 2c23e2e3 by mniip at 2020-04-23T18:33:21-04:00 Include docs for non-primop entries in primops.txt as well - - - - - 0ac29c88 by mniip at 2020-04-23T18:33:21-04:00 GHC.Prim docs: note and test - - - - - b0fbfc75 by John Ericson at 2020-04-24T12:07:14-04:00 Switch order on `GhcMake.IsBoot` In !1798 we were requested to replace many `Bool`s with this data type. But those bools had `False` meaning `NotBoot`, so the `Ord` instance would be flipped if we use this data-type as-is. Since the planned formally-`Bool` occurrences vastly outnumber the current occurrences, we figured it would be better to conform the `Ord` instance to how the `Bool` is used now, fixing any issues, rather than fix them currently with the bigger refactor later in !1798. That way, !1798 can be a "pure" refactor with no behavioral changes. - - - - - af332442 by Sylvain Henry at 2020-04-26T13:55:14-04:00 Modules: Utils and Data (#13009) Update Haddock submodule Metric Increase: haddock.compiler - - - - - cd4434c8 by Sylvain Henry at 2020-04-26T13:55:16-04:00 Fix misleading Ptr phantom type in SerializedCompact (#15653) - - - - - 22bf5c73 by Ömer Sinan Ağacan at 2020-04-26T13:55:22-04:00 Tweak includes in non-moving GC headers We don't use hash tables in non-moving GC so remove the includes. This breaks Compact.c as existing includes no longer include Hash.h, so include Hash.h explicitly in Compact.c. - - - - - 99823ed2 by Sylvain Henry at 2020-04-27T20:24:46-04:00 TH: fix Show/Eq/Ord instances for Bytes (#16457) We shouldn't compare pointer values but the actual bytes. - - - - - c62271a2 by Alp Mestanogullari at 2020-04-27T20:25:33-04:00 hadrian: always capture both stdout and stderr when running a builder fails The idea being that when a builder('s command) fails, we quite likely want to have all the information available to figure out why. Depending on the builder _and_ the particular problem, the useful bits of information can be printed on stdout or stderr. We accomplish this by defining a simple wrapper for Shake's `cmd` function, that just _always_ captures both streams in case the command returns a non-zero exit code, and by using this wrapper everywhere in `hadrian/src/Builder.hs`. Fixes #18089. - - - - - 4b9764db by Ryan Scott at 2020-04-28T15:40:04-04:00 Define a Quote IO instance Fixes #18103. - - - - - 518a63d4 by Ryan Scott at 2020-04-28T15:40:42-04:00 Make boxed 1-tuples have known keys Unlike other tuples, which use special syntax and are "known" by way of a special `isBuiltInOcc_maybe` code path, boxed 1-tuples do not use special syntax. Therefore, in order to make sure that the internals of GHC are aware of the `data Unit a = Unit a` definition in `GHC.Tuple`, we give `Unit` known keys. For the full details, see `Note [One-tuples] (Wrinkle: Make boxed one-tuple names have known keys)` in `GHC.Builtin.Types`. Fixes #18097. - - - - - 2cfc4ab9 by Sylvain Henry at 2020-04-30T01:56:56-04:00 Document backpack fields in DynFlags - - - - - 10a2ba90 by Sylvain Henry at 2020-04-30T01:56:56-04:00 Refactor UnitInfo * Rename InstalledPackageInfo into GenericUnitInfo The name InstalledPackageInfo is only kept for alleged backward compatibility reason in Cabal. ghc-boot has its own stripped down copy of this datatype but it doesn't need to keep the name. Internally we already use type aliases (UnitInfo in GHC, PackageCacheFormat in ghc-pkg). * Rename UnitInfo fields: add "unit" prefix and fix misleading names * Add comments on every UnitInfo field * Rename SourcePackageId into PackageId "Package" already indicates that it's a "source package". Installed package components are called units. Update Haddock submodule - - - - - 69562e34 by Sylvain Henry at 2020-04-30T01:56:56-04:00 Remove unused `emptyGenericUnitInfo` - - - - - 9e2c8e0e by Sylvain Henry at 2020-04-30T01:56:56-04:00 Refactor UnitInfo load/store from databases Converting between UnitInfo stored in package databases and UnitInfo as they are used in ghc-pkg and ghc was done in a very convoluted way (via BinaryStringRep and DbUnitModuleRep type classes using fun deps, etc.). It was difficult to understand and even more to modify (I wanted to try to use a GADT for UnitId but fun deps got in the way). The new code uses much more straightforward functions to convert between the different representations. Much simpler. - - - - - ea717aa4 by Sylvain Henry at 2020-04-30T01:56:56-04:00 Factorize mungePackagePaths code This patch factorizes the duplicated code used in ghc-pkg and in GHC to munge package paths/urls. It also fixes haddock-html munging in GHC (allowed to be either a file or a url) to mimic ghc-pkg behavior. - - - - - 10d15f1e by Sylvain Henry at 2020-04-30T01:56:56-04:00 Refactoring unit management code Over the years the unit management code has been modified a lot to keep up with changes in Cabal (e.g. support for several library components in the same package), to integrate BackPack, etc. I found it very hard to understand as the terminology wasn't consistent, was referring to past concepts, etc. The terminology is now explained as clearly as I could in the Note "About Units" and the code is refactored to reflect it. ------------------- Many names were misleading: UnitId is not an Id but could be a virtual unit (an indefinite one instantiated on the fly), IndefUnitId constructor may contain a definite instantiated unit, etc. * Rename IndefUnitId into InstantiatedUnit * Rename IndefModule into InstantiatedModule * Rename UnitId type into Unit * Rename IndefiniteUnitId constructor into VirtUnit * Rename DefiniteUnitId constructor into RealUnit * Rename packageConfigId into mkUnit * Rename getPackageDetails into unsafeGetUnitInfo * Rename InstalledUnitId into UnitId Remove references to misleading ComponentId: a ComponentId is just an indefinite unit-id to be instantiated. * Rename ComponentId into IndefUnitId * Rename ComponentDetails into UnitPprInfo * Fix display of UnitPprInfo with empty version: this is now used for units dynamically generated by BackPack Generalize several types (Module, Unit, etc.) so that they can be used with different unit identifier types: UnitKey, UnitId, Unit, etc. * GenModule: Module, InstantiatedModule and InstalledModule are now instances of this type * Generalize DefUnitId, IndefUnitId, Unit, InstantiatedUnit, PackageDatabase Replace BackPack fake "hole" UnitId by a proper HoleUnit constructor. Add basic support for UnitKey. They should be used more in the future to avoid mixing them up with UnitId as we do now. Add many comments. Update Haddock submodule - - - - - 8bfb0219 by Sylvain Henry at 2020-04-30T01:56:56-04:00 Unit: split and rename modules Introduce GHC.Unit.* hierarchy for everything concerning units, packages and modules. Update Haddock submodule - - - - - 71484b09 by Alexis King at 2020-04-30T01:57:35-04:00 Allow block arguments in arrow control operators Arrow control operators have their own entries in the grammar, so they did not cooperate with BlockArguments. This was just a minor oversight, so this patch adjusts the grammar to add the desired behavior. fixes #18050 - - - - - a48cd2a0 by Alexis King at 2020-04-30T01:57:35-04:00 Allow LambdaCase to be used as a command in proc notation - - - - - f4d3773c by Alexis King at 2020-04-30T01:57:35-04:00 Document BlockArguments/LambdaCase support in arrow notation - - - - - 5bdfdd13 by Simon Peyton Jones at 2020-04-30T01:58:15-04:00 Add tests for #17873 - - - - - 19b701c2 by Simon Peyton Jones at 2020-04-30T07:30:13-04:00 Mark rule args as non-tail-called This was just an omission...b I'd failed to call markAllNonTailCall on rule args. I think this bug has been here a long time, but it's quite hard to trigger. Fixes #18098 - - - - - 014ef4a3 by Matthew Pickering at 2020-04-30T07:30:50-04:00 Hadrian: Improve tool-args command to support more components There is a new command to hadrian, tool:path/to/file.hs, which returns the options needed to compile that file in GHCi. This is now used in the ghci script with argument `ghc/Main.hs` but its main purpose is to support the new multi-component branch of ghcide. - - - - - 2aa67611 by Ben Gamari at 2020-04-30T21:34:44-04:00 nonmoving: Clear bitmap after initializing block size Previously nonmovingInitSegment would clear the bitmap before initializing the segment's block size. This is broken since nonmovingClearBitmap looks at the segment's block size to determine how much bitmap to clear. - - - - - 54dad3cf by Ben Gamari at 2020-04-30T21:34:44-04:00 nonmoving: Explicitly memoize block count A profile cast doubt on whether the compiler hoisted the bound out the loop as I would have expected here. It turns out it did but nevertheless it seems clearer to just do this manually. - - - - - 99ff8145 by Ben Gamari at 2020-04-30T21:34:44-04:00 nonmoving: Eagerly flush all capabilities' update remembered sets (cherry picked from commit 2fa79119570b358a4db61446396889b8260d7957) - - - - - 05b0a9fd by Ömer Sinan Ağacan at 2020-04-30T21:35:24-04:00 Remove OneShotInfo field of LFReEntrant, document OneShotInfo The field is only used in withNewTickyCounterFun and it's easier to directly pass a parameter for one-shot info to withNewTickyCounterFun instead of passing it via LFReEntrant. This also makes !2842 simpler. Other changes: - New Note (by SPJ) [OneShotInfo overview] added. - Arity argument of thunkCode removed as it's always 0. - - - - - a43620c6 by Ömer Sinan Ağacan at 2020-04-30T21:35:24-04:00 GHC.StgToCmm.Ticky: remove a few unused stuff - - - - - 780de9e1 by Sylvain Henry at 2020-05-01T10:37:39-04:00 Use platform in Iface Binary - - - - - f8386c7b by Sylvain Henry at 2020-05-01T10:37:39-04:00 Refactor PprDebug handling If `-dppr-debug` is set, then PprUser and PprDump styles are silently replaced with PprDebug style. This was done in `mkUserStyle` and `mkDumpStyle` smart constructors. As a consequence they needed a DynFlags parameter. Now we keep the original PprUser and PprDump styles until they are used to create an `SDocContext`. I.e. the substitution is only performed in `initSDocContext`. - - - - - b3df9e78 by Sylvain Henry at 2020-05-01T10:37:39-04:00 Remove PprStyle param of logging actions Use `withPprStyle` instead to apply a specific style to a SDoc. - - - - - de9fc995 by Sylvain Henry at 2020-05-01T10:37:39-04:00 Fully remove PprDebug PprDebug was a pain to deal with consistently as it is implied by `-dppr-debug` but it isn't really a PprStyle. We remove it completely and query the appropriate SDoc flag instead (`sdocPprDebug`) via helpers (`getPprDebug` and its friends). - - - - - 8b51fcbd by Sebastian Graf at 2020-05-01T10:38:16-04:00 PmCheck: Only call checkSingle if we would report warnings - - - - - fd7ea0fe by Sebastian Graf at 2020-05-01T10:38:16-04:00 PmCheck: Pick up `EvVar`s bound in `HsWrapper`s for long-distance info `HsWrapper`s introduce evidence bindings through `WpEvLam` which the pattern-match coverage checker should be made aware of. Failing to do so caused #18049, where the resulting impreciseness of imcompleteness warnings seemingly contradicted with `-Winaccessible-code`. The solution is simple: Collect all the evidence binders of an `HsWrapper` and add it to the ambient `Deltas` before desugaring the wrapped expression. But that means we pick up many more evidence bindings, even when they wrap around code without a single pattern match to check! That regressed `T3064` by over 300%, so now we are adding long-distance info lazily through judicious use of `unsafeInterleaveIO`. Fixes #18049. - - - - - 7bfe9ac5 by Ben Gamari at 2020-05-03T04:41:33-04:00 rts: Enable tracing of nonmoving heap census with -ln Previously this was not easily available to the user. Fix this. Non-moving collection lifecycle events are now reported with -lg. - - - - - c560dd07 by Ben Gamari at 2020-05-03T04:41:33-04:00 users guide: Move eventlog documentation users guide - - - - - 02543d5e by Ben Gamari at 2020-05-03T04:41:33-04:00 users guide: Add documentation for non-moving GC events - - - - - b465dd45 by Alexis King at 2020-05-03T04:42:12-04:00 Flatten nested casts in the simple optimizer Normally, we aren’t supposed to generated any nested casts, since mkCast takes care to flatten them, but the simple optimizer didn’t use mkCast, so they could show up after inlining. This isn’t really a problem, since the simplifier will clean them up immediately anyway, but it can clutter the -ddump-ds output, and it’s an extremely easy fix. closes #18112 - - - - - 8bdc03d6 by Simon Peyton Jones at 2020-05-04T01:56:59-04:00 Don't return a panic in tcNestedSplice In GHC.Tc.Gen.Splice.tcNestedSplice we were returning a typechecked expression of "panic". That is usually OK, because the result is discarded. But it happens that tcApp now looks at the typechecked expression, trivially, to ask if it is tagToEnum. So being bottom is bad. Moreover a debug-trace might print it out. So better to return a civilised expression, even though it is usually discarded. - - - - - 0bf640b1 by Baldur Blöndal at 2020-05-04T01:57:36-04:00 Don't require parentheses around via type (`-XDerivingVia'). Fixes #18130". - - - - - 30272412 by Artem Pelenitsyn at 2020-05-04T13:19:59-04:00 Remove custom ExceptionMonad class (#18075) (updating haddock submodule accordingly) - - - - - b9f7c08f by jneira at 2020-05-04T13:20:37-04:00 Remove unused hs-boot file - - - - - 1d8f80cd by Sylvain Henry at 2020-05-05T03:22:46-04:00 Remove references to -package-key * remove references to `-package-key` which has been removed in 2016 (240ddd7c39536776e955e881d709bbb039b48513) * remove support for `-this-package-key` which has been deprecated at the same time - - - - - 7bc3a65b by Sylvain Henry at 2020-05-05T03:23:31-04:00 Remove SpecConstrAnnotation (#13681) This has been deprecated since 2013. Use GHC.Types.SPEC instead. Make GHC.Exts "not-home" for haddock Metric Decrease: haddock.base - - - - - 3c862f63 by DenisFrezzato at 2020-05-05T03:24:15-04:00 Fix Haskell98 short description in documentation - - - - - 2420c555 by Ryan Scott at 2020-05-05T03:24:53-04:00 Add regression tests for #16244, #16245, #16758 Commit e3c374cc5bd7eb49649b9f507f9f7740697e3f70 ended up fixing quite a few bugs: * This commit fixes #16244 completely. A regression test has been added. * This commit fixes one program from #16245. (The program in https://gitlab.haskell.org/ghc/ghc/issues/16245#note_211369 still panics, and the program in https://gitlab.haskell.org/ghc/ghc/issues/16245#note_211400 still loops infinitely.) A regression test has been added for this program. * This commit fixes #16758. Accordingly, this patch removes the `expect_broken` label from the `T16758` test case, moves it from `should_compile` to `should_fail` (as it should produce an error message), and checks in the expected stderr. - - - - - 40c71c2c by Sylvain Henry at 2020-05-05T03:25:31-04:00 Fix colorized error messages (#18128) In b3df9e780fb2f5658412c644849cd0f1e6f50331 I broke colorized messages by using "dump" style instead of "user" style. This commits fixes it. - - - - - 7ab6ab09 by Richard Eisenberg at 2020-05-06T04:39:32-04:00 Refactor hole constraints. Previously, holes (both expression holes / out of scope variables and partial-type-signature wildcards) were emitted as *constraints* via the CHoleCan constructor. While this worked fine for error reporting, there was a fair amount of faff in keeping these constraints in line. In particular, and unlike other constraints, we could never change a CHoleCan to become CNonCanonical. In addition: * the "predicate" of a CHoleCan constraint was really the type of the hole, which is not a predicate at all * type-level holes (partial type signature wildcards) carried evidence, which was never used * tcNormalise (used in the pattern-match checker) had to create a hole constraint just to extract it again; it was quite messy The new approach is to record holes directly in WantedConstraints. It flows much more nicely now. Along the way, I did some cleaning up of commentary in GHC.Tc.Errors.Hole, which I had a hard time understanding. This was instigated by a future patch that will refactor the way predicates are handled. The fact that CHoleCan's "predicate" wasn't really a predicate is incompatible with that future patch. No test case, because this is meant to be purely internal. It turns out that this change improves the performance of the pattern-match checker, likely because fewer constraints are sloshing about in tcNormalise. I have not investigated deeply, but an improvement is not a surprise here: ------------------------- Metric Decrease: PmSeriesG ------------------------- - - - - - 420b957d by Ben Gamari at 2020-05-06T04:40:08-04:00 rts: Zero block flags with -DZ Block flags are very useful for determining the state of a block. However, some block allocator users don't touch them, leading to misleading values. Ensure that we zero then when zero-on-gc is set. This is safe and makes the flags more useful during debugging. - - - - - 740b3b8d by Ben Gamari at 2020-05-06T04:40:08-04:00 nonmoving: Fix incorrect failed_to_evac value during deadlock gc Previously we would incorrectly set the failed_to_evac flag if we evacuated a value due to a deadlock GC. This would cause us to mark more things as dirty than strictly necessary. It also turned up a nasty but which I will fix next. - - - - - b2d72c75 by Ben Gamari at 2020-05-06T04:40:08-04:00 nonmoving: Fix handling of dirty objects Previously we (incorrectly) relied on failed_to_evac to be "precise". That is, we expected it to only be true if *all* of an object's fields lived outside of the non-moving heap. However, does not match the behavior of failed_to_evac, which is true if *any* of the object's fields weren't promoted (meaning that some others *may* live in the non-moving heap). This is problematic as we skip the non-moving write barrier for dirty objects (which we can only safely do if *all* fields point outside of the non-moving heap). Clearly this arises due to a fundamental difference in the behavior expected of failed_to_evac in the moving and non-moving collector. e.g., in the moving collector it is always safe to conservatively say failed_to_evac=true whereas in the non-moving collector the safe value is false. This issue went unnoticed as I never wrote down the dirtiness invariant enforced by the non-moving collector. We now define this invariant as An object being marked as dirty implies that all of its fields are on the mark queue (or, equivalently, update remembered set). To maintain this invariant we teach nonmovingScavengeOne to push the fields of objects which we fail to evacuate to the update remembered set. This is a simple and reasonably cheap solution and avoids the complexity and fragility that other, more strict alternative invariants would require. All of this is described in a new Note, Note [Dirty flags in the non-moving collector] in NonMoving.c. - - - - - 9f3e6884 by Zubin Duggal at 2020-05-06T04:41:08-04:00 Allow atomic update of NameCache in readHieFile The situation arises in ghcide where multiple different threads may need to update the name cache, therefore with the older interface it could happen that you start reading a hie file with name cache A and produce name cache A + B, but another thread in the meantime updated the namecache to A + C. Therefore if you write the new namecache you will lose the A' updates from the second thread. Updates haddock submodule - - - - - edec6a6c by Ryan Scott at 2020-05-06T04:41:57-04:00 Make isTauTy detect higher-rank contexts Previously, `isTauTy` would only detect higher-rank `forall`s, not higher-rank contexts, which led to some minor bugs observed in #18127. Easily fixed by adding a case for `(FunTy InvisArg _ _)`. Fixes #18127. - - - - - a95e7fe0 by Ömer Sinan Ağacan at 2020-05-06T04:42:39-04:00 ELF linker: increment curSymbol after filling in fields of current entry The bug was introduced in a8b7cef4d45 which added a field to the `symbols` array elements and then updated this code incorrectly: - oc->symbols[curSymbol++] = nm; + oc->symbols[curSymbol++].name = nm; + oc->symbols[curSymbol].addr = symbol->addr; - - - - - cab1871a by Sylvain Henry at 2020-05-06T04:43:21-04:00 Move LeadingUnderscore into Platform (#17957) Avoid direct use of DynFlags to know if symbols must be prefixed by an underscore. - - - - - 94e7c563 by Sylvain Henry at 2020-05-06T04:43:21-04:00 Don't use DynFlags in showLinkerState (#17957) - - - - - 9afd9251 by Ryan Scott at 2020-05-06T04:43:58-04:00 Refactoring: Use bindSigTyVarsFV in rnMethodBinds `rnMethodBinds` was explicitly using `xoptM` to determine if `ScopedTypeVariables` is enabled before bringing type variables bound by the class/instance header into scope. However, this `xoptM` logic is already performed by the `bindSigTyVarsFV` function. This patch uses `bindSigTyVarsFV` in `rnMethodBinds` to reduce the number of places where we need to consult if `ScopedTypeVariables` is on. This is purely refactoring, and there should be no user-visible change in behavior. - - - - - 6f6d72b2 by Brian Foley at 2020-05-08T15:29:25-04:00 Remove further dead code found by a simple Python script. Avoid removing some functions that are part of an API even though they're not used in-tree at the moment. - - - - - 78bf8bf9 by Julien Debon at 2020-05-08T15:29:28-04:00 Add doc examples for Bifoldable See #17929 - - - - - 66f0a847 by Julien Debon at 2020-05-08T15:29:29-04:00 doc (Bitraversable): Add examples to Bitraversable * Add examples to Data.Bitraversable * Fix formatting for (,) in Bitraversable and Bifoldable * Fix mistake on bimapAccumR documentation See #17929 - - - - - 9749fe12 by Baldur Blöndal at 2020-05-08T15:29:32-04:00 Specify kind variables for inferred kinds in base. - - - - - 4e9aef9e by John Ericson at 2020-05-08T15:29:36-04:00 HsSigWcTypeScoping: Pull in documentation from stray location - - - - - f4d5c6df by John Ericson at 2020-05-08T15:29:36-04:00 Rename local `real_fvs` to `implicit_vs` It doesn't make sense to call the "free" variables we are about to implicitly bind the real ones. - - - - - 20570b4b by John Ericson at 2020-05-08T15:29:36-04:00 A few tiny style nits with renaming - Use case rather than guards that repeatedly scrutenize same thing. - No need for view pattern when `L` is fine. - Use type synnonym to convey the intent like elsewhere. - - - - - 09ac8de5 by John Ericson at 2020-05-08T15:29:36-04:00 Add `forAllOrNothing` function with note - - - - - bb35c0e5 by Joseph C. Sible at 2020-05-08T15:29:40-04:00 Document lawlessness of Ap's Num instance - - - - - cdd229ff by Joseph C. Sible at 2020-05-08T15:29:40-04:00 Apply suggestion to libraries/base/Data/Monoid.hs - - - - - 926d2aab by Joseph C. Sible at 2020-05-08T15:29:40-04:00 Apply more suggestions from Simon Jakobi - - - - - 7a763cff by Adam Gundry at 2020-05-08T15:29:41-04:00 Reject all duplicate declarations involving DuplicateRecordFields (fixes #17965) This fixes a bug that resulted in some programs being accepted that used the same identifier as a field label and another declaration, depending on the order they appeared in the source code. - - - - - 88e3c815 by Simon Peyton Jones at 2020-05-08T15:29:41-04:00 Fix specialisation for DFuns When specialising a DFun we must take care to saturate the unfolding. See Note [Specialising DFuns] in Specialise. Fixes #18120 - - - - - 86c77b36 by Greg Steuck at 2020-05-08T15:29:45-04:00 Remove unused SEGMENT_PROT_RWX It's been unused for a year and is problematic on any OS which requires W^X for security. - - - - - 9d97f4b5 by nineonine at 2020-05-08T15:30:03-04:00 Add test for #16167 - - - - - aa318338 by Ryan Scott at 2020-05-08T15:30:04-04:00 Bump exceptions submodule so that dist-boot is .gitignore'd `exceptions` is a stage-0 boot library as of commit 30272412fa437ab8e7a8035db94a278e10513413, which means that building `exceptions` in a GHC tree will generate a `dist-boot` directory. However, this directory was not specified in `exceptions`' `.gitignore` file, which causes it to dirty up the current `git` working directory. Accordingly, this bumps the `exceptions` submodule to commit ghc/packages/exceptions at 23c0b8a50d7592af37ca09beeec16b93080df98f, which adds `dist-boot` to the `.gitignore` file. - - - - - ea86360f by Ömer Sinan Ağacan at 2020-05-08T15:30:30-04:00 Linker.c: initialize n_symbols of ObjectCode with other fields - - - - - 951c1fb0 by Sylvain Henry at 2020-05-09T21:46:38-04:00 Fix unboxed-sums GC ptr-slot rubbish value (#17791) This patch allows boot libraries to use unboxed sums without implicitly depending on `base` package because of `absentSumFieldError`. See updated Note [aBSENT_SUM_FIELD_ERROR_ID] in GHC.Core.Make - - - - - b352d63c by Ben Gamari at 2020-05-09T21:47:14-04:00 rts: Make non-existent linker search path merely a warning As noted in #18105, previously this resulted in a rather intrusive error message. This is in contrast to the general expectation that search paths are merely places to look, not places that must exist. Fixes #18105. - - - - - cf4f1e2f by Ben Gamari at 2020-05-13T02:02:33-04:00 rts/CNF: Fix fixup comparison function Previously we would implicitly convert the difference between two words to an int, resulting in an integer overflow on 64-bit machines. Fixes #16992 - - - - - a03da9bf by Ömer Sinan Ağacan at 2020-05-13T02:03:16-04:00 Pack some of IdInfo fields into a bit field This reduces residency of compiler quite a bit on some programs. Example stats when building T10370: Before: 2,871,242,832 bytes allocated in the heap 4,693,328,008 bytes copied during GC 33,941,448 bytes maximum residency (276 sample(s)) 375,976 bytes maximum slop 83 MiB total memory in use (0 MB lost due to fragmentation) After: 2,858,897,344 bytes allocated in the heap 4,629,255,440 bytes copied during GC 32,616,624 bytes maximum residency (278 sample(s)) 314,400 bytes maximum slop 80 MiB total memory in use (0 MB lost due to fragmentation) So -3.9% residency, -1.3% bytes copied and -0.4% allocations. Fixes #17497 Metric Decrease: T9233 T9675 - - - - - 670c3e5c by Ben Gamari at 2020-05-13T02:03:54-04:00 get-win32-tarballs: Fix base URL Revert a change previously made for testing purposes. - - - - - 8ad8dc41 by Ben Gamari at 2020-05-13T02:03:54-04:00 get-win32-tarballs: Improve diagnostics output - - - - - 8c0740b7 by Simon Jakobi at 2020-05-13T02:04:33-04:00 docs: Add examples for Data.Semigroup.Arg{Min,Max} Context: #17153 - - - - - cb22348f by Ben Gamari at 2020-05-13T02:05:11-04:00 Add few cleanups of the CAF logic Give the NameSet of non-CAFfy names a proper newtype to distinguish it from all of the other NameSets floating about. - - - - - 90e38b81 by Emeka Nkurumeh at 2020-05-13T02:05:51-04:00 fix printf warning when using with ghc with clang on mingw - - - - - 86d8ac22 by Sebastian Graf at 2020-05-13T02:06:29-04:00 CprAnal: Don't attach CPR sigs to expandable bindings (#18154) Instead, look through expandable unfoldings in `cprTransform`. See the new Note [CPR for expandable unfoldings]: ``` Long static data structures (whether top-level or not) like xs = x1 : xs1 xs1 = x2 : xs2 xs2 = x3 : xs3 should not get CPR signatures, because they * Never get WW'd, so their CPR signature should be irrelevant after analysis (in fact the signature might even be harmful for that reason) * Would need to be inlined/expanded to see their constructed product * Recording CPR on them blows up interface file sizes and is redundant with their unfolding. In case of Nested CPR, this blow-up can be quadratic! But we can't just stop giving DataCon application bindings the CPR property, for example fac 0 = 1 fac n = n * fac (n-1) fac certainly has the CPR property and should be WW'd! But FloatOut will transform the first clause to lvl = 1 fac 0 = lvl If lvl doesn't have the CPR property, fac won't either. But lvl doesn't have a CPR signature to extrapolate into a CPR transformer ('cprTransform'). So instead we keep on cprAnal'ing through *expandable* unfoldings for these arity 0 bindings via 'cprExpandUnfolding_maybe'. In practice, GHC generates a lot of (nested) TyCon and KindRep bindings, one for each data declaration. It's wasteful to attach CPR signatures to each of them (and intractable in case of Nested CPR). ``` Fixes #18154. - - - - - e34bf656 by Ben Gamari at 2020-05-13T02:07:08-04:00 users-guide: Add discussion of shared object naming Fixes #18074. - - - - - 5d0f2445 by Ben Gamari at 2020-05-13T02:07:47-04:00 testsuite: Print sign of performance changes Executes the minor formatting change in the tabulated performance changes suggested in #18135. - - - - - 9e4b981f by Ben Gamari at 2020-05-13T02:08:24-04:00 testsuite: Add testcase for #18129 - - - - - 266310c3 by Ivan-Yudin at 2020-05-13T02:09:03-04:00 doc: Reformulate the opening paragraph of Ch. 4 in User's guide Removes mentioning of Hugs (it is not helpful for new users anymore). Changes the wording for the rest of the paragraph. Fixes #18132. - - - - - 55e35c0b by Baldur Blöndal at 2020-05-13T20:02:48-04:00 Predicate, Equivalence derive via `.. -> a -> All' - - - - - d7e0b57f by Alp Mestanogullari at 2020-05-13T20:03:30-04:00 hadrian: add a --freeze2 option to freeze stage 1 and 2 - - - - - d880d6b2 by Artem Pelenitsyn at 2020-05-13T20:04:11-04:00 Don't reload environment files on every setSessionDynFlags Makes `interpretPackageEnv` (which loads envirinment files) a part of `parseDynamicFlags` (parsing command-line arguments, which is typically done once) instead of `setSessionDynFlags` (which is typically called several times). Making several (transitive) calls to `interpretPackageEnv`, as before, caused #18125 #16318, which should be fixed now. - - - - - 102cfd67 by Ryan Scott at 2020-05-13T20:04:46-04:00 Factor out HsPatSigType for pat sigs/RULE term sigs (#16762) This implements chunks (2) and (3) of https://gitlab.haskell.org/ghc/ghc/issues/16762#note_270170. Namely, it introduces a dedicated `HsPatSigType` AST type, which represents the types that can appear in pattern signatures and term-level `RULE` binders. Previously, these were represented with `LHsSigWcType`. Although `LHsSigWcType` is isomorphic to `HsPatSigType`, the intended semantics of the two types are slightly different, as evidenced by the fact that they have different code paths in the renamer and typechecker. See also the new `Note [Pattern signature binders and scoping]` in `GHC.Hs.Types`. - - - - - b17574f7 by Hécate at 2020-05-13T20:05:28-04:00 fix(documentation): Fix the RST links to GHC.Prim - - - - - df021fb1 by Baldur Blöndal at 2020-05-13T20:06:06-04:00 Document (->) using inferred quantification for its runtime representations. Fixes #18142. - - - - - 1a93ea57 by Takenobu Tani at 2020-05-13T20:06:54-04:00 Tweak man page for ghc command This commit updates the ghc command's man page as followings: * Enable `man_show_urls` to show URL addresses in the `DESCRIPTION` section of ghc.rst, because sphinx currently removes hyperlinks for man pages. * Add a `SEE ALSO` section to point to the GHC homepage - - - - - a951e1ba by Takenobu Tani at 2020-05-13T20:07:37-04:00 GHCi: Add link to the user's guide in help message This commit adds a link to the user's guide in ghci's `:help` message. Newcomers could easily reach to details of ghci. - - - - - 404581ea by Jeff Happily at 2020-05-13T20:08:15-04:00 Handle single unused import - - - - - 1c999e5d by Ben Gamari at 2020-05-13T20:09:07-04:00 Ensure that printMinimalImports closes handle Fixes #18166. - - - - - c9f5a8f4 by Ben Gamari at 2020-05-13T20:09:51-04:00 hadrian: Tell testsuite driver about LLVM availability This reflects the logic present in the Make build system into Hadrian. Fixes #18167. - - - - - c05c0659 by Simon Jakobi at 2020-05-14T03:31:21-04:00 Improve some folds over Uniq[D]FM * Replace some non-deterministic lazy folds with strict folds. * Replace some O(n log n) folds in deterministic order with O(n) non-deterministic folds. * Replace some folds with set-operations on the underlying IntMaps. This reduces max residency when compiling `nofib/spectral/simple/Main.hs` with -O0 by about 1%. Maximum residency when compiling Cabal also seems reduced on the order of 3-9%. - - - - - 477f13bb by Simon Jakobi at 2020-05-14T03:31:58-04:00 Use Data.IntMap.disjoint Data.IntMap gained a dedicated `disjoint` function in containers-0.6.2.1. This patch applies this function where appropriate in hopes of modest compiler performance improvements. Closes #16806. - - - - - e9c0110c by Ben Gamari at 2020-05-14T12:25:53-04:00 IdInfo: Add reference to bitfield-packing ticket - - - - - 9bd20e83 by Sebastian Graf at 2020-05-15T10:42:09-04:00 DmdAnal: Improve handling of precise exceptions This patch does two things: Fix possible unsoundness in what was called the "IO hack" and implement part 2.1 of the "fixing precise exceptions" plan in https://gitlab.haskell.org/ghc/ghc/wikis/fixing-precise-exceptions, which, in combination with !2956, supersedes !3014 and !2525. **IO hack** The "IO hack" (which is a fallback to preserve precise exceptions semantics and thus soundness, rather than some smart thing that increases precision) is called `exprMayThrowPreciseException` now. I came up with two testcases exemplifying possible unsoundness (if twisted enough) in the old approach: - `T13380d`: Demonstrating unsoundness of the "IO hack" when resorting to manual state token threading and direct use of primops. More details below. - `T13380e`: Demonstrating unsoundness of the "IO hack" when we have Nested CPR. Not currently relevant, as we don't have Nested CPR yet. - `T13380f`: Demonstrating unsoundness of the "IO hack" for safe FFI calls. Basically, the IO hack assumed that precise exceptions can only be thrown from a case scrutinee of type `(# State# RealWorld, _ #)`. I couldn't come up with a program using the `IO` abstraction that violates this assumption. But it's easy to do so via manual state token threading and direct use of primops, see `T13380d`. Also similar code might be generated by Nested CPR in the (hopefully not too) distant future, see `T13380e`. Hence, we now have a more careful test in `forcesRealWorld` that passes `T13380{d,e}` (and will hopefully be robust to Nested CPR). **Precise exceptions** In #13380 and #17676 we saw that we didn't preserve precise exception semantics in demand analysis. We fixed that with minimal changes in !2956, but that was terribly unprincipled. That unprincipledness resulted in a loss of precision, which is tracked by these new test cases: - `T13380b`: Regression in dead code elimination, because !2956 was too syntactic about `raiseIO#` - `T13380c`: No need to apply the "IO hack" when the IO action may not throw a precise exception (and the existing IO hack doesn't detect that) Fixing both issues in !3014 turned out to be too complicated and had the potential to regress in the future. Hence we decided to only fix `T13380b` and augment the `Divergence` lattice with a new middle-layer element, `ExnOrDiv`, which means either `Diverges` (, throws an imprecise exception) or throws a *precise* exception. See the wiki page on Step 2.1 for more implementational details: https://gitlab.haskell.org/ghc/ghc/wikis/fixing-precise-exceptions#dead-code-elimination-for-raiseio-with-isdeadenddiv-introducing-exnordiv-step-21 - - - - - 568d7279 by Ben Gamari at 2020-05-15T10:42:46-04:00 GHC.Cmm.Opt: Handle MO_XX_Conv This MachOp was introduced by 2c959a1894311e59cd2fd469c1967491c1e488f3 but a wildcard match in cmmMachOpFoldM hid the fact that it wasn't handled. Ideally we would eliminate the match but this appears to be a larger task. Fixes #18141. - - - - - 5bcf8606 by Ryan Scott at 2020-05-17T08:46:38-04:00 Remove duplicate Note [When to print foralls] in GHC.Core.TyCo.Ppr There are two different Notes named `[When to print foralls]`. The most up-to-date one is in `GHC.Iface.Type`, but there is a second one in `GHC.Core.TyCo.Ppr`. The latter is less up-to-date, as it was written before GHC switched over to using ifaces to pretty-print types. I decided to just remove the latter and replace it with a reference to the former. [ci skip] - - - - - 55f0e783 by Fumiaki Kinoshita at 2020-05-21T12:10:44-04:00 base: Add Generic instances to various datatypes under GHC.* * GHC.Fingerprint.Types: Fingerprint * GHC.RTS.Flags: GiveGCStats, GCFlags, ConcFlags, DebugFlags, CCFlags, DoHeapProfile, ProfFlags, DoTrace, TraceFlags, TickyFlags, ParFlags and RTSFlags * GHC.Stats: RTSStats and GCStats * GHC.ByteOrder: ByteOrder * GHC.Unicode: GeneralCategory * GHC.Stack.Types: SrcLoc Metric Increase: haddock.base - - - - - a9311cd5 by Gert-Jan Bottu at 2020-05-21T12:11:31-04:00 Explicit Specificity Implementation for Ticket #16393. Explicit specificity allows users to manually create inferred type variables, by marking them with braces. This way, the user determines which variables can be instantiated through visible type application. The additional syntax is included in the parser, allowing users to write braces in type variable binders (type signatures, data constructors etc). This information is passed along through the renamer and verified in the type checker. The AST for type variable binders, data constructors, pattern synonyms, partial signatures and Template Haskell has been updated to include the specificity of type variables. Minor notes: - Bumps haddock submodule - Disables pattern match checking in GHC.Iface.Type with GHC 8.8 - - - - - 24e61aad by Ben Price at 2020-05-21T12:12:17-04:00 Lint should say when it is checking a rule It is rather confusing that when lint finds an error in a rule attached to a binder, it reports the error as in the RHS, not the rule: ... In the RHS of foo We add a clarifying line: ... In the RHS of foo In a rule attached to foo The implication that the rule lives inside the RHS is a bit odd, but this niggle is already present for unfoldings, whose pattern we are following. - - - - - 78c6523c by Ben Gamari at 2020-05-21T12:13:01-04:00 nonmoving: Optimise the write barrier - - - - - 13f6c9d0 by Andreas Klebinger at 2020-05-21T12:13:45-04:00 Refactor linear reg alloc to remember past assignments. When assigning registers we now first try registers we assigned to in the past, instead of picking the "first" one. This is in extremely helpful when dealing with loops for which variables are dead for part of the loop. This is important for patterns like this: foo = arg1 loop: use(foo) ... foo = getVal() goto loop; There we: * assign foo to the register of arg1. * use foo, it's dead after this use as it's overwritten after. * do other things. * look for a register to put foo in. If we pick an arbitrary one it might differ from the register the start of the loop expect's foo to be in. To fix this we simply look for past register assignments for the given variable. If we find one and the register is free we use that register. This reduces the need for fixup blocks which match the register assignment between blocks. In the example above between the end and the head of the loop. This patch also moves branch weight estimation ahead of register allocation and adds a flag to control it (cmm-static-pred). * It means the linear allocator is more likely to assign the hotter code paths first. * If it assign these first we are: + Less likely to spill on the hot path. + Less likely to introduce fixup blocks on the hot path. These two measure combined are surprisingly effective. Based on nofib we get in the mean: * -0.9% instructions executed * -0.1% reads/writes * -0.2% code size. * -0.1% compiler allocations. * -0.9% compile time. * -0.8% runtime. Most of the benefits are simply a result of removing redundant moves and spills. Reduced compiler allocations likely are the result of less code being generated. (The added lookup is mostly non-allocating). - - - - - edc2cc58 by Andreas Klebinger at 2020-05-21T12:14:25-04:00 NCG: Codelayout: Distinguish conditional and other branches. In #18053 we ended up with a suboptimal code layout because the code layout algorithm didn't distinguish between conditional and unconditional control flow. We can completely eliminate unconditional control flow instructions by placing blocks next to each other, not so much for conditionals. In terms of implementation we simply give conditional branches less weight before computing the layout. Fixes #18053 - - - - - b7a6b2f4 by Gleb Popov at 2020-05-21T12:15:26-04:00 gitlab-ci: Set locale to C.UTF-8. - - - - - a8c27cf6 by Stefan Holdermans at 2020-05-21T12:16:08-04:00 Allow spaces in GHCi :script file names This patch updates the user interface of GHCi so that file names passed to the ':script' command may contain spaces escaped with a backslash. For example: :script foo\ bar.script The implementation uses a modified version of 'words' that does not break on escaped spaces. Fixes #18027. - - - - - 82663959 by Stefan Holdermans at 2020-05-21T12:16:08-04:00 Add extra tests for GHCi :script syntax checks The syntax for GHCi's ":script" command allows for only a single file name to be passed as an argument. This patch adds a test for the cases in which a file name is missing or multiple file names are passed. Related to #T18027. - - - - - a0b79e1b by Stefan Holdermans at 2020-05-21T12:16:08-04:00 Allow GHCi :script file names in double quotes This patch updates the user interface of GHCi so that file names passed to the ':script' command can be wrapped in double quotes. For example: :script "foo bar.script" The implementation uses a modified version of 'words' that treats character sequences enclosed in double quotes as single words. Fixes #18027. - - - - - cf566330 by Stefan Holdermans at 2020-05-21T12:16:08-04:00 Update documentation for GHCi :script This patch adds the fixes that allow for file names containing spaces to be passed to GHCi's ':script' command to the release notes for 8.12 and expands the user-guide documentation for ':script' by mentioning how such file names can be passed. Related to #18027. - - - - - 0004ccb8 by Tuan Le at 2020-05-21T12:16:46-04:00 llvmGen: Consider Relocatable read-only data as not constantReferences: #18137 - - - - - 964d3ea2 by John Ericson at 2020-05-21T12:17:30-04:00 Use `Checker` for `tc_pat` - - - - - b797aa42 by John Ericson at 2020-05-21T12:17:30-04:00 Use `Checker` for `tc_lpat` and `tc_lpats` - - - - - 5108e84a by John Ericson at 2020-05-21T12:17:30-04:00 More judiciously panic in `ts_pat` - - - - - 510e0451 by John Ericson at 2020-05-21T12:17:30-04:00 Put `PatEnv` first in `GHC.Tc.Gen.Pat.Checker` - - - - - cb4231db by John Ericson at 2020-05-21T12:17:30-04:00 Tiny cleaup eta-reduce away a function argument In GHC, not in the code being compiled! - - - - - 6890c38d by John Ericson at 2020-05-21T12:17:30-04:00 Use braces with do in `SplicePat` case for consistency - - - - - 3451584f by buggymcbugfix at 2020-05-21T12:18:06-04:00 Fix spelling mistakes and typos - - - - - b552e531 by buggymcbugfix at 2020-05-21T12:18:06-04:00 Add INLINABLE pragmas to Enum list producers The INLINABLE pragmas ensure that we export stable (unoptimised) unfoldings in the interface file so we can do list fusion at usage sites. Related tickets: #15185, #8763, #18178. - - - - - e7480063 by buggymcbugfix at 2020-05-21T12:18:06-04:00 Piggyback on Enum Word methods for Word64 If we are on a 64 bit platform, we can use the efficient Enum Word methods for the Enum Word64 instance. - - - - - 892b0c41 by buggymcbugfix at 2020-05-21T12:18:06-04:00 Document INLINE(ABLE) pragmas that enable fusion - - - - - 2b363ebb by Richard Eisenberg at 2020-05-21T12:18:45-04:00 MR template should ask for key part - - - - - a95bbd0b by Sebastian Graf at 2020-05-21T12:19:37-04:00 Make `Int`'s `mod` and `rem` strict in their first arguments They used to be strict until 4d2ac2d (9 years ago). It's obviously better to be strict for performance reasons. It also blocks #18067. NoFib results: ``` -------------------------------------------------------------------------------- Program Allocs Instrs -------------------------------------------------------------------------------- integer -1.1% +0.4% wheel-sieve2 +21.2% +20.7% -------------------------------------------------------------------------------- Min -1.1% -0.0% Max +21.2% +20.7% Geometric Mean +0.2% +0.2% ``` The regression in `wheel-sieve2` is due to reboxing that likely will go away with the resolution of #18067. See !3282 for details. Fixes #18187. - - - - - d3d055b8 by Galen Huntington at 2020-05-21T12:20:18-04:00 Clarify pitfalls of NegativeLiterals; see #18022. - - - - - 1b508a9e by Alexey Kuleshevich at 2020-05-21T12:21:02-04:00 Fix wording in primops documentation to reflect the correct reasoning: * Besides resizing functions, shrinking ones also mutate the size of a mutable array and because of those two `sizeofMutabeByteArray` and `sizeofSmallMutableArray` are now deprecated * Change reference in documentation to the newer functions `getSizeof*` instead of `sizeof*` for shrinking functions * Fix incorrect mention of "byte" instead of "small" - - - - - 4ca0c8a1 by Andreas Klebinger at 2020-05-21T12:21:53-04:00 Don't variable-length encode magic iface constant. We changed to use variable length encodings for many types by default, including Word32. This makes sense for numbers but not when Word32 is meant to represent four bytes. I added a FixedLengthEncoding newtype to Binary who's instances interpret their argument as a collection of bytes instead of a number. We then use this when writing/reading magic numbers to the iface file. I also took the libery to remove the dummy iface field. This fixes #18180. - - - - - a1275081 by Krzysztof Gogolewski at 2020-05-21T12:22:35-04:00 Add a regression test for #11506 The testcase works now. See explanation in https://gitlab.haskell.org/ghc/ghc/issues/11506#note_273202 - - - - - 8a816e5f by Krzysztof Gogolewski at 2020-05-21T12:23:55-04:00 Sort deterministically metric output Previously, we sorted according to the test name and way, but the metrics (max_bytes_used/peak_megabytes_allocated etc.) were appearing in nondeterministic order. - - - - - 566cc73f by Sylvain Henry at 2020-05-21T12:24:45-04:00 Move isDynLinkName into GHC.Types.Name It doesn't belong into GHC.Unit.State - - - - - d830bbc9 by Adam Sandberg Ericsson at 2020-05-23T13:36:20-04:00 docs: fix formatting and add some links [skip ci] - - - - - 49301ad6 by Andrew Martin at 2020-05-23T13:37:01-04:00 Implement cstringLength# and FinalPtr This function and its accompanying rule resolve issue #5218. A future PR to the bytestring library will make the internal Data.ByteString.Internal.unsafePackAddress compute string length with cstringLength#. This will improve the status quo because it is eligible for constant folding. Additionally, introduce a new data constructor to ForeignPtrContents named FinalPtr. This additional data constructor, when used in the IsString instance for ByteString, leads to more Core-to-Core optimization opportunities, fewer runtime allocations, and smaller binaries. Also, this commit re-exports all the functions from GHC.CString (including cstringLength#) in GHC.Exts. It also adds a new test driver. This test driver is used to perform substring matches on Core that is dumped after all the simplifier passes. In this commit, it is used to check that constant folding of cstringLength# works. - - - - - dcd6bdcc by Ben Gamari at 2020-05-23T13:37:48-04:00 simplCore: Ignore ticks in rule templates This fixes #17619, where a tick snuck in to the template of a rule, resulting in a panic during rule matching. The tick in question was introduced via post-inlining, as discussed in `Note [Simplifying rules]`. The solution we decided upon was to simply ignore ticks in the rule template, as discussed in `Note [Tick annotations in RULE matching]`. Fixes #18162. Fixes #17619. - - - - - 82cb8913 by John Ericson at 2020-05-23T13:38:32-04:00 Fix #18145 and also avoid needless work with implicit vars - `forAllOrNothing` now is monadic, so we can trace whether we bind an explicit `forall` or not. - #18145 arose because the free vars calculation was needlessly complex. It is now greatly simplified. - Replaced some other implicit var code with `filterFreeVarsToBind`. Co-authored-by: Ryan Scott <ryan.gl.scott at gmail.com> - - - - - a60dc835 by Ben Gamari at 2020-05-23T13:39:12-04:00 Bump process submodule Fixes #17926. - - - - - 856adf54 by Ben Gamari at 2020-05-23T13:40:21-04:00 users-guide: Clarify meaning of -haddock flag Fixes #18206. - - - - - 7ae57afd by Ben Gamari at 2020-05-23T13:41:03-04:00 git: Add ignored commits file This can be used to tell git to ignore bulk renaming commits like the recently-finished module hierarchy refactoring. Configured with, git config blame.ignoreRevsFile .git-ignore-revs - - - - - 63d30e60 by jneira at 2020-05-24T01:54:42-04:00 Add hie-bios script for windows systems It is a direct translation of the sh script - - - - - 59182b88 by jneira at 2020-05-24T01:54:42-04:00 Honour previous values for CABAL and CABFLAGS The immediate goal is let the hie-bios.bat script set CABFLAGS with `-v0` and remove all cabal output except the compiler arguments - - - - - 932dc54e by jneira at 2020-05-24T01:54:42-04:00 Add specific configuration for windows in hie.yaml - - - - - e0eda070 by jneira at 2020-05-24T01:54:42-04:00 Remove not needed hie-bios output - - - - - a0ea59d6 by Sylvain Henry at 2020-05-24T01:55:24-04:00 Move Config module into GHC.Settings - - - - - 37430251 by Sylvain Henry at 2020-05-24T01:55:24-04:00 Rename GHC.Core.Arity into GHC.Core.Opt.Arity - - - - - a426abb9 by Sylvain Henry at 2020-05-24T01:55:24-04:00 Rename GHC.Hs.Types into GHC.Hs.Type See discussion in https://gitlab.haskell.org/ghc/ghc/issues/13009#note_268610 - - - - - 1c91a7a0 by Sylvain Henry at 2020-05-24T01:55:24-04:00 Bump haddock submodule - - - - - 66bd24d1 by Ryan Scott at 2020-05-24T01:56:03-04:00 Add orderingTyCon to wiredInTyCons (#18185) `Ordering` needs to be wired in for use in the built-in `CmpNat` and `CmpSymbol` type families, but somehow it was never added to the list of `wiredInTyCons`, leading to the various oddities observed in #18185. Easily fixed by moving `orderingTyCon` from `basicKnownKeyNames` to `wiredInTyCons`. Fixes #18185. - - - - - 01c43634 by Matthew Pickering at 2020-05-24T01:56:42-04:00 Remove unused hs-boot file - - - - - 7a07aa71 by Sylvain Henry at 2020-05-24T15:22:17-04:00 Hadrian: fix cross-compiler build (#16051) - - - - - 15ccca16 by Sylvain Henry at 2020-05-24T15:22:17-04:00 Hadrian: fix distDir per stage - - - - - b420fb24 by Sylvain Henry at 2020-05-24T15:22:17-04:00 Hadrian: fix hp2ps error during cross-compilation Fixed by @alp (see https://gitlab.haskell.org/ghc/ghc/issues/16051#note_274265) - - - - - cd339ef0 by Joshua Price at 2020-05-24T15:22:56-04:00 Make Unicode brackets opening/closing tokens (#18225) The tokens `[|`, `|]`, `(|`, and `|)` are opening/closing tokens as described in GHC Proposal #229. This commit makes the unicode variants (`⟦`, `⟧`, `⦇`, and `⦈`) act the same as their ASCII counterparts. - - - - - 013d7120 by Ben Gamari at 2020-05-25T09:48:17-04:00 Revert "Specify kind variables for inferred kinds in base." As noted in !3132, this has rather severe knock-on consequences in user-code. We'll need to revisit this before merging something along these lines. This reverts commit 9749fe1223d182b1f8e7e4f7378df661c509f396. - - - - - 4c4312ed by Ben Gamari at 2020-05-25T09:48:53-04:00 Coverage: Drop redundant ad-hoc boot module check To determine whether the module is a boot module Coverage.addTicksToBinds was checking for a `boot` suffix in the module source filename. This is quite ad-hoc and shouldn't be necessary; the callsite in `deSugar` already checks that the module isn't a boot module. - - - - - 1abf3c84 by Ben Gamari at 2020-05-25T09:48:53-04:00 Coverage: Make tickBoxCount strict This could otherwise easily cause a leak of (+) thunks. - - - - - b2813750 by Ben Gamari at 2020-05-25T09:48:53-04:00 Coverage: Make ccIndices strict This just seems like a good idea. - - - - - 02e278eb by Ben Gamari at 2020-05-25T09:48:53-04:00 Coverage: Don't produce ModBreaks if not HscInterpreted emptyModBreaks contains a bottom and consequently it's important that we don't use it unless necessary. - - - - - b8c014ce by Ben Gamari at 2020-05-25T09:48:53-04:00 Coverage: Factor out addMixEntry - - - - - 53814a64 by Zubin Duggal at 2020-05-26T03:03:24-04:00 Add info about typeclass evidence to .hie files See `testsuite/tests/hiefile/should_run/HieQueries.hs` and `testsuite/tests/hiefile/should_run/HieQueries.stdout` for an example of this We add two new fields, `EvidenceVarBind` and `EvidenceVarUse` to the `ContextInfo` associated with an Identifier. These are associated with the appropriate identifiers for the evidence variables collected when we come across `HsWrappers`, `TcEvBinds` and `IPBinds` while traversing the AST. Instance dictionary and superclass selector dictionaries from `tcg_insts` and classes defined in `tcg_tcs` are also recorded in the AST as originating from their definition span This allows us to save a complete picture of the evidence constructed by the constraint solver, and will let us report this to the user, enabling features like going to the instance definition from the invocation of a class method(or any other method taking a constraint) and finding all usages of a particular instance. Additionally, - Mark NodeInfo with an origin so we can differentiate between bindings origininating in the source vs those in ghc - Along with typeclass evidence info, also include information on Implicit Parameters - Add a few utility functions to HieUtils in order to query the new info Updates haddock submodule - - - - - 6604906c by Sebastian Graf at 2020-05-26T03:04:04-04:00 Make WorkWrap.Lib.isWorkerSmallEnough aware of the old arity We should allow a wrapper with up to 82 parameters when the original function had 82 parameters to begin with. I verified that this made no difference on NoFib, but then again it doesn't use huge records... Fixes #18122. - - - - - cf772f19 by Sylvain Henry at 2020-05-26T03:04:45-04:00 Enhance Note [About units] for Backpack - - - - - ede24126 by Takenobu Tani at 2020-05-27T00:13:55-04:00 core-spec: Modify file paths according to new module hierarchy This patch updates file paths according to new module hierarchy [1]: * GHC/Core.hs <= coreSyn/CoreSyn.hs * GHC/Core/Coercion.hs <= types/Coercion.hs * GHC/Core/Coercion/Axiom.hs <= types/CoAxiom.hs * GHC/Core/Coercion/Opt.hs <= types/OptCoercion.hs * GHC/Core/DataCon.hs <= basicTypes/DataCon.hs * GHC/Core/FamInstEnv.hs <= types/FamInstEnv.hs * GHC/Core/Lint.hs <= coreSyn/CoreLint.hs * GHC/Core/Subst.hs <= coreSyn/CoreSubst.hs * GHC/Core/TyCo/Rep.hs <= types/TyCoRep.hs * GHC/Core/TyCon.hs <= types/TyCon.hs * GHC/Core/Type.hs <= types/Type.hs * GHC/Core/Unify.hs <= types/Unify.hs * GHC/Types/Literal.hs <= basicTypes/Literal.hs * GHC/Types/Var.hs <= basicTypes/Var.hs [1]: https://gitlab.haskell.org/ghc/ghc/-/wikis/Make-GHC-codebase-more-modular [skip ci] - - - - - 04750304 by Ben Gamari at 2020-05-27T00:14:33-04:00 eventlog: Fix racy flushing Previously no attempt was made to avoid multiple threads writing their capability-local eventlog buffers to the eventlog writer simultaneously. This could result in multiple eventlog streams being interleaved. Fix this by documenting that the EventLogWriter's write() and flush() functions may be called reentrantly and fix the default writer to protect its FILE* by a mutex. Fixes #18210. - - - - - d6203f24 by Joshua Price at 2020-05-27T00:15:17-04:00 Make `identifier` parse unparenthesized `->` (#18060) - - - - - 28deee28 by Ben Gamari at 2020-05-28T16:23:21-04:00 GHC.Core.Unfold: Refactor traceInline This reduces duplication as well as fixes a bug wherein -dinlining-check would override -ddump-inlinings. Moreover, the new variant - - - - - 1f393e1e by Ben Gamari at 2020-05-28T16:23:21-04:00 Avoid unnecessary allocations due to tracing utilities While ticky-profiling the typechecker I noticed that hundreds of millions of SDocs are being allocated just in case -ddump-*-trace is enabled. This is awful. We avoid this by ensuring that the dump flag check is inlined into the call site, ensuring that the tracing document needn't be allocated unless it's actually needed. See Note [INLINE conditional tracing utilities] for details. Fixes #18168. Metric Decrease: T9961 haddock.Cabal haddock.base haddock.compiler - - - - - 5f621a78 by Vladislav Zavialov at 2020-05-28T16:23:58-04:00 Add Semigroup/Monoid for Q (#18123) - - - - - dc5f004c by Xavier Denis at 2020-05-28T16:24:37-04:00 Fix #18071 Run the core linter on candidate instances to ensure they are well-kinded. Better handle quantified constraints by using a CtWanted to avoid having unsolved constraints thrown away at the end by the solver. - - - - - 10e6982c by Sebastian Graf at 2020-05-28T16:25:14-04:00 FloatOut: Only eta-expand dead-end RHS if arity will increase (#18231) Otherwise we risk turning trivial RHS into non-trivial RHS, introducing unnecessary bindings in the next Simplifier run, resulting in more churn. Fixes #18231. - - - - - 08dab5f7 by Sebastian Graf at 2020-05-28T16:25:14-04:00 DmdAnal: Recognise precise exceptions from case alternatives (#18086) Consider ```hs m :: IO () m = do putStrLn "foo" error "bar" ``` `m` (from #18086) always throws a (precise or imprecise) exception or diverges. Yet demand analysis infers `<L,A>` as demand signature instead of `<L,A>x` for it. That's because the demand analyser sees `putStrLn` occuring in a case scrutinee and decides that it has to `deferAfterPreciseException`, because `putStrLn` throws a precise exception on some control flow paths. This will mask the `botDiv` `Divergence`of the single case alt containing `error` to `topDiv`. Since `putStrLn` has `topDiv` itself, the final `Divergence` is `topDiv`. This is easily fixed: `deferAfterPreciseException` works by `lub`ing with the demand type of a virtual case branch denoting the precise exceptional control flow. We used `nopDmdType` before, but we can be more precise and use `exnDmdType`, which is `nopDmdType` with `exnDiv`. Now the `Divergence` from the case alt will degrade `botDiv` to `exnDiv` instead of `topDiv`, which combines with the result from the scrutinee to `exnDiv`, and all is well. Fixes #18086. - - - - - aef95f11 by Ben Gamari at 2020-05-28T16:25:53-04:00 Ticky-ticky: Record DataCon name in ticker name This makes it significantly easier to spot the nature of allocations regressions and comes at a reasonably low cost. - - - - - 8f021b8c by Ben Gamari at 2020-05-28T16:26:34-04:00 hadrian: Don't track GHC's verbosity argument Teach hadrian to ignore GHC's -v argument in its recompilation check, thus fixing #18131. - - - - - 13d9380b by Ben Gamari at 2020-05-28T16:27:20-04:00 Rip out CmmStackInfo(updfr_space) As noted in #18232, this field is currently completely unused and moreover doesn't have a clear meaning. - - - - - f10d11fa by Andreas Klebinger at 2020-05-29T01:38:42-04:00 Fix "build/elem" RULE. An redundant constraint prevented the rule from matching. Fixing this allows a call to elem on a known list to be translated into a series of equality checks, and eventually a simple case expression. Surprisingly this seems to regress elem for strings. To avoid this we now also allow foldrCString to inline and add an UTF8 variant. This results in elem being compiled to a tight non-allocating loop over the primitive string literal which performs a linear search. In the process this commit adds UTF8 variants for some of the functions in GHC.CString. This is required to make this work for both ASCII and UTF8 strings. There are also small tweaks to the CString related rules. We now allow ourselfes the luxury to compare the folding function via eqExpr, which helps to ensure the rule fires before we inline foldrCString*. Together with a few changes to allow matching on both the UTF8 and ASCII variants of the CString functions. - - - - - bbeb2389 by Ben Gamari at 2020-05-29T01:39:19-04:00 CoreToStg: Add Outputable ArgInfo instance - - - - - 0e3361ca by Simon Peyton Jones at 2020-05-29T01:39:19-04:00 Make Lint check return type of a join point Consider join x = rhs in body It's important that the type of 'rhs' is the same as the type of 'body', but Lint wasn't checking that invariant. Now it does! This was exposed by investigation into !3113. - - - - - c49f7df0 by Simon Peyton Jones at 2020-05-29T01:39:19-04:00 Do not float join points in exprIsConApp_maybe We hvae been making exprIsConApp_maybe cleverer in recent times: commit b78cc64e923716ac0512c299f42d4d0012306c05 Date: Thu Nov 15 17:14:31 2018 +0100 Make constructor wrappers inline only during the final phase commit 7833cf407d1f608bebb1d38bb99d3035d8d735e6 Date: Thu Jan 24 17:58:50 2019 +0100 Look through newtype wrappers (Trac #16254) commit c25b135ff5b9c69a90df0ccf51b04952c2dc6ee1 Date: Thu Feb 21 12:03:22 2019 +0000 Fix exprIsConApp_maybe But alas there was still a bug, now immortalised in Note [Don't float join points] in SimpleOpt. It's quite hard to trigger because it requires a dead join point, but it came up when compiling Cabal Cabal.Distribution.Fields.Lexer.hs, when working on !3113. Happily, the fix is extremly easy. Finding the bug was not so easy. - - - - - 46720997 by Ben Gamari at 2020-05-29T01:39:19-04:00 Allow simplification through runRW# Because runRW# inlines so late, we were previously able to do very little simplification across it. For instance, given even a simple program like case runRW# (\s -> let n = I# 42# in n) of I# n# -> f n# we previously had no way to avoid the allocation of the I#. This patch allows the simplifier to push strict contexts into the continuation of a runRW# application, as explained in in Note [Simplification of runRW#] in GHC.CoreToStg.Prep. Fixes #15127. Metric Increase: T9961 Metric Decrease: ManyConstructors Co-Authored-By: Simon Peyton-Jone <simonpj at microsoft.com> - - - - - 277c2f26 by Ben Gamari at 2020-05-29T01:39:55-04:00 Eta expand un-saturated primops Now since we no longer try to predict CAFfyness we have no need for the solution to #16846. Eta expanding unsaturated primop applications is conceptually simpler, especially in the presence of levity polymorphism. This essentially reverts cac8dc9f51e31e4c0a6cd9bc302f7e1bc7c03beb, as suggested in #18079. Closes #18079. - - - - - f44d7ae0 by Simon Jakobi at 2020-05-29T01:40:34-04:00 base: Scrap deprecation plan for Data.Monoid.{First,Last} See the discussion on the libraries mailing list for context: https://mail.haskell.org/pipermail/libraries/2020-April/030357.html - - - - - 8b494895 by Jeremy Schlatter at 2020-05-29T01:41:12-04:00 Fix typo in documentation - - - - - 998450f4 by Gleb Popov at 2020-05-29T01:41:53-04:00 Always define USE_PTHREAD_FOR_ITIMER for FreeBSD. - - - - - f9a513e0 by Alp Mestanogullari at 2020-05-29T01:42:36-04:00 hadrian: introduce 'install' target Its logic is very simple. It `need`s the `binary-dist-dir` target and runs suitable `configure` and `make install` commands for the user. A new `--prefix` command line argument is introduced to specify where GHC should be installed. - - - - - 67738db1 by Travis Whitaker at 2020-05-29T13:34:48-04:00 Build a threaded stage 1 if the bootstrapping GHC supports it. - - - - - aac19e6c by Peter Trommler at 2020-05-29T13:35:24-04:00 PPC NCG: No per-symbol .section ".toc" directives All position independent symbols are collected during code generation and emitted in one go. Prepending each symbol with a .section ".toc" directive is redundant. This patch drops the per-symbol directives leading to smaller assembler files. Fixes #18250 - - - - - 4413828b by Ben Gamari at 2020-05-30T06:07:31-04:00 rts: Teach getNumProcessors to return available processors Previously we would report the number of physical processors, which can be quite wrong in a containerized setting. Now we rather return how many processors are in our affinity mask when possible. I also refactored the code to prefer platform-specific since this will report logical CPUs instead of physical (using `machdep.cpu.thread_count` on Darwin and `cpuset_getaffinity` on FreeBSD). Fixes #14781. - - - - - 1449435c by Ben Gamari at 2020-05-30T06:07:31-04:00 users-guide: Note change in getNumProcessors in users guide - - - - - 3d960169 by Ben Gamari at 2020-05-30T06:07:31-04:00 rts: Drop compatibility shims for Windows Vista We can now assume that the thread and processor group interfaces are available. - - - - - 7f8f948c by Peter Trommler at 2020-05-30T06:08:07-04:00 PPC NCG: Fix .size directive on powerpc64 ELF v1 Thanks to Sergei Trofimovich for pointing out the issue. Fixes #18237 - - - - - 7c555b05 by Andreas Klebinger at 2020-05-30T06:08:43-04:00 Optimize GHC.Utils.Monad. Many functions in this module are recursive and as such are marked loop breakers. Which means they are unlikely to get an unfolding. This is *bad*. We always want to specialize them to specific Monads. Which requires a visible unfolding at the use site. I rewrote the recursive ones from: foo f x = ... foo x' ... to foo f x = go x where go x = ... As well as giving some pragmas to make all of them available for specialization. The end result is a reduction of allocations of about -1.4% for nofib/spectral/simple/Main.hs when compiled with `-O`. ------------------------- Metric Decrease: T12425 T14683 T5631 T9233 T9675 T9961 WWRec ------------------------- - - - - - 8b1cb5df by Ben Gamari at 2020-05-30T06:09:20-04:00 Windows: Bump Windows toolchain to 0.2 - - - - - 6947231a by Zubin Duggal at 2020-05-30T06:10:02-04:00 Simplify contexts in GHC.Iface.Ext.Ast - - - - - 2ee4f36c by Daniel Gröber at 2020-06-01T06:32:56-04:00 Cleanup OVERWRITING_CLOSURE logic The code is just more confusing than it needs to be. We don't need to mix the threaded check with the ldv profiling check since ldv's init already checks for this. Hence they can be two separate checks. Taking the sanity checking into account is also cleaner via DebugFlags.sanity. No need for checking the DEBUG define. The ZERO_SLOP_FOR_LDV_PROF and ZERO_SLOP_FOR_SANITY_CHECK definitions the old code had also make things a lot more opaque IMO so I removed those. - - - - - 6159559b by Daniel Gröber at 2020-06-01T06:32:56-04:00 Fix OVERWRITING_CLOSURE assuming closures are not inherently used The new ASSERT in LDV_recordDead() was being tripped up by MVars when removeFromMVarBlockedQueue() calls OVERWRITING_CLOSURE() via OVERWRITE_INFO(). - - - - - 38992085 by Daniel Gröber at 2020-06-01T06:32:56-04:00 Always zero shrunk mutable array slop when profiling When shrinking arrays in the profiling way we currently don't always zero the leftover slop. This means we can't traverse such closures in the heap profiler. The old Note [zeroing slop] and #8402 have some rationale for why this is so but I belive the reasoning doesn't apply to mutable closures. There users already have to ensure multiple threads don't step on each other's toes so zeroing should be safe. - - - - - b0c1f2a6 by Ben Gamari at 2020-06-01T06:33:37-04:00 testsuite: Add test for #18151 - - - - - 9a99a178 by Ben Gamari at 2020-06-01T06:33:37-04:00 testsuite: Add test for desugaring of PostfixOperators - - - - - 2b89ca5b by Ben Gamari at 2020-06-01T06:33:37-04:00 HsToCore: Eta expand left sections Strangely, the comment next to this code already alluded to the fact that even simply eta-expanding will sacrifice laziness. It's quite unclear how we regressed so far. See #18151. - - - - - d412d7a3 by Kirill Elagin at 2020-06-01T06:34:21-04:00 Winferred-safe-imports: Do not exit with error Currently, when -Winferred-safe-imports is enabled, even when it is not turned into an error, the compiler will still exit with exit code 1 if this warning was emitted. Make sure it is really treated as a warning. - - - - - f945eea5 by Ben Gamari at 2020-06-01T06:34:58-04:00 nonmoving: Optimise log2_ceil - - - - - aab606e4 by Bodigrim at 2020-06-01T06:35:36-04:00 Clarify description of fromListN - - - - - 7e5220e2 by Bodigrim at 2020-06-01T06:35:36-04:00 Apply suggestion to libraries/base/GHC/Exts.hs - - - - - f3fb1ce9 by fendor at 2020-06-01T06:36:18-04:00 Add `isInScope` check to `lintCoercion` Mirrors the behaviour of `lintType`. - - - - - 5ac4d946 by fendor at 2020-06-01T06:36:18-04:00 Lint rhs of IfaceRule - - - - - 1cef6126 by Jeremy Schlatter at 2020-06-01T06:37:00-04:00 Fix wording in documentation The duplicate "orphan instance" phrase here doesn't make sense, and was probably an accident. - - - - - 5aaf08f2 by Takenobu Tani at 2020-06-01T06:37:43-04:00 configure: Modify aclocal.m4 according to new module hierarchy This patch updates file paths according to new module hierarchy [1]: * Rename: * compiler/GHC/Parser.hs <= compiler/parser/Parser.hs * compiler/GHC/Parser/Lexer.hs <= compiler/Parser/Lexer.hs * Add: * compiler/GHC/Cmm/Lexer.hs [1]: https://gitlab.haskell.org/ghc/ghc/-/wikis/Make-GHC-codebase-more-modular - - - - - 15857ad8 by Ben Gamari at 2020-06-01T06:38:26-04:00 testsuite: Don't fail if we can't unlink __symlink_test Afterall, it's possible we were unable to create it due to lack of symlink permission. - - - - - 4a7229ef by Ben Gamari at 2020-06-01T06:38:26-04:00 testsuite: Refactor ghostscript detection Tamar reported that he saw crashes due to unhandled exceptions. - - - - - 2ab37eaf by Ben Gamari at 2020-06-01T06:38:26-04:00 testsuite/perf_notes: Fix ill-typed assignments - - - - - e45d5b66 by Ben Gamari at 2020-06-01T06:38:26-04:00 testsuite/testutil: Fix bytes/str mismatch - - - - - 7002d0cb by Ben Gamari at 2020-06-01T06:38:26-04:00 testsuite: Work around spurious mypy failure - - - - - 11390e3a by Takenobu Tani at 2020-06-01T06:39:05-04:00 Clean up file paths for new module hierarchy This updates comments only. This patch replaces file references according to new module hierarchy. See also: * https://gitlab.haskell.org/ghc/ghc/-/wikis/Make-GHC-codebase-more-modular * https://gitlab.haskell.org/ghc/ghc/issues/13009 - - - - - 8f2e5732 by Takenobu Tani at 2020-06-01T06:39:05-04:00 Modify file paths to module paths for new module hierarchy This updates comments only. This patch replaces module references according to new module hierarchy [1][2]. For files under the `compiler/` directory, I replace them as module paths instead of file paths. For instance, `GHC.Unit.State` instead of `compiler/GHC/Unit/State.hs` [3]. For current and future haddock's markup, this patch encloses the module name with "" [4]. [1]: https://gitlab.haskell.org/ghc/ghc/-/wikis/Make-GHC-codebase-more-modular [2]: https://gitlab.haskell.org/ghc/ghc/issues/13009 [3]: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3375#note_276613 [4]: https://haskell-haddock.readthedocs.io/en/latest/markup.html#linking-to-modules - - - - - 68b71c4a by Tom Ellis at 2020-06-01T06:39:55-04:00 Rename the singleton tuple GHC.Tuple.Unit to GHC.Tuple.Solo - - - - - 95da76c2 by Sylvain Henry at 2020-06-01T06:40:41-04:00 Hadrian: fix binary-dist target for cross-compilation - - - - - 730fcd54 by Vladislav Zavialov at 2020-06-01T06:41:18-04:00 Improve parser error messages for the @-operator Since GHC diverges from the Haskell Report by allowing the user to define (@) as an infix operator, we better give a good error message when the user does so unintentionally. In general, this is rather hard to do, as some failures will be discovered only in the renamer or the type checker: x :: (Integer, Integer) x @ (a, b) = (1, 2) This patch does *not* address this general case. However, it gives much better error messages when the binding is not syntactically valid: pairs xs @ (_:xs') = zip xs xs' Before this patch, the error message was rather puzzling: <interactive>:1:1: error: Parse error in pattern: pairs After this patch, the error message includes a hint: <interactive>:1:1: error: Parse error in pattern: pairs In a function binding for the ‘@’ operator. Perhaps you meant an as-pattern, which must not be surrounded by whitespace - - - - - 0fde5377 by Vladislav Zavialov at 2020-06-01T06:41:18-04:00 Improve parser error messages for TypeApplications With this patch, we always parse f @t as a type application, thereby producing better error messages. This steals two syntactic forms: * Prefix form of the @-operator in expressions. Since the @-operator is a divergence from the Haskell Report anyway, this is not a major loss. * Prefix form of @-patterns. Since we are stealing loose infix form anyway, might as well sacrifice the prefix form for the sake of much better error messages. - - - - - c68e7e1e by Vladislav Zavialov at 2020-06-01T06:41:18-04:00 Improve parser error messages for TemplateHaskellQuotes While [e| |], [t| |], [d| |], and so on, steal syntax from list comprehensions, [| |] and [|| ||] do not steal any syntax. Thus we can improve error messages by always accepting them in the lexer. Turns out the renamer already performs necessary validation. - - - - - 120aedbd by Ben Gamari at 2020-06-01T16:07:02-04:00 gitlab-ci: Disable use of ld.lld on ARMv7 It turns out that lld non-deterministically fails on ARMv7. I suspect this may be due to the a kernel regression as this only started happening when we upgraded to 5.4. Nevertheless, easily avoided by simply sticking with gold. Works around #18280. - - - - - d6279ff0 by Ben Gamari at 2020-06-02T13:03:30-04:00 gitlab-ci: Ensure that workaround for #18280 applies to bindisttest We need to ensure that the `configure` flags working around #18280 are propagated to the bindisttest `configure` as well. - - - - - cb5c31b5 by Ben Gamari at 2020-06-03T17:55:04-04:00 gitlab-ci: Allow ARMv7 job to fail Due to #18298. - - - - - 32a4ae90 by John Ericson at 2020-06-04T04:34:42-04:00 Clean up boot vs non-boot disambiguating types We often have (ModuleName, Bool) or (Module, Bool) pairs for "extended" module names (without or with a unit id) disambiguating boot and normal modules. We think this is important enough across the compiler that it deserves a new nominal product type. We do this with synnoyms and a functor named with a `Gen` prefix, matching other newly created definitions. It was also requested that we keep custom `IsBoot` / `NotBoot` sum type. So we have it too. This means changing many the many bools to use that instead. Updates `haddock` submodule. - - - - - c05756cd by Niklas Hambüchen at 2020-06-04T04:35:24-04:00 docs: Add more details on InterruptibleFFI. Details from https://gitlab.haskell.org/ghc/ghc/issues/8684 and https://github.com/takano-akio/filelock/pull/7#discussion_r280332430 - - - - - 1b975aed by Andrew Martin at 2020-06-04T04:36:03-04:00 Allow finalizeForeignPtr to be called on FinalPtr/PlainPtr. MR 2165 (commit 49301ad6226d9a83d110bee8c419615dd94f5ded) regressed finalizeForeignPtr by throwing exceptions when PlainPtr was encounterd. This regression did not make it into a release of GHC. Here, the original behavior is restored, and FinalPtr is given the same treatment as PlainPtr. - - - - - 2bd3929a by Luke Lau at 2020-06-04T04:36:41-04:00 Fix documentation on type families not being extracted It looks like the location of the Names used for CoAxioms on type families are now located at their type constructors. Previously, Docs.hs thought the Names were located in the RHS, so the RealSrcSpan in the instanceMap and getInstLoc didn't match up. Fixes #18241 - - - - - 6735b9d9 by Ben Gamari at 2020-06-04T04:37:21-04:00 GHC.Hs.Instances: Compile with -O0 This module contains exclusively Data instances, which are going to be slow no matter what we do. Furthermore, they are incredibly slow to compile with optimisation (see #9557). Consequently we compile this with -O0. See #18254. - - - - - c330331a by nineonine at 2020-06-04T04:37:59-04:00 Add test for #17669 - - - - - cab684f0 by Ben Gamari at 2020-06-04T04:38:36-04:00 rts: Add Windows-specific implementation of rtsSleep Previously we would use the POSIX path, which uses `nanosleep`. However, it turns out that `nanosleep` is provided by `libpthread` on Windows. In general we don't want to incur such a dependency. Avoid this by simply using `Sleep` on Windows. Fixes #18272. - - - - - ad44b504 by Ben Gamari at 2020-06-04T04:38:36-04:00 compiler: Disable use of process jobs with process < 1.6.9 Due to #17926. - - - - - 6a4098a4 by Moritz Angermann at 2020-06-04T04:55:51-04:00 [linker] Adds void printLoadedObjects(void); This allows us to dump in-memory object code locations for debugging. Fixup printLoadedObjects prototype - - - - - af5e3a88 by Artem Pelenitsyn at 2020-06-05T03:18:49-04:00 base: fix sign confusion in log1mexp implementation (fix #17125) author: claude (https://gitlab.haskell.org/trac-claude) The correct threshold for log1mexp is -(log 2) with the current specification of log1mexp. This change improves accuracy for large negative inputs. To avoid code duplication, a small helper function is added; it isn't the default implementation in Floating because it needs Ord. This patch does nothing to address that the Haskell specification is different from that in common use in other languages. - - - - - 2b792fac by Simon Peyton Jones at 2020-06-05T09:27:50-04:00 Simple subsumption This patch simplifies GHC to use simple subsumption. Ticket #17775 Implements GHC proposal #287 https://github.com/ghc-proposals/ghc-proposals/blob/master/ proposals/0287-simplify-subsumption.rst All the motivation is described there; I will not repeat it here. The implementation payload: * tcSubType and friends become noticably simpler, because it no longer uses eta-expansion when checking subsumption. * No deeplyInstantiate or deeplySkolemise That in turn means that some tests fail, by design; they can all be fixed by eta expansion. There is a list of such changes below. Implementing the patch led me into a variety of sticky corners, so the patch includes several othe changes, some quite significant: * I made String wired-in, so that "foo" :: String rather than "foo" :: [Char] This improves error messages, and fixes #15679 * The pattern match checker relies on knowing about in-scope equality constraints, andd adds them to the desugarer's environment using addTyCsDs. But the co_fn in a FunBind was missed, and for some reason simple-subsumption ends up with dictionaries there. So I added a call to addTyCsDs. This is really part of #18049. * I moved the ic_telescope field out of Implication and into ForAllSkol instead. This is a nice win; just expresses the code much better. * There was a bug in GHC.Tc.TyCl.Instance.tcDataFamInstHeader. We called checkDataKindSig inside tc_kind_sig, /before/ solveEqualities and zonking. Obviously wrong, easily fixed. * solveLocalEqualitiesX: there was a whole mess in here, around failing fast enough. I discovered a bad latent bug where we could successfully kind-check a type signature, and use it, but have unsolved constraints that could fill in coercion holes in that signature -- aargh. It's all explained in Note [Failure in local type signatures] in GHC.Tc.Solver. Much better now. * I fixed a serious bug in anonymous type holes. IN f :: Int -> (forall a. a -> _) -> Int that "_" should be a unification variable at the /outer/ level; it cannot be instantiated to 'a'. This was plain wrong. New fields mode_lvl and mode_holes in TcTyMode, and auxiliary data type GHC.Tc.Gen.HsType.HoleMode. This fixes #16292, but makes no progress towards the more ambitious #16082 * I got sucked into an enormous refactoring of the reporting of equality errors in GHC.Tc.Errors, especially in mkEqErr1 mkTyVarEqErr misMatchMsg misMatchMsgOrCND In particular, the very tricky mkExpectedActualMsg function is gone. It took me a full day. But the result is far easier to understand. (Still not easy!) This led to various minor improvements in error output, and an enormous number of test-case error wibbles. One particular point: for occurs-check errors I now just say Can't match 'a' against '[a]' rather than using the intimidating language of "occurs check". * Pretty-printing AbsBinds Tests review * Eta expansions T11305: one eta expansion T12082: one eta expansion (undefined) T13585a: one eta expansion T3102: one eta expansion T3692: two eta expansions (tricky) T2239: two eta expansions T16473: one eta determ004: two eta expansions (undefined) annfail06: two eta (undefined) T17923: four eta expansions (a strange program indeed!) tcrun035: one eta expansion * Ambiguity check at higher rank. Now that we have simple subsumption, a type like f :: (forall a. Eq a => Int) -> Int is no longer ambiguous, because we could write g :: (forall a. Eq a => Int) -> Int g = f and it'd typecheck just fine. But f's type is a bit suspicious, and we might want to consider making the ambiguity check do a check on each sub-term. Meanwhile, these tests are accepted, whereas they were previously rejected as ambiguous: T7220a T15438 T10503 T9222 * Some more interesting error message wibbles T13381: Fine: one error (Int ~ Exp Int) rather than two (Int ~ Exp Int, Exp Int ~ Int) T9834: Small change in error (improvement) T10619: Improved T2414: Small change, due to order of unification, fine T2534: A very simple case in which a change of unification order means we get tow unsolved constraints instead of one tc211: bizarre impredicative tests; just accept this for now Updates Cabal and haddock submodules. Metric Increase: T12150 T12234 T5837 haddock.base Metric Decrease: haddock.compiler haddock.Cabal haddock.base Merge note: This appears to break the `UnliftedNewtypesDifficultUnification` test. It has been marked as broken in the interest of merging. (cherry picked from commit 66b7b195cb3dce93ed5078b80bf568efae904cc5) - - - - - 2dff8141 by Ryan Scott at 2020-06-05T14:21:24-04:00 Simplify bindLHsTyVarBndrs and bindHsQTyVars Both `bindLHsTyVarBndrs` and `bindHsQTyVars` take two separate `Maybe` arguments, which I find terribly confusing. Thankfully, it's possible to remove one `Maybe` argument from each of these functions, which this patch accomplishes: * `bindHsQTyVars` takes a `Maybe SDoc` argument, which is `Just` if GHC should warn about any of the quantified type variables going unused. However, every call site uses `Nothing` in practice. This makes sense, since it doesn't really make sense to warn about unused type variables bound by an `LHsQTyVars`. For instance, you wouldn't warn about the `a` in `data Proxy a = Proxy` going unused. As a result, I simply remove this `Maybe SDoc` argument altogether. * `bindLHsTyVarBndrs` also takes a `Maybe SDoc` argument for the same reasons that `bindHsQTyVars` took one. To make things more confusing, however, `bindLHsTyVarBndrs` also takes a separate `HsDocContext` argument, which is pretty-printed (to an `SDoc`) in warnings and error messages. In practice, the `Maybe SDoc` and the `HsDocContext` often contain the same text. See the call sites for `bindLHsTyVarBndrs` in `rnFamInstEqn` and `rnConDecl`, for instance. There are only a handful of call sites where the text differs between the `Maybe SDoc` and `HsDocContext` arguments: * In `rnHsRuleDecl`, where the `Maybe SDoc` says "`In the rule`" and the `HsDocContext` says "`In the transformation rule`". * In `rnHsTyKi`/`rn_ty`, where the `Maybe SDoc` says "`In the type`" but the `HsDocContext` is inhereted from the surrounding context (e.g., if `rnHsTyKi` were called on a top-level type signature, the `HsDocContext` would be "`In the type signature`" instead) In both cases, warnings/error messages arguably _improve_ by unifying making the `Maybe SDoc`'s text match that of the `HsDocContext`. As a result, I decided to remove the `Maybe SDoc` argument to `bindLHsTyVarBndrs` entirely and simply reuse the text from the `HsDocContext`. (I decided to change the phrase "transformation rule" to "rewrite rule" while I was in the area.) The `Maybe SDoc` argument has one other purpose: signaling when to emit "`Unused quantified type variable`" warnings. To recover this functionality, I replaced the `Maybe SDoc` argument with a boolean-like `WarnUnusedForalls` argument. The only `bindLHsTyVarBndrs` call site that chooses _not_ to emit these warnings in `bindHsQTyVars`. - - - - - e372331b by Ben Gamari at 2020-06-07T08:46:41-04:00 hadrian: Add missing deriveConstants dependency on ghcplatform.h deriveConstants wants to compile C sources which #include PosixSource.h, which itself #includes ghcplatform.h. Make sure that Hadrian knows about this dependency. Fixes #18290. - - - - - b022051a by Moritz Angermann at 2020-06-07T08:46:42-04:00 ghc-prim needs to depend on libc and libm libm is just an empty shell on musl, and all the math functions are contained in libc. - - - - - 6dae6548 by Moritz Angermann at 2020-06-07T08:46:42-04:00 Disable DLL loading if without system linker Some platforms (musl, aarch64) do not have a working dynamic linker implemented in the libc, even though we might see dlopen. It will ultimately just return that this is not supported. Hence we'll add a flag to the compiler to flat our disable loading dlls. This is needed as we will otherwise try to load the shared library even if this will subsequently fail. At that point we have given up looking for static options though. - - - - - 4a158ffc by Moritz Angermann at 2020-06-07T08:46:43-04:00 Range is actually +/-2^32, not +/-2^31 See also: https://static.docs.arm.com/ihi0056/g/aaelf64.pdf - - - - - f1bfb806 by Ben Gamari at 2020-06-07T10:49:30-04:00 OccurAnal: Avoid exponential behavior due to where clauses Previously the `Var` case of `occAnalApp` could in some cases (namely in the case of `runRW#` applications) call `occAnalRhs` two. In the case of nested `runRW#`s this results in exponential complexity. In some cases the compilation time that resulted would be very long indeed (see #18296). Fixes #18296. Metric Decrease: T9961 T12150 T12234 - - - - - 9b607671 by Takenobu Tani at 2020-06-09T08:05:46-04:00 Add link to GHC's wiki in the GHC API header This adds a URL to point to GHC's wiki in the GHC API header. Newcomers could easily find more information from the GHC API's web like [1]. [1]: Current version, https://ghc.gitlab.haskell.org/ghc/doc/libraries/ghc-8.11.0.20200604/index.html [skip ci] - - - - - 72c7fe9a by Ryan Scott at 2020-06-09T08:06:24-04:00 Make GADT constructors adhere to the forall-or-nothing rule properly Issue #18191 revealed that the types of GADT constructors don't quite adhere to the `forall`-or-nothing rule. This patch serves to clean up this sad state of affairs somewhat. The main change is not in the code itself, but in the documentation, as this patch introduces two sections to the GHC User's Guide: * A "Formal syntax for GADTs" section that presents a BNF-style grammar for what is and isn't allowed in GADT constructor types. This mostly exists to codify GHC's existing behavior, but it also imposes a new restriction that addresses #18191: the outermost `forall` and/or context in a GADT constructor is not allowed to be surrounded by parentheses. Doing so would make these `forall`s/contexts nested, and GADTs do not support nested `forall`s/contexts at present. * A "`forall`-or-nothing rule" section that describes exactly what the `forall`-or-nothing rule is all about. Surprisingly, there was no mention of this anywhere in the User's Guide up until now! To adhere the new specification in the "Formal syntax for GADTs" section of the User's Guide, the following code changes were made: * A new function, `GHC.Hs.Type.splitLHsGADTPrefixTy`, was introduced. This is very much like `splitLHsSigmaTy`, except that it avoids splitting apart any parentheses, which can be syntactically significant for GADT types. See `Note [No nested foralls or contexts in GADT constructors]` in `GHC.Hs.Type`. * `ConDeclGADTPrefixPs`, an extension constructor for `XConDecl`, was introduced so that `GHC.Parser.PostProcess.mkGadtDecl` can return it when given a prefix GADT constructor. Unlike `ConDeclGADT`, `ConDeclGADTPrefixPs` does not split the GADT type into its argument and result types, as this cannot be done until after the type is renamed (see `Note [GADT abstract syntax]` in `GHC.Hs.Decls` for why this is the case). * `GHC.Renamer.Module.rnConDecl` now has an additional case for `ConDeclGADTPrefixPs` that (1) splits apart the full `LHsType` into its `forall`s, context, argument types, and result type, and (2) checks for nested `forall`s/contexts. Step (2) used to be performed the typechecker (in `GHC.Tc.TyCl.badDataConTyCon`) rather than the renamer, but now the relevant code from the typechecker can simply be deleted. One nice side effect of this change is that we are able to give a more accurate error message for GADT constructors that use visible dependent quantification (e.g., `MkFoo :: forall a -> a -> Foo a`), which improves the stderr in the `T16326_Fail6` test case. Fixes #18191. Bumps the Haddock submodule. - - - - - a47e6442 by Ryan Scott at 2020-06-10T03:39:12-04:00 Always use rnImplicitBndrs to bring implicit tyvars into scope This implements a first step towards #16762 by changing the renamer to always use `rnImplicitBndrs` to bring implicitly bound type variables into scope. The main change is in `rnFamInstEqn` and `bindHsQTyVars`, which previously used _ad hoc_ methods of binding their implicit tyvars. There are a number of knock-on consequences: * One of the reasons that `rnFamInstEqn` used an _ad hoc_ binding mechanism was to give more precise source locations in `-Wunused-type-patterns` warnings. (See https://gitlab.haskell.org/ghc/ghc/issues/16762#note_273343 for an example of this.) However, these warnings are actually a little _too_ precise, since implicitly bound type variables don't have exact binding sites like explicitly bound type variables do. A similar problem existed for "`Different names for the same type variable`" errors involving implicit tyvars bound by `bindHsQTyVars`. Therefore, we simply accept the less precise (but more accurate) source locations from `rnImplicitBndrs` in `rnFamInstEqn` and `bindHsQTyVars`. See `Note [Source locations for implicitly bound type variables]` in `GHC.Rename.HsType` for the full story. * In order for `rnImplicitBndrs` to work in `rnFamInstEqn`, it needs to be able to look up names from the parent class (in the event that we are renaming an associated type family instance). As a result, `rnImplicitBndrs` now takes an argument of type `Maybe assoc`, which is `Just` in the event that a type family instance is associated with a class. * Previously, GHC kept track of three type synonyms for free type variables in the renamer: `FreeKiTyVars`, `FreeKiTyVarsDups` (which are allowed to contain duplicates), and `FreeKiTyVarsNoDups` (which contain no duplicates). However, making is a distinction between `-Dups` and `-NoDups` is now pointless, as all code that returns `FreeKiTyVars{,Dups,NoDups}` will eventually end up being passed to `rnImplicitBndrs`, which removes duplicates. As a result, I decided to just get rid of `FreeKiTyVarsDups` and `FreeKiTyVarsNoDups`, leaving only `FreeKiTyVars`. * The `bindLRdrNames` and `deleteBys` functions are now dead code, so I took the liberty of removing them. - - - - - 24879129 by Takenobu Tani at 2020-06-10T03:39:59-04:00 Clarify leaf module names for new module hierarchy This updates comments only. This patch replaces leaf module names according to new module hierarchy [1][2] as followings: * Expand leaf names to easily find the module path: for instance, `Id.hs` to `GHC.Types.Id`. * Modify leaf names according to new module hierarchy: for instance, `Convert.hs` to `GHC.ThToHs`. * Fix typo: for instance, `GHC.Core.TyCo.Rep.hs` to `GHC.Core.TyCo.Rep` See also !3375 [1]: https://gitlab.haskell.org/ghc/ghc/-/wikis/Make-GHC-codebase-more-modular [2]: https://gitlab.haskell.org/ghc/ghc/issues/13009 - - - - - 92de9e25 by Ömer Sinan Ağacan at 2020-06-10T03:41:07-04:00 rts: Remove unused GET_ENTRY closure macro This macro is not used and got broken in the meantime, as ENTRY_CODE was deleted. - - - - - 87102928 by Ömer Sinan Ağacan at 2020-06-10T03:41:50-04:00 Fix -fkeep-cafs flag name in users guide - - - - - ccd6843d by Shayne Fletcher at 2020-06-10T04:14:57-04:00 Expose impliedGFlags, impledOffGFlags, impliedXFlags - - - - - 7a737e89 by Ömer Sinan Ağacan at 2020-06-10T04:14:58-04:00 Cross-module LambdaFormInfo passing - Store LambdaFormInfos of exported Ids in interface files - Use them in importing modules This is for optimization purposes: if we know LambdaFormInfo of imported Ids we can generate more efficient calling code, see `getCallMethod`. Exporting (putting them in interface files or in ModDetails) and importing (reading them from interface files) are both optional. We don't assume known LambdaFormInfos anywhere and do not change how we call Ids with unknown LambdaFormInfos. Runtime, allocation, and residency numbers when building Cabal-the-library (commit 0d4ee7ba3): (Log and .hp files are in the MR: !2842) | | GHC HEAD | This patch | Diff | |-----|----------|------------|----------------| | -O0 | 0:35.89 | 0:34.10 | -1.78s, -4.98% | | -O1 | 2:24.01 | 2:23.62 | -0.39s, -0.27% | | -O2 | 2:52.23 | 2:51.35 | -0.88s, -0.51% | | | GHC HEAD | This patch | Diff | |-----|-----------------|-----------------|----------------------------| | -O0 | 54,843,608,416 | 54,878,769,544 | +35,161,128 bytes, +0.06% | | -O1 | 227,136,076,400 | 227,569,045,168 | +432,968,768 bytes, +0.19% | | -O2 | 266,147,063,296 | 266,749,643,440 | +602,580,144 bytes, +0.22% | NOTE: Residency is measured with extra runtime args: `-i0 -h` which effectively turn all GCs into major GCs, and do GC more often. | | GHC HEAD | This patch | Diff | |-----|----------------------------|------------------------------|----------------------------| | -O0 | 410,284,000 (910 samples) | 411,745,008 (906 samples) | +1,461,008 bytes, +0.35% | | -O1 | 928,580,856 (2109 samples) | 943,506,552 (2103 samples) | +14,925,696 bytes, +1.60% | | -O2 | 993,951,352 (2549 samples) | 1,010,156,328 (2545 samples) | +16,204,9760 bytes, +1.63% | NoFib results: -------------------------------------------------------------------------------- Program Size Allocs Instrs Reads Writes -------------------------------------------------------------------------------- CS 0.0% 0.0% +0.0% +0.0% +0.0% CSD 0.0% 0.0% 0.0% +0.0% +0.0% FS 0.0% 0.0% +0.0% +0.0% +0.0% S 0.0% 0.0% +0.0% +0.0% +0.0% VS 0.0% 0.0% +0.0% +0.0% +0.0% VSD 0.0% 0.0% +0.0% +0.0% +0.1% VSM 0.0% 0.0% +0.0% +0.0% +0.0% anna 0.0% 0.0% -0.3% -0.8% -0.0% ansi 0.0% 0.0% -0.0% -0.0% 0.0% atom 0.0% 0.0% -0.0% -0.0% 0.0% awards 0.0% 0.0% -0.1% -0.3% 0.0% banner 0.0% 0.0% -0.0% -0.0% -0.0% bernouilli 0.0% 0.0% -0.0% -0.0% -0.0% binary-trees 0.0% 0.0% -0.0% -0.0% +0.0% boyer 0.0% 0.0% -0.0% -0.0% 0.0% boyer2 0.0% 0.0% -0.0% -0.0% 0.0% bspt 0.0% 0.0% -0.0% -0.2% 0.0% cacheprof 0.0% 0.0% -0.1% -0.4% +0.0% calendar 0.0% 0.0% -0.0% -0.0% 0.0% cichelli 0.0% 0.0% -0.9% -2.4% 0.0% circsim 0.0% 0.0% -0.0% -0.0% 0.0% clausify 0.0% 0.0% -0.1% -0.3% 0.0% comp_lab_zift 0.0% 0.0% -0.0% -0.0% +0.0% compress 0.0% 0.0% -0.0% -0.0% -0.0% compress2 0.0% 0.0% -0.0% -0.0% 0.0% constraints 0.0% 0.0% -0.1% -0.2% -0.0% cryptarithm1 0.0% 0.0% -0.0% -0.0% 0.0% cryptarithm2 0.0% 0.0% -1.4% -4.1% -0.0% cse 0.0% 0.0% -0.0% -0.0% -0.0% digits-of-e1 0.0% 0.0% -0.0% -0.0% -0.0% digits-of-e2 0.0% 0.0% -0.0% -0.0% -0.0% dom-lt 0.0% 0.0% -0.1% -0.2% 0.0% eliza 0.0% 0.0% -0.5% -1.5% 0.0% event 0.0% 0.0% -0.0% -0.0% -0.0% exact-reals 0.0% 0.0% -0.1% -0.3% +0.0% exp3_8 0.0% 0.0% -0.0% -0.0% -0.0% expert 0.0% 0.0% -0.3% -1.0% -0.0% fannkuch-redux 0.0% 0.0% +0.0% +0.0% +0.0% fasta 0.0% 0.0% -0.0% -0.0% +0.0% fem 0.0% 0.0% -0.0% -0.0% 0.0% fft 0.0% 0.0% -0.0% -0.0% 0.0% fft2 0.0% 0.0% -0.0% -0.0% 0.0% fibheaps 0.0% 0.0% -0.0% -0.0% +0.0% fish 0.0% 0.0% 0.0% -0.0% +0.0% fluid 0.0% 0.0% -0.4% -1.2% +0.0% fulsom 0.0% 0.0% -0.0% -0.0% 0.0% gamteb 0.0% 0.0% -0.1% -0.3% 0.0% gcd 0.0% 0.0% -0.0% -0.0% 0.0% gen_regexps 0.0% 0.0% -0.0% -0.0% -0.0% genfft 0.0% 0.0% -0.0% -0.0% 0.0% gg 0.0% 0.0% -0.0% -0.0% +0.0% grep 0.0% 0.0% -0.0% -0.0% -0.0% hidden 0.0% 0.0% -0.1% -0.4% -0.0% hpg 0.0% 0.0% -0.2% -0.5% +0.0% ida 0.0% 0.0% -0.0% -0.0% +0.0% infer 0.0% 0.0% -0.3% -0.8% -0.0% integer 0.0% 0.0% -0.0% -0.0% +0.0% integrate 0.0% 0.0% -0.0% -0.0% 0.0% k-nucleotide 0.0% 0.0% -0.0% -0.0% +0.0% kahan 0.0% 0.0% -0.0% -0.0% +0.0% knights 0.0% 0.0% -2.2% -5.4% 0.0% lambda 0.0% 0.0% -0.6% -1.8% 0.0% last-piece 0.0% 0.0% -0.0% -0.0% 0.0% lcss 0.0% 0.0% -0.0% -0.1% 0.0% life 0.0% 0.0% -0.0% -0.1% 0.0% lift 0.0% 0.0% -0.2% -0.6% +0.0% linear 0.0% 0.0% -0.0% -0.0% -0.0% listcompr 0.0% 0.0% -0.0% -0.0% 0.0% listcopy 0.0% 0.0% -0.0% -0.0% 0.0% maillist 0.0% 0.0% -0.1% -0.3% +0.0% mandel 0.0% 0.0% -0.0% -0.0% 0.0% mandel2 0.0% 0.0% -0.0% -0.0% -0.0% mate +0.0% 0.0% -0.0% -0.0% -0.0% minimax 0.0% 0.0% -0.2% -1.0% 0.0% mkhprog 0.0% 0.0% -0.1% -0.2% -0.0% multiplier 0.0% 0.0% -0.0% -0.0% -0.0% n-body 0.0% 0.0% -0.0% -0.0% +0.0% nucleic2 0.0% 0.0% -0.1% -0.2% 0.0% para 0.0% 0.0% -0.0% -0.0% -0.0% paraffins 0.0% 0.0% -0.0% -0.0% 0.0% parser 0.0% 0.0% -0.2% -0.7% 0.0% parstof 0.0% 0.0% -0.0% -0.0% +0.0% pic 0.0% 0.0% -0.0% -0.0% 0.0% pidigits 0.0% 0.0% +0.0% +0.0% +0.0% power 0.0% 0.0% -0.2% -0.6% +0.0% pretty 0.0% 0.0% -0.0% -0.0% -0.0% primes 0.0% 0.0% -0.0% -0.0% 0.0% primetest 0.0% 0.0% -0.0% -0.0% -0.0% prolog 0.0% 0.0% -0.3% -1.1% 0.0% puzzle 0.0% 0.0% -0.0% -0.0% 0.0% queens 0.0% 0.0% -0.0% -0.0% +0.0% reptile 0.0% 0.0% -0.0% -0.0% 0.0% reverse-complem 0.0% 0.0% -0.0% -0.0% +0.0% rewrite 0.0% 0.0% -0.7% -2.5% -0.0% rfib 0.0% 0.0% -0.0% -0.0% 0.0% rsa 0.0% 0.0% -0.0% -0.0% 0.0% scc 0.0% 0.0% -0.1% -0.2% -0.0% sched 0.0% 0.0% -0.0% -0.0% -0.0% scs 0.0% 0.0% -1.0% -2.6% +0.0% simple 0.0% 0.0% +0.0% -0.0% +0.0% solid 0.0% 0.0% -0.0% -0.0% 0.0% sorting 0.0% 0.0% -0.6% -1.6% 0.0% spectral-norm 0.0% 0.0% +0.0% 0.0% +0.0% sphere 0.0% 0.0% -0.0% -0.0% -0.0% symalg 0.0% 0.0% -0.0% -0.0% +0.0% tak 0.0% 0.0% -0.0% -0.0% 0.0% transform 0.0% 0.0% -0.0% -0.0% 0.0% treejoin 0.0% 0.0% -0.0% -0.0% 0.0% typecheck 0.0% 0.0% -0.0% -0.0% +0.0% veritas +0.0% 0.0% -0.2% -0.4% +0.0% wang 0.0% 0.0% -0.0% -0.0% 0.0% wave4main 0.0% 0.0% -0.0% -0.0% -0.0% wheel-sieve1 0.0% 0.0% -0.0% -0.0% -0.0% wheel-sieve2 0.0% 0.0% -0.0% -0.0% +0.0% x2n1 0.0% 0.0% -0.0% -0.0% -0.0% -------------------------------------------------------------------------------- Min 0.0% 0.0% -2.2% -5.4% -0.0% Max +0.0% 0.0% +0.0% +0.0% +0.1% Geometric Mean -0.0% -0.0% -0.1% -0.3% +0.0% Metric increases micro benchmarks tracked in #17686: Metric Increase: T12150 T12234 T12425 T13035 T5837 T6048 T9233 Co-authored-by: Andreas Klebinger <klebinger.andreas at gmx.at> - - - - - 3b22b14a by Shayne Fletcher at 2020-06-10T04:15:01-04:00 Give Language a Bounded instance - - - - - 9454511b by Simon Peyton Jones at 2020-06-10T04:17:06-04:00 Optimisation in Unique.Supply This patch switches on -fno-state-hack in GHC.Types.Unique.Supply. It turned out that my fixes for #18078 (coercion floating) changed the optimisation pathway for mkSplitUniqSupply in such a way that we had an extra allocation inside the inner loop. Adding -fno-state-hack fixed that -- and indeed the loop in mkSplitUniqSupply is a classic example of the way in which -fno-state-hack can be bad; see #18238. Moreover, the new code is better than the old. They allocate the same, but the old code ends up with a partial application. The net effect is that the test perf/should_run/UniqLoop runs 20% faster! From 2.5s down to 2.0s. The allocation numbers are the same -- but elapsed time falls. Good! The bad thing about this is that it's terribly delicate. But at least it's a good example of such delicacy in action. There is a long Note [Optimising the unique supply] which now explains all this. - - - - - 6d49d5be by Simon Peyton Jones at 2020-06-10T04:17:06-04:00 Implement cast worker/wrapper properly The cast worker/wrapper transformation transforms x = e |> co into y = e x = y |> co This is done by the simplifier, but we were being careless about transferring IdInfo from x to y, and about what to do if x is a NOINLNE function. This resulted in a series of bugs: #17673, #18093, #18078. This patch fixes all that: * Main change is in GHC.Core.Opt.Simplify, and the new prepareBinding function, which does this cast worker/wrapper transform. See Note [Cast worker/wrappers]. * There is quite a bit of refactoring around prepareRhs, makeTrivial etc. It's nicer now. * Some wrappers from strictness and cast w/w, notably those for a function with a NOINLINE, should inline very late. There wasn't really a mechanism for that, which was an existing bug really; so I invented a new finalPhase = Phase (-1). It's used for all simplifier runs after the user-visible phase 2,1,0 have run. (No new runs of the simplifier are introduced thereby.) See new Note [Compiler phases] in GHC.Types.Basic; the main changes are in GHC.Core.Opt.Driver * Doing this made me trip over two places where the AnonArgFlag on a FunTy was being lost so we could end up with (Num a -> ty) rather than (Num a => ty) - In coercionLKind/coercionRKind - In contHoleType in the Simplifier I fixed the former by defining mkFunctionType and using it in coercionLKind/RKind. I could have done the same for the latter, but the information is almost to hand. So I fixed the latter by - adding sc_hole_ty to ApplyToVal (like ApplyToTy), - adding as_hole_ty to ValArg (like TyArg) - adding sc_fun_ty to StrictArg Turned out I could then remove ai_type from ArgInfo. This is just moving the deck chairs around, but it worked out nicely. See the new Note [AnonArgFlag] in GHC.Types.Var * When looking at the 'arity decrease' thing (#18093) I discovered that stable unfoldings had a much lower arity than the actual optimised function. That's what led to the arity-decrease message. Simple solution: eta-expand. It's described in Note [Eta-expand stable unfoldings] in GHC.Core.Opt.Simplify * I also discovered that unsafeCoerce wasn't being inlined if the context was boring. So (\x. f (unsafeCoerce x)) would create a thunk -- yikes! I fixed that by making inlineBoringOK a bit cleverer: see Note [Inline unsafeCoerce] in GHC.Core.Unfold. I also found that unsafeCoerceName was unused, so I removed it. I made a test case for #18078, and a very similar one for #17673. The net effect of all this on nofib is very modest, but positive: -------------------------------------------------------------------------------- Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- anna -0.4% -0.1% -3.1% -3.1% 0.0% fannkuch-redux -0.4% -0.3% -0.1% -0.1% 0.0% maillist -0.4% -0.1% -7.8% -1.0% -14.3% primetest -0.4% -15.6% -7.1% -6.6% 0.0% -------------------------------------------------------------------------------- Min -0.9% -15.6% -13.3% -14.2% -14.3% Max -0.3% 0.0% +12.1% +12.4% 0.0% Geometric Mean -0.4% -0.2% -2.3% -2.2% -0.1% All following metric decreases are compile-time allocation decreases between -1% and -3%: Metric Decrease: T5631 T13701 T14697 T15164 - - - - - 32fd37f5 by Luke Lau at 2020-06-10T04:17:22-04:00 Fix lookupGlobalOccRn_maybe sometimes reporting an error In some cases it was possible for lookupGlobalOccRn_maybe to return an error, when it should be returning a Nothing. If it called lookupExactOcc_either when there were no matching GlobalRdrElts in the otherwise case, it would return an error message. This could be caused when lookupThName_maybe in Template Haskell was looking in different namespaces (thRdrNameGuesses), guessing different namespaces that the name wasn't guaranteed to be found in. However, by addressing this some more accurate errors were being lost in the conversion to Maybes. So some of the lookup* functions have been shuffled about so that errors should always be ignored in lookup*_maybes, and propagated otherwise. This fixes #18263 - - - - - 9b283e1b by Roland Senn at 2020-06-10T04:17:34-04:00 Initialize the allocation counter in GHCi to 0 (Fixes #16012) According to the documentation for the function `getAllocationCounter` in [System.Mem](http://hackage.haskell.org/package/base-4.14.0.0/docs/System-Mem.html) initialize the allocationCounter also in GHCi to 0. - - - - - 8d07c48c by Sylvain Henry at 2020-06-10T04:17:36-04:00 test: fix conc038 We had spurious failures of conc038 test on CI with stdout: ``` newThread started -mainThread -Haskell: 2 newThread back again +mainThread 1 sec later shutting down +Haskell: 2 ``` - - - - - 4c7e9689 by Sebastian Graf at 2020-06-11T10:37:38+02:00 Release Notes: Add news from the pattern-match checker [skip ci] - - - - - 3445b965 by Sylvain Henry at 2020-06-13T02:13:01-04:00 Only test T16190 with the NCG T16190 is meant to test a NCG feature. It has already caused spurious failures in other MRs (e.g. !2165) when LLVM is used. - - - - - 2517a51c by Sylvain Henry at 2020-06-13T02:13:01-04:00 DynFlags refactoring VIII (#17957) * Remove several uses of `sdocWithDynFlags`, especially in GHC.Llvm.* * Add LlvmOpts datatype to store Llvm backend options * Remove Outputable instances (for LlvmVar, LlvmLit, LlvmStatic and Llvm.MetaExpr) which require LlvmOpts. * Rename ppMetaExpr into ppMetaAnnotExpr (pprMetaExpr is now used in place of `ppr :: MetaExpr -> SDoc`) - - - - - 7a02599a by Sylvain Henry at 2020-06-13T02:13:02-04:00 Remove unused code - - - - - 72d08610 by Sylvain Henry at 2020-06-13T02:13:02-04:00 Refactor homeUnit * rename thisPackage into homeUnit * document and refactor several Backpack things - - - - - 8dc71f55 by Sylvain Henry at 2020-06-13T02:13:02-04:00 Rename unsafeGetUnitInfo into unsafeLookupUnit - - - - - f6be6e43 by Sylvain Henry at 2020-06-13T02:13:02-04:00 Add allowVirtualUnits field in PackageState Instead of always querying DynFlags to know whether we are allowed to use virtual units (i.e. instantiated on-the-fly, cf Note [About units] in GHC.Unit), we store it once for all in `PackageState.allowVirtualUnits`. This avoids using DynFlags too much (cf #17957) and is preliminary work for #14335. - - - - - e7272d53 by Sylvain Henry at 2020-06-13T02:13:02-04:00 Enhance UnitId use * use UnitId instead of String to identify wired-in units * use UnitId instead of Unit in the backend (Unit are only use by Backpack to produce type-checked interfaces, not real code) * rename lookup functions for consistency * documentation - - - - - 9c5572cd by Sylvain Henry at 2020-06-13T02:13:02-04:00 Remove LinkerUnitId type alias - - - - - d345edfe by Sylvain Henry at 2020-06-13T02:13:02-04:00 Refactor WiredMap * Remove WiredInUnitId and WiredUnitId type aliases - - - - - 3d171cd6 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Document and refactor `mkUnit` and `mkUnitInfoMap` - - - - - d2109b4f by Sylvain Henry at 2020-06-13T02:13:03-04:00 Remove PreloadUnitId type alias - - - - - f50c19b8 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Rename listUnitInfoMap into listUnitInfo There is no Map involved - - - - - ed533ec2 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Rename Package into Unit The terminology changed over time and now package databases contain "units" (there can be several units compiled from a single Cabal package: one per-component, one for each option set, one per instantiation, etc.). We should try to be consistent internally and use "units": that's what this renaming does. Maybe one day we'll fix the UI too (e.g. replace -package-id with -unit-id, we already have -this-unit-id and ghc-pkg has -unit-id...) but it's not done in this patch. * rename getPkgFrameworkOpts into getUnitFrameworkOpts * rename UnitInfoMap into ClosureUnitInfoMap * rename InstalledPackageIndex into UnitInfoMap * rename UnusablePackages into UnusableUnits * rename PackagePrecedenceIndex into UnitPrecedenceMap * rename PackageDatabase into UnitDatabase * rename pkgDatabase into unitDatabases * rename pkgState into unitState * rename initPackages into initUnits * rename renamePackage into renameUnitInfo * rename UnusablePackageReason into UnusableUnitReason * rename getPackage* into getUnit* * etc. - - - - - 202728e5 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Make ClosureUnitInfoMap uses UnitInfoMap - - - - - 55b4263e by Sylvain Henry at 2020-06-13T02:13:03-04:00 Remove ClosureUnitInfoMap - - - - - 653d17bd by Sylvain Henry at 2020-06-13T02:13:03-04:00 Rename Package into Unit (2) * rename PackageState into UnitState * rename findWiredInPackages into findWiredInUnits * rename lookupModuleInAll[Packages,Units] * etc. - - - - - ae900605 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Move dump_mod_map into initUnits - - - - - 598cc1dd by Sylvain Henry at 2020-06-13T02:13:03-04:00 Move wiring of homeUnitInstantiations outside of mkUnitState - - - - - 437265eb by Sylvain Henry at 2020-06-13T02:13:03-04:00 Avoid timing module map dump in initUnits - - - - - 9400aa93 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Remove preload parameter of mkUnitState * Remove preload parameter (unused) * Don't explicitly return preloaded units: redundant because already returned as "preloadUnits" field of UnitState - - - - - 266bc3d9 by Sylvain Henry at 2020-06-13T02:13:03-04:00 DynFlags: refactor unwireUnit - - - - - 9e715c1b by Sylvain Henry at 2020-06-13T02:13:03-04:00 Document getPreloadUnitsAnd - - - - - bd5810dc by Sylvain Henry at 2020-06-13T02:13:03-04:00 DynFlags: remove useless add_package parameter - - - - - 36e1daf0 by Sylvain Henry at 2020-06-13T02:13:03-04:00 DynFlags: make listVisibleModuleNames take a UnitState - - - - - 5226da37 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Refactor and document add_package - - - - - 4b53aac1 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Refactor and document closeUnitDeps - - - - - 42c054f6 by Sylvain Henry at 2020-06-13T02:13:03-04:00 DynFlags: findWiredInUnits - - - - - a444d01b by Sylvain Henry at 2020-06-13T02:13:03-04:00 DynFlags: reportCycles, reportUnusable - - - - - 8408d521 by Sylvain Henry at 2020-06-13T02:13:03-04:00 DynFlags: merge_databases - - - - - fca2d25f by Sylvain Henry at 2020-06-13T02:13:03-04:00 DynFlags: add UnitConfig datatype Avoid directly querying flags from DynFlags to build the UnitState. Instead go via UnitConfig so that we could reuse this to make another UnitState for plugins. - - - - - 4274688a by Sylvain Henry at 2020-06-13T02:13:03-04:00 Move distrustAll into mkUnitState - - - - - 28d804e1 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Create helper upd_wired_in_home_instantiations - - - - - ac964c83 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Put database cache in UnitConfig - - - - - bfd0a78c by Sylvain Henry at 2020-06-13T02:13:03-04:00 Don't return preload units when we set DyNFlags Preload units can be retrieved in UnitState when needed (i.e. in GHCi) - - - - - 1fbb4bf5 by Sylvain Henry at 2020-06-13T02:13:03-04:00 NCGConfig: remove useless ncgUnitId field - - - - - c10ff7e7 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Doc: fix some comments - - - - - 456e17f0 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Bump haddock submodule and allow metric decrease Metric Decrease: T12150 T12234 T5837 Metric Increase: T16190 - - - - - 42953902 by Simon Peyton Jones at 2020-06-13T02:13:03-04:00 Trim the demand for recursive product types Ticket #18304 showed that we need to be very careful when exploring the demand (esp usage demand) on recursive product types. This patch solves the problem by trimming the demand on such types -- in effect, a form of "widening". See the Note [Trimming a demand to a type] in DmdAnal, which explains how I did this by piggy-backing on an existing mechansim for trimming demands becuase of GADTs. The significant payload of this patch is very small indeed: * Make GHC.Core.Opt.WorkWrap.Utils.typeShape use RecTcChecker to avoid looking through recursive types. But on the way * I found that ae_rec_tc was entirely inoperative and did nothing. So I removed it altogether from DmdAnal. * I moved some code around in DmdAnal and Demand. (There are no actual changes in dmdFix.) * I changed the API of DmsAnal.dmdAnalRhsLetDown to return a StrictSig rather than a decorated Id * I removed the dead function peelTsFuns from Demand Performance effects: Nofib: 0.0% changes. Not surprising, because they don't use recursive products Perf tests T12227: 1% increase in compiler allocation, becuase $cto gets w/w'd. It did not w/w before because it takes a deeply nested argument, so the worker gets too many args, so we abandon w/w altogether (see GHC.Core.Opt.WorkWrap.Utils.isWorkerSmallEnough) With this patch we trim the demands. That is not strictly necessary (since these Generic type constructors are like tuples -- they can't cause a loop) but the net result is that we now w/w $cto which is fine. UniqLoop: 16% decrease in /runtime/ allocation. The UniqSupply is a recursive product, so currently we abandon all strictness on 'churn'. With this patch 'churn' gets useful strictness, and we w/w it. Hooray Metric Decrease: UniqLoop Metric Increase: T12227 - - - - - 87d504f4 by Viktor Dukhovni at 2020-06-13T02:13:05-04:00 Add introductory prose for Data.Traversable - - - - - 9f09b608 by Oleg Grenrus at 2020-06-13T02:13:07-04:00 Fix #12073: Add MonadFix Q instance - - - - - 220c2d34 by Ben Gamari at 2020-06-13T02:13:07-04:00 testsuite: Increase size of T12150 As noted in #18319, this test was previously very fragile. Increase its size to make it more likely that its fails with its newly-increased acceptance threshold. Metric Increase: T12150 - - - - - 8bba1c26 by Ben Gamari at 2020-06-13T04:59:06-04:00 gitlab-ci: Always push perf notes Previously we ci.sh would run with `set -e` implying that we wouldn't push perf notes if the testsuite were to fail, even if it *only* failed due to perf notes. This rendered the whole performance testing story quite fragile as a single regressing commit would cause every successive commit to fail since a new baseline would not be uploaded. Fix this by ensuring that we always push performance notes. - - - - - 7a773f16 by Ben Gamari at 2020-06-13T15:10:55-04:00 gitlab-ci: Eliminate redundant push of CI metrics - - - - - a31218f7 by Ryan Scott at 2020-06-13T15:58:37-04:00 Use HsForAllTelescope to avoid inferred, visible foralls Currently, `HsForAllTy` permits the combination of `ForallVis` and `Inferred`, but you can't actually typecheck code that uses it (e.g., `forall {a} ->`). This patch refactors `HsForAllTy` to use a new `HsForAllTelescope` data type that makes a type-level distinction between visible and invisible `forall`s such that visible `forall`s do not track `Specificity`. That part of the patch is actually quite small; the rest is simply changing consumers of `HsType` to accommodate this new type. Fixes #18235. Bumps the `haddock` submodule. - - - - - c0e6dee9 by Tamar Christina at 2020-06-14T09:07:44-04:00 winio: Add Atomic Exchange PrimOp and implement Atomic Ptr exchanges. The initial version was rewritten by Tamar Christina. It was rewritten in large parts by Andreas Klebinger. Co-authored-by: Andreas Klebinger <klebinger.andreas at gmx.at> - - - - - 9a7462fb by Ben Gamari at 2020-06-14T15:35:23-04:00 codeGen: Don't discard live case binders in unsafeEqualityProof logic Previously CoreToStg would unconditionally discard cases of the form: case unsafeEqualityProof of wild { _ -> rhs } and rather replace the whole thing with `rhs`. However, in some cases (see #18227) the case binder is still live, resulting in unbound occurrences in `rhs`. Fix this by only discarding the case if the case binder is dead. Fixes #18227. - - - - - e4137c48 by Ben Gamari at 2020-06-14T15:35:23-04:00 testsuite: Add tests for #18227 T18227A is the original issue which gave rise to the ticket and depends upon bytestring. T18227B is a minimized reproducer. - - - - - 8bab9ff1 by Ben Gamari at 2020-06-14T15:35:59-04:00 hadrian: Fix rts include and library paths Fixes two bugs: * (?) and (<>) associated in a surprising way * We neglected to include libdw paths in the rts configure flags - - - - - bd761185 by Ben Gamari at 2020-06-14T15:35:59-04:00 hadrian: Drop redundant GHC arguments Cabal should already be passing this arguments to GHC. - - - - - 01f7052c by Peter Trommler at 2020-06-14T15:36:38-04:00 FFI: Fix pass small ints in foreign call wrappers The Haskell calling convention requires integer parameters smaller than wordsize to be promoted to wordsize (where the upper bits are don't care). To access such small integer parameter read a word from the parameter array and then cast that word to the small integer target type. Fixes #15933 - - - - - 502647f7 by Krzysztof Gogolewski at 2020-06-14T15:37:14-04:00 Fix "ndecreasingIndentation" in manual (#18116) - - - - - 9a9cc089 by Simon Jakobi at 2020-06-15T13:10:00-04:00 Use foldl' in unionManyUniqDSets - - - - - 761dcb84 by Moritz Angermann at 2020-06-15T13:10:36-04:00 Load .lo as well. Some archives contain so called linker objects, with the affectionate .lo suffic. For example the musl libc.a will come in that form. We still want to load those objects, hence we should not discard them and look for .lo as well. Ultimately we might want to fix this proerly by looking at the file magic. - - - - - cf01477f by Vladislav Zavialov at 2020-06-15T13:11:20-04:00 User's Guide: KnownNat evidence is Natural This bit of documentation got outdated after commit 1fcede43d2b30f33b7505e25eb6b1f321be0407f - - - - - d0dcbfe6 by Jan Hrček at 2020-06-16T20:36:38+02:00 Fix typos and formatting in user guide - - - - - 56a9e95f by Jan Hrček at 2020-06-16T20:36:38+02:00 Resolve TODO - - - - - 3e884d14 by Jan Hrček at 2020-06-16T20:36:38+02:00 Rename TcHoleErrors to GHC.Tc.Errors.Hole - - - - - d23fc678 by Stefan Schulze Frielinghaus at 2020-06-17T15:31:09-04:00 hadrian: Build with threaded runtime if available See #16873. - - - - - 0639dc10 by Sylvain Henry at 2020-06-17T15:31:53-04:00 T16190: only measure bytes_allocated Just adding `{-# LANGUAGE BangPatterns #-}` makes the two other metrics fluctuate by 13%. - - - - - 4cab6897 by Adam Sandberg Ericsson at 2020-06-17T15:32:44-04:00 docs: fix formatting in users guide - - - - - eb8115a8 by Sylvain Henry at 2020-06-17T15:33:23-04:00 Move CLabel assertions into smart constructors (#17957) It avoids using DynFlags in the Outputable instance of Clabel to check assertions at pretty-printing time. - - - - - 7faa4509 by Ben Gamari at 2020-06-17T15:43:31-04:00 base: Bump to 4.15.0.0 - - - - - 20616959 by Ben Gamari at 2020-06-17T15:43:31-04:00 configure: Use grep -q instead of --quiet The latter is apparently not supported by busybox. - - - - - 40fa237e by Krzysztof Gogolewski at 2020-06-17T16:21:58-04:00 Linear types (#15981) This is the first step towards implementation of the linear types proposal (https://github.com/ghc-proposals/ghc-proposals/pull/111). It features * A language extension -XLinearTypes * Syntax for linear functions in the surface language * Linearity checking in Core Lint, enabled with -dlinear-core-lint * Core-to-core passes are mostly compatible with linearity * Fields in a data type can be linear or unrestricted; linear fields have multiplicity-polymorphic constructors. If -XLinearTypes is disabled, the GADT syntax defaults to linear fields The following items are not yet supported: * a # m -> b syntax (only prefix FUN is supported for now) * Full multiplicity inference (multiplicities are really only checked) * Decent linearity error messages * Linear let, where, and case expressions in the surface language (each of these currently introduce the unrestricted variant) * Multiplicity-parametric fields * Syntax for annotating lambda-bound or let-bound with a multiplicity * Syntax for non-linear/multiple-field-multiplicity records * Linear projections for records with a single linear field * Linear pattern synonyms * Multiplicity coercions (test LinearPolyType) A high-level description can be found at https://ghc.haskell.org/trac/ghc/wiki/LinearTypes/Implementation Following the link above you will find a description of the changes made to Core. This commit has been authored by * Richard Eisenberg * Krzysztof Gogolewski * Matthew Pickering * Arnaud Spiwack With contributions from: * Mark Barbone * Alexander Vershilov Updates haddock submodule. - - - - - 6cb84c46 by Krzysztof Gogolewski at 2020-06-17T16:22:03-04:00 Various performance improvements This implements several general performance improvements to GHC, to offset the effect of the linear types change. General optimisations: - Add a `coreFullView` function which iterates `coreView` on the head. This avoids making function recursive solely because the iterate `coreView` themselves. As a consequence, this functions can be inlined, and trigger case-of-known constructor (_e.g._ `kindRep_maybe`, `isLiftedRuntimeRep`, `isMultiplicityTy`, `getTyVar_maybe`, `splitAppTy_maybe`, `splitFunType_maybe`, `tyConAppTyCon_maybe`). The common pattern about all these functions is that they are almost always used as views, and immediately consumed by a case expression. This commit also mark them asx `INLINE`. - In `subst_ty` add a special case for nullary `TyConApp`, which avoid allocations altogether. - Use `mkTyConApp` in `subst_ty` for the general `TyConApp`. This required quite a bit of module shuffling. case. `myTyConApp` enforces crucial sharing, which was lost during substitution. See also !2952 . - Make `subst_ty` stricter. - In `eqType` (specifically, in `nonDetCmpType`), add a special case, tested first, for the very common case of nullary `TyConApp`. `nonDetCmpType` has been made `INLINE` otherwise it is actually a regression. This is similar to the optimisations in !2952. Linear-type specific optimisations: - Use `tyConAppTyCon_maybe` instead of the more complex `eqType` in the definition of the pattern synonyms `One` and `Many`. - Break the `hs-boot` cycles between `Multiplicity.hs` and `Type.hs`: `Multiplicity` now import `Type` normally, rather than from the `hs-boot`. This way `tyConAppTyCon_maybe` can inline properly in the `One` and `Many` pattern synonyms. - Make `updateIdTypeAndMult` strict in its type and multiplicity - The `scaleIdBy` gets a specialised definition rather than being an alias to `scaleVarBy` - `splitFunTy_maybe` is given the type `Type -> Maybe (Mult, Type, Type)` instead of `Type -> Maybe (Scaled Type, Type)` - Remove the `MultMul` pattern synonym in favour of a view `isMultMul` because pattern synonyms appear not to inline well. - in `eqType`, in a `FunTy`, compare multiplicities last: they are almost always both `Many`, so it helps failing faster. - Cache `manyDataConTy` in `mkTyConApp`, to make sure that all the instances of `TyConApp ManyDataConTy []` are physically the same. This commit has been authored by * Richard Eisenberg * Krzysztof Gogolewski * Arnaud Spiwack Metric Decrease: haddock.base T12227 T12545 T12990 T1969 T3064 T5030 T9872b Metric Increase: haddock.base haddock.Cabal haddock.compiler T12150 T12234 T12425 T12707 T13035 T13056 T15164 T16190 T18304 T1969 T3064 T3294 T5631 T5642 T5837 T6048 T9020 T9233 T9675 T9872a T9961 WWRec - - - - - 57db91d8 by Sylvain Henry at 2020-06-17T16:22:03-04:00 Remove integer-simple integer-simple uses lists of words (`[Word]`) to represent big numbers instead of ByteArray#: * it is less efficient than the newer ghc-bignum native backend * it isn't compatible with the big number representation that is now shared by all the ghc-bignum backends (based on the one that was used only in integer-gmp before). As a consequence, we simply drop integer-simple - - - - - 9f96bc12 by Sylvain Henry at 2020-06-17T16:22:03-04:00 ghc-bignum library ghc-bignum is a newer package that aims to replace the legacy integer-simple and integer-gmp packages. * it supports several backends. In particular GMP is still supported and most of the code from integer-gmp has been merged in the "gmp" backend. * the pure Haskell "native" backend is new and is much faster than the previous pure Haskell implementation provided by integer-simple * new backends are easier to write because they only have to provide a few well defined functions. All the other code is common to all backends. In particular they all share the efficient small/big number distinction previously used only in integer-gmp. * backends can all be tested against the "native" backend with a simple Cabal flag. Backends are only allowed to differ in performance, their results should be the same. * Add `integer-gmp` compat package: provide some pattern synonyms and function aliases for those in `ghc-bignum`. It is intended to avoid breaking packages that depend on `integer-gmp` internals. Update submodules: text, bytestring Metric Decrease: Conversions ManyAlternatives ManyConstructors Naperian T10359 T10547 T10678 T12150 T12227 T12234 T12425 T13035 T13719 T14936 T1969 T4801 T4830 T5237 T5549 T5837 T8766 T9020 parsing001 space_leak_001 T16190 haddock.base On ARM and i386, T17499 regresses (+6% > 5%). On x86_64 unregistered, T13701 sometimes regresses (+2.2% > 2%). Metric Increase: T17499 T13701 - - - - - 96aa5787 by Sylvain Henry at 2020-06-17T16:22:03-04:00 Update compiler Thanks to ghc-bignum, the compiler can be simplified: * Types and constructors of Integer and Natural can be wired-in. It means that we don't have to query them from interfaces. It also means that numeric literals don't have to carry their type with them. * The same code is used whatever ghc-bignum backend is enabled. In particular, conversion of bignum literals into final Core expressions is now much more straightforward. Bignum closure inspection too. * GHC itself doesn't depend on any integer-* package anymore * The `integerLibrary` setting is gone. - - - - - 0f67e344 by Sylvain Henry at 2020-06-17T16:22:03-04:00 Update `base` package * GHC.Natural isn't implemented in `base` anymore. It is provided by ghc-bignum in GHC.Num.Natural. It means that we can safely use Natural primitives in `base` without fearing issues with built-in rewrite rules (cf #15286) * `base` doesn't conditionally depend on an integer-* package anymore, it depends on ghc-bignum * Some duplicated code in integer-* can now be factored in GHC.Float * ghc-bignum tries to use a uniform naming convention so most of the other changes are renaming - - - - - aa9e7b71 by Sylvain Henry at 2020-06-17T16:22:03-04:00 Update `make` based build system * replace integer-* package selection with ghc-bignum backend selection - - - - - f817d816 by Sylvain Henry at 2020-06-17T16:22:04-04:00 Update testsuite * support detection of slow ghc-bignum backend (to replace the detection of integer-simple use). There are still some test cases that the native backend doesn't handle efficiently enough. * remove tests for GMP only functions that have been removed from ghc-bignum * fix test results showing dependent packages (e.g. integer-gmp) or showing suggested instances * fix test using Integer/Natural API or showing internal names - - - - - dceecb09 by Sylvain Henry at 2020-06-17T16:22:04-04:00 Update Hadrian * support ghc-bignum backend selection in flavours and command-line * support ghc-bignum "--check" flag (compare results of selected backend against results of the native one) in flavours and command-line (e.g. pass --bignum=check-gmp" to check the "gmp" backend) * remove the hack to workaround #15286 * build GMP only when the gmp backend is used * remove hacks to workaround `text` package flags about integer-*. We fix `text` to use ghc-bignum unconditionally in another patch - - - - - fa4281d6 by Sylvain Henry at 2020-06-17T16:22:04-04:00 Bump bytestring and text submodules - - - - - 1a3f6f34 by Adam Sandberg Ericsson at 2020-06-18T23:03:36-04:00 docs: mention -hiedir in docs for -outputdir [skip ci] - - - - - 729bcb02 by Sylvain Henry at 2020-06-18T23:04:17-04:00 Hadrian: fix build on Mac OS Catalina (#17798) - - - - - 95e18292 by Andreas Klebinger at 2020-06-18T23:04:58-04:00 Relax allocation threshold for T12150. This test performs little work, so the most minor allocation changes often cause the test to fail. Increasing the threshold to 2% should help with this. - - - - - 8ce6c393 by Sebastian Graf at 2020-06-18T23:05:36-04:00 hadrian: Bump pinned cabal.project to an existent index-state - - - - - 08c1cb0f by Ömer Sinan Ağacan at 2020-06-18T23:06:21-04:00 Fix uninitialized field read in Linker.c Valgrind report of the bug when running the test `linker_unload`: ==29666== Conditional jump or move depends on uninitialised value(s) ==29666== at 0x369C5B4: setOcInitialStatus (Linker.c:1305) ==29666== by 0x369C6C5: mkOc (Linker.c:1347) ==29666== by 0x36C027A: loadArchive_ (LoadArchive.c:522) ==29666== by 0x36C0600: loadArchive (LoadArchive.c:626) ==29666== by 0x2C144CD: ??? (in /home/omer/haskell/ghc_2/testsuite/tests/rts/linker/linker_unload.run/linker_unload) ==29666== ==29666== Conditional jump or move depends on uninitialised value(s) ==29666== at 0x369C5B4: setOcInitialStatus (Linker.c:1305) ==29666== by 0x369C6C5: mkOc (Linker.c:1347) ==29666== by 0x369C9F6: preloadObjectFile (Linker.c:1507) ==29666== by 0x369CA8D: loadObj_ (Linker.c:1536) ==29666== by 0x369CB17: loadObj (Linker.c:1557) ==29666== by 0x3866BC: main (linker_unload.c:33) The problem is `mkOc` allocates a new `ObjectCode` and calls `setOcInitialStatus` without initializing the `status` field. `setOcInitialStatus` reads the field as first thing: static void setOcInitialStatus(ObjectCode* oc) { if (oc->status == OBJECT_DONT_RESOLVE) return; if (oc->archiveMemberName == NULL) { oc->status = OBJECT_NEEDED; } else { oc->status = OBJECT_LOADED; } } `setOcInitialStatus` is unsed in two places for two different purposes: in `mkOc` where we don't have the `status` field initialized yet (`mkOc` is supposed to initialize it), and `loadOc` where we do have `status` field initialized and we want to update it. Instead of splitting the function into two functions which are both called just once I inline the functions in the use sites and remove it. Fixes #18342 - - - - - da18ff99 by Tamar Christina at 2020-06-18T23:07:03-04:00 fix windows bootstrap due to linker changes - - - - - 2af0ec90 by Sylvain Henry at 2020-06-18T23:07:47-04:00 DynFlags: store default depth in SDocContext (#17957) It avoids having to use DynFlags to reach for pprUserLength. - - - - - d4a0be75 by Sylvain Henry at 2020-06-18T23:08:35-04:00 Move tablesNextToCode field into Platform tablesNextToCode is a platform setting and doesn't belong into DynFlags (#17957). Doing this is also a prerequisite to fix #14335 where we deal with two platforms (target and host) that may have different platform settings. - - - - - 809caedf by John Ericson at 2020-06-23T22:47:37-04:00 Switch from HscSource to IsBootInterface for module lookup in GhcMake We look up modules by their name, and not their contents. There is no way to separately reference a signature vs regular module; you get what you get. Only boot files can be referenced indepenently with `import {-# SOURCE #-}`. - - - - - 7750bd45 by Sylvain Henry at 2020-06-23T22:48:18-04:00 Cmm: introduce SAVE_REGS/RESTORE_REGS We don't want to save both Fn and Dn register sets on x86-64 as they are aliased to the same arch register (XMMn). Moreover, when SAVE_STGREGS was used in conjunction with `jump foo [*]` which makes a set of Cmm registers alive so that they cover all arch registers used to pass parameter, we could have Fn, Dn and XMMn alive at the same time. It made the LLVM code generator choke (see #17920). Now `SAVE_REGS/RESTORE_REGS` and `jump foo [*]` use the same set of registers. - - - - - 2636794d by Sylvain Henry at 2020-06-23T22:48:18-04:00 CmmToC: don't add extern decl to parsed Cmm data Previously, if a .cmm file *not in the RTS* contained something like: ```cmm section "rodata" { msg : bits8[] "Test\n"; } ``` It would get compiled by CmmToC into: ```c ERW_(msg); const char msg[] = "Test\012"; ``` and fail with: ``` /tmp/ghc32129_0/ghc_4.hc:5:12: error: error: conflicting types for \u2018msg\u2019 const char msg[] = "Test\012"; ^~~ In file included from /tmp/ghc32129_0/ghc_4.hc:3:0: error: /tmp/ghc32129_0/ghc_4.hc:4:6: error: note: previous declaration of \u2018msg\u2019 was here ERW_(msg); ^ /builds/hsyl20/ghc/_build/install/lib/ghc-8.11.0.20200605/lib/../lib/x86_64-linux-ghc-8.11.0.20200605/rts-1.0/include/Stg.h:253:46: error: note: in definition of macro \u2018ERW_\u2019 #define ERW_(X) extern StgWordArray (X) ^ ``` See the rationale for this on https://gitlab.haskell.org/ghc/ghc/-/wikis/commentary/compiler/backends/ppr-c#prototypes Now we don't generate these extern declarations (ERW_, etc.) for top-level data. It shouldn't change anything for the RTS (the only place we use .cmm files) as it is already special cased in `GHC.Cmm.CLabel.needsCDecl`. And hand-written Cmm can use explicit extern declarations when needed. Note that it allows `cgrun069` test to pass with CmmToC (cf #15467). - - - - - 5f6a0665 by Sylvain Henry at 2020-06-23T22:48:18-04:00 LLVM: refactor and comment register padding code (#17920) - - - - - cad62ef1 by Sylvain Henry at 2020-06-23T22:48:18-04:00 Add tests for #17920 Metric Decrease: T12150 T12234 - - - - - a2a9006b by Xavier Denis at 2020-06-23T22:48:56-04:00 Fix issue #18262 by zonking constraints after solving Zonk residual constraints in checkForExistence to reveal user type errors. Previously when `:instances` was used with instances that have TypeError constraints the result would look something like: instance [safe] s0 => Err 'A -- Defined at ../Bug2.hs:8:10 whereas after zonking, `:instances` now sees the `TypeError` and properly eliminates the constraint from the results. - - - - - 181516bc by Simon Peyton Jones at 2020-06-23T22:49:33-04:00 Fix a buglet in Simplify.simplCast This bug, revealed by #18347, is just a missing update to sc_hole_ty in simplCast. I'd missed a code path when I made the recentchanges in commit 6d49d5be904c0c01788fa7aae1b112d5b4dfaf1c Author: Simon Peyton Jones <simonpj at microsoft.com> Date: Thu May 21 12:53:35 2020 +0100 Implement cast worker/wrapper properly The fix is very easy. Two other minor changes * Tidy up in SimpleOpt.simple_opt_expr. In fact I think this is an outright bug, introduced in the fix to #18112: we were simplifying the same coercion twice *with the same substitution*, which is just wrong. It'd be a hard bug to trigger, so I just fixed it; less code too. * Better debug printing of ApplyToVal - - - - - 625a7f54 by Simon Peyton Jones at 2020-06-23T22:50:11-04:00 Two small tweaks to Coercion.simplifyArgsWorker These tweaks affect the inner loop of simplifyArgsWorker, which in turn is called from the flattener in Flatten.hs. This is a key perf bottleneck to T9872{a,b,c,d}. These two small changes have a modest but useful benefit. No change in functionality whatsoever. Relates to #18354 - - - - - b5768cce by Sylvain Henry at 2020-06-23T22:50:49-04:00 Don't use timesInt2# with GHC < 8.11 (fix #18358) - - - - - 7ad4085c by Sylvain Henry at 2020-06-23T22:51:27-04:00 Fix invalid printf format - - - - - a1f34d37 by Krzysztof Gogolewski at 2020-06-23T22:52:09-04:00 Add missing entry to freeNamesItem (#18369) - - - - - 03a708ba by Andreas Klebinger at 2020-06-25T03:54:37-04:00 Enable large address space optimization on windows. Starting with Win 8.1/Server 2012 windows no longer preallocates page tables for reserverd memory eagerly, which prevented us from using this approach in the past. We also try to allocate the heap high in the memory space. Hopefully this makes it easier to allocate things in the low 4GB of memory that need to be there. Like jump islands for the linker. - - - - - 7e6d3d09 by Roland Senn at 2020-06-25T03:54:38-04:00 In `:break ident` allow out of scope and nested identifiers (Fix #3000) This patch fixes the bug and implements the feature request of #3000. 1. If `Module` is a real module name and `identifier` a name of a top-level function in `Module` then `:break Module.identifer` works also for an `identifier` that is out of scope. 2. Extend the syntax for `:break identifier` to: :break [ModQual.]topLevelIdent[.nestedIdent]...[.nestedIdent] `ModQual` is optional and is either the effective name of a module or the local alias of a qualified import statement. `topLevelIdent` is the name of a top level function in the module referenced by `ModQual`. `nestedIdent` is optional and the name of a function nested in a let or where clause inside the previously mentioned function `nestedIdent` or `topLevelIdent`. If `ModQual` is a module name, then `topLevelIdent` can be any top level identifier in this module. If `ModQual` is missing or a local alias of a qualified import, then `topLevelIdent` must be in scope. Breakpoints can be set on arbitrarily deeply nested functions, but the whole chain of nested function names must be specified. 3. To support the new functionality rewrite the code to tab complete `:break`. - - - - - 30e42652 by Ben Gamari at 2020-06-25T03:54:39-04:00 make: Respect XELATEX variable Previously we simply ignored the XELATEX variable when building PDF documentation. - - - - - 4acc2934 by Ben Gamari at 2020-06-25T03:54:39-04:00 hadrian/make: Detect makeindex Previously we would simply assume that makeindex was available. Now we correctly detect it in `configure` and respect this conclusion in hadrian and make. - - - - - 0d61f866 by Simon Peyton Jones at 2020-06-25T03:54:40-04:00 Expunge GhcTcId GHC.Hs.Extension had type GhcPs = GhcPass 'Parsed type GhcRn = GhcPass 'Renamed type GhcTc = GhcPass 'Typechecked type GhcTcId = GhcTc The last of these, GhcTcId, is a vestige of the past. This patch expunges it from GHC. - - - - - 8ddbed4a by Adam Wespiser at 2020-06-25T03:54:40-04:00 add examples to Data.Traversable - - - - - 284001d0 by Oleg Grenrus at 2020-06-25T03:54:42-04:00 Export readBinIface_ - - - - - 90f43872 by Zubin Duggal at 2020-06-25T03:54:43-04:00 Export everything from HsToCore. This lets us reuse these functions in haddock, avoiding synchronization bugs. Also fixed some divergences with haddock in that file Updates haddock submodule - - - - - c7dd6da7 by Takenobu Tani at 2020-06-25T03:54:44-04:00 Clean up haddock hyperlinks of GHC.* (part1) This updates haddock comments only. This patch focuses to update for hyperlinks in GHC API's haddock comments, because broken links especially discourage newcomers. This includes the following hierarchies: - GHC.Hs.* - GHC.Core.* - GHC.Stg.* - GHC.Cmm.* - GHC.Types.* - GHC.Data.* - GHC.Builtin.* - GHC.Parser.* - GHC.Driver.* - GHC top - - - - - 1eb997a8 by Takenobu Tani at 2020-06-25T03:54:44-04:00 Clean up haddock hyperlinks of GHC.* (part2) This updates haddock comments only. This patch focuses to update for hyperlinks in GHC API's haddock comments, because broken links especially discourage newcomers. This includes the following hierarchies: - GHC.Iface.* - GHC.Llvm.* - GHC.Rename.* - GHC.Tc.* - GHC.HsToCore.* - GHC.StgToCmm.* - GHC.CmmToAsm.* - GHC.Runtime.* - GHC.Unit.* - GHC.Utils.* - GHC.SysTools.* - - - - - 67a86b4d by Oleg Grenrus at 2020-06-25T03:54:46-04:00 Add MonadZip and MonadFix instances for Complex These instances are taken from https://hackage.haskell.org/package/linear-1.21/docs/Linear-Instances.html They are the unique possible, so let they be in `base`. - - - - - c50ef26e by Artem Pelenitsyn at 2020-06-25T03:54:47-04:00 test suite: add reproducer for #17516 - - - - - fe281b27 by Roland Senn at 2020-06-25T03:54:48-04:00 Enable maxBound checks for OverloadedLists (Fixes #18172) Consider the Literal `[256] :: [Data.Word.Word8]` When the `OverloadedLists` extension is not active, then the `ol_ext` field in the `OverLitTc` record that is passed to the function `getIntegralLit` contains the type `Word8`. This is a simple type, and we can use its type constructor immediately for the `warnAboutOverflowedLiterals` function. When the `OverloadedLists` extension is active, then the `ol_ext` field contains the type family `Item [Word8]`. The function `nomaliseType` is used to convert it to the needed type `Word8`. - - - - - a788d4d1 by Ben Gamari at 2020-06-25T03:54:52-04:00 rts/Hash: Simplify freeing of HashListChunks While looking at #18348 I noticed that the treatment of HashLists are a bit more complex than necessary (which lead to some initial confusion on my part). Specifically, we allocate HashLists in chunks. Each chunk allocation makes two allocations: one for the chunk itself and one for a HashListChunk to link together the chunks for the purposes of freeing. Simplify this (and hopefully make the relationship between these clearer) but allocating the HashLists and HashListChunk in a single malloc. This will both make the implementation easier to follow and reduce C heap fragmentation. Note that even after this patch we fail to bound the size of the free HashList pool. However, this is a separate bug. - - - - - d3c2d59b by Sylvain Henry at 2020-06-25T03:54:55-04:00 RTS: avoid overflow on 32-bit arch (#18375) We're now correctly computing allocated bytes on 32-bit arch, so we get huge increases. Metric Increase: haddock.Cabal haddock.base haddock.compiler space_leak_001 - - - - - a3d69dc6 by Sebastian Graf at 2020-06-25T23:06:18-04:00 GHC.Core.Unify: Make UM actions one-shot by default This MR makes the UM monad in GHC.Core.Unify into a one-shot monad. See the long Note [The one-shot state monad trick]. See also #18202 and !3309, which applies this to all Reader/State-like monads in GHC for compile-time perf improvements. The pattern used here enables something similar to the state-hack, but is applicable to user-defined monads, not just `IO`. Metric Decrease 'runtime/bytes allocated' (test_env='i386-linux-deb9'): haddock.Cabal - - - - - 9ee58f8d by Matthias Pall Gissurarson at 2020-06-26T17:12:45+00:00 Implement the proposed -XQualifiedDo extension Co-authored-by: Facundo Domínguez <facundo.dominguez at tweag.io> QualifiedDo is implemented using the same placeholders for operation names in the AST that were devised for RebindableSyntax. Whenever the renamer checks which names to use for do syntax, it first checks if the do block is qualified (e.g. M.do { stmts }), in which case it searches for qualified names in the module M. This allows users to write {-# LANGUAGE QualifiedDo #-} import qualified SomeModule as M f x = M.do -- desugars to: y <- M.return x -- M.return x M.>>= \y -> M.return y -- M.return y M.>> M.return y -- M.return y See Note [QualifiedDo] and the users' guide for more details. Issue #18214 Proposal: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0216-qualified-do.rst Since we change the constructors `ITdo` and `ITmdo` to carry the new module name, we need to bump the haddock submodule to account or the new shape of these constructors. - - - - - ce987865 by Ryan Scott at 2020-06-27T11:55:21-04:00 Revamp the treatment of auxiliary bindings for derived instances This started as a simple fix for #18321 that organically grew into a much more sweeping refactor of how auxiliary bindings for derived instances are handled. I have rewritten `Note [Auxiliary binders]` in `GHC.Tc.Deriv.Generate` to explain all of the moving parts, but the highlights are: * Previously, the OccName of each auxiliary binding would be given a suffix containing a hash of its package name, module name, and parent data type to avoid name clashes. This was needlessly complicated, so we take the more direct approach of generating `Exact` `RdrName`s for each auxiliary binding with the same `OccName`, but using an underlying `System` `Name` with a fresh `Unique` for each binding. Unlike hashes, allocating new `Unique`s does not require any cleverness and avoid name clashes all the same... * ...speaking of which, in order to convince the renamer that multiple auxiliary bindings with the same `OccName` (but different `Unique`s) are kosher, we now use `rnLocalValBindsLHS` instead of `rnTopBindsLHS` to rename auxiliary bindings. Again, see `Note [Auxiliary binders]` for the full story. * I have removed the `DerivHsBind` constructor for `DerivStuff`—which was only used for `Data.Data`-related auxiliary bindings—and refactored `gen_Data_binds` to use `DerivAuxBind` instead. This brings the treatment of `Data.Data`-related auxiliary bindings in line with every other form of auxiliary binding. Fixes #18321. - - - - - a403eb91 by Sylvain Henry at 2020-06-27T11:55:59-04:00 ghc-bignum: fix division by zero (#18359) - - - - - 1b3d13b6 by Sylvain Henry at 2020-06-27T11:55:59-04:00 Fix ghc-bignum exceptions We must ensure that exceptions are not simplified. Previously we used: case raiseDivZero of _ -> 0## -- dummyValue But it was wrong because the evaluation of `raiseDivZero` was removed and the dummy value was directly returned. See new Note [ghc-bignum exceptions]. I've also removed the exception triggering primops which were fragile. We don't need them to be primops, we can have them exported by ghc-prim. I've also added a test for #18359 which triggered this patch. - - - - - a74ec37c by Simon Peyton Jones at 2020-06-27T11:56:34-04:00 Better loop detection in findTypeShape Andreas pointed out, in !3466, that my fix for #18304 was not quite right. This patch fixes it properly, by having just one RecTcChecker rather than (implicitly) two nested ones, in findTypeShape. - - - - - a04020b8 by Sylvain Henry at 2020-06-27T11:57:11-04:00 DynFlags: don't store buildTag `DynFlags.buildTag` was a field created from the set of Ways in `DynFlags.ways`. It had to be kept in sync with `DynFlags.ways` which was fragile. We want to avoid global state like this (#17957). Moreover in #14335 we also want to support loading units with different ways: target units would still use `DynFlags.ways` but plugins would use `GHC.Driver.Ways.hostFullWays`. To avoid having to deal both with build tag and with ways, we recompute the buildTag on-the-fly (should be pretty cheap) and we remove `DynFlags.buildTag` field. - - - - - 0e83efa2 by Krzysztof Gogolewski at 2020-06-27T11:57:49-04:00 Don't generalize when typechecking a tuple section The code is simpler and cleaner. - - - - - d8ba9e6f by Peter Trommler at 2020-06-28T09:19:11-04:00 RTS: Refactor Haskell-C glue for PPC 64-bit Make sure the stack is 16 byte aligned even when reserved stack bytes are not a multiple of 16 bytes. Avoid saving r2 (TOC). On ELF v1 the function descriptor of StgReturn has the same TOC as StgRun, on ELF v2 the TOC is recomputed in the function prologue. Use the ABI provided functions to save clobbered GPRs and FPRs. Improve comments. Describe what the stack looks like and how it relates to the respective ABIs. - - - - - 42f797b0 by Ryan Scott at 2020-06-28T09:19:46-04:00 Use NHsCoreTy to embed types into GND-generated code `GeneralizedNewtypeDeriving` is in the unique situation where it must produce an `LHsType GhcPs` from a Core `Type`. Historically, this was done with the `typeToLHsType` function, which walked over the entire `Type` and attempted to construct an `LHsType` with the same overall structure. `typeToLHsType` is quite complicated, however, and has been the subject of numerous bugs over the years (e.g., #14579). Luckily, there is an easier way to accomplish the same thing: the `XHsType` constructor of `HsType`. `XHsType` bundles an `NHsCoreTy`, which allows embedding a Core `Type` directly into an `HsType`, avoiding the need to laboriously convert from one to another (as `typeToLHsType` did). Moreover, renaming and typechecking an `XHsType` is simple, since one doesn't need to do anything to a Core `Type`... ...well, almost. For the reasons described in `Note [Typechecking NHsCoreTys]` in `GHC.Tc.Gen.HsType`, we must apply a substitution that we build from the local `tcl_env` type environment. But that's a relatively modest price to pay. Now that `GeneralizedNewtypeDeriving` uses `NHsCoreTy`, the `typeToLHsType` function no longer has any uses in GHC, so this patch rips it out. Some additional tweaks to `hsTypeNeedsParens` were necessary to make the new `-ddump-deriv` output correctly parenthesized, but other than that, this patch is quite straightforward. This is a mostly internal refactoring, although it is likely that `GeneralizedNewtypeDeriving`-generated code will now need fewer language extensions in certain situations than it did before. - - - - - 68530b1c by Jan Hrček at 2020-06-28T09:20:22-04:00 Fix duplicated words and typos in comments and user guide - - - - - 15b79bef by Ryan Scott at 2020-06-28T09:20:57-04:00 Add integer-gmp's ghc.mk and GNUmakefile to .gitignore - - - - - bfa5698b by Simon Peyton Jones at 2020-06-28T09:21:32-04:00 Fix a typo in Lint This simple error in GHC.Core.Litn.lintJoinLams meant that Lint reported bogus errors. Fixes #18399 - - - - - 71006532 by Ryan Scott at 2020-06-30T07:10:42-04:00 Reject nested foralls/contexts in instance types more consistently GHC is very wishy-washy about rejecting instance declarations with nested `forall`s or contexts that are surrounded by outermost parentheses. This can even lead to some strange interactions with `ScopedTypeVariables`, as demonstrated in #18240. This patch makes GHC more consistently reject instance types with nested `forall`s/contexts so as to prevent these strange interactions. On the implementation side, this patch tweaks `splitLHsInstDeclTy` and `getLHsInstDeclHead` to not look through parentheses, which can be semantically significant. I've added a `Note [No nested foralls or contexts in instance types]` in `GHC.Hs.Type` to explain why. This also introduces a `no_nested_foralls_contexts_err` function in `GHC.Rename.HsType` to catch nested `forall`s/contexts in instance types. This function is now used in `rnClsInstDecl` (for ordinary instance declarations) and `rnSrcDerivDecl` (for standalone `deriving` declarations), the latter of which fixes #18271. On the documentation side, this adds a new "Formal syntax for instance declaration types" section to the GHC User's Guide that presents a BNF-style grammar for what is and isn't allowed in instance types. Fixes #18240. Fixes #18271. - - - - - bccf3351 by Sylvain Henry at 2020-06-30T07:10:46-04:00 Add ghc-bignum to 8.12 release notes - - - - - 81704a6f by David Eichmann at 2020-06-30T07:10:48-04:00 Update ssh keys in CI performance metrics upload script - - - - - 85310fb8 by Joshua Price at 2020-06-30T07:10:49-04:00 Add missing Ix instances for tuples of size 6 through 15 (#16643) - - - - - cbb6b62f by Vladislav Zavialov at 2020-07-01T15:41:38-04:00 Implement -XLexicalNegation (GHC Proposal #229) This patch introduces a new extension, -XLexicalNegation, which detects whether the minus sign stands for negation or subtraction using the whitespace-based rules described in GHC Proposal #229. Updates haddock submodule. - - - - - fb5a0d01 by Martin Handley at 2020-07-01T15:42:14-04:00 #17169: Clarify Fixed's Enum instance. - - - - - b316804d by Simon Peyton Jones at 2020-07-01T15:42:49-04:00 Improve debug tracing for substitution This patch improves debug tracing a bit (#18395) * Remove the ancient SDoc argument to substitution, replacing it with a HasDebugCallStack constraint. The latter does the same job (indicate the call site) but much better. * Add HasDebugCallStack to simpleOptExpr, exprIsConApp_maybe I needed this to help nail the lookupIdSubst panic in #18326, #17784 - - - - - 5c9fabb8 by Hécate at 2020-07-01T15:43:25-04:00 Add most common return values for `os` and `arch` - - - - - 76d8cc74 by Ryan Scott at 2020-07-01T15:44:01-04:00 Desugar quoted uses of DerivingVia and expression type signatures properly The way that `GHC.HsToCore.Quote` desugared quoted `via` types (e.g., `deriving via forall a. [a] instance Eq a => Eq (List a)`) and explicit type annotations in signatures (e.g., `f = id @a :: forall a. a -> a`) was completely wrong, as it did not implement the scoping guidelines laid out in `Note [Scoped type variables in bindings]`. This is easily fixed. While I was in town, I did some minor cleanup of related Notes: * `Note [Scoped type variables in bindings]` and `Note [Scoped type variables in class and instance declarations]` say very nearly the same thing. I decided to just consolidate the two Notes into `Note [Scoped type variables in quotes]`. * `Note [Don't quantify implicit type variables in quotes]` is somewhat outdated, as it predates GHC 8.10, where the `forall`-or-nothing rule requires kind variables to be explicitly quantified in the presence of an explicit `forall`. As a result, the running example in that Note doesn't even compile. I have changed the example to something simpler that illustrates the same point that the original Note was making. Fixes #18388. - - - - - 44d6a335 by Andreas Klebinger at 2020-07-02T02:54:54-04:00 T16012: Be verbose on failure. - - - - - f9853330 by Ryan Scott at 2020-07-02T02:55:29-04:00 Bump ghc-prim version to 0.7.0 Fixes #18279. Bumps the `text` submodule. - - - - - 23e4e047 by Sylvain Henry at 2020-07-02T10:46:31-04:00 Hadrian: fix PowerPC64le support (#17601) [ci skip] - - - - - 3cdd8d69 by Sylvain Henry at 2020-07-02T10:47:08-04:00 NCG: correctly handle addresses with huge offsets (#15570) Before this patch we could generate addresses of this form: movzbl cP0_str+-9223372036854775808,%eax The linker can't handle them because the offset is too large: ld.lld: error: Main.o:(.text+0xB3): relocation R_X86_64_32S out of range: -9223372036852653050 is not in [-2147483648, 2147483647] With this patch we detect those cases and generate: movq $-9223372036854775808,%rax addq $cP0_str,%rax movzbl (%rax),%eax I've also refactored `getAmode` a little bit to make it easier to understand and to trace. - - - - - 4d90b3ff by Gabor Greif at 2020-07-02T20:07:59-04:00 No need for CURSES_INCLUDE_DIRS This is a leftover from ef63ff27251a20ff11e58c9303677fa31e609a88 - - - - - f08d6316 by Sylvain Henry at 2020-07-02T20:08:36-04:00 Replace Opt_SccProfilingOn flag with sccProfilingEnabled helper function SCC profiling was enabled in a convoluted way: if WayProf was enabled, Opt_SccProfilingOn general flag was set (in `GHC.Driver.Ways.wayGeneralFlags`), and then this flag was queried in various places. There is no need to go via general flags, so this patch defines a `sccProfilingEnabled :: DynFlags -> Bool` helper function that just checks whether WayProf is enabled. - - - - - 8cc7274b by Ben Gamari at 2020-07-03T02:49:27-04:00 rts/ProfHeap: Only allocate the Censuses that we need When not LDV profiling there is no reason to allocate 32 Censuses; one will do. This is a very small memory footprint optimisation, but it comes for free. - - - - - b835112c by Ben Gamari at 2020-07-03T02:49:27-04:00 rts/ProfHeap: Free old allocations when reinitialising Censuses Previously when not LDV profiling we would repeatedly reinitialise `censuses[0]` with `initEra`. This failed to free the `Arena` and `HashTable` from the old census, resulting in a memory leak. Fixes #18348. - - - - - 34be6523 by Valery Tolstov at 2020-07-03T02:50:03-04:00 Mention flags that are not enabled by -Wall (#18372) * Mention missing flags that are not actually enabled by -Wall (docs/users_guide/using-warnings.rst) * Additionally remove -Wmissing-monadfail-instances from the list of flags enabled by -Wcompat, as it is not the case since 8.8 - - - - - edc8d22b by Sylvain Henry at 2020-07-03T02:50:40-04:00 LLVM: support R9 and R10 registers d535ef006d85dbdb7cda2b09c5bc35cb80108909 allowed the use of up to 10 vanilla registers but didn't update LLVM backend to support them. This patch fixes it. - - - - - 4bf18646 by Simon Peyton Jones at 2020-07-03T08:37:42+01:00 Improve handling of data type return kinds Following a long conversation with Richard, this patch tidies up the handling of return kinds for data/newtype declarations (vanilla, family, and instance). I have substantially edited the Notes in TyCl, so they would bear careful reading. Fixes #18300, #18357 In GHC.Tc.Instance.Family.newFamInst we were checking some Lint-like properties with ASSSERT. Instead Richard and I have added a proper linter for axioms, and called it from lintGblEnv, which in turn is called in tcRnModuleTcRnM New tests (T18300, T18357) cause an ASSERT failure in HEAD. - - - - - 41d26492 by Sylvain Henry at 2020-07-03T17:33:59-04:00 DynFlags: avoid the use of sdocWithDynFlags in GHC.Core.Rules (#17957) - - - - - 7aa6ef11 by Hécate at 2020-07-03T17:34:36-04:00 Add the __GHC_FULL_VERSION__ CPP macro to expose the full GHC version - - - - - e61d5395 by Chaitanya Koparkar at 2020-07-07T13:55:59-04:00 ghc-prim: Turn some comments into haddocks [ci skip] - - - - - 37743f91 by John Ericson at 2020-07-07T13:56:00-04:00 Support `timesInt2#` in LLVM backend - - - - - 46397e53 by John Ericson at 2020-07-07T13:56:00-04:00 `genericIntMul2Op`: Call `genericWordMul2Op` directly This unblocks a refactor, and removes partiality. It might be a PowerPC regression but that should be fixable. - - - - - 8a1c0584 by John Ericson at 2020-07-07T13:56:00-04:00 Simplify `PrimopCmmEmit` Follow @simonpj's suggestion of pushing the "into regs" logic into `emitPrimOp`. With the previous commit getting rid of the recursion in `genericIntMul2Op`, this is now an easy refactor. - - - - - 6607f203 by John Ericson at 2020-07-07T13:56:00-04:00 `opAllDone` -> `opIntoRegs` The old name was and terrible and became worse after the previous commit's refactor moved non-trivial funcationlity into its body. - - - - - fdcc53ba by Sylvain Henry at 2020-07-07T13:56:00-04:00 Optimise genericIntMul2Op We shouldn't directly call 'genericWordMul2Op' in genericIntMul2Op because a target may provide a faster primop for 'WordMul2Op': we'd better use it! - - - - - 686e7225 by Moritz Angermann at 2020-07-07T13:56:01-04:00 [linker/rtsSymbols] More linker symbols Mostly symbols needed for aarch64/armv7l and in combination with musl, where we have to rely on loading *all* objects/archives - __stack_chk_* only when not DYNAMIC - - - - - 3f60b94d by Moritz Angermann at 2020-07-07T13:56:01-04:00 better if guards. - - - - - 7abffced by Moritz Angermann at 2020-07-07T13:56:01-04:00 Fix (1) - - - - - cdfeb3f2 by Moritz Angermann at 2020-07-07T13:56:01-04:00 AArch32 symbols only on aarch32. - - - - - f496c955 by Adam Sandberg Ericsson at 2020-07-07T13:56:02-04:00 add -flink-rts flag to link the rts when linking a shared or static library #18072 By default we don't link the RTS when linking shared libraries because in the most usual mode a shared library is an intermediary product, for example a Haskell library, that will be linked into some executable in the end. So we wish to defer the RTS flavour to link to the final link. However sometimes the final product is the shared library, for example when writing a plugin for some other system, so we do wish the shared library to link the RTS. For consistency we also make -staticlib honor this flag and its inversion. -staticlib currently implies -flink-shared. - - - - - c59faf67 by Stefan Schulze Frielinghaus at 2020-07-07T13:56:04-04:00 hadrian: link check-ppr against debugging RTS if ghcDebugged - - - - - 0effc57d by Adam Sandberg Ericsson at 2020-07-07T13:56:05-04:00 rts linker: teach the linker about GLIBC's special handling of *stat, mknod and atexit functions #7072 - - - - - 96153433 by Adam Sandberg Ericsson at 2020-07-07T13:56:06-04:00 hadrian: make hadrian/ghci use the bootstrap compiler from configure #18190 - - - - - 4d24f886 by Adam Sandberg Ericsson at 2020-07-07T13:56:07-04:00 hadrian: ignore cabal configure verbosity related flags #18131 - - - - - 7332bbff by Ben Gamari at 2020-07-07T13:56:08-04:00 testsuite: Widen T12234 acceptance window to 2% Previously it wasn't uncommon to see +/-1% fluctuations in compiler allocations on this test. - - - - - 180b6313 by Gabor Greif at 2020-07-07T13:56:08-04:00 When running libtool, report it as such - - - - - d3bd6897 by Sylvain Henry at 2020-07-07T13:56:11-04:00 BigNum: rename BigNat types Before this patch BigNat names were confusing because we had: * GHC.Num.BigNat.BigNat: unlifted type used everywhere else * GHC.Num.BigNat.BigNatW: lifted type only used to share static constants * GHC.Natural.BigNat: lifted type only used for backward compatibility After this patch we have: * GHC.Num.BigNat.BigNat#: unlifted type * GHC.Num.BigNat.BigNat: lifted type (reexported from GHC.Natural) Thanks to @RyanGlScott for spotting this. - - - - - 929d26db by Sylvain Henry at 2020-07-07T13:56:12-04:00 Bignum: don't build ghc-bignum with stage0 Noticed by @Ericson2314 - - - - - d25b6851 by Sylvain Henry at 2020-07-07T13:56:12-04:00 Hadrian: ghc-gmp.h shouldn't be a compiler dependency - - - - - 0ddae2ba by Sylvain Henry at 2020-07-07T13:56:14-04:00 DynFlags: factor out pprUnitId from "Outputable UnitId" instance - - - - - 204f3f5d by Krzysztof Gogolewski at 2020-07-07T13:56:18-04:00 Remove unused function pprHsForAllExtra (#18423) The function `pprHsForAllExtra` was called only on `Nothing` since 2015 (1e041b7382b6aa). - - - - - 3033e0e4 by Adam Sandberg Ericsson at 2020-07-08T20:36:49-04:00 hadrian: add flag to skip rebuilding dependency information #17636 - - - - - b7de4b96 by Stefan Schulze Frielinghaus at 2020-07-09T09:49:22-04:00 Fix GHCi :print on big-endian platforms On big-endian platforms executing import GHC.Exts data Foo = Foo Float# deriving Show foo = Foo 42.0# foo :print foo results in an arithmetic overflow exception which is caused by function index where moveBytes equals word_size - (r + item_size_b) * 8 Here we have a mixture of units. Both, word_size and item_size_b have unit bytes whereas r has unit bits. On 64-bit platforms moveBytes equals then 8 - (0 + 4) * 8 which results in a negative and therefore invalid second parameter for a shiftL operation. In order to make things more clear the expression (word .&. (mask `shiftL` moveBytes)) `shiftR` moveBytes is equivalent to (word `shiftR` moveBytes) .&. mask On big-endian platforms the shift must be a left shift instead of a right shift. For symmetry reasons not a mask is used but two shifts in order to zero out bits. Thus the fixed version equals case endian of BigEndian -> (word `shiftL` moveBits) `shiftR` zeroOutBits `shiftL` zeroOutBits LittleEndian -> (word `shiftR` moveBits) `shiftL` zeroOutBits `shiftR` zeroOutBits Fixes #16548 and #14455 - - - - - 3656dff8 by Sylvain Henry at 2020-07-09T09:50:01-04:00 LLVM: fix MO_S_Mul2 support (#18434) The value indicating if the carry is useful wasn't taken into account. - - - - - d9f09506 by Simon Peyton Jones at 2020-07-10T10:33:44-04:00 Define multiShotIO and use it in mkSplitUniqueSupply This patch is part of the ongoing eta-expansion saga; see #18238. It implements a neat trick (suggested by Sebastian Graf) that allows the programmer to disable the default one-shot behaviour of IO (the "state hack"). The trick is to use a new multiShotIO function; see Note [multiShotIO]. For now, multiShotIO is defined here in Unique.Supply; but it should ultimately be moved to the IO library. The change is necessary to get good code for GHC's unique supply; see Note [Optimising the unique supply]. However it makes no difference to GHC as-is. Rather, it makes a difference when a subsequent commit Improve eta-expansion using ArityType lands. - - - - - bce695cc by Simon Peyton Jones at 2020-07-10T10:33:44-04:00 Make arityType deal with join points As Note [Eta-expansion and join points] describes, this patch makes arityType deal correctly with join points. What was there before was not wrong, but yielded lower arities than it could. Fixes #18328 In base GHC this makes no difference to nofib. Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- n-body -0.1% -0.1% -1.2% -1.1% 0.0% -------------------------------------------------------------------------------- Min -0.1% -0.1% -55.0% -56.5% 0.0% Max -0.0% 0.0% +16.1% +13.4% 0.0% Geometric Mean -0.0% -0.0% -30.1% -31.0% -0.0% But it starts to make real difference when we land the change to the way mkDupableAlts handles StrictArg, in fixing #13253 and friends. I think this is because we then get more non-inlined join points. - - - - - 2b7c71cb by Simon Peyton Jones at 2020-07-11T12:17:02-04:00 Improve eta-expansion using ArityType As #18355 shows, we were failing to preserve one-shot info when eta-expanding. It's rather easy to fix, by using ArityType more, rather than just Arity. This patch is important to suport the one-shot monad trick; see #18202. But the extra tracking of one-shot-ness requires the patch Define multiShotIO and use it in mkSplitUniqueSupply If that patch is missing, ths patch makes things worse in GHC.Types.Uniq.Supply. With it, however, we see these improvements T3064 compiler bytes allocated -2.2% T3294 compiler bytes allocated -1.3% T12707 compiler bytes allocated -1.3% T13056 compiler bytes allocated -2.2% Metric Decrease: T3064 T3294 T12707 T13056 - - - - - de139cc4 by Artem Pelenitsyn at 2020-07-12T02:53:20-04:00 add reproducer for #15630 - - - - - c4de6a7a by Andreas Klebinger at 2020-07-12T02:53:55-04:00 Give Uniq[D]FM a phantom type for its key. This fixes #17667 and should help to avoid such issues going forward. The changes are mostly mechanical in nature. With two notable exceptions. * The register allocator. The register allocator references registers by distinct uniques. However they come from the types of VirtualReg, Reg or Unique in various places. As a result we sometimes cast the key type of the map and use functions which operate on the now typed map but take a raw Unique as actual key. The logic itself has not changed it just becomes obvious where we do so now. * <Type>Env Modules. As an example a ClassEnv is currently queried using the types `Class`, `Name`, and `TyCon`. This is safe since for a distinct class value all these expressions give the same unique. getUnique cls getUnique (classTyCon cls) getUnique (className cls) getUnique (tcName $ classTyCon cls) This is for the most part contained within the modules defining the interface. However it requires us to play dirty when we are given a `Name` to lookup in a `UniqFM Class a` map. But again the logic did not change and it's for the most part hidden behind the Env Module. Some of these cases could be avoided by refactoring but this is left for future work. We also bump the haddock submodule as it uses UniqFM. - - - - - c2cfdfde by Aaron Allen at 2020-07-13T09:00:33-04:00 Warn about empty Char enumerations (#18402) Currently the "Enumeration is empty" warning (-Wempty-enumerations) only fires for numeric literals. This patch adds support for `Char` literals so that enumerating an empty list of `Char`s will also trigger the warning. - - - - - c3ac87ec by Stefan Schulze Frielinghaus at 2020-07-13T09:01:10-04:00 hadrian: build check-ppr dynamic if GHC is build dynamic Fixes #18361 - - - - - 9ad072b4 by Simon Peyton Jones at 2020-07-13T14:52:49-04:00 Use dumpStyle when printing inlinings This just makes debug-printing consistent, and more informative. - - - - - e78c4efb by Simon Peyton Jones at 2020-07-13T14:52:49-04:00 Comments only - - - - - 7ccb760b by Simon Peyton Jones at 2020-07-13T14:52:49-04:00 Reduce result discount in conSize Ticket #18282 showed that the result discount given by conSize was massively too large. This patch reduces that discount to a constant 10, which just balances the cost of the constructor application itself. Note [Constructor size and result discount] elaborates, as does the ticket #18282. Reducing result discount reduces inlining, which affects perf. I found that I could increase the unfoldingUseThrehold from 80 to 90 in compensation; in combination with the result discount change I get these overall nofib numbers: Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- boyer -0.2% +5.4% -3.2% -3.4% 0.0% cichelli -0.1% +5.9% -11.2% -11.7% 0.0% compress2 -0.2% +9.6% -6.0% -6.8% 0.0% cryptarithm2 -0.1% -3.9% -6.0% -5.7% 0.0% gamteb -0.2% +2.6% -13.8% -14.4% 0.0% genfft -0.1% -1.6% -29.5% -29.9% 0.0% gg -0.0% -2.2% -17.2% -17.8% -20.0% life -0.1% -2.2% -62.3% -63.4% 0.0% mate +0.0% +1.4% -5.1% -5.1% -14.3% parser -0.2% -2.1% +7.4% +6.7% 0.0% primetest -0.2% -12.8% -14.3% -14.2% 0.0% puzzle -0.2% +2.1% -10.0% -10.4% 0.0% rsa -0.2% -11.7% -3.7% -3.8% 0.0% simple -0.2% +2.8% -36.7% -38.3% -2.2% wheel-sieve2 -0.1% -19.2% -48.8% -49.2% -42.9% -------------------------------------------------------------------------------- Min -0.4% -19.2% -62.3% -63.4% -42.9% Max +0.3% +9.6% +7.4% +11.0% +16.7% Geometric Mean -0.1% -0.3% -17.6% -18.0% -0.7% I'm ok with these numbers, remembering that this change removes an *exponential* increase in code size in some in-the-wild cases. I investigated compress2. The difference is entirely caused by this function no longer inlining WriteRoutines.$woutputCodes = \ (w :: [CodeEvent]) -> let result_s1Sr = case WriteRoutines.outputCodes_$s$woutput w 0# 0# 8# 9# of (# ww1, ww2 #) -> (ww1, ww2) in (# case result_s1Sr of (x, _) -> map @Int @Char WriteRoutines.outputCodes1 x , case result_s1Sr of { (_, y) -> y } #) It was right on the cusp before, driven by the excessive result discount. Too bad! Happily, the compiler/perf tests show a number of improvements: T12227 compiler bytes-alloc -6.6% T12545 compiler bytes-alloc -4.7% T13056 compiler bytes-alloc -3.3% T15263 runtime bytes-alloc -13.1% T17499 runtime bytes-alloc -14.3% T3294 compiler bytes-alloc -1.1% T5030 compiler bytes-alloc -11.7% T9872a compiler bytes-alloc -2.0% T9872b compiler bytes-alloc -1.2% T9872c compiler bytes-alloc -1.5% Metric Decrease: T12227 T12545 T13056 T15263 T17499 T3294 T5030 T9872a T9872b T9872c - - - - - 7f0b671e by Ben Gamari at 2020-07-13T14:52:49-04:00 testsuite: Widen acceptance threshold on T5837 This test is positively tiny and consequently the bytes allocated measurement will be relatively noisy. Consequently I have seen this fail spuriously quite often. - - - - - 118e1c3d by Alp Mestanogullari at 2020-07-14T21:30:52-04:00 compiler: re-engineer the treatment of rebindable if Executing on the plan described in #17582, this patch changes the way if expressions are handled in the compiler in the presence of rebindable syntax. We get rid of the SyntaxExpr field of HsIf and instead, when rebindable syntax is on, we rewrite the HsIf node to the appropriate sequence of applications of the local `ifThenElse` function. In order to be able to report good error messages, with expressions as they were written by the user (and not as desugared by the renamer), we make use of TTG extensions to extend GhcRn expression ASTs with an `HsExpansion` construct, which keeps track of a source (GhcPs) expression and the desugared (GhcRn) expression that it gives rise to. This way, we can typecheck the latter while reporting the former in error messages. In order to discard the error context lines that arise from typechecking the desugared expressions (because they talk about expressions that the user has not written), we carefully give a special treatment to the nodes fabricated by this new renaming-time transformation when typechecking them. See Note [Rebindable syntax and HsExpansion] for more details. The note also includes a recipe to apply the same treatment to other rebindable constructs. Tests 'rebindable11' and 'rebindable12' have been added to make sure we report identical error messages as before this patch under various circumstances. We also now disable rebindable syntax when processing untyped TH quotes, as per the discussion in #18102 and document the interaction of rebindable syntax and Template Haskell, both in Note [Template Haskell quotes and Rebindable Syntax] and in the user guide, adding a test to make sure that we do not regress in that regard. - - - - - 64c774b0 by Andreas Klebinger at 2020-07-14T21:31:27-04:00 Explain why keeping DynFlags in AnalEnv saves allocation. - - - - - 254245d0 by Ben Gamari at 2020-07-14T21:32:03-04:00 docs/users-guide: Update default -funfolding-use-threshold value This was changed in 3d2991f8 but I neglected to update the documentation. Fixes #18419. - - - - - 4c259f86 by Andreas Klebinger at 2020-07-14T21:32:41-04:00 Escape backslashes in json profiling reports properly. I also took the liberty to do away the fixed buffer size for escaping. Using a fixed size here can only lead to issues down the line. Fixes #18438. - - - - - 23797224 by Sergei Trofimovich at 2020-07-14T21:33:19-04:00 .gitlab: re-enable integer-simple substitute (BIGNUM_BACKEND) Recently build system migrated from INTEGER_LIBRARY to BIGNUM_BACKEND. But gitlab CI was never updated. Let's enable BIGNUM_BACKEND=native. Bug: https://gitlab.haskell.org/ghc/ghc/-/issues/18437 Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - e0db878a by Sergei Trofimovich at 2020-07-14T21:33:19-04:00 ghc-bignum: bring in sync .hs-boot files with module declarations Before this change `BIGNUM_BACKEND=native` build was failing as: ``` libraries/ghc-bignum/src/GHC/Num/BigNat/Native.hs:708:16: error: * Variable not in scope: naturalFromBigNat# :: WordArray# -> t * Perhaps you meant one of these: `naturalFromBigNat' (imported from GHC.Num.Natural), `naturalToBigNat' (imported from GHC.Num.Natural) | 708 | m' = naturalFromBigNat# m | ``` This happens because `.hs-boot` files are slightly out of date. This change brings in data and function types in sync. Bug: https://gitlab.haskell.org/ghc/ghc/-/issues/18437 Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - c9f65c36 by Stefan Schulze Frielinghaus at 2020-07-14T21:33:57-04:00 rts/Disassembler.c: Use FMT_HexWord for printing values in hex format - - - - - 58ae62eb by Matthias Andreas Benkard at 2020-07-14T21:34:35-04:00 macOS: Load frameworks without stating them first. macOS Big Sur makes the following change to how frameworks are shipped with the OS: > New in macOS Big Sur 11 beta, the system ships with a built-in > dynamic linker cache of all system-provided libraries. As part of > this change, copies of dynamic libraries are no longer present on > the filesystem. Code that attempts to check for dynamic library > presence by looking for a file at a path or enumerating a directory > will fail. Instead, check for library presence by attempting to > dlopen() the path, which will correctly check for the library in the > cache. (62986286) https://developer.apple.com/documentation/macos-release-notes/macos-big-sur-11-beta-release-notes/ Therefore, the previous method of checking whether a library exists before attempting to load it makes GHC.Runtime.Linker.loadFramework fail to find frameworks installed at /System/Library/Frameworks. GHC.Runtime.Linker.loadFramework now opportunistically loads the framework libraries without checking for their existence first, failing only if all attempts to load a given framework from any of the various possible locations fail. - - - - - cdc4a6b0 by Matthias Andreas Benkard at 2020-07-14T21:34:35-04:00 loadFramework: Output the errors collected in all loading attempts. With the recent change away from first finding and then loading a framework, loadFramework had no way of communicating the real reason why loadDLL failed if it was any reason other than the framework missing from the file system. It now collects all loading attempt errors into a list and concatenates them into a string to return to the caller. - - - - - 51dbfa52 by Ben Gamari at 2020-07-15T04:05:34-04:00 StgToCmm: Use CmmRegOff smart constructor Previously we would generate expressions of the form `CmmRegOff BaseReg 0`. This should do no harm (and really should be handled by the NCG anyways) but it's better to just generate a plain `CmmReg`. - - - - - ae11bdfd by Ben Gamari at 2020-07-15T04:06:08-04:00 testsuite: Add regression test for #17744 Test due to @monoidal. - - - - - 0e3c277a by Ben Gamari at 2020-07-15T16:41:01-04:00 Bump Cabal submodule Updates a variety of tests as Cabal is now more strict about Cabal file form. - - - - - ceed994a by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Drop Windows Vista support, require Windows 7 - - - - - 00a23bfd by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Update Windows FileSystem wrapper utilities. - - - - - 459e1c5f by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Use SlimReaderLocks and ConditonalVariables provided by the OS instead of emulated ones - - - - - 763088fc by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Small linker comment and ifdef cleanups - - - - - 1a228ff9 by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Flush event logs eagerly. - - - - - e9e04dda by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Refactor Buffer structures to be able to track async operations - - - - - 356dc3fe by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Implement new Console API - - - - - 90e69f77 by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Add IOPort synchronization primitive - - - - - 71245fcc by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Add new io-manager cmdline options - - - - - d548a3b3 by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Init Windows console Codepage to UTF-8. - - - - - 58ef6366 by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Add unsafeSplat to GHC.Event.Array - - - - - d660725e by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Add size and iterate to GHC.Event.IntTable. - - - - - 050da6dd by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Switch Testsuite to test winio by default - - - - - 4bf542bf by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Multiple refactorings and support changes. - - - - - 4489af6b by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: core threaded I/O manager - - - - - 64d8f2fe by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: core non-threaded I/O manager - - - - - 8da15a09 by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: Fix a scheduler bug with the threaded-runtime. - - - - - 84ea3d14 by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: Relaxing some constraints in io-manager. - - - - - ccf0d107 by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: Fix issues with non-threaded I/O manager after split. - - - - - b492fe6e by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: Remove some barf statements that are a bit strict. - - - - - 01423fd2 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Expand comments describing non-threaded loop - - - - - 4b69004f by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: fix FileSize unstat-able handles - - - - - 9b384270 by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: Implement new tempfile routines for winio - - - - - f1e0be82 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix input truncation when reading from handle. This was caused by not upholding the read buffer invariant that bufR == bufL == 0 for empty read buffers. - - - - - e176b625 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix output truncation for writes larger than buffer size - - - - - a831ce0e by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Rewrite bufWrite. I think it's far easier to follow the code now. It's also correct now as I had still missed a spot where we didn't update the offset. - - - - - 6aefdf62 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix offset set by bufReadEmpty. bufReadEmpty returns the bytes read *including* content that was already buffered, But for calculating the offset we only care about the number of bytes read into the new buffer. - - - - - 750ebaee by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Clean up code surrounding IOPort primitives. According to phyx these should only be read and written once per object. Not neccesarily in that order. To strengthen that guarantee the primitives will now throw an exception if we violate this invariant. As a consequence we can eliminate some code from their primops. In particular code dealing with multiple queued readers/writers now simply checks the invariant and throws an exception if it was violated. That is in contrast to mvars which will do things like wake up all readers, queue multi writers etc. - - - - - ffd31db9 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix multi threaded threadDelay and a few other small changes. Multithreaded threadDelay suffered from a race condition based on the ioManagerStatus. Since the status isn't needed for WIO I removed it completely. This resulted in a light refactoring, as consequence we will always wake up the IO manager using interruptSystemManager, which uses `postQueuedCompletionStatus` internally. I also added a few comments which hopefully makes the code easier to dive into for the next person diving in. - - - - - 6ec26df2 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 wionio: Make IO subsystem check a no-op on non-windows platforms. - - - - - 29bcd936 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Set handle offset when opening files in Append mode. Otherwise we would truncate the file. - - - - - 55c29700 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Remove debug event log trace - - - - - 9acb9f40 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix sqrt and openFile009 test cases - - - - - 57017cb7 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Allow hp2ps to build with -DDEBUG - - - - - b8cd9995 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Update output of T9681 since we now actually run it. - - - - - 10af5b14 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: A few more improvements to the IOPort primitives. - - - - - 39afc4a7 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix expected tempfiles output. Tempfiles now works properly on windows, as such we can delete the win32 specific output. - - - - - 99db46e0 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Assign thread labels to IOManager threads. - - - - - be6af732 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Properly check for the tso of an incall to be zero. - - - - - e2c6dac7 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Mark FD instances as unsupported under WINIO. - - - - - fd02ceed by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix threadDelay maxBound invocations. Instead of letting the ns timer overflow now clamp it at (maxBound :: Word64) ns. That still gives a few hundred years. - - - - - bc79f9f1 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Add comments/cleanup an import in base - - - - - 1d197f4b by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Mark outstanding_service_requests volatile. As far as I know C(99) gives no guarantees for code like bool condition; ... while(condition) sleep(); that condition will be updated if it's changed by another thread. So we are explicit here and mark it as volatile, this will force a reload from memory on each iteration. - - - - - dc438186 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Make last_event a local variable - - - - - 2fc957c5 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Add comment about thread safety of processCompletion. - - - - - 4c026b6c by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: nonthreaded: Create io processing threads in main thread. We now set a flag in the IO thread. The scheduler when looking for work will check the flag and create/queue threads accordingly. We used to create these in the IO thread. This improved performance but caused frequent segfaults. Thread creation/allocation is only safe to do if nothing currently accesses the storeagemanager. However without locks in the non-threaded runtime this can't be guaranteed. This shouldn't change performance all too much. In the past we had: * IO: Create/Queue thread. * Scheduler: Runs a few times. Eventually picks up IO processing thread. Now it's: * IO: Set flag to queue thread. * Scheduler: Pick up flag, if set create/queue thread. Eventually picks up IO processing thread. - - - - - f47c7208 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Add an exported isHeapAlloced function to the RTS - - - - - cc5d7bb1 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Queue IO processing threads at the front of the queue. This will unblock the IO thread sooner hopefully leading to higher throughput in some situations. - - - - - e7630115 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: ThreadDelay001: Use higher resolution timer. - - - - - 451b5f96 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Update T9681 output, disable T4808 on windows. T4808 tests functionality of the FD interface which won't be supported under WINIO. T9681 just has it's expected output tweaked. - - - - - dd06f930 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Wake io manager once per registerTimeout. Which is implicitly done in editTimeouts, so need to wake it up twice. - - - - - e87d0bf9 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Update placeholder comment with actual function name. - - - - - fc9025db by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Always lock win32 event queue - - - - - c24c9a1f by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Display thread labels when tracing scheduler events. - - - - - 06542b03 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Refactor non-threaded runner thread and scheduler interface. Only use a single communication point (registerAlertableWait) to inform the C side aobut both timeouts to use as well as outstanding requests. Also queue a haskell processing thread after each return from alertable waits. This way there is no risk of us missing a timer event. - - - - - 256299b1 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Remove outstanding_requests from runner. We used a variable to keep track of situations where we got entries from the IO port, but all of them had already been canceled. While we can avoid some work that way this case seems quite rare. So we give up on tracking this and instead always assume at least one of the returned entries is valid. If that's not the case no harm is done, we just perform some additional work. But it makes the runner easier to reason about. In particular we don't need to care if another thread modifies oustanding_requests after we return from waiting on the IO Port. - - - - - 3ebd8ad9 by Tamar Christina at 2020-07-15T16:41:03-04:00 winio: Various fixes related to rebase and testdriver - - - - - 6be6bcba by Tamar Christina at 2020-07-15T16:41:03-04:00 winio: Fix rebase artifacts - - - - - 2c649dc3 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Rename unsafeSplat to unsafeCopyFromBuffer - - - - - a18b73f3 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Remove unused size/iterate operations from IntTable - - - - - 16bab48e by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Detect running IO Backend via peeking at RtsConfig - - - - - 8b8405a0 by Tamar Christina at 2020-07-15T16:41:03-04:00 winio: update temp path so GCC etc can handle it. Also fix PIPE support, clean up error casting, fix memory leaks - - - - - 2092bc54 by Ben Gamari at 2020-07-15T16:41:03-04:00 winio: Minor comments/renamings - - - - - a5b5b6c0 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Checking if an error code indicates completion is now a function. - - - - - 362176fd by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Small refactor in withOverlappedEx - - - - - 32e20597 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: A few comments and commented out dbxIO - - - - - a4bfc1d9 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Don't drop buffer offset in byteView/cwcharView - - - - - b3ad2a54 by Tamar Christina at 2020-07-15T16:41:03-04:00 winio: revert BHandle changes. - - - - - 3dcd87e2 by Ben Gamari at 2020-07-15T16:41:03-04:00 winio: Fix imports - - - - - 5a371890 by Tamar Christina at 2020-07-15T16:41:03-04:00 winio: update ghc-cabal to handle new Cabal submodule bump - - - - - d07ebe0d by Ben Gamari at 2020-07-15T16:41:03-04:00 winio: Only compile sources on Windows - - - - - dcb42393 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Actually return Nothing on EOF for non-blocking read - - - - - 895a3beb by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Deduplicate logic in encodeMultiByte[Raw]IO. - - - - - e06e6734 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Deduplicate openFile logic - - - - - b59430c0 by Tamar Christina at 2020-07-15T16:41:03-04:00 winio: fix -werror issue in encoding file - - - - - f8d39a51 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Don't mention windows specific functions when building on Linux. - - - - - 6a533d2a by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: add a note about file locking in the RTS. - - - - - cf37ce34 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Add version to @since annotation - - - - - 0fafa2eb by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Rename GHC.Conc.IOCP -> GHC.Conc.WinIO - - - - - 1854fc23 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Expand GHC.Conc.POSIX description It now explains users may not use these functions when using the old IO manager. - - - - - fcc7ba41 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Fix potential spaceleak in __createUUIDTempFileErrNo - - - - - 6b3fd9fa by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Remove redundant -Wno-missing-signatures pragmas - - - - - 916fc861 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Make it explicit that we only create one IO manager - - - - - f260a721 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Note why we don't use blocking waits. - - - - - aa0a4bbf by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Remove commented out pragma - - - - - d679b544 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Remove redundant buffer write in Handle/Text.hs:bufReadEmpty - - - - - d3f94368 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Rename SmartHandles to StdHandles - - - - - bd6b8ec1 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: add comment stating failure behaviour for getUniqueFileInfo. - - - - - 12846b85 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Update IOPort haddocks. - - - - - 9f39fb14 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Add a note cross reference - - - - - 62dd5a73 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Name Haskell/OS I/O Manager explicitly in Note - - - - - fa807828 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Expand BlockedOnIOCompletion description. - - - - - f0880a1d by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Remove historical todos - - - - - 8e58e714 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Update note, remove debugging pragma. - - - - - aa4d84d5 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: flushCharReadBuffer shouldn't need to adjust offsets. - - - - - e580893a by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Remove obsolete comment about cond. variables - - - - - d54e9d79 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: fix initial linux validate build - - - - - 3cd4de46 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Fix ThreadDelay001 CPP - - - - - c88b1b9f by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Fix openFile009 merge conflict leftover - - - - - 849e8889 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Accept T9681 output. GHC now reports String instead of [Char]. - - - - - e7701818 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Fix cabal006 after upgrading cabal submodule Demand cabal 2.0 syntax instead of >= 1.20 as required by newer cabal versions. - - - - - a44f0373 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Fix stderr output for ghci/linking/dyn tests. We used to filter rtsopts, i opted to instead just accept the warning of it having no effect. This works both for -rtsopts, as well as -with-rtsopts which winio adds. - - - - - 515d9896 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Adjust T15261b stdout for --io-manager flag. - - - - - 949aaacc by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Adjust T5435_dyn_asm stderr The warning about rtsopts having no consequences is expected. So accept new stderr. - - - - - 7d424e1e by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Also accept T7037 stderr - - - - - 1f009768 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: fix cabal04 by filtering rts args - - - - - 981a9f2e by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: fix cabal01 by accepting expected stderr - - - - - b7b0464e by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: fix safePkg01 by accepting expected stderr - - - - - 32734b29 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: fix T5435_dyn_gcc by accepting expected stderr - - - - - acc5cebf by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: fix tempfiles test on linux - - - - - c577b789 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Accept accepted stderr for T3807 - - - - - c108c527 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Accept accepted stderr for linker_unload - - - - - 2b0b9a08 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Accept accepted stderr for linker_unload_multiple_objs - - - - - 67afb03c by Tamar Christina at 2020-07-15T16:41:04-04:00 winio: clarify wording on conditional variables. - - - - - 3bd41572 by Tamar Christina at 2020-07-15T16:41:04-04:00 winio: clarify comment on cooked mode. - - - - - ded58a03 by Tamar Christina at 2020-07-15T16:41:04-04:00 winio: update lockfile signature and remove mistaken symbol in rts. - - - - - 2143c492 by Ben Gamari at 2020-07-15T16:41:04-04:00 testsuite: Add winio and winio_threaded ways Reverts many of the testsuite changes - - - - - c0979cc5 by Ben Gamari at 2020-07-16T10:56:54-04:00 Merge remote-tracking branch 'origin/wip/winio' - - - - - 750a1595 by Ben Gamari at 2020-07-18T07:26:41-04:00 rts: Add --copying-gc flag to reverse effect of --nonmoving-gc Fixes #18281. - - - - - 6ba6a881 by Hécate at 2020-07-18T07:26:42-04:00 Implement `fullCompilerVersion` Follow-up of https://gitlab.haskell.org/ghc/ghc/-/issues/18403 This MR adds `fullCompilerVersion`, a function that shares the same backend as the `--numeric-version` GHC flag, exposing a full, three-digit version datatype. - - - - - e6cf27df by Hécate at 2020-07-18T07:26:43-04:00 Add a Lint hadrian rule and an .hlint.yaml file in base/ - - - - - bcb177dd by Simon Peyton Jones at 2020-07-18T07:26:43-04:00 Allow multiple case branches to have a higher rank type As #18412 points out, it should be OK for multiple case alternatives to have a higher rank type, provided they are all the same. This patch implements that change. It sweeps away GHC.Tc.Gen.Match.tauifyMultipleBranches, and friends, replacing it with an enhanced version of fillInferResult. The basic change to fillInferResult is to permit the case in which another case alternative has already filled in the result; and in that case simply unify. It's very simple actually. See the new Note [fillInferResult] in TcMType Other refactoring: - Move all the InferResult code to one place, in GHC.Tc.Utils.TcMType (previously some of it was in Unify) - Move tcInstType and friends from TcMType to Instantiate, where it more properly belongs. (TCMType was getting very long.) - - - - - e5525a51 by Simon Peyton Jones at 2020-07-18T07:26:43-04:00 Improve typechecking of NPlusK patterns This patch (due to Richard Eisenberg) improves documentation of the wrapper returned by tcSubMult (see Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify). And, more substantially, it cleans up the multiplicity handling in the typechecking of NPlusKPat - - - - - 12f90352 by Krzysztof Gogolewski at 2020-07-18T07:26:45-04:00 Remove {-# CORE #-} pragma (part of #18048) This pragma has no effect since 2011. It was introduced for External Core, which no longer exists. Updates haddock submodule. - - - - - e504c913 by Simon Peyton Jones at 2020-07-18T07:26:45-04:00 Refactor the simplification of join binders This MR (for #18449) refactors the Simplifier's treatment of join-point binders. Specifically, it puts together, into GHC.Core.Opt.Simplify.Env.adjustJoinPointType two currently-separate ways in which we adjust the type of a join point. As the comment says: -- (adjustJoinPointType mult new_res_ty join_id) does two things: -- -- 1. Set the return type of the join_id to new_res_ty -- See Note [Return type for join points] -- -- 2. Adjust the multiplicity of arrows in join_id's type, as -- directed by 'mult'. See Note [Scaling join point arguments] I think this actually fixes a latent bug, by ensuring that the seIdSubst and seInScope have the right multiplicity on the type of join points. I did some tidying up while I was at it. No more setJoinResTy, or modifyJoinResTy: instead it's done locally in Simplify.Env.adjustJoinPointType - - - - - 49b265f0 by Chaitanya Koparkar at 2020-07-18T07:26:46-04:00 Fix minor typos in a Core.hs note - - - - - 8d59aed6 by Stefan Schulze Frielinghaus at 2020-07-18T07:26:47-04:00 GHCi: Fix isLittleEndian - - - - - c26e81d1 by Ben Gamari at 2020-07-18T07:26:47-04:00 testsuite: Mark ghci tests as fragile under unreg compiler In particular I have seen T16012 fail repeatedly under the unregisterised compiler. - - - - - 868e4523 by Moritz Angermann at 2020-07-20T04:30:38-04:00 Revert "AArch32 symbols only on aarch32." This reverts commit cdfeb3f24f76e8fd30452016676e56fbc827789a. Signed-off-by: Moritz Angermann <moritz.angermann at gmail.com> - - - - - c915ba84 by Moritz Angermann at 2020-07-20T04:30:38-04:00 Revert "Fix (1)" This reverts commit 7abffced01f5680efafe44f6be2733eab321b039. Signed-off-by: Moritz Angermann <moritz.angermann at gmail.com> - - - - - 777c452a by Moritz Angermann at 2020-07-20T04:30:38-04:00 Revert "better if guards." This reverts commit 3f60b94de1f460ca3f689152860b108a19ce193e. Signed-off-by: Moritz Angermann <moritz.angermann at gmail.com> - - - - - 0dd40552 by Moritz Angermann at 2020-07-20T04:30:38-04:00 Revert "[linker/rtsSymbols] More linker symbols" This reverts commit 686e72253aed3880268dd6858eadd8c320f09e97. Signed-off-by: Moritz Angermann <moritz.angermann at gmail.com> - - - - - 30caeee7 by Sylvain Henry at 2020-07-21T06:39:33-04:00 DynFlags: remove use of sdocWithDynFlags from GHC.Stg.* (#17957) * add StgPprOpts datatype * remove Outputable instances for types that need `StgPprOpts` to be pretty-printed and explicitly call type specific ppr functions * add default `panicStgPprOpts` for panic messages (when it's not convenient to thread StgPprOpts or DynFlags down to the ppr function call) - - - - - 863c544c by Mark at 2020-07-21T06:39:34-04:00 Fix a typo in existential_quantification.rst - - - - - 05910be1 by Krzysztof Gogolewski at 2020-07-21T14:47:07-04:00 Add release notes entry for #17816 [skip ci] - - - - - a6257192 by Matthew Pickering at 2020-07-21T14:47:19-04:00 Use a newtype `Code` for the return type of typed quotations (Proposal #195) There are three problems with the current API: 1. It is hard to properly write instances for ``Quote m => m (TExp a)`` as the type is the composition of two type constructors. Doing so in your program involves making your own newtype and doing a lot of wrapping/unwrapping. For example, if I want to create a language which I can either run immediately or generate code from I could write the following with the new API. :: class Lang r where _int :: Int -> r Int _if :: r Bool -> r a -> r a -> r a instance Lang Identity where _int = Identity _if (Identity b) (Identity t) (Identity f) = Identity (if b then t else f) instance Quote m => Lang (Code m) where _int = liftTyped _if cb ct cf = [|| if $$cb then $$ct else $$cf ||] 2. When doing code generation it is common to want to store code fragments in a map. When doing typed code generation, these code fragments contain a type index so it is desirable to store them in one of the parameterised map data types such as ``DMap`` from ``dependent-map`` or ``MapF`` from ``parameterized-utils``. :: compiler :: Env -> AST a -> Code Q a data AST a where ... data Ident a = ... type Env = MapF Ident (Code Q) newtype Code m a = Code (m (TExp a)) In this example, the ``MapF`` maps an ``Ident String`` directly to a ``Code Q String``. Using one of these map types currently requires creating your own newtype and constantly wrapping every quotation and unwrapping it when using a splice. Achievable, but it creates even more syntactic noise than normal metaprogramming. 3. ``m (TExp a)`` is ugly to read and write, understanding ``Code m a`` is easier. This is a weak reason but one everyone can surely agree with. Updates text submodule. - - - - - 58235d46 by Ben Gamari at 2020-07-21T14:47:28-04:00 users-guide: Fix :rts-flag:`--copying-gc` documentation It was missing a newline. - - - - - 19e80b9a by Vladislav Zavialov at 2020-07-21T14:50:01-04:00 Accumulate Haddock comments in P (#17544, #17561, #8944) Haddock comments are, first and foremost, comments. It's very annoying to incorporate them into the grammar. We can take advantage of an important property: adding a Haddock comment does not change the parse tree in any way other than wrapping some nodes in HsDocTy and the like (and if it does, that's a bug). This patch implements the following: * Accumulate Haddock comments with their locations in the P monad. This is handled in the lexer. * After parsing, do a pass over the AST to associate Haddock comments with AST nodes using location info. * Report the leftover comments to the user as a warning (-Winvalid-haddock). - - - - - f218cfc9 by Ben Gamari at 2020-07-21T15:27:01-04:00 Bump version to 9.0 - - - - - a10505e7 by Ben Gamari at 2020-07-28T15:24:29-04:00 Bump haddock submodule - - - - - 32496789 by Sylvain Henry at 2020-08-11T17:43:13+02:00 Bignum: add support for negative shifts (fix #18499) shiftR/shiftL support negative arguments despite Haskell 2010 report saying otherwise. We explicitly test for negative values which is bad (it gets in the way of constant folding, etc.). Anyway, for consistency we fix Bits instancesof Integer/Natural. - - - - - b4cccab3 by Sylvain Henry at 2020-08-11T17:48:05+02:00 Fix bug in Natural multiplication (fix #18509) A bug was lingering in Natural multiplication (inverting two limbs) despite QuickCheck tests used during the development leading to wrong results (independently of the selected backend). - - - - - 817f94f5 by Sylvain Henry at 2020-08-11T17:48:22+02:00 Bignum: fix powMod for gmp backend (#18515) Also reenable integerPowMod test which had never been reenabled by mistake. - - - - - eab2511e by Sylvain Henry at 2020-08-12T11:43:42+02:00 Bignum: add backward compat integer-gmp functions Also enhance bigNatCheck# and isValidNatural test - - - - - 3745bdb6 by Sylvain Henry at 2020-08-12T11:43:42+02:00 Bignum: add more BigNat compat functions in integer-gmp - - - - - 7cf007cc by David Binder at 2020-08-13T18:22:38-04:00 Fix dead link to haskell prime discussion - - - - - 205f168c by BinderDavid at 2020-08-13T18:22:38-04:00 Replace broken links to old haskell-prime site by working links to gitlab instance. [skip ci] - - - - - 29794212 by Daniel Gröber at 2020-08-13T18:22:38-04:00 Remove length field from FastString - - - - - f8804cd8 by Daniel Gröber at 2020-08-13T18:22:38-04:00 Use ShortByteString for FastString There are multiple reasons we want this: - Fewer allocations: ByteString has 3 fields, ShortByteString just has one. - ByteString memory is pinned: - This can cause fragmentation issues (see for example #13110) but also - makes using FastStrings in compact regions impossible. Metric Decrease: T5837 T12150 T12234 T12425 - - - - - 5acdf506 by Daniel Gröber at 2020-08-13T18:22:38-04:00 Pass specialised utf8DecodeChar# to utf8DecodeLazy# for performance Currently we're passing a indexWord8OffAddr# type function to utf8DecodeLazy# which then passes it on to utf8DecodeChar#. By passing one of utf8DecodeCharAddr# or utf8DecodeCharByteArray# instead we benefit from the inlining and specialization already done for those. - - - - - a9b46ec3 by Daniel Gröber at 2020-08-13T18:22:38-04:00 Encoding: Add comment about tricky ForeignPtr lifetime - - - - - fcb9e94d by Daniel Gröber at 2020-08-13T18:22:38-04:00 Use IO constructor instead of `stToIO . ST` - - - - - 44b28e97 by Daniel Gröber at 2020-08-13T18:22:38-04:00 Encoding: Remove redundant use of withForeignPtr - - - - - f0fe989d by Daniel Gröber at 2020-08-13T18:22:38-04:00 Encoding: Reformat utf8EncodeShortByteString to be more consistent - - - - - 59cd5cd4 by Daniel Gröber at 2020-08-13T18:22:38-04:00 FastString: Reintroduce character count cache Metric Increase: ManyConstructors Metric Decrease: T4029 - - - - - 0f66e49e by Ben Gamari at 2020-08-13T18:22:38-04:00 get-win32-tarballs: Fix detection of missing tarballs This fixes the error message given by configure when the user attempts to configure without first download the win32 tarballs. - - - - - 3ecac53c by Andreas Klebinger at 2020-08-13T18:22:39-04:00 Enable BangPatterns, ScopedTypeVariables for ghc and hadrian by default. This is only for their respective codebases. - - - - - dbf77b79 by Sylvain Henry at 2020-08-13T18:22:39-04:00 Remove unused "ncg" flag This flag has been removed in 066b369de2c6f7da03c88206288dca29ab061b31 in 2011. - - - - - 4e22de2a by Sylvain Henry at 2020-08-13T18:22:39-04:00 Don't panic if the NCG isn't built (it is always built) - - - - - e27698ce by Sylvain Henry at 2020-08-13T18:22:39-04:00 Remove unused sGhcWithNativeCodeGen - - - - - 666acbd4 by Sylvain Henry at 2020-08-13T18:22:39-04:00 Correctly test active backend Previously we used a platform settings to detect if the native code generator was used. This was wrong. We need to use the `DynFlags.hscTarget` field instead. - - - - - ce5408c0 by Sylvain Henry at 2020-08-13T18:22:39-04:00 Replace ghcWithNativeCodeGen with a proper Backend datatype * Represent backends with a `Backend` datatype in GHC.Driver.Backend * Don't detect the default backend to use for the target platform at compile time in Hadrian/make but at runtime. It makes "Settings" simpler and it is a step toward making GHC multi-target. * The latter change also fixes hadrian which has not been updated to take into account that the NCG now supports AIX and PPC64 (cf df26b95559fd467abc0a3a4151127c95cb5011b9 and d3c1dda60d0ec07fc7f593bfd83ec9457dfa7984) * Also we don't treat iOS specifically anymore (cf cb4878ffd18a3c70f98bdbb413cd3c4d1f054e1f) - - - - - 9751d499 by Tamar Christina at 2020-08-13T18:22:39-04:00 winio: restore console cp on exit (cherry picked from commit cdd0ff16f20ce920c74f9128a1067cbe1bd378c2) - - - - - 5438dcec by Tamar Christina at 2020-08-13T18:22:39-04:00 winio: change memory allocation strategy and fix double free errors. (cherry picked from commit c1f4f81d3a439cd1a8128e4ab11c7caac7cc0ad8) - - - - - 5544d17a by Stefan Schulze Frielinghaus at 2020-08-13T18:22:39-04:00 Require SMP support in order to build a threaded stage1 Fixes 18266 (cherry picked from commit fc0f6fbcd95f2dc69a8efabbee2d8a485c34cc47) - - - - - e66e281d by Matthias Andreas Benkard at 2020-08-13T18:22:39-04:00 Document loadFramework changes. (#18446) Adds commentary on the rationale for the changes made in merge request !3689. (cherry picked from commit a7c4439a407ad85b76aab9301fda61e7c10183ff) - - - - - 986063cf by Ben Gamari at 2020-08-13T18:22:39-04:00 rts/win32: Exit with EXIT_HEAPOVERFLOW if memory commit fails Since switching to the two-step allocator, the `outofmem` test fails via `osCommitMemory` failing to commit. However, this was previously exiting with `EXIT_FAILURE`, rather than `EXIT_HEAPOVERFLOW`. I think the latter is a more reasonable exit code for this case and matches the behavior on POSIX platforms. (cherry picked from commit da7269a4472856ba701d956a247599f721e9915e) - - - - - b2f8c6a7 by Ben Gamari at 2020-08-13T18:22:39-04:00 testsuite: Update win32 output for parseTree (cherry picked from commit f153a1d0a3351ad4d94cef4cef8e63bab5b47008) - - - - - 83a0649c by Ben Gamari at 2020-08-13T18:22:39-04:00 testsuite: Normalise WinIO error message differences Previously the old Windows IO manager threw different errors than WinIO. We now canonicalise these to the WinIO errors. (cherry picked from commit e91672f0b7185bbafbe8ed1f2ae2cb775111f950) - - - - - 97ac5b2a by Ben Gamari at 2020-08-13T18:22:39-04:00 gitlab-ci: Kill ssh-agent after pushing test metrics Otherwise the Windows builds hang forever waiting for the process to terminate. (cherry picked from commit 9cbfe0868418a531da0872b0c477a15aa67f8861) - - - - - 8f1154d3 by Tamar Christina at 2020-08-13T18:22:39-04:00 winio: remove dead argument to stg_newIOPortzh (cherry picked from commit 8236925fc8cc2e6e3fed61a0676fa65270a4a538) - - - - - 39c6fbae by Tamar Christina at 2020-08-13T18:22:39-04:00 winio: fix detection of tty terminals (cherry picked from commit ce0a1d678fbc8efa5fd384fd0227b7b3dc97cadd) - - - - - b784c75a by Tamar Christina at 2020-08-13T18:22:40-04:00 winio: update codeowners (cherry picked from commit 52685cf7c077c51e3719e3c4dd5ca8257a99c4ea) - - - - - 8388567e by Ben Gamari at 2020-08-13T18:22:40-04:00 Drop 32-bit Windows support As noted in #18487, we have reached the end of this road. (cherry picked from commit aa054d32a8ff69c334293a0d6c9d11b83a236a96) - - - - - 353521ab by Simon Peyton Jones at 2020-08-13T18:22:40-04:00 Eta-expand the Simplifier monad This patch eta-expands the Simplifier's monad, using the method explained in GHC.Core.Unify Note [The one-shot state monad trick]. It's part of the exta-expansion programme in #18202. It's a tiny patch, but is worth a 1-2% reduction in bytes-allocated by the compiler. Here's the list, based on the compiler-performance tests in perf/compiler: Reduction in bytes allocated T10858(normal) -0.7% T12425(optasm) -1.3% T13056(optasm) -1.8% T14683(normal) -1.1% T15164(normal) -1.3% T15630(normal) -1.4% T17516(normal) -2.3% T18282(normal) -1.6% T18304(normal) -0.8% T1969(normal) -0.6% T4801(normal) -0.8% T5321FD(normal) -0.7% T5321Fun(normal) -0.5% T5642(normal) -0.9% T6048(optasm) -1.1% T9020(optasm) -2.7% T9233(normal) -0.7% T9675(optasm) -0.5% T9961(normal) -2.9% WWRec(normal) -1.2% Metric Decrease: T12425 T9020 T9961 (cherry picked from commit 3d345c9680ab3d766ef43dd8389ccc1eaeca066c) - - - - - c0a3283a by Ben Gamari at 2020-08-13T18:22:40-04:00 gitlab-ci: Ensure that Hadrian jobs don't download artifacts Previously the Hadrian jobs had the default dependencies, meaning that they would download artifacts from all jobs of earlier stages. This is unneccessary. (cherry picked from commit 57aca6bba1c000f8542ce94e8b724b0334ff96d4) - - - - - e14ee26b by Ben Gamari at 2020-08-13T18:22:40-04:00 gitlab-ci: Bump bootstrap compiler to 8.8.4 Hopefully this will make the Windows jobs a bit more reliable. (cherry picked from commit 0a815cea9fa11ce6ef22aec3525dd7a0df541daf) - - - - - cf9a6c17 by Simon Peyton Jones at 2020-08-13T18:22:40-04:00 This patch addresses the exponential blow-up in the simplifier. Specifically: #13253 exponential inlining #10421 ditto #18140 strict constructors #18282 another nested-function call case This patch makes one really significant changes: change the way that mkDupableCont handles StrictArg. The details are explained in GHC.Core.Opt.Simplify Note [Duplicating StrictArg]. Specific changes * In mkDupableCont, when making auxiliary bindings for the other arguments of a call, add extra plumbing so that we don't forget the demand on them. Otherwise we haev to wait for another round of strictness analysis. But actually all the info is to hand. This change affects: - Make the strictness list in ArgInfo be [Demand] instead of [Bool], and rename it to ai_dmds. - Add as_dmd to ValArg - Simplify.makeTrivial takes a Demand - mkDupableContWithDmds takes a [Demand] There are a number of other small changes 1. For Ids that are used at most once in each branch of a case, make the occurrence analyser record the total number of syntactic occurrences. Previously we recorded just OneBranch or MultipleBranches. I thought this was going to be useful, but I ended up barely using it; see Note [Note [Suppress exponential blowup] in GHC.Core.Opt.Simplify.Utils Actual changes: * See the occ_n_br field of OneOcc. * postInlineUnconditionally 2. I found a small perf buglet in SetLevels; see the new function GHC.Core.Opt.SetLevels.hasFreeJoin 3. Remove the sc_cci field of StrictArg. I found I could get its information from the sc_fun field instead. Less to get wrong! 4. In ArgInfo, arrange that ai_dmds and ai_discs have a simpler invariant: they line up with the value arguments beyond ai_args This allowed a bit of nice refactoring; see isStrictArgInfo, lazyArgcontext, strictArgContext There is virtually no difference in nofib. (The runtime numbers are bogus -- I tried a few manually.) Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- fft +0.0% -2.0% -48.3% -49.4% 0.0% multiplier +0.0% -2.2% -50.3% -50.9% 0.0% -------------------------------------------------------------------------------- Min -0.4% -2.2% -59.2% -60.4% 0.0% Max +0.0% +0.1% +3.3% +4.9% 0.0% Geometric Mean +0.0% -0.0% -33.2% -34.3% -0.0% Test T18282 is an existing example of these deeply-nested strict calls. We get a big decrease in compile time (-85%) because so much less inlining takes place. Metric Decrease: T18282 (cherry picked from commit 0bd60059b0edfee9e8f66c6817257bbb946656cd) - - - - - 6ba13945 by Sergei Trofimovich at 2020-08-13T18:22:40-04:00 ghc/mk: don't build gmp packages for BIGNUM_BACKEND=native Before this change make-based `BIGNUM_BACKEND=native` build was failing as: ``` x86_64-pc-linux-gnu-gcc: error: libraries/ghc-bignum/gmp/objs/*.o: No such file or directory ``` This happens because ghc.mk was pulling in gmp-dependent ghc-bignum library unconditionally. The change avoid building ghc-bignum. Bug: https://gitlab.haskell.org/ghc/ghc/-/issues/18437 Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> (cherry picked from commit 39c89862161bf488a6aca9372cbb67690f436ce7) - - - - - 59226e20 by Felix Wiemuth at 2020-08-13T18:22:40-04:00 Fix typo (cherry picked from commit b9a880fce484d0a87bb794b9d2d8a73e54819011) - - - - - 9166d4d6 by Simon Peyton Jones at 2020-08-13T18:22:40-04:00 Kill off sc_mult and as_mult fields They are readily derivable from other fields, so this is more efficient, and less error prone. Fixes #18494 (cherry picked from commit bbc5191640761ca9773abc898c077363b7beb4e7) - - - - - 505a9d68 by John Ericson at 2020-08-13T18:22:40-04:00 For `-fkeep-going` do not duplicate dependency edge code We now compute the deps for `-fkeep-going` the same way that the original graph calculates them, so the edges are correct. Upsweep really ought to take the graph rather than a topological sort so we are never recalculating anything, but at least things are recaluclated consistently now. (cherry picked from commit 6c68a84254d70280e2dc73485f361787a3503850) - - - - - bd365c1d by Simon Peyton Jones at 2020-08-13T18:22:40-04:00 Add two bangs to improve perf of flattening This tiny patch improves the compile time of flatten-heavy programs by 1-2%, by adding two bangs. Addresses (somewhat) #18502 This reduces allocation by T9872b -1.1% T9872d -3.3% T5321Fun -0.2% T5631 -0.2% T5837 +0.1% T6048 +0.1% Metric Decrease: T9872b T9872d (cherry picked from commit 9f71f69714255165d0fdc2790a588487ff9439dc) - - - - - 6653e139 by Sylvain Henry at 2020-08-13T18:22:40-04:00 Fix minimal imports dump for boot files (fix #18497) (cherry picked from commit 7c274cd530cc42a26028050b75d56b3437e06ec1) - - - - - 2c86713b by Leon Schoorl at 2020-08-13T18:22:41-04:00 Fix GHC_STAGE definition generated by make Fixes #18070 GHC_STAGE is the stage of the compiler we're building, it should be 1,2(,3?). But make was generating 0 and 1. Hadrian does this correctly using a similar `+ 1`: https://gitlab.haskell.org/ghc/ghc/-/blob/eb8115a8c4cbc842b66798480fefc7ab64d31931/hadrian/src/Rules/Generate.hs#L245 (cherry picked from commit f2d1accf67cb6e1dab6b2c78fef4b64526c31a4a) - - - - - 36d8cd6f by Niklas Hambüchen at 2020-08-13T18:22:41-04:00 hadrian: Fix running stage0/bin/ghc with wrong package DB. Fixes #17468. In the invocation of `cabal configure`, `--ghc-pkg-option=--global-package-db` was already given correctly to tell `stage0/bin/ghc-pkg` that it should use the package DB in `stage1/`. However, `ghc` needs to be given this information as well, not only `ghc-pkg`! Until now that was not the case; the package DB in `stage0` was given to `ghc` instead. This was wrong, because there is no binary compatibility guarantee that says that the `stage0` DB's `package.cache` (which is written by the stage0 == system-provided ghc-pkg) can be deserialised by the `ghc-pkg` from the source code tree. As a result, when trying to add fields to `InstalledPackageInfo` that get serialised into / deserialised from the `package.cache`, errors like _build/stage0/lib/package.conf.d/package.cache: GHC.PackageDb.readPackageDb: inappropriate type (Not a valid Unicode code point!) would appear. This was because the `stage0/bin/ghc would try to deserialise the newly added fields from `_build/stage0/lib/package.conf.d/package.cache`, but they were not in there because the system `ghc-pkg` doesn't know about them and thus didn't write them there. It would try to do that because any GHC by default tries to read the global package db in `../lib/package.conf.d/package.cache`. For `stage0/bin/ghc` that *can never work* as explained above, so we must disable this default via `-no-global-package-db` and give it the correct package DB explicitly. This is the same problem as #16534, and the same fix as in MR !780 (but in another context; that one was for developers trying out the `stage0/bin/ghc` == `_build/ghc-stage1` interactively, while this fix is for a `cabal configure` invocation). I also noticed that the fix for #16534 forgot to pass `-no-global-package-db`, and have fixed that in this commit as well. It only worked until now because nobody tried to add a new ghc-pkg `.conf` field since the introduction of Hadrian. (cherry picked from commit 947206f478d4eef641dfc58cb4c13471a23260c3) - - - - - 01534bf9 by Krzysztof Gogolewski at 2020-08-13T18:22:48-04:00 Rename Core.Opt.Driver -> Core.Opt.Pipeline Closes #18504. (cherry picked from commit 5e12cd1733b581f48a5873b12971b6974778eabb) - - - - - 20a45d0c by Ben Gamari at 2020-08-13T18:22:48-04:00 Revert "iserv: Don't pass --export-dynamic on FreeBSD" This reverts commit 2290eb02cf95e9cfffcb15fc9c593d5ef79c75d9. (cherry picked from commit 2bff2f87e43985e02bdde8c6fa39279df86cb617) - - - - - 2911d640 by Ben Gamari at 2020-08-13T18:22:48-04:00 Refactor handling of object merging Previously to merge a set of object files we would invoke the linker as usual, adding -r to the command-line. However, this can result in non-sensical command-lines which causes lld to balk (#17962). To avoid this we introduce a new tool setting into GHC, -pgmlm, which is the linker which we use to merge object files. (cherry picked from commit 53ce0db5a06598c88c6b8cb32043b878e7083dd4) - - - - - cb3e202a by Ryan Scott at 2020-08-13T18:22:48-04:00 Make CodeQ and TExpQ levity polymorphic The patch is quite straightforward. The only tricky part is that `Language.Haskell.TH.Lib.Internal` now must be `Trustworthy` instead of `Safe` due to the `GHC.Exts` import (in order to import `TYPE`). Since `CodeQ` has yet to appear in any released version of `template-haskell`, I didn't bother mentioning the change to `CodeQ` in the `template-haskell` release notes. Fixes #18521. (cherry picked from commit fbcb886d503dd7aaebc4c40e59615068b3fd0bd7) - - - - - bd506bd6 by Vladislav Zavialov at 2020-08-13T18:22:48-04:00 Improve NegativeLiterals (#18022, GHC Proposal #344) Before this patch, NegativeLiterals used to parse x-1 as x (-1). This may not be what the user expects, and now it is fixed: x-1 is parsed as (-) x 1. We achieve this by the following requirement: * When lexing a negative literal, it must not be preceded by a 'closing token'. This also applies to unboxed literals, e.g. -1#. See GHC Proposal #229 for the definition of a closing token. A nice consequence of this change is that -XNegativeLiterals becomes a subset of -XLexicalNegation. In other words, enabling both of those extensions has the same effect as enabling -XLexicalNegation alone. (cherry picked from commit aee45d9ea8c6cf4ebad4d5c732748923c7865cbe) - - - - - bc186461 by Takenobu Tani at 2020-08-13T18:22:48-04:00 users-guide: Rename 8.12 to 9.0 GHC 8.12.1 has been renamed to GHC 9.0.1. See also: https://mail.haskell.org/pipermail/ghc-devs/2020-July/019083.html [skip ci] (cherry picked from commit 9570c21295a2b4a1d1e40939869124f0b9b9bf91) - - - - - 77653d5c by Ben Gamari at 2020-08-13T18:22:48-04:00 cmm: Clean up Notes a bit (cherry picked from commit 5f03606319f745b10e9918c76a47426b293f0bf9) - - - - - 47de152f by Ben Gamari at 2020-08-13T18:22:48-04:00 CmmLint: Check foreign call argument register invariant As mentioned in Note [Register parameter passing] the arguments of foreign calls cannot refer to caller-saved registers. (cherry picked from commit 6402c1240d5bd768b8fe8b4368413932bedbe107) - - - - - e64ac078 by Ben Gamari at 2020-08-13T18:22:48-04:00 nativeGen: One approach to fix #18527 Previously the code generator could produce corrupt C call sequences due to register overlap between MachOp lowerings and the platform's calling convention. We fix this using a hack described in Note [Evaluate C-call arguments before placing in destination registers]. (cherry picked from commit 15b36de030ecdd60897bc7a6a02bdeabd0825be4) - - - - - 24c230ce by Ben Gamari at 2020-08-13T18:22:48-04:00 testsuite: Add test for #18527 (cherry picked from commit 3847ae0ccf67bddf73304a39f5320c3ba285aa48) - - - - - ee2ed876 by Ben Gamari at 2020-08-13T18:22:48-04:00 testsuite: Fix prog001 Previously it failed as the `ghc` package was not visible. (cherry picked from commit dd51d53be42114c105b5ab15fcbdb387526b1c17) - - - - - b4c33250 by Alan Zimmerman at 2020-08-13T18:22:48-04:00 ApiAnnotations; tweaks for ghc-exactprint update Remove unused ApiAnns, add one for linear arrow. Include API Annotations for trailing comma in export list. (cherry picked from commit e4f1b73ad9f292a6bbeb21fee44b0ba1a7f3c33b) - - - - - cb39cfdc by Ben Gamari at 2020-08-13T18:22:48-04:00 configure: Fix double-negation in ld merge-objects check We want to only run the check if ld is gold. Fixes the fix to #17962. (cherry picked from commit 8a665db6174eaedbbae925c0ccb4c22b3f29bcaf) - - - - - b221b571 by Alex Biehl at 2020-08-13T18:22:48-04:00 Hardcode RTS includes to cope with unregistered builds (cherry picked from commit ef2ae81a394df573510b12b7e11bba0c931249d8) - - - - - c15fb71b by Ben Gamari at 2020-08-13T18:22:48-04:00 testsuite: Specify metrics collected by T17516 Previously it collected everything, including "max bytes used". This is problematic since the test makes no attempt to control for deviations in GC timing, resulting in high variability. Fix this by only collecting "bytes allocated". (cherry picked from commit f1088b3f31ceddf918a319c97557fb1f08a9a387) - - - - - 3bda53ad by Ben Gamari at 2020-08-13T20:44:39-04:00 testsuite: Allow baseline commit to be set explicitly (cherry picked from commit bbde6ea0ce80a154735f1302251d073a56606c20) - - - - - ce32390c by Ben Gamari at 2020-08-15T12:19:32-04:00 gitlab-ci: Use MR base commit as performance baseline (cherry picked from commit 4b91e5edf64363eff7d087731c2806464033447c) Metric Decrease: T13056 T18304 T1969 T9233 - - - - - 57fd3ff0 by Ben Gamari at 2020-08-16T12:18:11-04:00 Allow unsaturated runRW# applications Previously we had a very aggressive Core Lint check which caught unsaturated applications of runRW#. However, there is nothing wrong with such applications and they may naturally arise in desugared Core. For instance, the desugared Core of Data.Primitive.Array.runArray# from the `primitive` package contains: case ($) (runRW# @_ @_) (\s -> ...) of ... In this case it's almost certain that ($) will be inlined, turning the application into a saturated application. However, even if this weren't the case there isn't a problem: CorePrep (after deleting an unnecessary case) can simply generate code in its usual way, resulting in a call to the Haskell definition of runRW#. Fixes #18291. (cherry picked from commit 2f0bae734e2dc8737fbbb8465de7ded89c1121b6) - - - - - 0af2db18 by Ben Gamari at 2020-08-16T12:18:19-04:00 testsuite: Add test for #18291 (cherry picked from commit 6c7785f8e17a43a2578366134f74fd1989077b73) - - - - - 614ac76d by Ben Gamari at 2020-08-17T15:14:35-04:00 Clean up TBDs in changelog (cherry picked from commit 4f334120c8e9cc4aefcbf11d99f169f648af9fde) - - - - - 1a54d708 by Ben Gamari at 2020-08-17T15:14:35-04:00 Bump bytestring submodule - - - - - 20e19811 by Ben Gamari at 2020-08-17T15:14:35-04:00 Bump binary submodule - - - - - 8c7e8e1c by Ben Gamari at 2020-08-17T20:09:30+00:00 Bump Cabal submodule - - - - - 1f6824a1 by Ben Gamari at 2020-08-21T11:35:00-04:00 Accept spurious performance shift Metric Decrease: T13035 - - - - - 5ccf44c6 by Krzysztof Gogolewski at 2020-08-24T21:35:48-04:00 Fix types in silly shifts (#18589) Patch written by Simon. I have only added a testcase. (cherry picked from commit 364258e0ad25bc95e69745554f5ca831ce80baf8) - - - - - 29e9d2d1 by Vladislav Zavialov at 2020-08-29T16:54:45+02:00 Import qualified Prelude in Cmm/Parser.y In preparation for the next version of 'happy', c95920 added a qualified import to GHC/Parser.y but for some reason neglected GHC/Cmm/Parser.y This patch adds the missing qualified import to GHC/Cmm/Parser.y and also adds a clarifying comment to explain why this import is needed. (cherry picked from commit fddddbf47d6ba2b1b3b6ec89bd40c8fa020e6606) - - - - - bf8bb9e7 by Sylvain Henry at 2020-08-31T13:49:08-04:00 Bignum: fix BigNat subtraction (#18604) There was a confusion between the boolean expected by withNewWordArrayTrimedMaybe and the boolean returned by subtracting functions. - - - - - a3e90763 by Sylvain Henry at 2020-09-01T10:22:24+02:00 Fix documentation and fix "check" bignum backend (#18604) (cherry-picked from 0a3723876c6c79a0a407d50f4baa2818a13f232e) - - - - - d5c3a027 by Sylvain Henry at 2020-09-01T10:22:46+02:00 Bignum: add BigNat compat functions (#18613) (cherry-picked from a8a2568b7b64e5b9fca5b12df7da759de4db39ae) - - - - - a6809cf8 by Ben Gamari at 2020-09-02T15:27:27-04:00 users-guide: A few release notes fixes - - - - - 2dbdb7b9 by GHC GitLab CI at 2020-09-03T19:55:38-04:00 configure: Avoid hard-coded ld path on Windows The fix to #17962 ended up regressing on Windows as it failed to replicate the logic responsible for overriding the toolchain paths on Windows. This resulted in a hard-coded path to a directory that likely doesn't exist on the user's system (#18550). (cherry picked from commit 34e0fa963f35a77093fc7111a80c557fc6bd614f) - - - - - 4e8f05fa by Ben Gamari at 2020-09-06T15:27:00-04:00 gitlab-ci: More intelligent detection of locale availability Previously ci.sh would unconditionally use C.UTF-8. However, this fails on Centos 7, which appears not to provide this locale. Now we first try C.UTF-8, then try en_US.UTF-8, then fail. Works around #18607. (cherry picked from commit be2cc0ad2109894d2f576c73e3f037b6b79a6bdc) - - - - - 104b0ccd by Ben Gamari at 2020-09-07T03:18:32-04:00 gitlab-ci: Configure bignum backend in Hadrian builds - - - - - cee137dc by Ben Gamari at 2020-09-07T03:18:32-04:00 gitlab-ci: Use hadrian builds for Window release artifacts - - - - - c2030f00 by Ben Gamari at 2020-09-07T16:16:05-04:00 testsuite: Only run llvm ways if llc is available As noted in #18560, we previously would always run the LLVM ways since `configure` would set `SettingsLlcCommand` to something non-null when it otherwise couldn't find the `llc` executable. Now we rather probe for the existence of the `llc` executable in the testsuite driver. Fixes #18560. (cherry picked from commit aa4b744d51aa6bdb46064f981ea8e001627921d6) - - - - - 6dbd1054 by Sylvain Henry at 2020-09-07T16:20:38-04:00 Remove outdated note - - - - - c23275f4 by Sylvain Henry at 2020-09-07T16:20:38-04:00 Bignum: add missing compat import/export functions - - - - - 214b2b69 by Ben Gamari at 2020-09-07T20:28:21-04:00 gitlab-ci: Accept Centos 7 C.utf8 locale Centos apparently has C.utf8 rather than C.UTF-8. (cherry picked from commit d9f85dd25a26a04d3485470afb3395ee2dec6464) (cherry picked from commit 9374737005c9fa36a870111f100fe27f9a0efd8e) - - - - - b093074e by Ben Gamari at 2020-09-07T20:28:26-04:00 gitlab-ci: Handle distributions without locales Previously we would assume that the `locale` utility exists. However, this is not so on Alpine as musl's locale support is essentially non-existent. (cherry picked from commit 17cdb7ac3b557a245fee1686e066f9f770ddc21e) (cherry picked from commit c10ff55fddf8c6708d679e91f3253dc642b91565) - - - - - 3e55edd9 by Ben Gamari at 2020-09-08T09:46:42-04:00 gitlab-ci: Rename RELEASE variable to RELEASE_JOB This interfered with the autoconf variable of the same name, breaking pre-release builds. (cherry picked from commit 15dca84793d5ec4ff922726477923e40caa075eb) - - - - - 12d9742c by Zubin Duggal at 2020-09-16T14:38:15-04:00 Export enrichHie from GHC.Iface.Ext.Ast This is useful for `ghcide` Backport of !4037 - - - - - 59862b4a by Ben Gamari at 2020-09-17T19:46:29-04:00 Bump Win32 submodule to 2.9.0.0 Also bumps Cabal, directory (cherry picked from commit 9c6c1ebc9ab2f18d711a8793c7f0ec36e989d687) - - - - - e8f5e16a by Ryan Scott at 2020-09-17T19:46:29-04:00 Don't mark closed type family equations as occurrences Previously, `rnFamInstEqn` would mark the name of the type/data family used in an equation as an occurrence, regardless of what sort of family it is. Most of the time, this is the correct thing to do. The exception is closed type families, whose equations constitute its definition and therefore should not be marked as occurrences. Overzealously counting the equations of a closed type family as occurrences can cause certain warnings to not be emitted, as observed in #18470. See `Note [Type family equations and occurrences]` in `GHC.Rename.Module` for the full story. This fixes #18470 with a little bit of extra-casing in `rnFamInstEqn`. To accomplish this, I added an extra `ClosedTyFamInfo` field to the `NonAssocTyFamEqn` constructor of `AssocTyFamInfo` and refactored the relevant call sites accordingly so that this information is propagated to `rnFamInstEqn`. While I was in town, I moved `wrongTyFamName`, which checks that the name of a closed type family matches the name in an equation for that family, from the renamer to the typechecker to avoid the need for an `ASSERT`. As an added bonus, this lets us simplify the details of `ClosedTyFamInfo` a bit. (cherry picked from commit 4f83e9ad76b1e7c67a440ea89f22f6fc03921b5d) - - - - - eae6f239 by Ryan Scott at 2020-09-17T19:46:29-04:00 Clean up the inferred type variable restriction This patch primarily: * Documents `checkInferredVars` (previously called `check_inferred_vars`) more carefully. This is the function which throws an error message if a user quantifies an inferred type variable in a place where specificity cannot be observed. See `Note [Unobservably inferred type variables]` in `GHC.Rename.HsType`. Note that I now invoke `checkInferredVars` _alongside_ `rnHsSigType`, `rnHsWcSigType`, etc. rather than doing so _inside_ of these functions. This results in slightly more call sites for `checkInferredVars`, but it makes it much easier to enumerate the spots where the inferred type variable restriction comes into effect. * Removes the inferred type variable restriction for default method type signatures, per the discussion in #18432. As a result, this patch fixes #18432. Along the way, I performed some various cleanup: * I moved `no_nested_foralls_contexts_err` into `GHC.Rename.Utils` (under the new name `noNestedForallsContextsErr`), since it now needs to be invoked from multiple modules. I also added a helper function `addNoNestedForallsContextsErr` that throws the error message after producing it, as this is a common idiom. * In order to ensure that users cannot sneak inferred type variables into `SPECIALISE instance` pragmas by way of nested `forall`s, I now invoke `addNoNestedForallsContextsErr` when renaming `SPECIALISE instance` pragmas, much like when we rename normal instance declarations. (This probably should have originally been done as a part of the fix for #18240, but this task was somehow overlooked.) As a result, this patch fixes #18455 as a side effect. (cherry picked from commit 502605f7ae9907a6b0b9823e8f055ae390c57b1d) - - - - - 8dcbbeec by Ben Gamari at 2020-09-17T19:46:29-04:00 typecheck: Drop SPECIALISE pragmas when there is no unfolding Previously the desugarer would instead fall over when it realized that there was no unfolding for an imported function with a SPECIALISE pragma. We now rather drop the SPECIALISE pragma and throw a warning. Fixes #18118. (cherry picked from commit 708e374a8bf108999c11b6cf59c7d27677ed24a8) - - - - - df6d0218 by Ben Gamari at 2020-09-17T19:46:29-04:00 testsuite: Add test for #18118 (cherry picked from commit 2cdb72a569f6049a390626bca0dd6e362045ed65) - - - - - 675c0cce by Ben Gamari at 2020-09-17T19:46:29-04:00 testsuite: Drop --io-manager flag from testsuite configuration This is no longer necessary as there are now dedicated testsuite ways which run tests with WinIO. (cherry picked from commit 77b1ebf6dd34df8068a07865d92301ff298cf5ca) - - - - - 7e315b15 by Ben Gamari at 2020-09-17T19:46:29-04:00 llvm-targets: Add i686 targets Addresses #18422. (cherry picked from commit 12dadd04a09c23c91d7da6f5b17ef78688d93fe7) - - - - - 264afed3 by Krzysztof Gogolewski at 2020-09-17T19:46:29-04:00 Do not print synonyms in :i (->), :i Type (#18594) This adds a new printing flag `sdocPrintTypeAbbreviations` that is used specifically to avoid ghci printing 'type (->) = (->)' and 'type Type = Type'. (cherry picked from commit 8b86509270227dbc61f0700c7d9261a4c7672361) - - - - - 2c2ed25b by Krzysztof Gogolewski at 2020-09-17T19:46:29-04:00 Move pprTyTcApp' inside pprTyTcApp No semantic change (cherry picked from commit d8f61182c3bdd1b6121c83be632b4941b907de88) - - - - - 8d0a75c6 by Takenobu Tani at 2020-09-17T19:46:29-04:00 Limit upper version of Happy for ghc-9.0 and earlier (#18620) This patch adds the upper bound of a happy version for ghc-9.0 and earlier. Currently, we can't use happy-1.20.0 for ghc-9.0. See #18620. (cherry picked from commit 84ec8daa016d07ae42f0f0f48575dd7d907d5f9d) - - - - - aac5417a by Ben Gamari at 2020-09-17T19:46:29-04:00 configure: Fix whitespace (cherry picked from commit 1213fd87564ab092aa914d8633df4de07fe04905) - - - - - b83682c7 by Ben Gamari at 2020-09-17T19:46:29-04:00 gitlab-ci: Bump Windows toolchain version This should have been done when we bumped the bootstrap compiler to 8.8.4. (cherry picked from commit 566ac68de70e5b580c96e8ab8b3b02ad0f1acd42) - - - - - cb8610b8 by Ben Gamari at 2020-09-17T19:46:29-04:00 gitlab-ci: Drop Windows make job These are a significant burden on our CI resources and end up failing quite often due to #18274. Here I drop the make jobs during validaion; it is now run only during the nightly builds. (cherry picked from commit 72036e1c03385aa4f5ed70179ab4b154beed81cb) - - - - - ab244fc9 by Ben Gamari at 2020-09-17T19:46:29-04:00 testsuite: Drop Windows-specific output for parseTree The normalise_slashes normaliser should handle this. (cherry picked from commit 4597752ad3c031e17fe3cceb20c61e4d5b58c52f) - - - - - ad6cef78 by Ben Gamari at 2020-09-17T19:46:29-04:00 testsuite: Mark T5975[ab] as broken on Windows Due to #7305. (cherry picked from commit 5b12bb7c98529374ff8e932d0c36104d1a0fe509) - - - - - cc3e00cb by Ben Gamari at 2020-09-17T19:46:29-04:00 gitlab-ci: Fix typo A small typo in a rule regular expression. (cherry picked from commit c4fd8947f4104e7b6d6bf3d320a63a361191bde1) - - - - - 702bd58c by Ben Gamari at 2020-09-17T19:46:29-04:00 rts: Add stg_copyArray_barrier to RtsSymbols list It's incredible that this wasn't noticed until now. (cherry picked from commit c2fefaf37ae134aefc4136bae7e5976f991d76f4) - - - - - 5b0fb69f by Ryan Scott at 2020-09-17T19:46:29-04:00 Postpone associated tyfam default checks until after typechecking Previously, associated type family defaults were validity-checked during typechecking. Unfortunately, the error messages that these checks produce run the risk of printing knot-tied type constructors, which will cause GHC to diverge. In order to preserve the current error message's descriptiveness, this patch postpones these validity checks until after typechecking, which are now located in the new function `GHC.Tc.Validity.checkValidAssocTyFamDeflt`. Fixes #18648. (cherry picked from commit 5e883375409efc2336da6295c7d81bd10b542210) - - - - - 7d00408b by Ryan Scott at 2020-09-17T19:46:29-04:00 Don't quote argument to Hadrian's test-env flag (#18656) Doing so causes the name of the test environment to gain an extra set of double quotes, which changes the name entirely. Fixes #18656. (cherry picked from commit bc487caf830ce6cd2c03845b29416c6706185fbc) - - - - - 8edda01f by Krzysztof Gogolewski at 2020-09-17T19:46:29-04:00 Make sure we can read past perf notes See #18656. (cherry picked from commit b8a9cff2ce651c085c84980d3e709db2ecda8c3f) - - - - - af32a4cb by Ben Gamari at 2020-09-17T19:46:29-04:00 rts: Fix erroneous usage of vsnprintf As pointed out in #18685, this should be snprintf not vsnprintf. This appears to be due to a cut-and-paste error. Fixes #18658. (cherry picked from commit 35ea92708e17c90e476167163ae24747a3f5508e) - - - - - efc41fcc by HaskellMouse at 2020-09-17T19:46:29-04:00 Added explicit fixity to (~). Solves #18252 (cherry picked from commit 3c94c81629ac9159775b8b70baf2c635f0331708) - - - - - 3309d2a2 by Ben Gamari at 2020-09-17T19:46:29-04:00 rts/nonmoving: Add missing STM write barrier When updating a TRec for a TVar already part of a transaction we previously neglected to add the old value to the update remembered set. I suspect this was the cause of #18587. (cherry picked from commit a64e94f98ca18e53ecc13f736d50b9cb2d156b05) - - - - - 4e00ee7b by Ben Gamari at 2020-09-17T19:46:29-04:00 gitlab-ci: Use hadrian builds for Windows release artifacts (cherry picked from commit d4bc9f0de7992f60bce403731019829f6248cc2c) - - - - - 4ffa7d40 by Ben Gamari at 2020-09-18T08:31:56-04:00 rts: Drop field initializer on thread_basic_info_data_t This struct has a number of fields and we only care that the value is initialized with zeros. This eliminates the warnings noted in #17905. (cherry picked from commit 09b91e8b95eb16fe72aef8405896fd6caf789f61) - - - - - e5f6188b by Zubin Duggal at 2020-09-18T08:32:37-04:00 Stop removing definitions of record fields in GHC.Iface.Ext.Ast - - - - - d16223fd by Alan Zimmerman at 2020-09-18T08:38:16-04:00 Api Annotations : Adjust SrcSpans for prefix bang (!). And prefix ~ (cherry picked from commit 8dbee2c578b1f642d45561be3f416119863e01eb) (cherry picked from commit 701463ec9998c679b03dcc848912a7ce9da9a66a) - - - - - 23f34f7b by Alan Zimmerman at 2020-09-18T08:38:29-04:00 ApiAnnotations: Fix parser for new GHC 9.0 features (cherry picked from commit 0f4d29cac3826392ceb26ea219fce6e8a7505107) - - - - - f91ea170 by Alan Zimmerman at 2020-09-20T19:25:22+01:00 API Annotations: Fix annotation for strictness This adds the correct location for a ! or ~. It is a reconstruction of 3ccc80ee6120db7ead579c6e9fc5c2164f3bf575, some of which got mangled in the backport process. - - - - - fbdc93e7 by Ben Gamari at 2020-09-21T15:27:17-04:00 Bump Win32 submodule - - - - - 17740c20 by Ben Gamari at 2020-09-21T15:27:17-04:00 ci.sh: Enforce minimum happy/alex versions Also, always invoke cabal-install to ensure that happy/alex symlinks are up-to-date. (cherry picked from commit a89c2fbab9bcf7d769e9d27262ab29f93342f114) Modified to use happy-1.19 - - - - - d4d44edb by Ben Gamari at 2020-09-22T17:05:52-04:00 gitlab-ci: Ensure that cabal-install overwrites existing executables Previously cabal-install wouldn't overwrite toolchain executables if they already existed (as they likely would due to caching). (cherry picked from commit 2f7ef2fb3234cdfb89b3da1298fc9c1b7381e418) - - - - - b1c4116d by Simon Jakobi at 2020-09-24T13:09:09-04:00 Deprecate Data.Semigroup.Option Libraries email: https://mail.haskell.org/pipermail/libraries/2018-April/028724.html GHC issue: https://gitlab.haskell.org/ghc/ghc/issues/15028 Corresponding PRs for deepseq: * https://github.com/haskell/deepseq/pull/55 * https://github.com/haskell/deepseq/pull/57 Bumps the deepseq submodule. (cherry picked from commit a90d13091ff82e954432bedd0bb20845c666eddb) - - - - - 29fc00bc by Wander Hillen at 2020-09-24T13:11:02-04:00 Export singleton function from Data.List Data.OldList exports a monomorphized singleton function but it is not re-exported by Data.List. Adding the export to Data.List causes a conflict with a 14-year old function of the same name and type by SPJ in GHC.Utils.Misc. We can't just remove this function because that leads to a problems when building GHC with a stage0 compiler that does not have singleton in Data.List yet. We also can't hide the function in GHC.Utils.Misc since it is not possible to hide a function from a module if the module does not export the function. To work around this, all places where the Utils.Misc singleton was used now use a qualified version like Utils.singleton and in GHC.Utils.Misc we are very specific about which version we export. (cherry picked from commit e195dae6d959e2a9b1a22a2ca78db5955e1d7dea) - - - - - 7f418acf by Ryan Scott at 2020-09-24T13:14:46-04:00 Remove ConDeclGADTPrefixPs This removes the `ConDeclGADTPrefixPs` per the discussion in #18517. Most of this patch simply removes code, although the code in the `rnConDecl` case for `ConDeclGADTPrefixPs` had to be moved around a bit: * The nested `forall`s check now lives in the `rnConDecl` case for `ConDeclGADT`. * The `LinearTypes`-specific code that used to live in the `rnConDecl` case for `ConDeclGADTPrefixPs` now lives in `GHC.Parser.PostProcess.mkGadtDecl`, which is now monadic so that it can check if `-XLinearTypes` is enabled. Fixes #18157. (cherry picked from commit 3ea8ac774efd9ee25156f444eacf49893d48a6c9) - - - - - 4c37274a by Ben Gamari at 2020-09-25T17:39:53-04:00 Bump Cabal, haskeline, directory, process submodules To accomodate Win32 2.10.0.0. - - - - - 12957a0b by Ben Gamari at 2020-09-25T17:39:53-04:00 Disable -Wdeprecations for deepseq Use to use of Data.Semigroup.Option for NFData instance. - - - - - 6c98a930 by Sylvain Henry at 2020-09-28T08:37:29+02:00 Bignum: refactor backend modules * move backends into GHC.Num.Backend.* * split backend selection into GHC.Num.Backend and GHC.Num.Backend.Selected to avoid duplication with the Check backend - - - - - 74f3f581 by Sylvain Henry at 2020-09-28T08:37:29+02:00 Bignum: implement extended GCD (#18427) - - - - - ebcc0968 by Sylvain Henry at 2020-09-28T09:56:49+02:00 Bignum: add bigNatFromWordArray Reimplementation of integer-gmp's byteArrayToBigNat# - - - - - edfa896e by Arnaud Spiwack at 2020-09-29T11:41:25-04:00 Pattern guards BindStmt always use multiplicity Many Fixes #18439 . The rhs of the pattern guard was consumed with multiplicity one, while the pattern assumed it was Many. We use Many everywhere instead. This is behaviour consistent with that of `case` expression. See #18738. (cherry picked from commit 2707c4eae4cf99e6da2709e128f560d91e468357) - - - - - a64ea9d0 by Krzysztof Gogolewski at 2020-09-29T11:41:25-04:00 Disallow linear types in FFI (#18472) (cherry picked from commit 160fba4aa306c0649c72a6dcd7c98d9782a0e74b) - - - - - f8d8c343 by Krzysztof Gogolewski at 2020-09-29T11:41:25-04:00 Various documentation fixes * Remove UnliftedFFITypes from conf. Some time ago, this extension was undocumented and we had to silence a warning. This is no longer needed. * Use r'' in conf.py. This fixes a Sphinx warning: WARNING: Support for evaluating Python 2 syntax is deprecated and will be removed in Sphinx 4.0. Convert docs/users_guide/conf.py to Python 3 syntax. * Mark GHCForeignImportPrim as documented * Fix formatting in template_haskell.rst * Remove 'recursive do' from the list of unsupported items in TH (cherry picked from commit 83407ffc7acc00cc025b9f6ed063add9ab9f9bcc) - - - - - 90fe5cff by Krzysztof Gogolewski at 2020-09-29T11:41:25-04:00 Fix handling of function coercions (#18747) This was broken when we added multiplicity to the function type. (cherry picked from commit e124f2a7d9a5932a4c2383fd3f9dd772b2059885) - - - - - 93df442a by Krzysztof Gogolewski at 2020-09-30T01:05:27+03:00 Linear types: fix kind inference when checking datacons (cherry picked from b31a3360e2ef12f3ec7eaf66b3600247c1eb36c3) - - - - - 7c7bd94d by Vladislav Zavialov at 2020-09-30T01:06:07+03:00 New linear types syntax: a %p -> b (#18459) Implements GHC Proposal #356 Updates the haddock submodule. (cherry-picked from 5830a12c46e7227c276a8a71213057595ee4fc04) - - - - - d5e13ceb by Vladislav Zavialov at 2020-10-02T01:39:25+03:00 Fix pretty-printing of the mult-polymorphic arrow (cherry-picked from a8018c17747342444c67eeec21a506c89c1110e8) - - - - - 89a00150 by Sylvain Henry at 2020-10-05T10:32:31+02:00 Bignum: add integerNegate RULE - - - - - 175d7141 by Sylvain Henry at 2020-10-05T10:32:38+02:00 Bignum: implement integerRecipMod (#18427) - - - - - 5d414fdc by Sylvain Henry at 2020-10-05T10:32:43+02:00 Bignum: implement integerPowMod (#18427) Incidentally fix powModInteger which was crashing in integer-gmp for negative exponents when the modular multiplicative inverse for the base didn't exist. Now we compute it explicitly with integerRecipMod so that every backend returns the same result without crashing. - - - - - b936c542 by MaxGabriel at 2020-10-12T14:19:41+02:00 Document -Wderiving-typeable Tracking: #18641 (cherry picked from commit 73d2521688bd1da4b6bd1202e5325a00cb410a44) - - - - - c073a4ab by Hécate at 2020-10-12T14:20:47+02:00 Remove the list of loaded modules from the ghci prompt (cherry picked from commit 086ef01813069fad84cafe81cab37527d41c8568) - - - - - aff164bc by Benjamin Maurer at 2020-10-12T14:21:51+02:00 Workaround for #18623: GHC crashes bc. under rlimit for vmem it will reserve _all_ of it, leaving nothing for, e.g., thread stacks. Fix will only allocate 2/3rds and check whether remainder is at least large enough for minimum amount of thread stacks. (cherry picked from commit 74c797f6b72c4d01f5e0092dfac1461f3f3dd7a2) - - - - - 44779899 by Krzysztof Gogolewski at 2020-10-12T14:22:35+02:00 Add a flag to indicate that gcc supports -no-pie Fixes #17919. (cherry picked from commit e48cab2a57f2342891f985bcb44817e17e985275) - - - - - ba446875 by Krzysztof Gogolewski at 2020-10-12T14:23:25+02:00 Fix linear types in TH splices (#18465) (cherry picked from commit 802b5e6fdd6dfc58396a9dca1903dc5a1d6634ca) - - - - - b10154d6 by Icelandjack at 2020-10-12T14:25:47+02:00 Replaced MkT1 with T1 in type signatures. (cherry picked from commit b81350bb925f8cb309355ee46238dbc11b796faf) - - - - - baa55369 by Krzysztof Gogolewski at 2020-10-12T14:26:12+02:00 Linear types: fix quantification in GADTs (#18790) (cherry picked from commit 22f218b729a751bc5e5965624a716fc542f502a5) - - - - - 146cff70 by Alan Zimmerman at 2020-10-12T14:27:02+02:00 Preserve as-parsed arrow type for HsUnrestrictedArrow When linear types are disabled, HsUnrestrictedArrow is treated as HslinearArrow. Move this adjustment into the type checking phase, so that the parsed source accurately represents the source as parsed. Closes #18791 (cherry picked from commit d6dff830754a97220eacf032c32cd54b18654917) - - - - - 8c370e11 by Alan Zimmerman at 2020-10-12T14:27:30+02:00 ApiAnnotations : preserve parens in GADTs A cleanup in 7f418acf61e accidentally discarded some parens in ConDeclGADT. Make sure these stay in the AST in a usable format. Also ensure the AnnLolly does not get lost in a GADT. (cherry picked from commit 36787bba78ae5acbb857c84b85b8feb7c83e54a5) - - - - - 15c4eb1f by Krzysztof Gogolewski at 2020-10-12T14:28:15+02:00 Linear types: fix roles in GADTs (#18799) (cherry picked from commit 8fafb304cacae69f8dbbdcf22ab858a5b28b6818) - - - - - a740aa0b by Sylvain Henry at 2020-10-12T15:10:13+02:00 Bignum: match on small Integer/Natural Previously we only matched on *variables* whose unfoldings were a ConApp of the form `IS lit#` or `NS lit##`. But we forgot to match on the ConApp directly... As a consequence, constant folding only worked after the FloatOut pass which creates bindings for most sub-expressions. With this patch, matching on bignums works even with -O0 (see bignumMatch test). - - - - - d09e7e41 by Sylvain Henry at 2020-10-12T15:10:30+02:00 Bignum: fix bigNatCompareWord# bug (#18813) (cherry picked from commit 74ee1237bf243dd7d8b758a53695575c364c3088) - - - - - 7e257575 by Simon Peyton Jones at 2020-10-13T23:35:26+02:00 Care with implicit-parameter superclasses Two bugs, #18627 and #18649, had the same cause: we were not account for the fact that a constaint tuple might hide an implicit parameter. The solution is not hard: look for implicit parameters in superclasses. See Note [Local implicit parameters] in GHC.Core.Predicate. Then we use this new function in two places * The "short-cut solver" in GHC.Tc.Solver.Interact.shortCutSolver which simply didn't handle implicit parameters properly at all. This fixes #18627 * The specialiser, which should not specialise on implicit parameters This fixes #18649 There are some lingering worries (see Note [Local implicit parameters]) but things are much better. (cherry picked from commit c7182a5c67fe8b5bd256cb8eb805562636853ea2) - - - - - 9060a9dd by Ben Gamari at 2020-10-13T23:36:56+02:00 sdist: Include hadrian sources in source distribution Previously the make build system's source distribution rules neglected to include Hadrian's sources. Fixes #18794. (cherry picked from commit 9657f6f34a1a00008a0db935dbf25733cb483cd4) - - - - - fb5eb8ab by Simon Peyton Jones at 2020-10-13T23:37:29+02:00 Fix desugaring of record updates on data families This fixes a long-standing bug in the desugaring of record updates for data families, when the latter involves a GADT. It's all explained in Note [Update for GADTs] in GHC.HsToCore.Expr. Building the correct cast is surprisingly tricky, as that Note explains. Fixes #18809. The test case (in indexed-types/should_compile/T18809) contains several examples that exercise the dark corners. (cherry picked from commit bfdccac6acce84e15292a454d12f4e0d87ef6f10) - - - - - 64ab97bf by Krzysztof Gogolewski at 2020-10-13T23:39:06+02:00 Add -pgmlm and -optlm flags !3798 added documentation and semantics for the flags, but not parsing. (cherry picked from commit fd302e938ebf48c73d9f715d67ce8cd990f972ff) - - - - - b1a2c5e4 by Tamar Christina at 2020-10-16T10:21:20-04:00 winio: add release note - - - - - 51b09fe4 by Alan Zimmerman at 2020-10-21T23:53:56-04:00 API Annotations: Keep track of unicode for linear arrow notation The linear arrow can be parsed as `%1 ->` or a direct single token unicode equivalent. Make sure that this distinction is captured in the parsed AST by using IsUnicodeSyntax where it appears, and introduce a new API Annotation, AnnMult to represent its location when unicode is not used. Updated haddock submodule (cherry picked from commit ea736839d85594c95490dcf02d3325c2bbc68f33) - - - - - 5a2400c6 by Viktor Dukhovni at 2020-10-23T20:51:00-04:00 Naming, value types and tests for Addr# atomics The atomic Exchange and CAS operations on integral types are updated to take and return more natural `Word#` rather than `Int#` values. These are bit-block not arithmetic operations, and the sign bit plays no special role. Standardises the names to `atomic<OpType><ValType>Addr#`, where `OpType` is one of `Cas` or `Exchange` and `ValType` is presently either `Word` or `Addr`. Eventually, variants for `Word32` and `Word64` can and should be added, once #11953 and related issues (e.g. #13825) are resolved. Adds tests for `Addr#` CAS that mirror existing tests for `MutableByteArray#`. - - - - - 7644d85c by Moritz Angermann at 2020-10-30T10:59:36-04:00 [macOS] improved runpath handling In b592bd98ff25730bbe3c13d6f62a427df8c78e28 we started using -dead_strip_dylib on macOS when lining dynamic libraries and binaries. The underlying reason being the Load Command Size Limit in macOS Sierra (10.14) and later. GHC will produce @rpath/libHS... dependency entries together with a corresponding RPATH entry pointing to the location of the libHS... library. Thus for every library we produce two Load Commands. One to specify the dependent library, and one with the path where to find it. This makes relocating libraries and binaries easier, as we just need to update the RPATH entry with the install_name_tool. The dynamic linker will then subsitute each @rpath with the RPATH entries it finds in the libraries load commands or the environement, when looking up @rpath relative libraries. -dead_strip_dylibs intructs the linker to drop unused libraries. This in turn help us reduce the number of referenced libraries, and subsequently the size of the load commands. This however does not remove the RPATH entries. Subsequently we can end up (in extreme cases) with only a single @rpath/libHS... entry, but 100s or more RPATH entries in the Load Commands. This patch rectifies this (slighly unorthodox) by passing *no* -rpath arguments to the linker at link time, but -headerpad 8000. The headerpad argument is in hexadecimal and the maxium 32k of the load command size. This tells the linker to pad the load command section enough for us to inject the RPATHs later. We then proceed to link the library or binary with -dead_strip_dylibs, and *after* the linking inspect the library to find the left over (non-dead-stripped) dependencies (using otool). We find the corresponding RPATHs for each @rpath relative dependency, and inject them into the library or binary using the install_name_tool. Thus achieving a deadstripped dylib (and rpaths) build product. We can not do this in GHC, without starting to reimplement a dynamic linker as we do not know which symbols and subsequently libraries are necessary. Commissioned-by: Mercury Technologies, Inc. (mercury.com) (cherry picked from commit 89a753308deb2c7ed012e875e220b1d39e1798d8) Signed-off-by: Moritz Angermann <moritz.angermann at gmail.com> - - - - - 3d7f5ec8 by Alan Zimmerman at 2020-11-01T11:45:02-05:00 Api Annotations: Introduce AnnPercent for HsExplicitMult For the case foo :: a %p -> b The location of the '%' is captured, separate from the 'p' (cherry picked from commit c15b5f25ad54164c951e797ecbd10d0df1cf4ba6) - - - - - bba8f79c by Sylvain Henry at 2020-11-09T11:10:17-05:00 Bignum: make GMP's bignat_add not recursive bignat_add was a loopbreaker with an INLINE pragma (spotted by @mpickering). This patch makes it non recursive to avoid the issue. (cherry picked from commit bff74de713dac3e62c3bb6f1946e0649549f2215) - - - - - ed1699b2 by Tamar Christina at 2020-11-09T11:11:52-05:00 winio: Fix unused variables warnings (cherry picked from commit cb1f755c6fb77f140aee11fdc7b4da04dd5dcd02) - - - - - 0736b4e3 by Simon Peyton Jones at 2020-11-09T11:13:57-05:00 Fix two constraint solving problems This patch fixes two problems in the constraint solver. * An actual bug #18555: we were floating out a constraint to eagerly, and that was ultimately fatal. It's explained in Note [Do not float blocked constraints] in GHC.Core.Constraint. This is all very delicate, but it's all going to become irrelevant when we stop floating constraints (#17656). * A major performance infelicity in the flattener. When flattening (ty |> co) we *never* generated Refl, even when there was nothing at all to do. Result: we would gratuitously rewrite the constraint to exactly the same thing, wasting work. Described in #18413, and came up again in #18855. Solution: exploit the special case by calling the new function castCoercionKind1. See Note [castCoercionKind1] in GHC.Core.Coercion (cherry picked from commit 0b3d23afcad8bc14f2ba69b8dbe05c314e6e7b29) - - - - - 6c1cf280 by Tamar Christina at 2020-11-09T11:17:24-05:00 winio: simplify logic remove optimization step. (cherry picked from commit 412018c1214a19649e0ccfff73e80a0622635dd5) - - - - - e49c8923 by David Beacham at 2020-11-09T14:15:13-05:00 Fix `instance Bounded a => Bounded (Down a)` (#18716) * Flip `minBound` and `maxBound` to respect the change in ordering * Remove awkward `Enum` (and hence `Integral`) instances for `Data.Ord.Down` * Update changelog (cherry picked from commit 9ad51bc9d2ad9168abad271f715ce73d3562218a) - - - - - fb544de7 by Sylvain Henry at 2020-11-09T14:15:15-05:00 Fix parsing of PIE flags -fPIE and -fno-PIE flags were (un)setting Opt_PIC instead of Opt_PIE. Original commit: 3625728a0e3a9b56c2b85ae7ea8bcabdd83ece6a (cherry picked from commit 17d2f0a886f9f56ea408d2dd8b7f054021da19a4) - - - - - fa671e75 by Vladislav Zavialov at 2020-11-09T14:15:15-05:00 Fix PostfixOperators (#18151) This fixes a regression introduced in 2b89ca5b850b4097447cc4908cbb0631011ce979 See the new T18151x test case. (cherry picked from commit bf2411a3c198cb2df93a9e0aa0c3b8297f47058d) - - - - - e5f73b99 by Ben Gamari at 2020-11-09T14:15:15-05:00 Bump win32-tarballs version to 0.3 This should fix #18774. (cherry picked from commit e5c7c9c8578de1248826c21ebd08e475d094a552) - - - - - 063d174f by Ben Gamari at 2020-11-09T14:15:15-05:00 mingw: Extract zst toolchain archives This should have been done when the toolchain was bumped. (cherry picked from commit a848d52748c09a27ed5bef0fb039c51656bebdf1) - - - - - da266403 by Tamar Christina at 2020-11-09T14:15:15-05:00 winio: fixed bytestring reading interface. (cherry picked from commit 0fd3d360cab977e00fb6d90d0519962227b029bb) - - - - - c4fa35fa by Tamar Christina at 2020-11-09T14:15:15-05:00 winio: fixed more data error. (cherry picked from commit dfaef1cae7a4a0cb8783933274dae7f39d7165a0) - - - - - 556c2356 by Tamar Christina at 2020-11-09T14:15:15-05:00 winio: fix array splat (cherry picked from commit 6f0243ae5b359124936a8ff3dd0a287df3d7aca2) - - - - - c3a8c0bf by Tamar Christina at 2020-11-09T14:15:16-05:00 winio: fixed timeouts non-threaded. (cherry picked from commit c832f7e2a9314cfd61257cb161b1795b612d12b5) - - - - - e615aa85 by Andreas Klebinger at 2020-11-09T14:15:16-05:00 NCG: Fix 64bit int comparisons on 32bit x86 We no compare these by doing 64bit subtraction and checking the resulting flags. We used to do this differently but the old approach was broken when the high bits compared equal and the comparison was one of >= or <=. The new approach should be both correct and faster. (cherry picked from commit bb100805337adc666867da300ee5b0b11c18fe00) - - - - - 25a24e5d by Alan Zimmerman at 2020-11-09T14:15:16-05:00 Restrict Linear arrow %1 to exactly literal 1 only This disallows `a %001 -> b`, and makes sure the type literal is printed from its SourceText so it is clear why. Closes #18888 (cherry picked from commit 616bec0dee67ae4841c4e60e9406cc9c63358223) - - - - - 2b3af303 by Ben Gamari at 2020-11-09T14:15:16-05:00 rts: Add __mingw_vfprintf to RtsSymbols.c Following the model of the other printf symbols. See Note [Symbols for MinGW's printf]. (cherry picked from commit 6434c2e35122886ad28a861cb857fa47bcc7e82d) - - - - - 06e7aed0 by Ben Gamari at 2020-11-09T14:15:16-05:00 testsuite: Account for -Wnoncanonical-monoid-instances changes on Windows (cherry picked from commit d76224c29a78ab962d86b9a1a92cde73e41b6479) - - - - - 918157d5 by Ben Gamari at 2020-11-09T19:17:08-05:00 testsuite: Update output for T18888_datakinds - - - - - 7fcca77f by Ben Gamari at 2020-11-09T19:17:13-05:00 testsuite: Update output for T12427a - - - - - c94c56d5 by Sylvain Henry at 2020-11-10T11:04:03-05:00 Export SPEC from GHC.Exts (#13681) (cherry picked from commit 4c407f6e71f096835f8671e2d3ea6bda38074314) - - - - - d4483f7b by Ben Gamari at 2020-11-14T06:49:57-05:00 rts/linker: Fix relocation overflow in PE linker Previously the overflow check for the IMAGE_REL_AMD64_ADDR32NB relocation failed to account for the signed nature of the value. Specifically, the overflow check was: uint64_t v; v = S + A; if (v >> 32) { ... } However, `v` ultimately needs to fit into 32-bits as a signed value. Consequently, values `v > 2^31` in fact overflow yet this is not caught by the existing overflow check. Here we rewrite the overflow check to rather ensure that `INT32_MIN <= v <= INT32_MAX`. There is now quite a bit of repetition between the `IMAGE_REL_AMD64_REL32` and `IMAGE_REL_AMD64_ADDR32` cases but I am leaving fixing this for future work. This bug was first noticed by @awson. Fixes #15808. (cherry picked from commit 6d21ecee535782f01dba9947a49e282afee25724) - - - - - 08d75467 by Ben Gamari at 2020-11-24T12:03:00-05:00 SMP.h: Add C11-style atomic operations - - - - - 9f6d3341 by Ben Gamari at 2020-11-24T12:03:00-05:00 rts: Infrastructure for testing with ThreadSanitizer - - - - - 8b5e7dc7 by Ben Gamari at 2020-11-24T12:03:01-05:00 rts/CNF: Initialize all bdescrs in group It seems wise and cheap to ensure that the whole bdescr of all blocks of a compact group is valid, even if most cases only look at the flags field. - - - - - 67c0f410 by Ben Gamari at 2020-11-24T12:03:01-05:00 rts/Capability: Intialize interrupt field Previously this was left uninitialized. Also clarify some comments. - - - - - 829a72cd by Ben Gamari at 2020-11-24T12:03:01-05:00 rts/Task: Make comments proper Notes - - - - - c19ee6d5 by Ben Gamari at 2020-11-24T12:03:01-05:00 rts/SpinLock: Move to proper atomics This is fairly straightforward; we just needed to use relaxed operations for the PROF_SPIN counters and a release store instead of a write barrier. - - - - - 5ed8139a by Ben Gamari at 2020-11-24T12:03:01-05:00 rts/OSThreads: Fix data race Previously we would race on the cached processor count. Avoiding this is straightforward; just use relaxed operations. - - - - - 3c35c588 by Ben Gamari at 2020-11-24T12:03:01-05:00 rts/ClosureMaros: Use relaxed atomics - - - - - 83e759a7 by Ben Gamari at 2020-11-24T12:03:01-05:00 configure: Bump minimum-supported gcc version to 4.7 Since the __atomic_* builtins are not supported until gcc 4.7. Given that this version was released in 2012 I think this is acceptable. - - - - - 7d846a79 by Ben Gamari at 2020-11-24T12:03:01-05:00 testsuite: Fix thread leak in hs_try_putmvar00[13] - - - - - 37886925 by Ben Gamari at 2020-11-24T12:03:01-05:00 rts: Introduce SET_HDR_RELEASE Also ensure that we also store the info table pointer last to ensure that the synchronization covers all stores. - - - - - 5541b8ea by Ben Gamari at 2020-11-24T12:03:01-05:00 rts: Factor out logic to identify a good capability for running a task Not only does this make the control flow a bit clearer but it also allows us to add a TSAN suppression on this logic, which requires (harmless) data races. - - - - - 12c8702a by Ben Gamari at 2020-11-24T12:03:01-05:00 rts: Annotate benign race in waitForCapability - - - - - 3eb46f2e by Ben Gamari at 2020-11-24T12:03:01-05:00 rts: Clarify locking behavior of releaseCapability_ - - - - - e052a812 by Ben Gamari at 2020-11-24T12:03:01-05:00 rts: Add assertions for task ownership of capabilities - - - - - 2b1da3d8 by Ben Gamari at 2020-11-24T12:03:01-05:00 rts: Use relaxed atomics on n_returning_tasks This mitigates the warning of a benign race on n_returning_tasks in shouldYieldCapability. See #17261. - - - - - 053d3c5b by Ben Gamari at 2020-11-24T12:03:02-05:00 rts: Mitigate races in capability interruption logic - - - - - 7ebad34c by Ben Gamari at 2020-11-24T12:03:02-05:00 rts/Capability: Use relaxed operations for last_free_capability - - - - - 67716ed3 by Ben Gamari at 2020-11-24T12:03:02-05:00 rts: Use relaxed operations for cap->running_task (TODO) This shouldn't be necessary since only the owning thread of the capability should be touching this. - - - - - 5615aac8 by Ben Gamari at 2020-11-24T12:03:02-05:00 rts/Schedule: Use relaxed operations for sched_state - - - - - 677988d5 by Ben Gamari at 2020-11-24T12:03:02-05:00 rts: Accept data race in work-stealing implementation This race is okay since the task is owned by the capability pushing it. By Note [Ownership of Task] this means that the capability is free to write to `task->cap` without taking `task->lock`. Fixes #17276. - - - - - 7ce38423 by Ben Gamari at 2020-11-24T12:03:02-05:00 rts: Eliminate data races on pending_sync - - - - - 05f59c23 by Ben Gamari at 2020-11-24T12:03:02-05:00 rts/Schedule: Eliminate data races on recent_activity We cannot safely use relaxed atomics here. - - - - - 6417288c by Ben Gamari at 2020-11-24T12:03:02-05:00 rts: Avoid data races in message handling - - - - - dba1771b by Ben Gamari at 2020-11-24T12:03:02-05:00 rts/Messages: Drop incredibly fishy write barrier executeMessage previously had a write barrier at the beginning of its loop apparently in an attempt to synchronize with another thread's writes to the Message. I would guess that the author had intended to use a load barrier here given that there are no globally-visible writes done in executeMessage. I've removed the redundant barrier since the necessary load barrier is now provided by the ACQUIRE_LOAD. - - - - - 1727bc57 by Ben Gamari at 2020-11-24T12:03:02-05:00 rts/ThreadPaused: Avoid data races - - - - - 3e36d9ee by Ben Gamari at 2020-11-24T12:03:02-05:00 rts/Schedule: Eliminate data races in run queue management - - - - - 7b856fcd by Ben Gamari at 2020-11-24T12:03:03-05:00 rts: Eliminate shutdown data race on task counters - - - - - 04a19bfc by Ben Gamari at 2020-11-24T12:03:03-05:00 rts/Threads: Avoid data races (TODO) Replace barriers with appropriate ordering. Drop redundant barrier in tryWakeupThread (the RELEASE barrier will be provided by sendMessage's mutex release). We use relaxed operations on why_blocked and the stack although it's not clear to me why this is necessary. - - - - - 1f5dded6 by Ben Gamari at 2020-11-24T12:03:03-05:00 rts/Messages: Annotate benign race - - - - - 852eb2cc by Ben Gamari at 2020-11-24T12:03:03-05:00 rts/RaiseAsync: Synchronize what_next read - - - - - d9b6eb31 by Ben Gamari at 2020-11-24T12:03:03-05:00 rts/Task: Move debugTrace to avoid data race Specifically, we need to hold all_tasks_mutex to read taskCount. - - - - - 1bcc9cd0 by Ben Gamari at 2020-11-24T12:03:03-05:00 Disable flawed assertion - - - - - 2e76a631 by Ben Gamari at 2020-11-24T12:03:03-05:00 Document schedulePushWork race - - - - - 718a46db by Ben Gamari at 2020-11-24T12:03:03-05:00 Capabiliity: Properly fix data race on n_returning_tasks There is a real data race but can be made safe by using proper atomic (but relaxed) accesses. - - - - - 588a950b by Ben Gamari at 2020-11-24T12:03:03-05:00 rts: Make write of to_cap->inbox atomic This is necessary since emptyInbox may read from to_cap->inbox without taking cap->lock. - - - - - 853ef5e1 by Ben Gamari at 2020-11-24T12:03:03-05:00 gitlab-ci: Add nightly-x86_64-linux-deb9-tsan job - - - - - 5bcda8ba by GHC GitLab CI at 2020-11-24T12:03:03-05:00 testsuite: Mark setnumcapabilities001 as broken with TSAN Due to #18808. - - - - - e78d90e3 by GHC GitLab CI at 2020-11-24T12:03:03-05:00 testsuite: Skip divbyzero and derefnull under TSAN ThreadSanitizer changes the output of these tests. - - - - - a99f05ef by Ben Gamari at 2020-11-24T12:03:03-05:00 testsuite: Skip high memory usage tests with TSAN ThreadSanitizer significantly increases the memory footprint of tests, so much so that it can send machines into OOM. - - - - - 02d2e42b by Ben Gamari at 2020-11-24T12:03:04-05:00 testsuite: Mark hie002 as high_memory_usage This test has a peak residency of 1GByte; this is large enough to classify as "high" in my book. - - - - - fba38edf by Ben Gamari at 2020-11-24T12:03:04-05:00 testsuite: Mark T9872[abc] as high_memory_usage These all have a maximum residency of over 2 GB. - - - - - 0215ff52 by Ben Gamari at 2020-11-24T12:03:04-05:00 gitlab-ci: Disable documentation in TSAN build Haddock chews through enough memory to cause the CI builders to OOM and there's frankly no reason to build documentation in this job anyways. - - - - - e191eb78 by Ben Gamari at 2020-11-24T12:03:04-05:00 TSANUtils: Ensure that C11 atomics are supported - - - - - a31bccca by Ben Gamari at 2020-11-24T12:03:04-05:00 testsuite: Mark T3807 as broken with TSAN Due to #18883. - - - - - 7aba9e54 by Ben Gamari at 2020-11-24T12:03:04-05:00 testsuite: Mark T13702 as broken with TSAN due to #18884 - - - - - 23a30a3b by Ben Gamari at 2020-11-24T12:03:04-05:00 rts/BlockAlloc: Use relaxed operations - - - - - 4139b672 by Ben Gamari at 2020-11-24T12:03:04-05:00 rts: Rework handling of mutlist scavenging statistics - - - - - 33b7b375 by Ben Gamari at 2020-11-24T12:03:04-05:00 rts: Avoid data races in StablePtr implementation This fixes two potentially problematic data races in the StablePtr implementation: * We would fail to RELEASE the stable pointer table when enlarging it, causing other cores to potentially see uninitialized memory. * We would fail to ACQUIRE when dereferencing a stable pointer. - - - - - 725dfd75 by Ben Gamari at 2020-11-24T12:03:04-05:00 rts/Storage: Use atomics - - - - - 240bb1b4 by Ben Gamari at 2020-11-24T12:03:04-05:00 rts/Updates: Use proper atomic operations - - - - - b7b0f3ae by Ben Gamari at 2020-11-24T12:03:04-05:00 rts/Weak: Eliminate data races By taking all_tasks_mutex in stat_exit. Also better-document the fact that the task statistics are protected by all_tasks_mutex. - - - - - 20787589 by Ben Gamari at 2020-11-24T12:03:04-05:00 rts/GC: Use atomics - - - - - b15db127 by Ben Gamari at 2020-11-24T12:03:04-05:00 rts: Use RELEASE ordering in unlockClosure - - - - - 49c8049e by Ben Gamari at 2020-11-24T12:03:04-05:00 rts/Storage: Accept races on heap size counters - - - - - 89864d46 by Ben Gamari at 2020-11-24T12:03:04-05:00 rts: Join to concurrent mark thread during shutdown Previously we would take all capabilities but fail to join on the thread itself, potentially resulting in a leaked thread. - - - - - 31669bd3 by GHC GitLab CI at 2020-11-24T12:03:04-05:00 rts: Fix race in GC CPU time accounting Ensure that the GC leader synchronizes with workers before calling stat_endGC. - - - - - 7e968942 by Ben Gamari at 2020-11-24T12:03:05-05:00 rts/SpinLock: Separate out slow path Not only is this in general a good idea, but it turns out that GCC unrolls the retry loop, resulting is massive code bloat in critical parts of the RTS (e.g. `evacuate`). - - - - - acef7fd3 by Ben Gamari at 2020-11-24T12:03:05-05:00 rts: Use relaxed ordering on spinlock counters - - - - - 53920304 by Ben Gamari at 2020-11-24T12:03:05-05:00 rts: Annotate hopefully "benign" races in freeGroup - - - - - 0ca2beeb by Ben Gamari at 2020-11-24T12:03:05-05:00 Strengthen ordering in releaseGCThreads - - - - - 7d3d0f13 by Ben Gamari at 2020-11-24T12:03:05-05:00 rts/WSDeque: Rewrite with proper atomics After a few attempts at shoring up the previous implementation, I ended up turning to the literature and now use the proven implementation, > N.M. Lê, A. Pop, A.Cohen, and F.Z. Nardelli. "Correct and Efficient > Work-Stealing for Weak Memory Models". PPoPP'13, February 2013, > ACM 978-1-4503-1922/13/02. Note only is this approach formally proven correct under C11 semantics but it is also proved to be a bit faster in practice. - - - - - c29b1a83 by Ben Gamari at 2020-11-24T12:03:05-05:00 rts: Use relaxed atomics for whitehole spin stats - - - - - 55b252f2 by Ben Gamari at 2020-11-24T12:03:05-05:00 rts: Avoid lock order inversion during fork Fixes #17275. - - - - - d9e82a56 by GHC GitLab CI at 2020-11-24T12:03:05-05:00 rts: Use proper relaxe operations in getCurrentThreadCPUTime Here we are doing lazy initialization; it's okay if we do the check more than once, hence relaxed operation is fine. - - - - - d9ed5a62 by Ben Gamari at 2020-11-24T12:03:05-05:00 rts/STM: Use atomics This fixes a potentially harmful race where we failed to synchronize before looking at a TVar's current_value. Also did a bit of refactoring to avoid abstract over management of max_commits. - - - - - 219f6496 by Ben Gamari at 2020-11-24T12:03:05-05:00 rts/stm: Strengthen orderings to SEQ_CST instead of volatile Previously the `current_value`, `first_watch_queue_entry`, and `num_updates` fields of `StgTVar` were marked as `volatile` in an attempt to provide strong ordering. Of course, this isn't sufficient. We now use proper atomic operations. In most of these cases I strengthen the ordering all the way to SEQ_CST although it's possible that some could be weakened with some thought. - - - - - cf99c5e5 by Ben Gamari at 2020-11-24T12:03:05-05:00 Mitigate data races in event manager startup/shutdown - - - - - d7655654 by Ben Gamari at 2020-11-24T12:03:05-05:00 Suppress data race due to close This suppresses the other side of a race during shutdown. - - - - - 389c92df by Ben Gamari at 2020-11-24T12:03:05-05:00 rts: Accept benign races in Proftimer - - - - - b4ced846 by Ben Gamari at 2020-11-24T12:03:05-05:00 rts: Pause timer while changing capability count This avoids #17289. - - - - - 9116b39a by Ben Gamari at 2020-11-24T12:03:05-05:00 Fix #17289 - - - - - 75b8c066 by Ben Gamari at 2020-11-24T12:03:05-05:00 suppress #17289 (ticker) race - - - - - dcea5aef by Ben Gamari at 2020-11-24T12:03:05-05:00 rts: Fix timer initialization Previously `initScheduler` would attempt to pause the ticker and in so doing acquire the ticker mutex. However, initTicker, which is responsible for initializing said mutex, hadn't been called yet. - - - - - 16d3ea21 by Ben Gamari at 2020-11-24T12:03:06-05:00 rts: Fix races in Pthread timer backend shudown We can generally be pretty relaxed in the barriers here since the timer thread is a loop. - - - - - da69341b by Ben Gamari at 2020-11-24T12:03:06-05:00 rts/Stats: Hide a few unused unnecessarily global functions - - - - - f65a5c9e by Ben Gamari at 2020-11-24T12:03:06-05:00 rts/Stats: Protect with mutex While on face value this seems a bit heavy, I think it's far better than enforcing ordering on every access. - - - - - 543ad4f3 by Ben Gamari at 2020-11-24T12:03:06-05:00 rts: Tear down stats_mutex after exitHeapProfiling Since the latter wants to call getRTSStats. - - - - - b944fd08 by Viktor Dukhovni at 2020-11-27T18:39:43-05:00 8.10 - dirty MVAR after mutating TSO queue head While the original head and tail of the TSO queue may be in the same generation as the MVAR, interior elements of the queue could be younger after a GC run and may then be exposed by putMVar operation that updates the queue head. Resolves #18919 (cherry picked from commit 699facec0bc8dd7d5b82cc537fbf131b74f5bd2c) - - - - - c2eaeda5 by GHC GitLab CI at 2020-11-29T18:48:41-05:00 nonmoving: Fix regression from TSAN work The TSAN rework (specifically aad1f803) introduced a subtle regression in GC.c, swapping `g0` in place of `gen`. Whoops! Fixes #18997. (cherry picked from commit 21c807df67afe1aee7bf4a964a00cc78ef19e00f) - - - - - 7629341d by GHC GitLab CI at 2020-11-29T18:48:41-05:00 rts/Messages: Add missing write barrier in THROWTO message update After a THROWTO message has been handle the message closure is overwritten by a NULL message. We must ensure that the original closure's pointers continue to be visible to the nonmoving GC. (cherry picked from commit 6c2faf158fd26fc06b03c9bd11b6d2cf8e8db572) - - - - - 8ceec852 by GHC GitLab CI at 2020-11-29T18:48:41-05:00 nonmoving: Add missing write barrier in shrinkSmallByteArray (cherry picked from commit 35c22991ae5c22b10ca1a81f0aa888d1939f0b3f) - - - - - 29873608 by GHC GitLab CI at 2020-11-29T18:48:41-05:00 Updates: Don't zero slop until closure has been pushed Ensure that the the free variables have been pushed to the update remembered set before we zero the slop. (cherry picked from commit 134f759926bb4163d7ab97e72ce7209ed42f98b9) - - - - - 84684501 by GHC GitLab CI at 2020-11-29T18:48:41-05:00 OSThreads: Fix error code checking pthread_join returns its error code and apparently doesn't set errno. (cherry picked from commit c488ac737e8ca3813fe6db069cbeb7abba00cfb9) - - - - - fda49d26 by GHC GitLab CI at 2020-11-29T18:48:42-05:00 nonmoving: Don't join to mark_thread on shutdown The mark thread is not joinable as we detach from it on creation. (cherry picked from commit ca1ef0e758a3fb787691529a0f8149e9d10b1d00) - - - - - 6567e49a by Ben Gamari at 2020-11-29T18:48:42-05:00 nonmoving: Add reference to Ueno 2016 (cherry picked from commit a3b8375eeb2ce9d2e30f8269f5b489c5bcacc69f) - - - - - cb365f51 by GHC GitLab CI at 2020-11-29T18:50:27-05:00 nonmoving: Ensure that evacuated large objects are marked See Note [Non-moving GC: Marking evacuated objects]. (cherry picked from commit b416189e4004506b89f06f147be37e76f4cd507f) - - - - - 824332c4 by Andreas Klebinger at 2020-11-30T18:56:35-05:00 WinIO: Small changes related to atomic request swaps. Move the atomix exchange over the Ptr type to an internal module. Fix a bug caused by us passing ptr-to-ptr instead of ptr to atomic exchange. Renamed interlockedExchange to exchangePtr. I've also added an cas primitive. It turned out we don't need it for WinIO but I'm leaving it in as it's useful for other things. (cherry picked from commit 401a64b80fb210fa1b403afe5b28d16f961f21bc) - - - - - 7cb92dec by Krzysztof Gogolewski at 2020-11-30T18:56:35-05:00 Force argument in setIdMult (#18925) (cherry picked from commit 5506f1342e51bad71a7525ddad0650d1ac63afeb) - - - - - 77a239ec by Moritz Angermann at 2020-11-30T18:56:35-05:00 AArch64/arm64 adjustments This addes the necessary logic to support aarch64 on elf, as well as aarch64 on mach-o, which Apple calls arm64. We change architecture name to AArch64, which is the official arm naming scheme. (cherry picked from commit 8887102fc4ed8ed1089c1aafd19bab424ad706f3) - - - - - 7da4e588 by Krzysztof Gogolewski at 2020-11-30T18:56:35-05:00 Export indexError from GHC.Ix (#18579) (cherry picked from commit 165352a2d163537afb01a835bccc7cd0a667410a) - - - - - 4b83b6a8 by Ben Gamari at 2020-11-30T18:56:35-05:00 rts/linker: Align bssSize to page size when mapping symbol extras We place symbol_extras right after bss. We also need to ensure that symbol_extras can be mprotect'd independently from the rest of the image. To ensure this we round up the size of bss to a page boundary, thus ensuring that symbol_extras is also page-aligned. (cherry picked from commit 9f40cf6ca9fb24dbc55f7eae43e2b89aa12bf251) - - - - - e0d7563a by Ben Gamari at 2020-11-30T18:56:35-05:00 testsuite: Add testcase for #18733 (cherry picked from commit 787e93ae141ae0f33bc36895494d48a2a5e49e08) - - - - - 3d59089b by Ben Gamari at 2020-11-30T18:56:35-05:00 compiler: Fix recompilation checking In ticket #18733 we noticed a rather serious deficiency in the current fingerprinting logic for recursive groups. I have described the old fingerprinting story and its problems in Note [Fingerprinting recursive groups] and have reworked the story accordingly to avoid these issues. Fixes #18733. (cherry picked from commit 5353fd500b1e92636cd9d45274585fd88a915ff6) - - - - - eaa632ba by Ben Gamari at 2020-11-30T18:56:35-05:00 rts: Allocate MBlocks with MAP_TOP_DOWN on Windows As noted in #18991, we would previously allocate heap in low memory. Due to this the linker, which typically *needs* low memory, would end up competing with the heap. In longer builds we end up running out of low memory entirely, leading to linking failures. (cherry picked from commit a1a75aa9be2c133dd1372a08eeb6a92c31688df7) - - - - - 0bba6516 by Ben Gamari at 2020-11-30T18:56:35-05:00 gitlab-ci: Run LLVM job on appropriately-labelled MRs Namely, those marked with the ~"LLVM backend" label (cherry picked from commit 7c03cc5010999d0f0f9dfc549984023b3a1f2c8d) - - - - - be408b86 by Ben Gamari at 2020-11-30T18:56:35-05:00 rts/linker: Ensure that .rodata is aligned to 16 bytes Pulled out of !4310. - - - - - 3a09acdc by Ömer Sinan Ağacan at 2020-11-30T18:56:35-05:00 Fix and enable object unloading in GHCi Fixes #16525 by tracking dependencies between object file symbols and marking symbol liveness during garbage collection See Note [Object unloading] in CheckUnload.c for details. (cherry picked from commit c34a4b98b1f09ea3096d39a839a86f2d7185c796) - - - - - 01f5126b by Ray Shih at 2020-11-30T18:56:35-05:00 Add loadNativeObj and unloadNativeObj (This change is originally written by niteria) This adds two functions: * `loadNativeObj` * `unloadNativeObj` and implements them for Linux. They are useful if you want to load a shared object with Haskell code using the system linker and have GHC call dlclose() after the code is no longer referenced from the heap. Using the system linker allows you to load the shared object above outside the low-mem region. It also loads the DWARF sections in a way that `perf` understands. `dl_iterate_phdr` is what makes this implementation Linux specific. (cherry picked from commit 2782487f5f6ad9df4dc8725226a47f07fec77f9f) - - - - - a1a0ec33 by GHC GitLab CI at 2020-11-30T18:56:35-05:00 rts: Introduce highMemDynamic (cherry picked from commit 7a65f9e140906087273ce95f062775f18f6a708d) - - - - - cae06fc4 by GHC GitLab CI at 2020-11-30T18:56:35-05:00 Introduce test for dynamic library unloading This uses the highMemDynamic flag introduced earlier to verify that dynamic objects are properly unloaded. (cherry picked from commit e9e1b2e75de17be47ab887a26943f5517a8463ac) - - - - - f72f27a3 by GHC GitLab CI at 2020-11-30T19:21:56-05:00 ThreadPaused: Don't zero slop until free vars are pushed When threadPaused blackholes a thunk it calls `OVERWRITING_CLOSURE` to zero the slop for the benefit of the sanity checker. Previously this was done *before* pushing the thunk's free variables to the update remembered set. Consequently we would pull zero'd pointers to the update remembered set. (cherry picked from commit 3e75b0dbaca5fbd8abc529d70c1df159f5bfbaa4) - - - - - 43ff60b5 by Ben Gamari at 2020-12-01T00:55:55-05:00 rts: Refactor foreign export tracking This avoids calling `libc` in the initializers which are responsible for registering foreign exports. We believe this should avoid the corruption observed in #18548. See Note [Tracking foreign exports] in rts/ForeignExports.c for an overview of the new scheme. (cherry picked from commit c492134912e5270180881b7345ee86dc32756bdd) - - - - - 85822a88 by Ben Gamari at 2020-12-01T00:57:01-05:00 rts: Refactor unloading of foreign export StablePtrs Previously we would allocate a linked list cell for each foreign export. Now we can avoid this by taking advantage of the fact that they are already broken into groups. (cherry picked from commit 40dc91069d15bfc1d81f1722b39e06cac8fdddd1) - - - - - 2a622d0f by Ben Gamari at 2020-12-01T21:39:09+00:00 hadrian: Pass input file to makeindex Strangely I find that on Alpine (and apparently only on Alpine) the latex makeindex command expects to be given a filename, lest it reads from stdin. (cherry picked from commit 389a668343c0d4f5fa095112ff98d0da6998e99d) - - - - - 553ec815 by GHC GitLab CI at 2020-12-01T22:19:04+00:00 Fix various documentation issues - - - - - 007055cc by GHC GitLab CI at 2020-12-01T22:19:12+00:00 Fix cas_int - - - - - 794616b6 by Ben Gamari at 2020-12-03T22:16:06-05:00 testsuite: Add missing #include on <stdlib.h> This otherwise fails on newer Clangs, which warn more aggressively on undeclared symbols. (cherry picked from commit 3d7db1488c4bd7764e8b1fe3cfde4c5a548cde16) - - - - - 35412cbd by GHC GitLab CI at 2020-12-07T15:02:16+00:00 Bump text submodule to v1.2.4.1-rc1 Per @phadej's request. - - - - - 18 changed files: - .ghcid - + .git-ignore-revs - .gitlab-ci.yml - + .gitlab/ci.sh - − .gitlab/darwin-init.sh - + .gitlab/linters/check-changelogs.sh - .gitlab/linters/check-cpp.py - .gitlab/merge_request_templates/merge-request.md - − .gitlab/prepare-system.sh - − .gitlab/push-test-metrics.sh - + .gitlab/test-metrics.sh - − .gitlab/win32-init.sh - .gitmodules - CODEOWNERS - HACKING.md - Makefile - aclocal.m4 - boot The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/190c6c553a54d476dc55c9bb4275b5c096539b6e...35412cbd07b3a96a959c149e73368a302fd05793 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/190c6c553a54d476dc55c9bb4275b5c096539b6e...35412cbd07b3a96a959c149e73368a302fd05793 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Dec 7 15:19:57 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 07 Dec 2020 10:19:57 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/backports-8.10 Message-ID: <5fce481da293c_6b211b1451c362918@gitlab.mail> Ben Gamari pushed new branch wip/backports-8.10 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/backports-8.10 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Dec 7 15:20:38 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 07 Dec 2020 10:20:38 -0500 Subject: [Git][ghc/ghc][wip/backports-8.10] Bump text submodule to 1.2.4.1-rc1 Message-ID: <5fce4846b5e71_6b2117f16f03631b7@gitlab.mail> Ben Gamari pushed to branch wip/backports-8.10 at Glasgow Haskell Compiler / GHC Commits: e7dbdbfa by GHC GitLab CI at 2020-12-07T15:19:45+00:00 Bump text submodule to 1.2.4.1-rc1 Per request of @phadej. - - - - - 1 changed file: - libraries/text Changes: ===================================== libraries/text ===================================== @@ -1 +1 @@ -Subproject commit e07c14940c25f33fe5b282912d745d3a79dd4ade +Subproject commit be54b46175db603aafea3e3f19a6a75e87a29828 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e7dbdbfadf897b246a0b7d669bb559d18030c3c6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e7dbdbfadf897b246a0b7d669bb559d18030c3c6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Dec 7 20:34:52 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 07 Dec 2020 15:34:52 -0500 Subject: [Git][ghc/ghc] Deleted branch wip/backports-8.10 Message-ID: <5fce91ec5e554_6b2132ee3441129b@gitlab.mail> Ben Gamari deleted branch wip/backports-8.10 at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Dec 7 20:34:55 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 07 Dec 2020 15:34:55 -0500 Subject: [Git][ghc/ghc][ghc-8.10] 13 commits: rts/Sanity: Avoid nasty race in weak pointer sanity-checking Message-ID: <5fce91ef7a928_6b2174471c411464@gitlab.mail> Ben Gamari pushed to branch ghc-8.10 at Glasgow Haskell Compiler / GHC Commits: d7e4813c by Ben Gamari at 2020-12-07T15:10:41+00:00 rts/Sanity: Avoid nasty race in weak pointer sanity-checking See Note [Racing weak pointer evacuation] for all of the gory details. - - - - - ef241371 by GHC GitLab CI at 2020-12-07T15:11:57+00:00 nonmoving: Fix regression from TSAN work The TSAN rework (specifically aad1f803) introduced a subtle regression in GC.c, swapping `g0` in place of `gen`. Whoops! Fixes #18997. (cherry picked from commit 21c807df67afe1aee7bf4a964a00cc78ef19e00f) - - - - - 38f2f627 by GHC GitLab CI at 2020-12-07T15:12:10+00:00 rts/Messages: Add missing write barrier in THROWTO message update After a THROWTO message has been handle the message closure is overwritten by a NULL message. We must ensure that the original closure's pointers continue to be visible to the nonmoving GC. (cherry picked from commit 6c2faf158fd26fc06b03c9bd11b6d2cf8e8db572) - - - - - 813c5219 by GHC GitLab CI at 2020-12-07T15:12:51+00:00 nonmoving: Add missing write barrier in shrinkSmallByteArray (cherry picked from commit 35c22991ae5c22b10ca1a81f0aa888d1939f0b3f) - - - - - de7f2203 by GHC GitLab CI at 2020-12-07T15:13:01+00:00 Updates: Don't zero slop until closure has been pushed Ensure that the the free variables have been pushed to the update remembered set before we zero the slop. (cherry picked from commit 134f759926bb4163d7ab97e72ce7209ed42f98b9) - - - - - 2ba6b268 by GHC GitLab CI at 2020-12-07T15:13:15+00:00 OSThreads: Fix error code checking pthread_join returns its error code and apparently doesn't set errno. (cherry picked from commit c488ac737e8ca3813fe6db069cbeb7abba00cfb9) - - - - - 7122ff03 by GHC GitLab CI at 2020-12-07T15:13:31+00:00 nonmoving: Don't join to mark_thread on shutdown The mark thread is not joinable as we detach from it on creation. (cherry picked from commit ca1ef0e758a3fb787691529a0f8149e9d10b1d00) - - - - - ada68f55 by Ben Gamari at 2020-12-07T15:13:46+00:00 nonmoving: Add reference to Ueno 2016 (cherry picked from commit a3b8375eeb2ce9d2e30f8269f5b489c5bcacc69f) - - - - - 4f01c8b4 by GHC GitLab CI at 2020-12-07T15:14:20+00:00 nonmoving: Ensure that evacuated large objects are marked See Note [Non-moving GC: Marking evacuated objects]. (cherry picked from commit b416189e4004506b89f06f147be37e76f4cd507f) - - - - - 658b7fc9 by Ben Gamari at 2020-12-07T15:14:40+00:00 rts/linker: Align bssSize to page size when mapping symbol extras We place symbol_extras right after bss. We also need to ensure that symbol_extras can be mprotect'd independently from the rest of the image. To ensure this we round up the size of bss to a page boundary, thus ensuring that symbol_extras is also page-aligned. (cherry picked from commit 9f40cf6ca9fb24dbc55f7eae43e2b89aa12bf251) (cherry picked from commit 4b83b6a8f8ac08e81b6e75c47f133e3ed6bdea95) - - - - - abab9157 by Ben Gamari at 2020-12-07T15:15:20+00:00 rts: Allocate MBlocks with MAP_TOP_DOWN on Windows As noted in #18991, we would previously allocate heap in low memory. Due to this the linker, which typically *needs* low memory, would end up competing with the heap. In longer builds we end up running out of low memory entirely, leading to linking failures. (cherry picked from commit a1a75aa9be2c133dd1372a08eeb6a92c31688df7) - - - - - b160abf5 by Ben Gamari at 2020-12-07T15:16:23+00:00 rts/linker: Ensure that .rodata is aligned to 16 bytes Pulled out of !4310. (cherry picked from commit be408b86c9125dedd2f83e9701ea9f2e499c8dd4) - - - - - e7dbdbfa by GHC GitLab CI at 2020-12-07T15:19:45+00:00 Bump text submodule to 1.2.4.1-rc1 Per request of @phadej. - - - - - 14 changed files: - libraries/text - rts/LinkerInternals.h - rts/Messages.c - rts/Messages.h - rts/PrimOps.cmm - rts/RaiseAsync.c - rts/Updates.h - rts/linker/SymbolExtras.c - rts/posix/OSThreads.c - rts/sm/Evac.c - rts/sm/GC.c - rts/sm/NonMoving.c - rts/sm/Sanity.c - rts/win32/OSMem.c Changes: ===================================== libraries/text ===================================== @@ -1 +1 @@ -Subproject commit e07c14940c25f33fe5b282912d745d3a79dd4ade +Subproject commit be54b46175db603aafea3e3f19a6a75e87a29828 ===================================== rts/LinkerInternals.h ===================================== @@ -135,7 +135,7 @@ typedef struct _Segment { int n_sections; } Segment; -#if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH) +#if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH) || defined(aarch64_HOST_ARCH) #define NEED_SYMBOL_EXTRAS 1 #endif ===================================== rts/Messages.c ===================================== @@ -100,7 +100,7 @@ loop: case THROWTO_SUCCESS: { // this message is done StgTSO *source = t->source; - doneWithMsgThrowTo(t); + doneWithMsgThrowTo(cap, t); tryWakeupThread(cap, source); break; } ===================================== rts/Messages.h ===================================== @@ -23,8 +23,16 @@ void sendMessage (Capability *from_cap, Capability *to_cap, Message *msg); #include "SMPClosureOps.h" INLINE_HEADER void -doneWithMsgThrowTo (MessageThrowTo *m) +doneWithMsgThrowTo (Capability *cap, MessageThrowTo *m) { + // The message better be locked + ASSERT(m->header.info == &stg_WHITEHOLE_info); + IF_NONMOVING_WRITE_BARRIER_ENABLED { + updateRemembSetPushClosure(cap, (StgClosure *) m->link); + updateRemembSetPushClosure(cap, (StgClosure *) m->source); + updateRemembSetPushClosure(cap, (StgClosure *) m->target); + updateRemembSetPushClosure(cap, (StgClosure *) m->exception); + } OVERWRITING_CLOSURE((StgClosure*)m); unlockClosure((StgClosure*)m, &stg_MSG_NULL_info); LDV_RECORD_CREATE(m); ===================================== rts/PrimOps.cmm ===================================== @@ -233,6 +233,22 @@ stg_shrinkSmallMutableArrayzh ( gcptr mba, W_ new_size ) OVERWRITING_CLOSURE_OFS(mba, (BYTES_TO_WDS(SIZEOF_StgSmallMutArrPtrs) + new_size)); + + IF_NONMOVING_WRITE_BARRIER_ENABLED { + // Ensure that the elements we are about to shrink out of existence + // remain visible to the non-moving collector. + W_ p, end; + p = mba + SIZEOF_StgSmallMutArrPtrs + WDS(new_size); + end = mba + SIZEOF_StgSmallMutArrPtrs + WDS(StgSmallMutArrPtrs_ptrs(mba)); +again: + ccall updateRemembSetPushClosure_(BaseReg "ptr", + W_[p] "ptr"); + if (p < end) { + p = p + SIZEOF_W; + goto again; + } + } + StgSmallMutArrPtrs_ptrs(mba) = new_size; // See the comments in overwritingClosureOfs for an explanation // of the interaction with LDV profiling. ===================================== rts/RaiseAsync.c ===================================== @@ -336,7 +336,7 @@ check_target: } // nobody else can wake up this TSO after we claim the message - doneWithMsgThrowTo(m); + doneWithMsgThrowTo(cap, m); raiseAsync(cap, target, msg->exception, false, NULL); return THROWTO_SUCCESS; @@ -577,7 +577,7 @@ maybePerformBlockedException (Capability *cap, StgTSO *tso) throwToSingleThreaded(cap, msg->target, msg->exception); source = msg->source; - doneWithMsgThrowTo(msg); + doneWithMsgThrowTo(cap, msg); tryWakeupThread(cap, source); return 1; } @@ -599,7 +599,7 @@ awakenBlockedExceptionQueue (Capability *cap, StgTSO *tso) i = lockClosure((StgClosure *)msg); if (i != &stg_MSG_NULL_info) { source = msg->source; - doneWithMsgThrowTo(msg); + doneWithMsgThrowTo(cap, msg); tryWakeupThread(cap, source); } else { unlockClosure((StgClosure *)msg,i); @@ -696,7 +696,7 @@ removeFromQueues(Capability *cap, StgTSO *tso) // ASSERT(m->header.info == &stg_WHITEHOLE_info); // unlock and revoke it at the same time - doneWithMsgThrowTo(m); + doneWithMsgThrowTo(cap, m); break; } ===================================== rts/Updates.h ===================================== @@ -49,7 +49,6 @@ W_ bd; \ \ prim_write_barrier; \ - OVERWRITING_CLOSURE(p1); \ bd = Bdescr(p1); \ if (bdescr_gen_no(bd) != 0 :: bits16) { \ IF_NONMOVING_WRITE_BARRIER_ENABLED { \ @@ -60,6 +59,7 @@ } else { \ TICK_UPD_NEW_IND(); \ } \ + OVERWRITING_CLOSURE(p1); \ StgInd_indirectee(p1) = p2; \ prim_write_barrier; \ SET_INFO(p1, stg_BLACKHOLE_info); \ ===================================== rts/linker/SymbolExtras.c ===================================== @@ -77,7 +77,9 @@ int ocAllocateExtras(ObjectCode* oc, int count, int first, int bssSize) /* N.B. We currently can't mark symbol extras as non-executable in this * case. */ size_t n = roundUpToPage(oc->fileSize); - bssSize = roundUpToAlign(bssSize, 8); + // round bssSize up to the nearest page size since we need to ensure that + // symbol_extras is aligned to a page boundary so it can be mprotect'd. + bssSize = roundUpToPage(bssSize); size_t allocated_size = n + bssSize + extras_size; void *new = mmapForLinker(allocated_size, PROT_READ | PROT_WRITE, MAP_ANONYMOUS, -1, 0); if (new) { ===================================== rts/posix/OSThreads.c ===================================== @@ -380,8 +380,9 @@ interruptOSThread (OSThreadId id) void joinOSThread (OSThreadId id) { - if (pthread_join(id, NULL) != 0) { - sysErrorBelch("joinOSThread: error %d", errno); + int ret = pthread_join(id, NULL); + if (ret != 0) { + sysErrorBelch("joinOSThread: error %d", ret); } } ===================================== rts/sm/Evac.c ===================================== @@ -109,6 +109,8 @@ alloc_for_copy (uint32_t size, uint32_t gen_no) // // However, if we are in a deadlock detection GC then we disable aging // so there is no need. + // + // See Note [Non-moving GC: Marking evacuated objects]. if (major_gc && !deadlock_detect_gc) markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, (StgClosure *) to); return to; @@ -134,7 +136,58 @@ alloc_for_copy (uint32_t size, uint32_t gen_no) The evacuate() code -------------------------------------------------------------------------- */ -/* size is in words */ +/* + * Note [Non-moving GC: Marking evacuated objects] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * + * When the non-moving collector is in use we must be careful to ensure that any + * references to objects in the non-moving generation from younger generations + * are pushed to the mark queue. + * + * In particular we need to ensure that we handle newly-promoted objects are + * correctly marked. For instance, consider this case: + * + * generation 0 generation 1 + * ────────────── ────────────── + * + * ┌───────┐ + * ┌───────┐ │ A │ + * │ B │ ◁────────────────────────── │ │ + * │ │ ──┬─────────────────┐ └───────┘ + * └───────┘ ┆ after GC │ + * ┆ │ + * ┌───────┐ ┆ before GC │ ┌───────┐ + * │ C │ ◁┄┘ └─────▷ │ C' │ + * │ │ │ │ + * └───────┘ └───────┘ + * + * + * In this case object C started off in generation 0 and was evacuated into + * generation 1 during the preparatory GC. However, the only reference to C' + * is from B, which lives in the generation 0 (via aging); this reference will + * not be visible to the concurrent non-moving collector (which can only + * traverse the generation 1 heap). Consequently, upon evacuating C we need to + * ensure that C' is added to the update remembered set as we know that it will + * continue to be reachable via B (which is assumed to be reachable as it lives + * in a younger generation). + * + * Where this happens depends upon the type of the object (e.g. C'): + * + * - In the case of "normal" small heap-allocated objects this happens in + * alloc_for_copy. + * - In the case of compact region this happens in evacuate_compact. + * - In the case of large objects this happens in evacuate_large. + * + * See also Note [Aging under the non-moving collector] in NonMoving.c. + * + */ + +/* size is in words + + We want to *always* inline this as often the size of the closure is static, + which allows unrolling of the copy loop. + + */ STATIC_INLINE GNUC_ATTR_HOT void copy_tag(StgClosure **p, const StgInfoTable *info, StgClosure *src, uint32_t size, uint32_t gen_no, StgWord tag) @@ -351,6 +404,9 @@ evacuate_large(StgPtr p) __atomic_fetch_or(&bd->flags, BF_EVACUATED, __ATOMIC_ACQ_REL); if (RTS_UNLIKELY(RtsFlags.GcFlags.useNonmoving && new_gen == oldest_gen)) { __atomic_fetch_or(&bd->flags, BF_NONMOVING, __ATOMIC_ACQ_REL); + + // See Note [Non-moving GC: Marking evacuated objects]. + markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, (StgClosure *) p); } initBdescr(bd, new_gen, new_gen->to); @@ -505,6 +561,9 @@ evacuate_compact (StgPtr p) bd->flags |= BF_EVACUATED; if (RTS_UNLIKELY(RtsFlags.GcFlags.useNonmoving && new_gen == oldest_gen)) { __atomic_fetch_or(&bd->flags, BF_NONMOVING, __ATOMIC_RELAXED); + + // See Note [Non-moving GC: Marking evacuated objects]. + markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, (StgClosure *) str); } initBdescr(bd, new_gen, new_gen->to); @@ -690,13 +749,6 @@ loop: */ if (flags & BF_LARGE) { evacuate_large((P_)q); - - // We may have evacuated the block to the nonmoving generation. If so - // we need to make sure it is added to the mark queue since the only - // reference to it may be from the moving heap. - if (major_gc && flags & BF_NONMOVING && !deadlock_detect_gc) { - markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, q); - } return; } ===================================== rts/sm/GC.c ===================================== @@ -1689,13 +1689,8 @@ collect_gct_blocks (void) static void collect_pinned_object_blocks (void) { - generation *gen; const bool use_nonmoving = RtsFlags.GcFlags.useNonmoving; - if (use_nonmoving && major_gc) { - gen = oldest_gen; - } else { - gen = g0; - } + generation *const gen = (use_nonmoving && major_gc) ? oldest_gen : g0; for (uint32_t n = 0; n < n_capabilities; n++) { bdescr *last = NULL; @@ -1720,7 +1715,7 @@ collect_pinned_object_blocks (void) if (gen->large_objects != NULL) { gen->large_objects->u.back = last; } - g0->large_objects = RELAXED_LOAD(&capabilities[n]->pinned_object_blocks); + gen->large_objects = RELAXED_LOAD(&capabilities[n]->pinned_object_blocks); RELAXED_STORE(&capabilities[n]->pinned_object_blocks, NULL); } } ===================================== rts/sm/NonMoving.c ===================================== @@ -191,8 +191,8 @@ Mutex concurrent_coll_finished_lock; * === Other references === * * Apart from the design document in docs/storage/nonmoving-gc and the Ueno - * 2016 paper (TODO citation) from which it drew inspiration, there are a - * variety of other relevant Notes scattered throughout the tree: + * 2016 paper [ueno 2016] from which it drew inspiration, there are a variety + * of other relevant Notes scattered throughout the tree: * * - Note [Concurrent non-moving collection] (NonMoving.c) describes * concurrency control of the nonmoving collector @@ -204,6 +204,10 @@ Mutex concurrent_coll_finished_lock; * - Note [Aging under the non-moving collector] (NonMoving.c) describes how * we accomodate aging * + * - Note [Non-moving GC: Marking evacuated objects] (Evac.c) describes how + * non-moving objects reached by evacuate() are marked, which is necessary + * due to aging. + * * - Note [Large objects in the non-moving collector] (NonMovingMark.c) * describes how we track large objects. * @@ -232,6 +236,11 @@ Mutex concurrent_coll_finished_lock; * how we use the DIRTY flags associated with MUT_VARs and TVARs to improve * barrier efficiency. * + * [ueno 2016]: + * Katsuhiro Ueno and Atsushi Ohori. 2016. A fully concurrent garbage + * collector for functional programs on multicore processors. SIGPLAN Not. 51, + * 9 (September 2016), 421–433. DOI:https://doi.org/10.1145/3022670.2951944 + * * * Note [Concurrent non-moving collection] * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -312,6 +321,8 @@ Mutex concurrent_coll_finished_lock; * * The non-moving collector will come to C in the mark queue and mark it. * + * The implementation details of this are described in Note [Non-moving GC: + * Marking evacuated objects] in Evac.c. * * Note [Deadlock detection under the non-moving collector] * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -726,7 +737,6 @@ void nonmovingStop(void) "waiting for nonmoving collector thread to terminate"); ACQUIRE_LOCK(&concurrent_coll_finished_lock); waitCondition(&concurrent_coll_finished, &concurrent_coll_finished_lock); - joinOSThread(mark_thread); } #endif } ===================================== rts/sm/Sanity.c ===================================== @@ -224,6 +224,111 @@ checkClosureProfSanity(const StgClosure *p) } #endif +/* Note [Racing weak pointer evacuation] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * While debugging a GC crash (#18919) I noticed a spurious crash due to the + * end-of-GC sanity check stumbling across a weak pointer with unevacuated key. + * This can happen when two GC threads race to evacuate a weak pointer. + * Specifically, we start out with a heap with a weak pointer reachable + * from both a generation's weak pointer list and some other root-reachable + * closure (e.g. a Just constructor): + * + * O W + * ┌──────────┐ ┌──────────┐ + * Root ────→ │ Just │ ╭───→ │ Weak# │ ←─────── weak_ptr_list + * Set ├──────────┤ │ ├──────────┤ + * │ │ ────╯ │ value │ ─→ ... + * └──────────┘ │ key │ ───╮ K + * │ ... │ │ ┌──────────┐ + * └──────────┘ ╰──→ │ ... │ + * ├──────────┤ + * + * The situation proceeds as follows: + * + * 1. Thread A initiates a GC, wakes up the GC worker threads, and starts + * evacuating roots. + * 2. Thread A evacuates a weak pointer object O to location O'. + * 3. Thread A fills the block where O' lives and pushes it to its + * work-stealing queue. + * 4. Thread B steals the O' block and starts scavenging it. + * 5. Thread A enters markWeakPtrList. + * 6. Thread A starts evacuating W, resulting in Wb'. + * 7. Thread B scavenges O', evacuating W', resulting in Wa'. + * 8. Thread A and B are now racing to evacuate W. Only one will win the race + * (due to the CAS in copy_tag). Let the winning copy be called W'. + * 9. W will be replaced by a forwarding pointer to the winning copy, W'. + * 10. Whichever thread loses the race will retry evacuation, see + * that W has already been evacuated, and proceed as usual. + * 10. W' will get added to weak_ptr_list by markWeakPtrList. + * 11. Eventually W' will be scavenged. + * 12. traverseWeakPtrList will see that W' has been scavenged and evacuate the + * its key. + * 13. However, the copy that lost the race is not on `weak_ptr_list` + * and will therefore never get its `key` field scavenged (since + * `traverseWeakPtrList` will never see it). + * + * Now the heap looks like: + * + * O' W (from-space) + * ┌──────────┐ ┌──────────┐ + * Root ────→ │ Just │ │ Fwd-ptr │ ───────────╮ + * Set ├──────────┤ ├──────────┤ │ + * │ │ ────╮ │ value │ ─→ ... │ + * └──────────┘ │ │ key │ ────────────────────────╮ + * │ │ ... │ │ │ + * │ └──────────┘ │ │ + * │ │ │ + * │ Wa' │ │ + * │ ┌──────────┐ ╭────╯ │ + * ╰───→ │ Weak# │ ←─────┤ │ + * ├──────────┤ ╰─ weak_ptr_list │ + * │ value │ ─→ ... │ + * │ key │ ───╮ K' │ + * │ ... │ │ ┌──────────┐ │ + * └──────────┘ ╰──→ │ ... │ │ + * ├──────────┤ │ + * Wb' │ + * ┌──────────┐ │ + * │ Weak# │ │ + * ├──────────┤ │ + * │ value │ ─→ ... │ + * │ key │ ───╮ K (from-space) │ + * │ ... │ │ ┌──────────┐ │ + * └──────────┘ ╰──→ │ 0xaaaaa │ ←──╯ + * ├──────────┤ + * + * + * Without sanity checking this is fine; we have introduced a spurious copy of + * W, Wb' into the heap but it is unreachable and therefore won't cause any + * trouble. However, with sanity checking we may encounter this spurious copy + * when walking the heap. Moreover, this copy was never added to weak_ptr_list, + * meaning that its key field (along with the other fields mark as + * non-pointers) will not get scavenged and will therefore point into + * from-space. + * + * To avoid this checkClosure skips over the key field when it sees a weak + * pointer. Note that all fields of Wb' *other* than the key field should be + * valid, so we don't skip the closure entirely. + * + * We then do additional checking of all closures on the weak_ptr_lists, where + * we *do* check `key`. + */ + +// Check validity of objects on weak_ptr_list. +// See Note [Racing weak pointer evacuation]. +static void +checkGenWeakPtrList( uint32_t g ) +{ + for (StgWeak *w = generations[g].weak_ptr_list; w != NULL; w = w->link) { + ASSERT(LOOKS_LIKE_CLOSURE_PTR(w)); + ASSERT(w->header.info == &stg_WEAK_info); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(w->key)); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(w->value)); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(w->finalizer)); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(w->cfinalizers)); + } +} + // Returns closure size in words StgOffset checkClosure( const StgClosure* p ) @@ -343,12 +448,9 @@ checkClosure( const StgClosure* p ) * representative of the actual layout. */ { StgWeak *w = (StgWeak *)p; - ASSERT(LOOKS_LIKE_CLOSURE_PTR(w->key)); - ASSERT(LOOKS_LIKE_CLOSURE_PTR(w->value)); - ASSERT(LOOKS_LIKE_CLOSURE_PTR(w->finalizer)); - if (w->link) { - ASSERT(LOOKS_LIKE_CLOSURE_PTR(w->link)); - } + // N.B. Checking most of the fields here is not safe. + // See Note [Racing weak pointer evacuation] for why. + ASSERT(LOOKS_LIKE_CLOSURE_PTR(w->cfinalizers)); return sizeW_fromITBL(info); } @@ -851,6 +953,12 @@ static void checkGeneration (generation *gen, checkHeapChain(ws->scavd_list); } + // Check weak pointer lists + // See Note [Racing weak pointer evacuation]. + for (uint32_t g = 0; g < RtsFlags.GcFlags.generations; g++) { + checkGenWeakPtrList(g); + } + checkLargeObjects(gen->large_objects); checkCompactObjects(gen->compact_objects); } ===================================== rts/win32/OSMem.c ===================================== @@ -67,8 +67,11 @@ allocNew(uint32_t n) { alloc_rec* rec; rec = (alloc_rec*)stgMallocBytes(sizeof(alloc_rec),"getMBlocks: allocNew"); rec->size = ((W_)n+1)*MBLOCK_SIZE; + // N.B. We use MEM_TOP_DOWN here to ensure that we leave the bottom of the + // address space available for the linker and libraries, which in general + // want to live in low memory. See #18991. rec->base = - VirtualAlloc(NULL, rec->size, MEM_RESERVE, PAGE_READWRITE); + VirtualAlloc(NULL, rec->size, MEM_RESERVE | MEM_TOP_DOWN, PAGE_READWRITE); if(rec->base==0) { stgFree((void*)rec); rec=0; View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/391a3f6d3776a069534a91e34e5915a0c8d0391b...e7dbdbfadf897b246a0b7d669bb559d18030c3c6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/391a3f6d3776a069534a91e34e5915a0c8d0391b...e7dbdbfadf897b246a0b7d669bb559d18030c3c6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 8 11:37:49 2020 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Tue, 08 Dec 2020 06:37:49 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/t19038 Message-ID: <5fcf658d5ad0_6b2113d8dc04658f9@gitlab.mail> Matthew Pickering pushed new branch wip/t19038 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/t19038 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 8 11:40:54 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Tue, 08 Dec 2020 06:40:54 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/T18962-simpl Message-ID: <5fcf664617b2c_6b211d85db44675ad@gitlab.mail> Sebastian Graf pushed new branch wip/T18962-simpl at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T18962-simpl You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 8 11:44:46 2020 From: gitlab at gitlab.haskell.org (Andreas Klebinger) Date: Tue, 08 Dec 2020 06:44:46 -0500 Subject: [Git][ghc/ghc][wip/andreask/fix_rts_warnings] 61 commits: rts: Flush eventlog buffers from flushEventLog Message-ID: <5fcf672e575a4_6b2132ee34469099@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/fix_rts_warnings at Glasgow Haskell Compiler / GHC Commits: f88f4339 by Ben Gamari at 2020-11-24T02:43:20-05:00 rts: Flush eventlog buffers from flushEventLog As noted in #18043, flushTrace failed flush anything beyond the writer. This means that a significant amount of data sitting in capability-local event buffers may never get flushed, despite the users' pleads for us to flush. Fix this by making flushEventLog flush all of the event buffers before flushing the writer. Fixes #18043. - - - - - 7c03cc50 by Ben Gamari at 2020-11-24T02:43:55-05:00 gitlab-ci: Run LLVM job on appropriately-labelled MRs Namely, those marked with the ~"LLVM backend" label - - - - - 9b95d815 by Ben Gamari at 2020-11-24T02:43:55-05:00 gitlab-ci: Run LLVM builds on Debian 10 The current Debian 9 image doesn't provide LLVM 7. - - - - - 2ed3e6c0 by Ben Gamari at 2020-11-24T02:43:55-05:00 CmmToLlvm: Declare signature for memcmp Otherwise `opt` fails with: error: use of undefined value '@memcmp$def' - - - - - be5d74ca by Moritz Angermann at 2020-11-26T16:00:32-05:00 [Sized Cmm] properly retain sizes. This replaces all Word<N> = W<N># Word# and Int<N> = I<N># Int# with Word<N> = W<N># Word<N># and Int<N> = I<N># Int<N>#, thus providing us with properly sized primitives in the codegenerator instead of pretending they are all full machine words. This came up when implementing darwinpcs for arm64. The darwinpcs reqires us to pack function argugments in excess of registers on the stack. While most procedure call standards (pcs) assume arguments are just passed in 8 byte slots; and thus the caller does not know the exact signature to make the call, darwinpcs requires us to adhere to the prototype, and thus have the correct sizes. If we specify CInt in the FFI call, it should correspond to the C int, and not just be Word sized, when it's only half the size. This does change the expected output of T16402 but the new result is no less correct as it eliminates the narrowing (instead of the `and` as was previously done). Bumps the array, bytestring, text, and binary submodules. Co-Authored-By: Ben Gamari <ben at well-typed.com> Metric Increase: T13701 T14697 - - - - - a84e53f9 by Andreas Klebinger at 2020-11-26T16:00:32-05:00 RTS: Fix failed inlining of copy_tag. On windows using gcc-10 gcc failed to inline copy_tag into evacuate. To fix this we now set the always_inline attribute for the various copy* functions in Evac.c. The main motivation here is not the overhead of the function call, but rather that this allows the code to "specialize" for the size of the closure we copy which is often known at compile time. An earlier commit also tried to avoid evacuate_large inlining. But didn't quite succeed. So I also marked evacuate_large as noinline. Fixes #12416 - - - - - cdbd16f5 by Sylvain Henry at 2020-11-26T16:00:33-05:00 Fix toArgRep to support 64-bit reps on all systems [This is @Ericson2314 writing a commit message for @hsyl20's patch.] (Progress towards #11953, #17377, #17375) `Int64Rep` and `Word64Rep` are currently broken on 64-bit systems. This is because they should use "native arg rep" but instead use "large arg rep" as they do on 32-bit systems, which is either a non-concept or a 128-bit rep depending on one's vantage point. Now, these reps currently aren't used during 64-bit compilation, so the brokenness isn't observed, but I don't think that constitutes reasons not to fix it. Firstly, the linked issues there is a clearly expressed desire to use explicit-bitwidth constructs in more places. Secondly, per [1], there are other bugs that *do* manifest from not threading explicit-bitwidth information all the way through the compilation pipeline. One can therefore view this as one piece of the larger effort to do that, improve ergnomics, and squash remaining bugs. Also, this is needed for !3658. I could just merge this as part of that, but I'm keen on merging fixes "as they are ready" so the fixes that aren't ready are isolated and easier to debug. [1]: https://mail.haskell.org/pipermail/ghc-devs/2020-October/019332.html - - - - - a9378e69 by Tim Barnes at 2020-11-26T16:00:34-05:00 Set dynamic users-guide TOC spacing (fixes #18554) - - - - - 86a59d93 by Ben Gamari at 2020-11-26T16:00:34-05:00 rts: Use RTS_LIKELY in CHECK Most compilers probably already infer that `barf` diverges but it nevertheless doesn't hurt to be explicit. - - - - - 5757e82b by Matthew Pickering at 2020-11-26T16:00:35-05:00 Remove special case for GHC.ByteCode.Instr This was added in https://github.com/nomeata/ghc-heap-view/commit/34935206e51b9c86902481d84d2f368a6fd93423 GHC.ByteCode.Instr.BreakInfo no longer exists so the special case is dead code. Any check like this can be easily dealt with in client code. - - - - - d9c8b5b4 by Matthew Pickering at 2020-11-26T16:00:35-05:00 Split Up getClosureDataFromHeapRep Motivation 1. Don't enforce the repeated decoding of an info table, when the client can cache it (ghc-debug) 2. Allow the constructor information decoding to be overridden, this casues segfaults in ghc-debug - - - - - 3e3555cc by Andreas Klebinger at 2020-11-26T16:00:35-05:00 RegAlloc: Add missing raPlatformfield to RegAllocStatsSpill Fixes #18994 Co-Author: Benjamin Maurer <maurer.benjamin at gmail.com> - - - - - a1a75aa9 by Ben Gamari at 2020-11-27T06:20:41-05:00 rts: Allocate MBlocks with MAP_TOP_DOWN on Windows As noted in #18991, we would previously allocate heap in low memory. Due to this the linker, which typically *needs* low memory, would end up competing with the heap. In longer builds we end up running out of low memory entirely, leading to linking failures. - - - - - 75fc1ed5 by Sylvain Henry at 2020-11-28T15:40:23-05:00 Hadrian: fix detection of ghc-pkg for cross-compilers - - - - - 7cb5df96 by Sylvain Henry at 2020-11-28T15:40:23-05:00 hadrian: fix ghc-pkg uses (#17601) Make sure ghc-pkg doesn't read the compiler "settings" file by passing --no-user-package-db. - - - - - e3fd4226 by Ben Gamari at 2020-11-28T15:40:23-05:00 gitlab-ci: Introduce a nightly cross-compilation job This adds a job to test cross-compilation from x86-64 to AArch64 with Hadrian. Fixes #18234 - - - - - 698d3d96 by Ben Gamari at 2020-11-28T15:41:00-05:00 gitlab-ci: Only deploy GitLab Pages in ghc/ghc> The deployments are quite large and yet are currently only served for the ghc/ghc> project. - - - - - 625726f9 by David Eichmann at 2020-11-28T15:41:37-05:00 ghc-heap: partial TSO/STACK decoding Co-authored-by: Sven Tennie <sven.tennie at gmail.com> Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> Co-authored-by: Ben Gamari <bgamari.foss at gmail.com> - - - - - 22ea9c29 by Andreas Klebinger at 2020-11-28T15:42:13-05:00 Small optimization to CmmSink. Inside `regsUsedIn` we can avoid some thunks by specializing the recursion. In particular we avoid the thunk for `(f e z)` in the MachOp/Load branches, where we know this will evaluate to z. Reduces allocations for T3294 by ~1%. - - - - - bba42c62 by John Ericson at 2020-11-28T15:42:49-05:00 Make primop handler indentation more consistent - - - - - c82bc8e9 by John Ericson at 2020-11-28T15:42:49-05:00 Cleanup some primop constructor names Harmonize the internal (big sum type) names of the native vs fixed-sized number primops a bit. (Mainly by renaming the former.) No user-facing names are changed. - - - - - ae14f160 by Ben Gamari at 2020-11-28T15:43:25-05:00 testsuite: Mark T14702 as fragile on Windows Due to #18953. - - - - - 1bc104b0 by Ben Gamari at 2020-11-29T15:33:18-05:00 withTimings: Emit allocations counter This will allow us to back out the allocations per compiler pass from the eventlog. Note that we dump the allocation counter rather than the difference since this will allow us to determine how much work is done *between* `withTiming` blocks. - - - - - e992ea84 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 ThreadPaused: Don't zero slop until free vars are pushed When threadPaused blackholes a thunk it calls `OVERWRITING_CLOSURE` to zero the slop for the benefit of the sanity checker. Previously this was done *before* pushing the thunk's free variables to the update remembered set. Consequently we would pull zero'd pointers to the update remembered set. - - - - - e82cd140 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Fix regression from TSAN work The TSAN rework (specifically aad1f803) introduced a subtle regression in GC.c, swapping `g0` in place of `gen`. Whoops! Fixes #18997. - - - - - 35a5207e by GHC GitLab CI at 2020-11-29T15:33:54-05:00 rts/Messages: Add missing write barrier in THROWTO message update After a THROWTO message has been handle the message closure is overwritten by a NULL message. We must ensure that the original closure's pointers continue to be visible to the nonmoving GC. - - - - - 0120829f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Add missing write barrier in shrinkSmallByteArray - - - - - 8a4d8fb6 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 Updates: Don't zero slop until closure has been pushed Ensure that the the free variables have been pushed to the update remembered set before we zero the slop. - - - - - 2793cfdc by GHC GitLab CI at 2020-11-29T15:33:54-05:00 OSThreads: Fix error code checking pthread_join returns its error code and apparently doesn't set errno. - - - - - e391a16f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Don't join to mark_thread on shutdown The mark thread is not joinable as we detach from it on creation. - - - - - 60d088ab by Ben Gamari at 2020-11-29T15:33:54-05:00 nonmoving: Add reference to Ueno 2016 - - - - - 3aa60362 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Ensure that evacuated large objects are marked See Note [Non-moving GC: Marking evacuated objects]. - - - - - 8d304a99 by Ben Gamari at 2020-11-30T10:15:22-05:00 rts/m32: Refactor handling of allocator seeding Previously, in an attempt to reduce fragmentation, each new allocator would map a region of M32_MAX_PAGES fresh pages to seed itself. However, this ends up being extremely wasteful since it turns out that we often use fewer than this. Consequently, these pages end up getting freed which, ends up fragmenting our address space more than than we would have if we had naively allocated pages on-demand. Here we refactor m32 to avoid this waste while achieving the fragmentation mitigation previously desired. In particular, we move all page allocation into the global m32_alloc_page, which will pull a page from the free page pool. If the free page pool is empty we then refill it by allocating a region of M32_MAP_PAGES and adding them to the pool. Furthermore, we do away with the initial seeding entirely. That is, the allocator starts with no active pages: pages are rather allocated on an as-needed basis. On the whole this ends up being a pleasingly simple change, simultaneously making m32 more efficient, more robust, and simpler. Fixes #18980. - - - - - b6629289 by Ben Gamari at 2020-11-30T10:15:58-05:00 rts: Use CHECK instead of assert Use the GHC wrappers instead of <assert.h>. - - - - - 9f4efa6a by Ben Gamari at 2020-11-30T10:15:58-05:00 rts/linker: Replace some ASSERTs with CHECK In the past some people have confused ASSERT, which is for checking internal invariants, which CHECK, which should be used when checking things that might fail due to bad input (and therefore should be enabled even in the release compiler). Change some of these cases in the linker to use CHECK. - - - - - 0f8a4655 by Ryan Scott at 2020-11-30T10:16:34-05:00 Allow deploy:pages job to fail See #18973. - - - - - 49ebe369 by chessai at 2020-11-30T19:47:40-05:00 Optimisations in Data.Foldable (T17867) This PR concerns the following functions from `Data.Foldable`: * minimum * maximum * sum * product * minimumBy * maximumBy - Default implementations of these functions now use `foldl'` or `foldMap'`. - All have been marked with INLINEABLE to make room for further optimisations. - - - - - 4d79ef65 by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - 6af074ce by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - ab334262 by Viktor Dukhovni at 2020-11-30T19:48:17-05:00 dirty MVAR after mutating TSO queue head While the original head and tail of the TSO queue may be in the same generation as the MVAR, interior elements of the queue could be younger after a GC run and may then be exposed by putMVar operation that updates the queue head. Resolves #18919 - - - - - 5eb163f3 by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Don't allow shared libraries to be loaded multiple times - - - - - 490aa14d by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Initialise CCSs from native shared objects - - - - - 6ac3db5f by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Move shared library loading logic into Elf.c - - - - - b6698d73 by GHC GitLab CI at 2020-11-30T19:48:53-05:00 rts/linker: Don't declare dynamic objects with image_mapped This previously resulted in warnings due to spurious unmap failures. - - - - - b94a65af by jneira at 2020-11-30T19:49:31-05:00 Include tried paths in findToolDir error - - - - - 72a87fbc by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Move core flattening algorithm to Core.Unify This sets the stage for a later change, where this algorithm will be needed from GHC.Core.InstEnv. This commit also splits GHC.Core.Map into GHC.Core.Map.Type and GHC.Core.Map.Expr, in order to avoid module import cycles with GHC.Core. - - - - - 0dd45d0a by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Bump the # of commits searched for perf baseline The previous value of 75 meant that a feature branch with more than 75 commits would get spurious CI passes. This affects #18692, but does not fix that ticket, because if a baseline cannot be found, we should fail, not succeed. - - - - - 8bb52d91 by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Remove flattening variables This patch redesigns the flattener to simplify type family applications directly instead of using flattening meta-variables and skolems. The key new innovation is the CanEqLHS type and the new CEqCan constraint (Ct). A CanEqLHS is either a type variable or exactly-saturated type family application; either can now be rewritten using a CEqCan constraint in the inert set. Because the flattener no longer reduces all type family applications to variables, there was some performance degradation if a lengthy type family application is now flattened over and over (not making progress). To compensate, this patch contains some extra optimizations in the flattener, leading to a number of performance improvements. Close #18875. Close #18910. There are many extra parts of the compiler that had to be affected in writing this patch: * The family-application cache (formerly the flat-cache) sometimes stores coercions built from Given inerts. When these inerts get kicked out, we must kick out from the cache as well. (This was, I believe, true previously, but somehow never caused trouble.) Kicking out from the cache requires adding a filterTM function to TrieMap. * This patch obviates the need to distinguish "blocking" coercion holes from non-blocking ones (which, previously, arose from CFunEqCans). There is thus some simplification around coercion holes. * Extra commentary throughout parts of the code I read through, to preserve the knowledge I gained while working. * A change in the pure unifier around unifying skolems with other types. Unifying a skolem now leads to SurelyApart, not MaybeApart, as documented in Note [Binding when looking up instances] in GHC.Core.InstEnv. * Some more use of MCoercion where appropriate. * Previously, class-instance lookup automatically noticed that e.g. C Int was a "unifier" to a target [W] C (F Bool), because the F Bool was flattened to a variable. Now, a little more care must be taken around checking for unifying instances. * Previously, tcSplitTyConApp_maybe would split (Eq a => a). This is silly, because (=>) is not a tycon in Haskell. Fixed now, but there are some knock-on changes in e.g. TrieMap code and in the canonicaliser. * New function anyFreeVarsOf{Type,Co} to check whether a free variable satisfies a certain predicate. * Type synonyms now remember whether or not they are "forgetful"; a forgetful synonym drops at least one argument. This is useful when flattening; see flattenView. * The pattern-match completeness checker invokes the solver. This invocation might need to look through newtypes when checking representational equality. Thus, the desugarer needs to keep track of the in-scope variables to know what newtype constructors are in scope. I bet this bug was around before but never noticed. * Extra-constraints wildcards are no longer simplified before printing. See Note [Do not simplify ConstraintHoles] in GHC.Tc.Solver. * Whether or not there are Given equalities has become slightly subtler. See the new HasGivenEqs datatype. * Note [Type variable cycles in Givens] in GHC.Tc.Solver.Canonical explains a significant new wrinkle in the new approach. * See Note [What might match later?] in GHC.Tc.Solver.Interact, which explains the fix to #18910. * The inert_count field of InertCans wasn't actually used, so I removed it. Though I (Richard) did the implementation, Simon PJ was very involved in design and review. This updates the Haddock submodule to avoid #18932 by adding a type signature. ------------------------- Metric Decrease: T12227 T5030 T9872a T9872b T9872c Metric Increase: T9872d ------------------------- - - - - - d66660ba by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Rename the flattener to become the rewriter. Now that flattening doesn't produce flattening variables, it's not really flattening anything: it's rewriting. This change also means that the rewriter can no longer be confused the core flattener (in GHC.Core.Unify), which is sometimes used during type-checking. - - - - - add0aeae by Ben Gamari at 2020-12-01T19:58:17-05:00 rts: Introduce mmapAnonForLinker Previously most of the uses of mmapForLinker were mapping anonymous memory, resulting in a great deal of unnecessary repetition. Factor this out into a new helper. Also fixes a few places where error checking was missing or suboptimal. - - - - - 97d71646 by Ben Gamari at 2020-12-01T19:58:17-05:00 rts/linker: Introduce munmapForLinker Consolidates munmap calls to ensure consistent error handling. - - - - - d8872af0 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/Linker: Introduce Windows implementations for mmapForLinker, et al. - - - - - c35d0e03 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/m32: Introduce NEEDS_M32 macro Instead of relying on RTS_LINKER_USE_MMAP - - - - - 41c64eb5 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/linker: Use m32 to allocate symbol extras in PEi386 - - - - - e0b08c5f by Ben Gamari at 2020-12-03T13:01:47-05:00 gitlab-ci: Fix copy-paste error Also be more consistent in quoting. - - - - - 33ec3a06 by Ben Gamari at 2020-12-03T23:11:31-05:00 gitlab-ci: Run linters through ci.sh Ensuring that the right toolchain is used. - - - - - 4a437bc1 by Shayne Fletcher at 2020-12-05T09:06:38-05:00 Fix bad span calculations of post qualified imports - - - - - 8fac4b93 by Ben Gamari at 2020-12-05T09:07:13-05:00 testsuite: Add a test for #18923 - - - - - 3a5860a4 by Andreas Klebinger at 2020-12-08T12:41:39+01:00 OSMem.c: Use proper type for mbinds mask argument. StgWord has different widths on 32/64bit. So use the proper type instead. - - - - - ce7109a6 by Andreas Klebinger at 2020-12-08T12:44:33+01:00 rts: EventLog.c: Properly cast (potential) 32bit pointers to uint64_t - - - - - dadb803a by Andreas Klebinger at 2020-12-08T12:44:33+01:00 Rts/elf-linker: Upcast to 64bit to satisfy format string. The elf size is 32bit on 32bit builds and 64 otherwise. We just upcast to 64bits before printing now. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/Reg/Graph.hs - compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Axiom.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FamInstEnv.hs - compiler/GHC/Core/InstEnv.hs - + compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Map.hs → compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/Opt/CSE.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/79285cb614d656f2fd94e2fe1a0430e6604028bf...dadb803acc941c5e8e9f9ef1ed25041f6c4c3a39 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/79285cb614d656f2fd94e2fe1a0430e6604028bf...dadb803acc941c5e8e9f9ef1ed25041f6c4c3a39 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 8 11:51:16 2020 From: gitlab at gitlab.haskell.org (Andreas Klebinger) Date: Tue, 08 Dec 2020 06:51:16 -0500 Subject: [Git][ghc/ghc][wip/andreask/opt_cmm_sink_sets] 18 commits: Move core flattening algorithm to Core.Unify Message-ID: <5fcf68b4af70_6b2118051dc469999@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/opt_cmm_sink_sets at Glasgow Haskell Compiler / GHC Commits: 72a87fbc by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Move core flattening algorithm to Core.Unify This sets the stage for a later change, where this algorithm will be needed from GHC.Core.InstEnv. This commit also splits GHC.Core.Map into GHC.Core.Map.Type and GHC.Core.Map.Expr, in order to avoid module import cycles with GHC.Core. - - - - - 0dd45d0a by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Bump the # of commits searched for perf baseline The previous value of 75 meant that a feature branch with more than 75 commits would get spurious CI passes. This affects #18692, but does not fix that ticket, because if a baseline cannot be found, we should fail, not succeed. - - - - - 8bb52d91 by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Remove flattening variables This patch redesigns the flattener to simplify type family applications directly instead of using flattening meta-variables and skolems. The key new innovation is the CanEqLHS type and the new CEqCan constraint (Ct). A CanEqLHS is either a type variable or exactly-saturated type family application; either can now be rewritten using a CEqCan constraint in the inert set. Because the flattener no longer reduces all type family applications to variables, there was some performance degradation if a lengthy type family application is now flattened over and over (not making progress). To compensate, this patch contains some extra optimizations in the flattener, leading to a number of performance improvements. Close #18875. Close #18910. There are many extra parts of the compiler that had to be affected in writing this patch: * The family-application cache (formerly the flat-cache) sometimes stores coercions built from Given inerts. When these inerts get kicked out, we must kick out from the cache as well. (This was, I believe, true previously, but somehow never caused trouble.) Kicking out from the cache requires adding a filterTM function to TrieMap. * This patch obviates the need to distinguish "blocking" coercion holes from non-blocking ones (which, previously, arose from CFunEqCans). There is thus some simplification around coercion holes. * Extra commentary throughout parts of the code I read through, to preserve the knowledge I gained while working. * A change in the pure unifier around unifying skolems with other types. Unifying a skolem now leads to SurelyApart, not MaybeApart, as documented in Note [Binding when looking up instances] in GHC.Core.InstEnv. * Some more use of MCoercion where appropriate. * Previously, class-instance lookup automatically noticed that e.g. C Int was a "unifier" to a target [W] C (F Bool), because the F Bool was flattened to a variable. Now, a little more care must be taken around checking for unifying instances. * Previously, tcSplitTyConApp_maybe would split (Eq a => a). This is silly, because (=>) is not a tycon in Haskell. Fixed now, but there are some knock-on changes in e.g. TrieMap code and in the canonicaliser. * New function anyFreeVarsOf{Type,Co} to check whether a free variable satisfies a certain predicate. * Type synonyms now remember whether or not they are "forgetful"; a forgetful synonym drops at least one argument. This is useful when flattening; see flattenView. * The pattern-match completeness checker invokes the solver. This invocation might need to look through newtypes when checking representational equality. Thus, the desugarer needs to keep track of the in-scope variables to know what newtype constructors are in scope. I bet this bug was around before but never noticed. * Extra-constraints wildcards are no longer simplified before printing. See Note [Do not simplify ConstraintHoles] in GHC.Tc.Solver. * Whether or not there are Given equalities has become slightly subtler. See the new HasGivenEqs datatype. * Note [Type variable cycles in Givens] in GHC.Tc.Solver.Canonical explains a significant new wrinkle in the new approach. * See Note [What might match later?] in GHC.Tc.Solver.Interact, which explains the fix to #18910. * The inert_count field of InertCans wasn't actually used, so I removed it. Though I (Richard) did the implementation, Simon PJ was very involved in design and review. This updates the Haddock submodule to avoid #18932 by adding a type signature. ------------------------- Metric Decrease: T12227 T5030 T9872a T9872b T9872c Metric Increase: T9872d ------------------------- - - - - - d66660ba by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Rename the flattener to become the rewriter. Now that flattening doesn't produce flattening variables, it's not really flattening anything: it's rewriting. This change also means that the rewriter can no longer be confused the core flattener (in GHC.Core.Unify), which is sometimes used during type-checking. - - - - - add0aeae by Ben Gamari at 2020-12-01T19:58:17-05:00 rts: Introduce mmapAnonForLinker Previously most of the uses of mmapForLinker were mapping anonymous memory, resulting in a great deal of unnecessary repetition. Factor this out into a new helper. Also fixes a few places where error checking was missing or suboptimal. - - - - - 97d71646 by Ben Gamari at 2020-12-01T19:58:17-05:00 rts/linker: Introduce munmapForLinker Consolidates munmap calls to ensure consistent error handling. - - - - - d8872af0 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/Linker: Introduce Windows implementations for mmapForLinker, et al. - - - - - c35d0e03 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/m32: Introduce NEEDS_M32 macro Instead of relying on RTS_LINKER_USE_MMAP - - - - - 41c64eb5 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/linker: Use m32 to allocate symbol extras in PEi386 - - - - - e0b08c5f by Ben Gamari at 2020-12-03T13:01:47-05:00 gitlab-ci: Fix copy-paste error Also be more consistent in quoting. - - - - - 33ec3a06 by Ben Gamari at 2020-12-03T23:11:31-05:00 gitlab-ci: Run linters through ci.sh Ensuring that the right toolchain is used. - - - - - 4a437bc1 by Shayne Fletcher at 2020-12-05T09:06:38-05:00 Fix bad span calculations of post qualified imports - - - - - 8fac4b93 by Ben Gamari at 2020-12-05T09:07:13-05:00 testsuite: Add a test for #18923 - - - - - 2f693c82 by Andreas Klebinger at 2020-12-08T12:50:57+01:00 CodeGen: Make folds User/DefinerOfRegs INLINEABLE. Reduces allocation for the test case I was looking at by about 1.2%. Mostly from avoiding allocation of some folding functions which turn into let-no-escape bindings which just reuse their environment instead. We also force inlining in a few key places in CmmSink which helps a bit more. - - - - - 8ff748af by Andreas Klebinger at 2020-12-08T12:50:57+01:00 CmmSink: Force inlining of foldRegsDefd Helps avoid allocating the folding function. Improves perf for T3294 by about 1%. - - - - - 0b8b8a8d by Andreas Klebinger at 2020-12-08T12:50:57+01:00 Cmm: Make a few types and utility function slightly stricter. About 0.6% reduction in allocations for the code I was looking at. Not a huge difference but no need to throw away performance. - - - - - 1c841f9c by Andreas Klebinger at 2020-12-08T12:50:57+01:00 Cmm.Sink: Optimize retaining of assignments, live sets. Sinking requires us to track live local regs after each cmm statement. We used to do this via "Set LocalReg". However we can replace this with a solution based on IntSet which is overall more efficient without losing much. The thing we lose is width of the variables, which isn't used by the sinking pass anyway. I also reworked how we keep assignments to regs mentioned in skipped assignments. I put the details into Note [Keeping assignemnts mentioned in skipped RHSs]. The gist of it is instead of keeping track of it via the use count which is a `IntMap Int` we now use the live regs set (IntSet) which is quite a bit faster. I think it also matches the semantics a lot better. The skipped (not discarded) assignment does in fact keep the regs on it's rhs alive so keeping track of this in the live set seems like the clearer solution as well. Improves allocations for T3294 by yet another 1%. - - - - - acc75450 by Andreas Klebinger at 2020-12-08T12:50:57+01:00 GHC.Cmm.Opt: Be stricter in results. Optimization either returns Nothing if nothing is to be done or `Just <cmmExpr>` otherwise. There is no point in being lazy in `cmmExpr`. We usually inspect this element so the thunk gets forced not long after. We might eliminate it as dead code once in a blue moon but that's not a case worth optimizing for. Overall the impact of this is rather low. As Cmm.Opt doesn't allocate much (compared to the rest of GHC) to begin with. - - - - - 25 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Expr.hs - + compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Liveness.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Axiom.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FamInstEnv.hs - compiler/GHC/Core/InstEnv.hs - + compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Map.hs → compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/Opt/CSE.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/TyCon/Env.hs - compiler/GHC/Core/Type.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/23e1050e1a9abaa58e2216143c5165efec9ff31c...acc7545008639b9fd23bc4e55217d6d3e4b00c96 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/23e1050e1a9abaa58e2216143c5165efec9ff31c...acc7545008639b9fd23bc4e55217d6d3e4b00c96 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 8 13:43:50 2020 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Tue, 08 Dec 2020 08:43:50 -0500 Subject: [Git][ghc/ghc][wip/t19038] ghc-heap: Allow more control about decoding CCS fields Message-ID: <5fcf831628289_6b2132ee344760a9@gitlab.mail> Matthew Pickering pushed to branch wip/t19038 at Glasgow Haskell Compiler / GHC Commits: f145647a by Matthew Pickering at 2020-12-08T13:43:33+00:00 ghc-heap: Allow more control about decoding CCS fields We have to be careful not to decode too much, too eagerly, as in ghc-debug this will lead to references to memory locations outside of the currently copied closure. Fixes #19038 - - - - - 5 changed files: - libraries/ghc-heap/GHC/Exts/Heap.hs - libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingDisabled.hsc - libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc - libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/PeekProfInfo_ProfilingDisabled.hsc - libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/PeekProfInfo_ProfilingEnabled.hsc Changes: ===================================== libraries/ghc-heap/GHC/Exts/Heap.hs ===================================== @@ -71,6 +71,7 @@ import GHC.Exts.Heap.InfoTable #endif import GHC.Exts.Heap.Utils import qualified GHC.Exts.Heap.FFIClosures as FFIClosures +import qualified GHC.Exts.Heap.ProfInfo.PeekProfInfo as PPI import Control.Monad import Data.Bits @@ -170,13 +171,17 @@ getClosureDataFromHeapObject x = do getClosureDataFromHeapRep :: ByteArray# -> Ptr StgInfoTable -> [b] -> IO (GenClosure b) getClosureDataFromHeapRep heapRep infoTablePtr pts = do itbl <- peekItbl infoTablePtr - getClosureDataFromHeapRepPrim (dataConNames infoTablePtr) itbl heapRep pts + getClosureDataFromHeapRepPrim (dataConNames infoTablePtr) PPI.peekTopCCS itbl heapRep pts getClosureDataFromHeapRepPrim :: IO (String, String, String) -- ^ A continuation used to decode the constructor description field, -- in ghc-debug this code can lead to segfaults because dataConNames -- will dereference a random part of memory. + -> (Ptr a -> IO (Maybe CostCentreStack)) + -- ^ A continuation which is used to decode a cost centre stack + -- In ghc-debug, this code will need to call back into the debuggee to + -- fetch the representation of the CCS before decoding it. -> StgInfoTable -- ^ The `StgInfoTable` of the closure, extracted from the heap -- representation. @@ -191,7 +196,7 @@ getClosureDataFromHeapRepPrim -- `b` is some representation of a pointer e.g. `Any` or `Ptr Any`. -> IO (GenClosure b) -- ^ Heap representation of the closure. -getClosureDataFromHeapRepPrim getConDesc itbl heapRep pts = do +getClosureDataFromHeapRepPrim getConDesc decodeCCS itbl heapRep pts = do let -- heapRep as a list of words. rawHeapWords :: [Word] rawHeapWords = [W# (indexWordArray# heapRep i) | I# i <- [0.. end] ] @@ -343,7 +348,7 @@ getClosureDataFromHeapRepPrim getConDesc itbl heapRep pts = do } TSO | [ u_lnk, u_gbl_lnk, tso_stack, u_trec, u_blk_ex, u_bq] <- pts -> withArray rawHeapWords (\ptr -> do - fields <- FFIClosures.peekTSOFields ptr + fields <- FFIClosures.peekTSOFields decodeCCS ptr pure $ TSOClosure { info = itbl , link = u_lnk ===================================== libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingDisabled.hsc ===================================== @@ -30,8 +30,8 @@ data TSOFields = TSOFields { } -- | Get non-pointer fields from @StgTSO_@ (@TSO.h@) -peekTSOFields :: Ptr tsoPtr -> IO TSOFields -peekTSOFields ptr = do +peekTSOFields :: (Ptr a -> IO (Maybe CostCentreStack)) -> Ptr tsoPtr -> IO TSOFields +peekTSOFields decodeCCS ptr = do what_next' <- (#peek struct StgTSO_, what_next) ptr why_blocked' <- (#peek struct StgTSO_, why_blocked) ptr flags' <- (#peek struct StgTSO_, flags) ptr @@ -40,7 +40,7 @@ peekTSOFields ptr = do dirty' <- (#peek struct StgTSO_, dirty) ptr alloc_limit' <- (#peek struct StgTSO_, alloc_limit) ptr tot_stack_size' <- (#peek struct StgTSO_, tot_stack_size) ptr - tso_prof' <- peekStgTSOProfInfo ptr + tso_prof' <- peekStgTSOProfInfo decodeCCS ptr return TSOFields { tso_what_next = parseWhatNext what_next', ===================================== libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc ===================================== @@ -30,8 +30,8 @@ data TSOFields = TSOFields { } -- | Get non-pointer fields from @StgTSO_@ (@TSO.h@) -peekTSOFields :: Ptr tsoPtr -> IO TSOFields -peekTSOFields ptr = do +peekTSOFields :: (Ptr a -> IO (Maybe CostCentreStack)) -> Ptr tsoPtr -> IO TSOFields +peekTSOFields decodeCCS ptr = do what_next' <- (#peek struct StgTSO_, what_next) ptr why_blocked' <- (#peek struct StgTSO_, why_blocked) ptr flags' <- (#peek struct StgTSO_, flags) ptr @@ -40,7 +40,7 @@ peekTSOFields ptr = do dirty' <- (#peek struct StgTSO_, dirty) ptr alloc_limit' <- (#peek struct StgTSO_, alloc_limit) ptr tot_stack_size' <- (#peek struct StgTSO_, tot_stack_size) ptr - tso_prof' <- peekStgTSOProfInfo ptr + tso_prof' <- peekStgTSOProfInfo decodeCCS ptr return TSOFields { tso_what_next = parseWhatNext what_next', ===================================== libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/PeekProfInfo_ProfilingDisabled.hsc ===================================== @@ -1,5 +1,6 @@ module GHC.Exts.Heap.ProfInfo.PeekProfInfo_ProfilingDisabled( peekStgTSOProfInfo + , peekTopCCS ) where import Prelude @@ -8,5 +9,8 @@ import GHC.Exts.Heap.ProfInfo.Types -- | This implementation is used when PROFILING is undefined. -- It always returns 'Nothing', because there is no profiling info available. -peekStgTSOProfInfo :: Ptr tsoPtr -> IO (Maybe StgTSOProfInfo) -peekStgTSOProfInfo _ = return Nothing +peekStgTSOProfInfo :: (Ptr a -> IO (Maybe CostCentreStack)) -> Ptr tsoPtr -> IO (Maybe StgTSOProfInfo) +peekStgTSOProfInfo _ _ = return Nothing + +peekTopCCS :: Ptr a -> IO (Maybe CostCentreStack) +peekTopCCS _ = return Nothing ===================================== libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/PeekProfInfo_ProfilingEnabled.hsc ===================================== @@ -3,6 +3,7 @@ module GHC.Exts.Heap.ProfInfo.PeekProfInfo_ProfilingEnabled( peekStgTSOProfInfo + , peekTopCCS ) where #if __GLASGOW_HASKELL__ >= 811 @@ -33,16 +34,20 @@ import Prelude type AddressSet = IntSet type AddressMap = IntMap -peekStgTSOProfInfo :: Ptr a -> IO (Maybe StgTSOProfInfo) -peekStgTSOProfInfo tsoPtr = do +peekStgTSOProfInfo :: (Ptr b -> IO (Maybe CostCentreStack)) -> Ptr a -> IO (Maybe StgTSOProfInfo) +peekStgTSOProfInfo decodeCCS tsoPtr = do cccs_ptr <- peekByteOff tsoPtr cccsOffset - costCenterCacheRef <- newIORef IntMap.empty - cccs' <- peekCostCentreStack IntSet.empty costCenterCacheRef cccs_ptr + cccs' <- decodeCCS cccs_ptr return $ Just StgTSOProfInfo { cccs = cccs' } +peekTopCCS :: Ptr b -> IO (Maybe CostCentreStack) +peekTopCCS cccs_ptr = do + costCenterCacheRef <- newIORef IntMap.empty + peekCostCentreStack IntSet.empty costCenterCacheRef cccs_ptr + cccsOffset :: Int cccsOffset = (#const OFFSET_StgTSO_cccs) + (#size StgHeader) @@ -162,4 +167,7 @@ import GHC.Exts.Heap.ProfInfo.Types peekStgTSOProfInfo :: Ptr a -> IO (Maybe StgTSOProfInfo) peekStgTSOProfInfo _ = return Nothing + +peekTopCCS :: Ptr a -> IO (Maybe CostCentreStack) +peekTopCCS _ = return Nothing #endif View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f145647a8d7a3f716dd2f603c21ffc8f87c385f6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f145647a8d7a3f716dd2f603c21ffc8f87c385f6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 8 13:53:56 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Tue, 08 Dec 2020 08:53:56 -0500 Subject: [Git][ghc/ghc][wip/T17656] 55 commits: [Sized Cmm] properly retain sizes. Message-ID: <5fcf85747bf2e_6b211e6fbe447688e@gitlab.mail> Simon Peyton Jones pushed to branch wip/T17656 at Glasgow Haskell Compiler / GHC Commits: be5d74ca by Moritz Angermann at 2020-11-26T16:00:32-05:00 [Sized Cmm] properly retain sizes. This replaces all Word<N> = W<N># Word# and Int<N> = I<N># Int# with Word<N> = W<N># Word<N># and Int<N> = I<N># Int<N>#, thus providing us with properly sized primitives in the codegenerator instead of pretending they are all full machine words. This came up when implementing darwinpcs for arm64. The darwinpcs reqires us to pack function argugments in excess of registers on the stack. While most procedure call standards (pcs) assume arguments are just passed in 8 byte slots; and thus the caller does not know the exact signature to make the call, darwinpcs requires us to adhere to the prototype, and thus have the correct sizes. If we specify CInt in the FFI call, it should correspond to the C int, and not just be Word sized, when it's only half the size. This does change the expected output of T16402 but the new result is no less correct as it eliminates the narrowing (instead of the `and` as was previously done). Bumps the array, bytestring, text, and binary submodules. Co-Authored-By: Ben Gamari <ben at well-typed.com> Metric Increase: T13701 T14697 - - - - - a84e53f9 by Andreas Klebinger at 2020-11-26T16:00:32-05:00 RTS: Fix failed inlining of copy_tag. On windows using gcc-10 gcc failed to inline copy_tag into evacuate. To fix this we now set the always_inline attribute for the various copy* functions in Evac.c. The main motivation here is not the overhead of the function call, but rather that this allows the code to "specialize" for the size of the closure we copy which is often known at compile time. An earlier commit also tried to avoid evacuate_large inlining. But didn't quite succeed. So I also marked evacuate_large as noinline. Fixes #12416 - - - - - cdbd16f5 by Sylvain Henry at 2020-11-26T16:00:33-05:00 Fix toArgRep to support 64-bit reps on all systems [This is @Ericson2314 writing a commit message for @hsyl20's patch.] (Progress towards #11953, #17377, #17375) `Int64Rep` and `Word64Rep` are currently broken on 64-bit systems. This is because they should use "native arg rep" but instead use "large arg rep" as they do on 32-bit systems, which is either a non-concept or a 128-bit rep depending on one's vantage point. Now, these reps currently aren't used during 64-bit compilation, so the brokenness isn't observed, but I don't think that constitutes reasons not to fix it. Firstly, the linked issues there is a clearly expressed desire to use explicit-bitwidth constructs in more places. Secondly, per [1], there are other bugs that *do* manifest from not threading explicit-bitwidth information all the way through the compilation pipeline. One can therefore view this as one piece of the larger effort to do that, improve ergnomics, and squash remaining bugs. Also, this is needed for !3658. I could just merge this as part of that, but I'm keen on merging fixes "as they are ready" so the fixes that aren't ready are isolated and easier to debug. [1]: https://mail.haskell.org/pipermail/ghc-devs/2020-October/019332.html - - - - - a9378e69 by Tim Barnes at 2020-11-26T16:00:34-05:00 Set dynamic users-guide TOC spacing (fixes #18554) - - - - - 86a59d93 by Ben Gamari at 2020-11-26T16:00:34-05:00 rts: Use RTS_LIKELY in CHECK Most compilers probably already infer that `barf` diverges but it nevertheless doesn't hurt to be explicit. - - - - - 5757e82b by Matthew Pickering at 2020-11-26T16:00:35-05:00 Remove special case for GHC.ByteCode.Instr This was added in https://github.com/nomeata/ghc-heap-view/commit/34935206e51b9c86902481d84d2f368a6fd93423 GHC.ByteCode.Instr.BreakInfo no longer exists so the special case is dead code. Any check like this can be easily dealt with in client code. - - - - - d9c8b5b4 by Matthew Pickering at 2020-11-26T16:00:35-05:00 Split Up getClosureDataFromHeapRep Motivation 1. Don't enforce the repeated decoding of an info table, when the client can cache it (ghc-debug) 2. Allow the constructor information decoding to be overridden, this casues segfaults in ghc-debug - - - - - 3e3555cc by Andreas Klebinger at 2020-11-26T16:00:35-05:00 RegAlloc: Add missing raPlatformfield to RegAllocStatsSpill Fixes #18994 Co-Author: Benjamin Maurer <maurer.benjamin at gmail.com> - - - - - a1a75aa9 by Ben Gamari at 2020-11-27T06:20:41-05:00 rts: Allocate MBlocks with MAP_TOP_DOWN on Windows As noted in #18991, we would previously allocate heap in low memory. Due to this the linker, which typically *needs* low memory, would end up competing with the heap. In longer builds we end up running out of low memory entirely, leading to linking failures. - - - - - 75fc1ed5 by Sylvain Henry at 2020-11-28T15:40:23-05:00 Hadrian: fix detection of ghc-pkg for cross-compilers - - - - - 7cb5df96 by Sylvain Henry at 2020-11-28T15:40:23-05:00 hadrian: fix ghc-pkg uses (#17601) Make sure ghc-pkg doesn't read the compiler "settings" file by passing --no-user-package-db. - - - - - e3fd4226 by Ben Gamari at 2020-11-28T15:40:23-05:00 gitlab-ci: Introduce a nightly cross-compilation job This adds a job to test cross-compilation from x86-64 to AArch64 with Hadrian. Fixes #18234 - - - - - 698d3d96 by Ben Gamari at 2020-11-28T15:41:00-05:00 gitlab-ci: Only deploy GitLab Pages in ghc/ghc> The deployments are quite large and yet are currently only served for the ghc/ghc> project. - - - - - 625726f9 by David Eichmann at 2020-11-28T15:41:37-05:00 ghc-heap: partial TSO/STACK decoding Co-authored-by: Sven Tennie <sven.tennie at gmail.com> Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> Co-authored-by: Ben Gamari <bgamari.foss at gmail.com> - - - - - 22ea9c29 by Andreas Klebinger at 2020-11-28T15:42:13-05:00 Small optimization to CmmSink. Inside `regsUsedIn` we can avoid some thunks by specializing the recursion. In particular we avoid the thunk for `(f e z)` in the MachOp/Load branches, where we know this will evaluate to z. Reduces allocations for T3294 by ~1%. - - - - - bba42c62 by John Ericson at 2020-11-28T15:42:49-05:00 Make primop handler indentation more consistent - - - - - c82bc8e9 by John Ericson at 2020-11-28T15:42:49-05:00 Cleanup some primop constructor names Harmonize the internal (big sum type) names of the native vs fixed-sized number primops a bit. (Mainly by renaming the former.) No user-facing names are changed. - - - - - ae14f160 by Ben Gamari at 2020-11-28T15:43:25-05:00 testsuite: Mark T14702 as fragile on Windows Due to #18953. - - - - - 1bc104b0 by Ben Gamari at 2020-11-29T15:33:18-05:00 withTimings: Emit allocations counter This will allow us to back out the allocations per compiler pass from the eventlog. Note that we dump the allocation counter rather than the difference since this will allow us to determine how much work is done *between* `withTiming` blocks. - - - - - e992ea84 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 ThreadPaused: Don't zero slop until free vars are pushed When threadPaused blackholes a thunk it calls `OVERWRITING_CLOSURE` to zero the slop for the benefit of the sanity checker. Previously this was done *before* pushing the thunk's free variables to the update remembered set. Consequently we would pull zero'd pointers to the update remembered set. - - - - - e82cd140 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Fix regression from TSAN work The TSAN rework (specifically aad1f803) introduced a subtle regression in GC.c, swapping `g0` in place of `gen`. Whoops! Fixes #18997. - - - - - 35a5207e by GHC GitLab CI at 2020-11-29T15:33:54-05:00 rts/Messages: Add missing write barrier in THROWTO message update After a THROWTO message has been handle the message closure is overwritten by a NULL message. We must ensure that the original closure's pointers continue to be visible to the nonmoving GC. - - - - - 0120829f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Add missing write barrier in shrinkSmallByteArray - - - - - 8a4d8fb6 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 Updates: Don't zero slop until closure has been pushed Ensure that the the free variables have been pushed to the update remembered set before we zero the slop. - - - - - 2793cfdc by GHC GitLab CI at 2020-11-29T15:33:54-05:00 OSThreads: Fix error code checking pthread_join returns its error code and apparently doesn't set errno. - - - - - e391a16f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Don't join to mark_thread on shutdown The mark thread is not joinable as we detach from it on creation. - - - - - 60d088ab by Ben Gamari at 2020-11-29T15:33:54-05:00 nonmoving: Add reference to Ueno 2016 - - - - - 3aa60362 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Ensure that evacuated large objects are marked See Note [Non-moving GC: Marking evacuated objects]. - - - - - 8d304a99 by Ben Gamari at 2020-11-30T10:15:22-05:00 rts/m32: Refactor handling of allocator seeding Previously, in an attempt to reduce fragmentation, each new allocator would map a region of M32_MAX_PAGES fresh pages to seed itself. However, this ends up being extremely wasteful since it turns out that we often use fewer than this. Consequently, these pages end up getting freed which, ends up fragmenting our address space more than than we would have if we had naively allocated pages on-demand. Here we refactor m32 to avoid this waste while achieving the fragmentation mitigation previously desired. In particular, we move all page allocation into the global m32_alloc_page, which will pull a page from the free page pool. If the free page pool is empty we then refill it by allocating a region of M32_MAP_PAGES and adding them to the pool. Furthermore, we do away with the initial seeding entirely. That is, the allocator starts with no active pages: pages are rather allocated on an as-needed basis. On the whole this ends up being a pleasingly simple change, simultaneously making m32 more efficient, more robust, and simpler. Fixes #18980. - - - - - b6629289 by Ben Gamari at 2020-11-30T10:15:58-05:00 rts: Use CHECK instead of assert Use the GHC wrappers instead of <assert.h>. - - - - - 9f4efa6a by Ben Gamari at 2020-11-30T10:15:58-05:00 rts/linker: Replace some ASSERTs with CHECK In the past some people have confused ASSERT, which is for checking internal invariants, which CHECK, which should be used when checking things that might fail due to bad input (and therefore should be enabled even in the release compiler). Change some of these cases in the linker to use CHECK. - - - - - 0f8a4655 by Ryan Scott at 2020-11-30T10:16:34-05:00 Allow deploy:pages job to fail See #18973. - - - - - 49ebe369 by chessai at 2020-11-30T19:47:40-05:00 Optimisations in Data.Foldable (T17867) This PR concerns the following functions from `Data.Foldable`: * minimum * maximum * sum * product * minimumBy * maximumBy - Default implementations of these functions now use `foldl'` or `foldMap'`. - All have been marked with INLINEABLE to make room for further optimisations. - - - - - 4d79ef65 by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - 6af074ce by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - ab334262 by Viktor Dukhovni at 2020-11-30T19:48:17-05:00 dirty MVAR after mutating TSO queue head While the original head and tail of the TSO queue may be in the same generation as the MVAR, interior elements of the queue could be younger after a GC run and may then be exposed by putMVar operation that updates the queue head. Resolves #18919 - - - - - 5eb163f3 by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Don't allow shared libraries to be loaded multiple times - - - - - 490aa14d by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Initialise CCSs from native shared objects - - - - - 6ac3db5f by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Move shared library loading logic into Elf.c - - - - - b6698d73 by GHC GitLab CI at 2020-11-30T19:48:53-05:00 rts/linker: Don't declare dynamic objects with image_mapped This previously resulted in warnings due to spurious unmap failures. - - - - - b94a65af by jneira at 2020-11-30T19:49:31-05:00 Include tried paths in findToolDir error - - - - - 72a87fbc by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Move core flattening algorithm to Core.Unify This sets the stage for a later change, where this algorithm will be needed from GHC.Core.InstEnv. This commit also splits GHC.Core.Map into GHC.Core.Map.Type and GHC.Core.Map.Expr, in order to avoid module import cycles with GHC.Core. - - - - - 0dd45d0a by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Bump the # of commits searched for perf baseline The previous value of 75 meant that a feature branch with more than 75 commits would get spurious CI passes. This affects #18692, but does not fix that ticket, because if a baseline cannot be found, we should fail, not succeed. - - - - - 8bb52d91 by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Remove flattening variables This patch redesigns the flattener to simplify type family applications directly instead of using flattening meta-variables and skolems. The key new innovation is the CanEqLHS type and the new CEqCan constraint (Ct). A CanEqLHS is either a type variable or exactly-saturated type family application; either can now be rewritten using a CEqCan constraint in the inert set. Because the flattener no longer reduces all type family applications to variables, there was some performance degradation if a lengthy type family application is now flattened over and over (not making progress). To compensate, this patch contains some extra optimizations in the flattener, leading to a number of performance improvements. Close #18875. Close #18910. There are many extra parts of the compiler that had to be affected in writing this patch: * The family-application cache (formerly the flat-cache) sometimes stores coercions built from Given inerts. When these inerts get kicked out, we must kick out from the cache as well. (This was, I believe, true previously, but somehow never caused trouble.) Kicking out from the cache requires adding a filterTM function to TrieMap. * This patch obviates the need to distinguish "blocking" coercion holes from non-blocking ones (which, previously, arose from CFunEqCans). There is thus some simplification around coercion holes. * Extra commentary throughout parts of the code I read through, to preserve the knowledge I gained while working. * A change in the pure unifier around unifying skolems with other types. Unifying a skolem now leads to SurelyApart, not MaybeApart, as documented in Note [Binding when looking up instances] in GHC.Core.InstEnv. * Some more use of MCoercion where appropriate. * Previously, class-instance lookup automatically noticed that e.g. C Int was a "unifier" to a target [W] C (F Bool), because the F Bool was flattened to a variable. Now, a little more care must be taken around checking for unifying instances. * Previously, tcSplitTyConApp_maybe would split (Eq a => a). This is silly, because (=>) is not a tycon in Haskell. Fixed now, but there are some knock-on changes in e.g. TrieMap code and in the canonicaliser. * New function anyFreeVarsOf{Type,Co} to check whether a free variable satisfies a certain predicate. * Type synonyms now remember whether or not they are "forgetful"; a forgetful synonym drops at least one argument. This is useful when flattening; see flattenView. * The pattern-match completeness checker invokes the solver. This invocation might need to look through newtypes when checking representational equality. Thus, the desugarer needs to keep track of the in-scope variables to know what newtype constructors are in scope. I bet this bug was around before but never noticed. * Extra-constraints wildcards are no longer simplified before printing. See Note [Do not simplify ConstraintHoles] in GHC.Tc.Solver. * Whether or not there are Given equalities has become slightly subtler. See the new HasGivenEqs datatype. * Note [Type variable cycles in Givens] in GHC.Tc.Solver.Canonical explains a significant new wrinkle in the new approach. * See Note [What might match later?] in GHC.Tc.Solver.Interact, which explains the fix to #18910. * The inert_count field of InertCans wasn't actually used, so I removed it. Though I (Richard) did the implementation, Simon PJ was very involved in design and review. This updates the Haddock submodule to avoid #18932 by adding a type signature. ------------------------- Metric Decrease: T12227 T5030 T9872a T9872b T9872c Metric Increase: T9872d ------------------------- - - - - - d66660ba by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Rename the flattener to become the rewriter. Now that flattening doesn't produce flattening variables, it's not really flattening anything: it's rewriting. This change also means that the rewriter can no longer be confused the core flattener (in GHC.Core.Unify), which is sometimes used during type-checking. - - - - - add0aeae by Ben Gamari at 2020-12-01T19:58:17-05:00 rts: Introduce mmapAnonForLinker Previously most of the uses of mmapForLinker were mapping anonymous memory, resulting in a great deal of unnecessary repetition. Factor this out into a new helper. Also fixes a few places where error checking was missing or suboptimal. - - - - - 97d71646 by Ben Gamari at 2020-12-01T19:58:17-05:00 rts/linker: Introduce munmapForLinker Consolidates munmap calls to ensure consistent error handling. - - - - - d8872af0 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/Linker: Introduce Windows implementations for mmapForLinker, et al. - - - - - c35d0e03 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/m32: Introduce NEEDS_M32 macro Instead of relying on RTS_LINKER_USE_MMAP - - - - - 41c64eb5 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/linker: Use m32 to allocate symbol extras in PEi386 - - - - - e0b08c5f by Ben Gamari at 2020-12-03T13:01:47-05:00 gitlab-ci: Fix copy-paste error Also be more consistent in quoting. - - - - - 33ec3a06 by Ben Gamari at 2020-12-03T23:11:31-05:00 gitlab-ci: Run linters through ci.sh Ensuring that the right toolchain is used. - - - - - 4a437bc1 by Shayne Fletcher at 2020-12-05T09:06:38-05:00 Fix bad span calculations of post qualified imports - - - - - 8fac4b93 by Ben Gamari at 2020-12-05T09:07:13-05:00 testsuite: Add a test for #18923 - - - - - 6313ae21 by Simon Peyton Jones at 2020-12-08T13:52:20+00:00 Kill floatEqualities completely This WIP patch over-delivers on #17656. I say "over-delivers" because instead of improving floatEqualities, it kills it off entirely. Instead we use level numbers. There is plenty of dead code to delete, and Notes to write, but for now this a proof of concept, to enable code review. It validates. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/Reg/Graph.hs - compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs - compiler/GHC/CmmToC.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Axiom.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FamInstEnv.hs - compiler/GHC/Core/InstEnv.hs - + compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Map.hs → compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/Opt/CSE.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCon.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/061eee913a913b934845549ba90a4e8381454b1d...6313ae215c19bbde5e1c11c503e8cf51e893b6ea -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/061eee913a913b934845549ba90a4e8381454b1d...6313ae215c19bbde5e1c11c503e8cf51e893b6ea You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 8 14:24:07 2020 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Tue, 08 Dec 2020 09:24:07 -0500 Subject: [Git][ghc/ghc][wip/ghc-dynamic-census] Profiling: Allow heap profiling to be controlled dynamically. Message-ID: <5fcf8c872e2b4_6b2132ee344995ea@gitlab.mail> Matthew Pickering pushed to branch wip/ghc-dynamic-census at Glasgow Haskell Compiler / GHC Commits: 3687de21 by Matthew Pickering at 2020-12-08T14:23:57+00:00 Profiling: Allow heap profiling to be controlled dynamically. This patch exposes three new functions in `GHC.Profiling` which allow heap profiling to be enabled and disabled dynamically. 1. startHeapProfTimer - Starts heap profiling with the given RTS options 2. stopHeapProfTimer - Stops heap profiling 3. requestHeapCensus - Perform a heap census on the next context switch, regardless of whether the timer is enabled or not. - - - - - 12 changed files: - docs/users_guide/9.2.1-notes.rst - docs/users_guide/profiling.rst - includes/Rts.h - includes/rts/Flags.h - + includes/rts/prof/Heap.h - libraries/base/GHC/Profiling.hs - libraries/base/GHC/RTS/Flags.hsc - rts/Proftimer.c - rts/Proftimer.h - rts/RtsFlags.c - rts/Schedule.c - rts/rts.cabal.in Changes: ===================================== docs/users_guide/9.2.1-notes.rst ===================================== @@ -47,7 +47,13 @@ Compiler - There is a significant refactoring in the solver; any type-checker plugins will have to be updated, as GHC no longer uses flattening skolems or flattening metavariables. - + +- The heap profiler can now be controlled from within a Haskell program using + functions in ``GHC.Profiling``. Profiling can be started and stopped or a heap + census requested at a specific point in the program. + There is a new RTS flag :rts-flag:`--no-automatic-heap-samples` which can be + used to stop heap profiling starting when a program starts. + ``ghc-prim`` library ~~~~~~~~~~~~~~~~~~~~ ===================================== docs/users_guide/profiling.rst ===================================== @@ -459,7 +459,7 @@ compiled program. :type: dynamic Deprecated alias for :ghc-flag:`-fprof-auto-exported` - + .. ghc-flag:: -caf-all :shortdesc: *(deprecated)* Alias for :ghc-flag:`-fprof-cafs` :type: dynamic @@ -885,6 +885,13 @@ There are three more options which relate to heap profiling: profiles are always sampled with the frequency of the RTS clock. See :ref:`prof-time-options` for changing that. +.. rts-flag:: --no-automatic-heap-samples + :since: 9.2.1 + + Don't start heap profiling from the start of program executation. If this + option is enabled, it's expected that the user will manually start heap + profiling or request specific samples using functions from ``GHC.Profiling``. + .. rts-flag:: -xt Include the memory occupied by threads in a heap profile. Each ===================================== includes/Rts.h ===================================== @@ -194,6 +194,7 @@ void _assertFail(const char *filename, unsigned int linenum) /* Profiling information */ #include "rts/prof/CCS.h" +#include "rts/prof/Heap.h" #include "rts/prof/LDV.h" /* Parallel information */ ===================================== includes/rts/Flags.h ===================================== @@ -145,6 +145,7 @@ typedef struct _PROFILING_FLAGS { Time heapProfileInterval; /* time between samples */ uint32_t heapProfileIntervalTicks; /* ticks between samples (derived) */ bool includeTSOs; + bool startHeapProfileAtStartup; /* true if we start profiling from program startup */ bool showCCSOnException; ===================================== includes/rts/prof/Heap.h ===================================== @@ -0,0 +1,24 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The University of Glasgow, 2009 + * + * Heap Census Profiling + * + * Do not #include this file directly: #include "Rts.h" instead. + * + * To understand the structure of the RTS headers, see the wiki: + * https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes + * + * ---------------------------------------------------------------------------*/ + +#pragma once + +/* ----------------------------------------------------------------------------- + * Fine-grained control over heap census profiling which can be called from + * Haskell to restrict the profile to portion(s) of the execution. + * See the module GHC.Profiling. + * ---------------------------------------------------------------------------*/ + +void requestHeapCensus ( void ); +void startHeapProfTimer ( void ); +void stopHeapProfTimer ( void ); ===================================== libraries/base/GHC/Profiling.hs ===================================== @@ -2,7 +2,14 @@ {-# LANGUAGE NoImplicitPrelude #-} -- | @since 4.7.0.0 -module GHC.Profiling where +module GHC.Profiling ( -- * Cost Centre Profiling + startProfTimer + , stopProfTimer + -- * Heap Profiling + , startHeapProfTimer + , stopHeapProfTimer + , requestHeapCensus + )where import GHC.Base @@ -17,3 +24,19 @@ foreign import ccall stopProfTimer :: IO () -- -- @since 4.7.0.0 foreign import ccall startProfTimer :: IO () + +-- | Request a heap census on the next context switch. +-- +-- @since 4.16.0.0 +foreign import ccall requestHeapCensus :: IO () + +-- | Start heap profiling. This is called normally by the RTS on start-up, +-- but can be disabled using the rts flag `--no-automatic-gc-intervals` +-- +-- @since 4.16.0.0 +foreign import ccall startHeapProfTimer :: IO () + +-- | Stop heap profiling. +-- +-- @since 4.16.0.0 +foreign import ccall stopHeapProfTimer :: IO () ===================================== libraries/base/GHC/RTS/Flags.hsc ===================================== @@ -289,6 +289,7 @@ data ProfFlags = ProfFlags , heapProfileInterval :: RtsTime -- ^ time between samples , heapProfileIntervalTicks :: Word -- ^ ticks between samples (derived) , includeTSOs :: Bool + , startHeapProfileAtStartup :: Bool , showCCSOnException :: Bool , maxRetainerSetSize :: Word , ccsLength :: Word @@ -586,6 +587,8 @@ getProfFlags = do <*> #{peek PROFILING_FLAGS, heapProfileIntervalTicks} ptr <*> (toBool <$> (#{peek PROFILING_FLAGS, includeTSOs} ptr :: IO CBool)) + <*> (toBool <$> + (#{peek PROFILING_FLAGS, startHeapProfileAtStartup} ptr :: IO CBool)) <*> (toBool <$> (#{peek PROFILING_FLAGS, showCCSOnException} ptr :: IO CBool)) <*> #{peek PROFILING_FLAGS, maxRetainerSetSize} ptr ===================================== rts/Proftimer.c ===================================== @@ -18,7 +18,12 @@ static bool do_prof_ticks = false; // enable profiling ticks #endif -static bool do_heap_prof_ticks = false; // enable heap profiling ticks +static bool do_heap_prof_ticks = false; // Whether the timer is currently ticking down +static bool heap_prof_timer_active = false; // Whether the timer is enabled at all + +/* The heap_prof_timer_active flag controls whether heap profiling is enabled +at all, once it is enabled, the `do_heap_prof_ticks` flag controls whether the +counter is currently counting down. This is paused, for example, in Schedule.c. */ // Sampling of Ticky-Ticky profiler to eventlog #if defined(TICKY_TICKY) && defined(TRACING) @@ -51,18 +56,36 @@ startProfTimer( void ) void stopHeapProfTimer( void ) { - RELAXED_STORE(&do_heap_prof_ticks, false); + RELAXED_STORE(&heap_prof_timer_active, false); + pauseHeapProfTimer(); } void startHeapProfTimer( void ) { + RELAXED_STORE(&heap_prof_timer_active, true); + resumeHeapProfTimer(); +} + +void +pauseHeapProfTimer ( void ) { + RELAXED_STORE(&do_heap_prof_ticks, false); +} + + +void +resumeHeapProfTimer ( void ) { if (RtsFlags.ProfFlags.doHeapProfile && RtsFlags.ProfFlags.heapProfileIntervalTicks > 0) { - do_heap_prof_ticks = true; + RELAXED_STORE(&do_heap_prof_ticks, true); } } +void +requestHeapCensus( void ){ + RELAXED_STORE(&performHeapProfile, true); +} + void initProfTimer( void ) { @@ -70,7 +93,12 @@ initProfTimer( void ) ticks_to_heap_profile = RtsFlags.ProfFlags.heapProfileIntervalTicks; - startHeapProfTimer(); + /* This might look a bit strange but the heap profile timer can + be toggled on/off from within Haskell by calling the startHeapProf + function from within Haskell */ + if (RtsFlags.ProfFlags.startHeapProfileAtStartup){ + startHeapProfTimer(); + } } uint32_t total_ticks = 0; @@ -99,7 +127,7 @@ handleProfTick(void) } #endif - if (RELAXED_LOAD(&do_heap_prof_ticks)) { + if (RELAXED_LOAD(&do_heap_prof_ticks) && RELAXED_LOAD(&heap_prof_timer_active)) { ticks_to_heap_profile--; if (ticks_to_heap_profile <= 0) { ticks_to_heap_profile = RtsFlags.ProfFlags.heapProfileIntervalTicks; ===================================== rts/Proftimer.h ===================================== @@ -12,9 +12,8 @@ void initProfTimer ( void ); void handleProfTick ( void ); - -void stopHeapProfTimer ( void ); -void startHeapProfTimer ( void ); +void pauseHeapProfTimer ( void ); +void resumeHeapProfTimer ( void ); extern bool performHeapProfile; extern bool performTickySample; ===================================== rts/RtsFlags.c ===================================== @@ -211,6 +211,7 @@ void initRtsFlagsDefaults(void) RtsFlags.ProfFlags.doHeapProfile = false; RtsFlags.ProfFlags.heapProfileInterval = USToTime(100000); // 100ms + RtsFlags.ProfFlags.startHeapProfileAtStartup = true; #if defined(PROFILING) RtsFlags.ProfFlags.includeTSOs = false; @@ -390,6 +391,10 @@ usage_text[] = { " -hT Produce a heap profile grouped by closure type", #endif /* PROFILING */ +" -i Time between heap profile samples (seconds, default: 0.1)", +" --no-automatic-heap-samples Do not start the heap profile interval time", +" rely on the user to trigger samples from their application", + #if defined(TRACING) "", " -ol Send binary eventlog to (default: .eventlog)", @@ -415,7 +420,6 @@ usage_text[] = { " the initial enabled event classes are 'sgpu'", #endif -" -i Time between heap profile samples (seconds, default: 0.1)", "", #if defined(TICKY_TICKY) " -r Produce ticky-ticky statistics (with -rstderr for stderr)", @@ -1080,6 +1084,12 @@ error = true; } break; } + else if (strequal("no-automatic-heap-samples", + &rts_argv[arg][2])) { + OPTION_SAFE; + RtsFlags.ProfFlags.startHeapProfileAtStartup = false; + break; + } else { OPTION_SAFE; errorBelch("unknown RTS option: %s",rts_argv[arg]); ===================================== rts/Schedule.c ===================================== @@ -415,7 +415,7 @@ run_thread: // that. cap->r.rCurrentTSO = t; - startHeapProfTimer(); + resumeHeapProfTimer(); // ---------------------------------------------------------------------- // Run the current thread @@ -533,7 +533,7 @@ run_thread: // ---------------------------------------------------------------------- // Costs for the scheduler are assigned to CCS_SYSTEM - stopHeapProfTimer(); + pauseHeapProfTimer(); #if defined(PROFILING) cap->r.rCCCS = CCS_SYSTEM; #endif ===================================== rts/rts.cabal.in ===================================== @@ -180,6 +180,7 @@ library rts/Types.h rts/Utils.h rts/prof/CCS.h + rts/prof/Heap.h rts/prof/LDV.h rts/storage/Block.h rts/storage/ClosureMacros.h View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3687de21f77d5bea938ee328a1b29855cffc8122 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3687de21f77d5bea938ee328a1b29855cffc8122 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 8 14:37:31 2020 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Tue, 08 Dec 2020 09:37:31 -0500 Subject: [Git][ghc/ghc][wip/ghc-dynamic-census] Profiling: Allow heap profiling to be controlled dynamically. Message-ID: <5fcf8fabbba9f_6b211e6fbe4516612@gitlab.mail> Matthew Pickering pushed to branch wip/ghc-dynamic-census at Glasgow Haskell Compiler / GHC Commits: 21285405 by Matthew Pickering at 2020-12-08T14:37:24+00:00 Profiling: Allow heap profiling to be controlled dynamically. This patch exposes three new functions in `GHC.Profiling` which allow heap profiling to be enabled and disabled dynamically. 1. startHeapProfTimer - Starts heap profiling with the given RTS options 2. stopHeapProfTimer - Stops heap profiling 3. requestHeapCensus - Perform a heap census on the next context switch, regardless of whether the timer is enabled or not. - - - - - 12 changed files: - docs/users_guide/9.2.1-notes.rst - docs/users_guide/profiling.rst - includes/Rts.h - includes/rts/Flags.h - + includes/rts/prof/Heap.h - libraries/base/GHC/Profiling.hs - libraries/base/GHC/RTS/Flags.hsc - rts/Proftimer.c - rts/Proftimer.h - rts/RtsFlags.c - rts/Schedule.c - rts/rts.cabal.in Changes: ===================================== docs/users_guide/9.2.1-notes.rst ===================================== @@ -47,7 +47,13 @@ Compiler - There is a significant refactoring in the solver; any type-checker plugins will have to be updated, as GHC no longer uses flattening skolems or flattening metavariables. - + +- The heap profiler can now be controlled from within a Haskell program using + functions in ``GHC.Profiling``. Profiling can be started and stopped or a heap + census requested at a specific point in the program. + There is a new RTS flag :rts-flag:`--no-automatic-heap-samples` which can be + used to stop heap profiling starting when a program starts. + ``ghc-prim`` library ~~~~~~~~~~~~~~~~~~~~ ===================================== docs/users_guide/profiling.rst ===================================== @@ -459,7 +459,7 @@ compiled program. :type: dynamic Deprecated alias for :ghc-flag:`-fprof-auto-exported` - + .. ghc-flag:: -caf-all :shortdesc: *(deprecated)* Alias for :ghc-flag:`-fprof-cafs` :type: dynamic @@ -885,6 +885,13 @@ There are three more options which relate to heap profiling: profiles are always sampled with the frequency of the RTS clock. See :ref:`prof-time-options` for changing that. +.. rts-flag:: --no-automatic-heap-samples + :since: 9.2.1 + + Don't start heap profiling from the start of program executation. If this + option is enabled, it's expected that the user will manually start heap + profiling or request specific samples using functions from ``GHC.Profiling``. + .. rts-flag:: -xt Include the memory occupied by threads in a heap profile. Each ===================================== includes/Rts.h ===================================== @@ -194,6 +194,7 @@ void _assertFail(const char *filename, unsigned int linenum) /* Profiling information */ #include "rts/prof/CCS.h" +#include "rts/prof/Heap.h" #include "rts/prof/LDV.h" /* Parallel information */ ===================================== includes/rts/Flags.h ===================================== @@ -145,6 +145,7 @@ typedef struct _PROFILING_FLAGS { Time heapProfileInterval; /* time between samples */ uint32_t heapProfileIntervalTicks; /* ticks between samples (derived) */ bool includeTSOs; + bool startHeapProfileAtStartup; /* true if we start profiling from program startup */ bool showCCSOnException; ===================================== includes/rts/prof/Heap.h ===================================== @@ -0,0 +1,24 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The University of Glasgow, 2009 + * + * Heap Census Profiling + * + * Do not #include this file directly: #include "Rts.h" instead. + * + * To understand the structure of the RTS headers, see the wiki: + * https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes + * + * ---------------------------------------------------------------------------*/ + +#pragma once + +/* ----------------------------------------------------------------------------- + * Fine-grained control over heap census profiling which can be called from + * Haskell to restrict the profile to portion(s) of the execution. + * See the module GHC.Profiling. + * ---------------------------------------------------------------------------*/ + +void requestHeapCensus ( void ); +void startHeapProfTimer ( void ); +void stopHeapProfTimer ( void ); ===================================== libraries/base/GHC/Profiling.hs ===================================== @@ -2,7 +2,14 @@ {-# LANGUAGE NoImplicitPrelude #-} -- | @since 4.7.0.0 -module GHC.Profiling where +module GHC.Profiling ( -- * Cost Centre Profiling + startProfTimer + , stopProfTimer + -- * Heap Profiling + , startHeapProfTimer + , stopHeapProfTimer + , requestHeapCensus + )where import GHC.Base @@ -17,3 +24,20 @@ foreign import ccall stopProfTimer :: IO () -- -- @since 4.7.0.0 foreign import ccall startProfTimer :: IO () + +-- | Request a heap census on the next context switch. The census can be +-- requested whether or not the heap profiling timer is running. +-- +-- @since 4.16.0.0 +foreign import ccall requestHeapCensus :: IO () + +-- | Start heap profiling. This is called normally by the RTS on start-up, +-- but can be disabled using the rts flag `--no-automatic-heap-samples` +-- +-- @since 4.16.0.0 +foreign import ccall startHeapProfTimer :: IO () + +-- | Stop heap profiling. +-- +-- @since 4.16.0.0 +foreign import ccall stopHeapProfTimer :: IO () ===================================== libraries/base/GHC/RTS/Flags.hsc ===================================== @@ -289,6 +289,7 @@ data ProfFlags = ProfFlags , heapProfileInterval :: RtsTime -- ^ time between samples , heapProfileIntervalTicks :: Word -- ^ ticks between samples (derived) , includeTSOs :: Bool + , startHeapProfileAtStartup :: Bool , showCCSOnException :: Bool , maxRetainerSetSize :: Word , ccsLength :: Word @@ -586,6 +587,8 @@ getProfFlags = do <*> #{peek PROFILING_FLAGS, heapProfileIntervalTicks} ptr <*> (toBool <$> (#{peek PROFILING_FLAGS, includeTSOs} ptr :: IO CBool)) + <*> (toBool <$> + (#{peek PROFILING_FLAGS, startHeapProfileAtStartup} ptr :: IO CBool)) <*> (toBool <$> (#{peek PROFILING_FLAGS, showCCSOnException} ptr :: IO CBool)) <*> #{peek PROFILING_FLAGS, maxRetainerSetSize} ptr ===================================== rts/Proftimer.c ===================================== @@ -18,7 +18,12 @@ static bool do_prof_ticks = false; // enable profiling ticks #endif -static bool do_heap_prof_ticks = false; // enable heap profiling ticks +static bool do_heap_prof_ticks = false; // Whether the timer is currently ticking down +static bool heap_prof_timer_active = false; // Whether the timer is enabled at all + +/* The heap_prof_timer_active flag controls whether heap profiling is enabled +at all, once it is enabled, the `do_heap_prof_ticks` flag controls whether the +counter is currently counting down. This is paused, for example, in Schedule.c. */ // Sampling of Ticky-Ticky profiler to eventlog #if defined(TICKY_TICKY) && defined(TRACING) @@ -51,18 +56,36 @@ startProfTimer( void ) void stopHeapProfTimer( void ) { - RELAXED_STORE(&do_heap_prof_ticks, false); + RELAXED_STORE(&heap_prof_timer_active, false); + pauseHeapProfTimer(); } void startHeapProfTimer( void ) { + RELAXED_STORE(&heap_prof_timer_active, true); + resumeHeapProfTimer(); +} + +void +pauseHeapProfTimer ( void ) { + RELAXED_STORE(&do_heap_prof_ticks, false); +} + + +void +resumeHeapProfTimer ( void ) { if (RtsFlags.ProfFlags.doHeapProfile && RtsFlags.ProfFlags.heapProfileIntervalTicks > 0) { - do_heap_prof_ticks = true; + RELAXED_STORE(&do_heap_prof_ticks, true); } } +void +requestHeapCensus( void ){ + RELAXED_STORE(&performHeapProfile, true); +} + void initProfTimer( void ) { @@ -70,7 +93,12 @@ initProfTimer( void ) ticks_to_heap_profile = RtsFlags.ProfFlags.heapProfileIntervalTicks; - startHeapProfTimer(); + /* This might look a bit strange but the heap profile timer can + be toggled on/off from within Haskell by calling the startHeapProf + function from within Haskell */ + if (RtsFlags.ProfFlags.startHeapProfileAtStartup){ + startHeapProfTimer(); + } } uint32_t total_ticks = 0; @@ -99,7 +127,7 @@ handleProfTick(void) } #endif - if (RELAXED_LOAD(&do_heap_prof_ticks)) { + if (RELAXED_LOAD(&do_heap_prof_ticks) && RELAXED_LOAD(&heap_prof_timer_active)) { ticks_to_heap_profile--; if (ticks_to_heap_profile <= 0) { ticks_to_heap_profile = RtsFlags.ProfFlags.heapProfileIntervalTicks; ===================================== rts/Proftimer.h ===================================== @@ -12,9 +12,8 @@ void initProfTimer ( void ); void handleProfTick ( void ); - -void stopHeapProfTimer ( void ); -void startHeapProfTimer ( void ); +void pauseHeapProfTimer ( void ); +void resumeHeapProfTimer ( void ); extern bool performHeapProfile; extern bool performTickySample; ===================================== rts/RtsFlags.c ===================================== @@ -211,6 +211,7 @@ void initRtsFlagsDefaults(void) RtsFlags.ProfFlags.doHeapProfile = false; RtsFlags.ProfFlags.heapProfileInterval = USToTime(100000); // 100ms + RtsFlags.ProfFlags.startHeapProfileAtStartup = true; #if defined(PROFILING) RtsFlags.ProfFlags.includeTSOs = false; @@ -390,6 +391,10 @@ usage_text[] = { " -hT Produce a heap profile grouped by closure type", #endif /* PROFILING */ +" -i Time between heap profile samples (seconds, default: 0.1)", +" --no-automatic-heap-samples Do not start the heap profile interval timer,", +" rely on the user to trigger samples from their application", + #if defined(TRACING) "", " -ol Send binary eventlog to (default: .eventlog)", @@ -415,7 +420,6 @@ usage_text[] = { " the initial enabled event classes are 'sgpu'", #endif -" -i Time between heap profile samples (seconds, default: 0.1)", "", #if defined(TICKY_TICKY) " -r Produce ticky-ticky statistics (with -rstderr for stderr)", @@ -1080,6 +1084,12 @@ error = true; } break; } + else if (strequal("no-automatic-heap-samples", + &rts_argv[arg][2])) { + OPTION_SAFE; + RtsFlags.ProfFlags.startHeapProfileAtStartup = false; + break; + } else { OPTION_SAFE; errorBelch("unknown RTS option: %s",rts_argv[arg]); ===================================== rts/Schedule.c ===================================== @@ -415,7 +415,7 @@ run_thread: // that. cap->r.rCurrentTSO = t; - startHeapProfTimer(); + resumeHeapProfTimer(); // ---------------------------------------------------------------------- // Run the current thread @@ -533,7 +533,7 @@ run_thread: // ---------------------------------------------------------------------- // Costs for the scheduler are assigned to CCS_SYSTEM - stopHeapProfTimer(); + pauseHeapProfTimer(); #if defined(PROFILING) cap->r.rCCCS = CCS_SYSTEM; #endif ===================================== rts/rts.cabal.in ===================================== @@ -180,6 +180,7 @@ library rts/Types.h rts/Utils.h rts/prof/CCS.h + rts/prof/Heap.h rts/prof/LDV.h rts/storage/Block.h rts/storage/ClosureMacros.h View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/212854051c77dc40ba3bf10f897f20fb7eb669d8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/212854051c77dc40ba3bf10f897f20fb7eb669d8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 8 14:38:31 2020 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Tue, 08 Dec 2020 09:38:31 -0500 Subject: [Git][ghc/ghc][wip/ghc-dynamic-census] Profiling: Allow heap profiling to be controlled dynamically. Message-ID: <5fcf8fe79f74e_6b21258bc705191b4@gitlab.mail> Matthew Pickering pushed to branch wip/ghc-dynamic-census at Glasgow Haskell Compiler / GHC Commits: 7e16280f by Matthew Pickering at 2020-12-08T14:38:21+00:00 Profiling: Allow heap profiling to be controlled dynamically. This patch exposes three new functions in `GHC.Profiling` which allow heap profiling to be enabled and disabled dynamically. 1. startHeapProfTimer - Starts heap profiling with the given RTS options 2. stopHeapProfTimer - Stops heap profiling 3. requestHeapCensus - Perform a heap census on the next context switch, regardless of whether the timer is enabled or not. - - - - - 12 changed files: - docs/users_guide/9.2.1-notes.rst - docs/users_guide/profiling.rst - includes/Rts.h - includes/rts/Flags.h - + includes/rts/prof/Heap.h - libraries/base/GHC/Profiling.hs - libraries/base/GHC/RTS/Flags.hsc - rts/Proftimer.c - rts/Proftimer.h - rts/RtsFlags.c - rts/Schedule.c - rts/rts.cabal.in Changes: ===================================== docs/users_guide/9.2.1-notes.rst ===================================== @@ -47,7 +47,13 @@ Compiler - There is a significant refactoring in the solver; any type-checker plugins will have to be updated, as GHC no longer uses flattening skolems or flattening metavariables. - + +- The heap profiler can now be controlled from within a Haskell program using + functions in ``GHC.Profiling``. Profiling can be started and stopped or a heap + census requested at a specific point in the program. + There is a new RTS flag :rts-flag:`--no-automatic-heap-samples` which can be + used to stop heap profiling starting when a program starts. + ``ghc-prim`` library ~~~~~~~~~~~~~~~~~~~~ ===================================== docs/users_guide/profiling.rst ===================================== @@ -459,7 +459,7 @@ compiled program. :type: dynamic Deprecated alias for :ghc-flag:`-fprof-auto-exported` - + .. ghc-flag:: -caf-all :shortdesc: *(deprecated)* Alias for :ghc-flag:`-fprof-cafs` :type: dynamic @@ -885,6 +885,13 @@ There are three more options which relate to heap profiling: profiles are always sampled with the frequency of the RTS clock. See :ref:`prof-time-options` for changing that. +.. rts-flag:: --no-automatic-heap-samples + :since: 9.2.1 + + Don't start heap profiling from the start of program execution. If this + option is enabled, it's expected that the user will manually start heap + profiling or request specific samples using functions from ``GHC.Profiling``. + .. rts-flag:: -xt Include the memory occupied by threads in a heap profile. Each ===================================== includes/Rts.h ===================================== @@ -194,6 +194,7 @@ void _assertFail(const char *filename, unsigned int linenum) /* Profiling information */ #include "rts/prof/CCS.h" +#include "rts/prof/Heap.h" #include "rts/prof/LDV.h" /* Parallel information */ ===================================== includes/rts/Flags.h ===================================== @@ -145,6 +145,7 @@ typedef struct _PROFILING_FLAGS { Time heapProfileInterval; /* time between samples */ uint32_t heapProfileIntervalTicks; /* ticks between samples (derived) */ bool includeTSOs; + bool startHeapProfileAtStartup; /* true if we start profiling from program startup */ bool showCCSOnException; ===================================== includes/rts/prof/Heap.h ===================================== @@ -0,0 +1,24 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The University of Glasgow, 2009 + * + * Heap Census Profiling + * + * Do not #include this file directly: #include "Rts.h" instead. + * + * To understand the structure of the RTS headers, see the wiki: + * https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes + * + * ---------------------------------------------------------------------------*/ + +#pragma once + +/* ----------------------------------------------------------------------------- + * Fine-grained control over heap census profiling which can be called from + * Haskell to restrict the profile to portion(s) of the execution. + * See the module GHC.Profiling. + * ---------------------------------------------------------------------------*/ + +void requestHeapCensus ( void ); +void startHeapProfTimer ( void ); +void stopHeapProfTimer ( void ); ===================================== libraries/base/GHC/Profiling.hs ===================================== @@ -2,7 +2,14 @@ {-# LANGUAGE NoImplicitPrelude #-} -- | @since 4.7.0.0 -module GHC.Profiling where +module GHC.Profiling ( -- * Cost Centre Profiling + startProfTimer + , stopProfTimer + -- * Heap Profiling + , startHeapProfTimer + , stopHeapProfTimer + , requestHeapCensus + )where import GHC.Base @@ -17,3 +24,20 @@ foreign import ccall stopProfTimer :: IO () -- -- @since 4.7.0.0 foreign import ccall startProfTimer :: IO () + +-- | Request a heap census on the next context switch. The census can be +-- requested whether or not the heap profiling timer is running. +-- +-- @since 4.16.0.0 +foreign import ccall requestHeapCensus :: IO () + +-- | Start heap profiling. This is called normally by the RTS on start-up, +-- but can be disabled using the rts flag `--no-automatic-heap-samples` +-- +-- @since 4.16.0.0 +foreign import ccall startHeapProfTimer :: IO () + +-- | Stop heap profiling. +-- +-- @since 4.16.0.0 +foreign import ccall stopHeapProfTimer :: IO () ===================================== libraries/base/GHC/RTS/Flags.hsc ===================================== @@ -289,6 +289,7 @@ data ProfFlags = ProfFlags , heapProfileInterval :: RtsTime -- ^ time between samples , heapProfileIntervalTicks :: Word -- ^ ticks between samples (derived) , includeTSOs :: Bool + , startHeapProfileAtStartup :: Bool , showCCSOnException :: Bool , maxRetainerSetSize :: Word , ccsLength :: Word @@ -586,6 +587,8 @@ getProfFlags = do <*> #{peek PROFILING_FLAGS, heapProfileIntervalTicks} ptr <*> (toBool <$> (#{peek PROFILING_FLAGS, includeTSOs} ptr :: IO CBool)) + <*> (toBool <$> + (#{peek PROFILING_FLAGS, startHeapProfileAtStartup} ptr :: IO CBool)) <*> (toBool <$> (#{peek PROFILING_FLAGS, showCCSOnException} ptr :: IO CBool)) <*> #{peek PROFILING_FLAGS, maxRetainerSetSize} ptr ===================================== rts/Proftimer.c ===================================== @@ -18,7 +18,12 @@ static bool do_prof_ticks = false; // enable profiling ticks #endif -static bool do_heap_prof_ticks = false; // enable heap profiling ticks +static bool do_heap_prof_ticks = false; // Whether the timer is currently ticking down +static bool heap_prof_timer_active = false; // Whether the timer is enabled at all + +/* The heap_prof_timer_active flag controls whether heap profiling is enabled +at all, once it is enabled, the `do_heap_prof_ticks` flag controls whether the +counter is currently counting down. This is paused, for example, in Schedule.c. */ // Sampling of Ticky-Ticky profiler to eventlog #if defined(TICKY_TICKY) && defined(TRACING) @@ -51,18 +56,36 @@ startProfTimer( void ) void stopHeapProfTimer( void ) { - RELAXED_STORE(&do_heap_prof_ticks, false); + RELAXED_STORE(&heap_prof_timer_active, false); + pauseHeapProfTimer(); } void startHeapProfTimer( void ) { + RELAXED_STORE(&heap_prof_timer_active, true); + resumeHeapProfTimer(); +} + +void +pauseHeapProfTimer ( void ) { + RELAXED_STORE(&do_heap_prof_ticks, false); +} + + +void +resumeHeapProfTimer ( void ) { if (RtsFlags.ProfFlags.doHeapProfile && RtsFlags.ProfFlags.heapProfileIntervalTicks > 0) { - do_heap_prof_ticks = true; + RELAXED_STORE(&do_heap_prof_ticks, true); } } +void +requestHeapCensus( void ){ + RELAXED_STORE(&performHeapProfile, true); +} + void initProfTimer( void ) { @@ -70,7 +93,12 @@ initProfTimer( void ) ticks_to_heap_profile = RtsFlags.ProfFlags.heapProfileIntervalTicks; - startHeapProfTimer(); + /* This might look a bit strange but the heap profile timer can + be toggled on/off from within Haskell by calling the startHeapProf + function from within Haskell */ + if (RtsFlags.ProfFlags.startHeapProfileAtStartup){ + startHeapProfTimer(); + } } uint32_t total_ticks = 0; @@ -99,7 +127,7 @@ handleProfTick(void) } #endif - if (RELAXED_LOAD(&do_heap_prof_ticks)) { + if (RELAXED_LOAD(&do_heap_prof_ticks) && RELAXED_LOAD(&heap_prof_timer_active)) { ticks_to_heap_profile--; if (ticks_to_heap_profile <= 0) { ticks_to_heap_profile = RtsFlags.ProfFlags.heapProfileIntervalTicks; ===================================== rts/Proftimer.h ===================================== @@ -12,9 +12,8 @@ void initProfTimer ( void ); void handleProfTick ( void ); - -void stopHeapProfTimer ( void ); -void startHeapProfTimer ( void ); +void pauseHeapProfTimer ( void ); +void resumeHeapProfTimer ( void ); extern bool performHeapProfile; extern bool performTickySample; ===================================== rts/RtsFlags.c ===================================== @@ -211,6 +211,7 @@ void initRtsFlagsDefaults(void) RtsFlags.ProfFlags.doHeapProfile = false; RtsFlags.ProfFlags.heapProfileInterval = USToTime(100000); // 100ms + RtsFlags.ProfFlags.startHeapProfileAtStartup = true; #if defined(PROFILING) RtsFlags.ProfFlags.includeTSOs = false; @@ -390,6 +391,10 @@ usage_text[] = { " -hT Produce a heap profile grouped by closure type", #endif /* PROFILING */ +" -i Time between heap profile samples (seconds, default: 0.1)", +" --no-automatic-heap-samples Do not start the heap profile interval timer,", +" rely on the user to trigger samples from their application", + #if defined(TRACING) "", " -ol Send binary eventlog to (default: .eventlog)", @@ -415,7 +420,6 @@ usage_text[] = { " the initial enabled event classes are 'sgpu'", #endif -" -i Time between heap profile samples (seconds, default: 0.1)", "", #if defined(TICKY_TICKY) " -r Produce ticky-ticky statistics (with -rstderr for stderr)", @@ -1080,6 +1084,12 @@ error = true; } break; } + else if (strequal("no-automatic-heap-samples", + &rts_argv[arg][2])) { + OPTION_SAFE; + RtsFlags.ProfFlags.startHeapProfileAtStartup = false; + break; + } else { OPTION_SAFE; errorBelch("unknown RTS option: %s",rts_argv[arg]); ===================================== rts/Schedule.c ===================================== @@ -415,7 +415,7 @@ run_thread: // that. cap->r.rCurrentTSO = t; - startHeapProfTimer(); + resumeHeapProfTimer(); // ---------------------------------------------------------------------- // Run the current thread @@ -533,7 +533,7 @@ run_thread: // ---------------------------------------------------------------------- // Costs for the scheduler are assigned to CCS_SYSTEM - stopHeapProfTimer(); + pauseHeapProfTimer(); #if defined(PROFILING) cap->r.rCCCS = CCS_SYSTEM; #endif ===================================== rts/rts.cabal.in ===================================== @@ -180,6 +180,7 @@ library rts/Types.h rts/Utils.h rts/prof/CCS.h + rts/prof/Heap.h rts/prof/LDV.h rts/storage/Block.h rts/storage/ClosureMacros.h View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7e16280f2f498d165c77efd3ce794b10d3aa064d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7e16280f2f498d165c77efd3ce794b10d3aa064d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 8 14:51:46 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 08 Dec 2020 09:51:46 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Fix bad span calculations of post qualified imports Message-ID: <5fcf930268877_6b21258bc70528630@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 4a437bc1 by Shayne Fletcher at 2020-12-05T09:06:38-05:00 Fix bad span calculations of post qualified imports - - - - - 8fac4b93 by Ben Gamari at 2020-12-05T09:07:13-05:00 testsuite: Add a test for #18923 - - - - - 7e6db8eb by Simon Peyton Jones at 2020-12-08T09:51:34-05:00 Fix kind inference for data types. Again. This patch fixes several aspects of kind inference for data type declarations, especially data /instance/ declarations Specifically 1. In kcConDecls/kcConDecl make it clear that the tc_res_kind argument is only used in the H98 case; and in that case there is no result kind signature; and hence no need for the disgusting splitPiTys in kcConDecls (now thankfully gone). The GADT case is a bit different to before, and much nicer. This is what fixes #18891. See Note [kcConDecls: kind-checking data type decls] 2. Do not look at the constructor decls of a data/newtype instance in tcDataFamInstanceHeader. See GHC.Tc.TyCl.Instance Note [Kind inference for data family instances]. This was a new realisation that arose when doing (1) This causes a few knock-on effects in the tests suite, because we require more information than before in the instance /header/. New user-manual material about this in "Kind inference in data type declarations" and "Kind inference for data/newtype instance declarations". 3. Minor improvement in kcTyClDecl, combining GADT and H98 cases 4. Fix #14111 and #8707 by allowing the header of a data instance to affect kind inferece for the the data constructor signatures; as described at length in Note [GADT return types] in GHC.Tc.TyCl This led to a modest refactoring of the arguments (and argument order) of tcConDecl/tcConDecls. 5. Fix #19000 by inverting the sense of the test in new_locs in GHC.Tc.Solver.Canonical.canDecomposableTyConAppOK. - - - - - 5cb804df by Adam Sandberg Ericsson at 2020-12-08T09:51:36-05:00 hadrian: build the _l and _thr_l rts flavours in the develN flavours The ghc binary requires the eventlog rts since fc644b1a643128041cfec25db84e417851e28bab - - - - - 30 changed files: - compiler/GHC/Hs/Extension.hs - compiler/GHC/Parser.y - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Instance.hs - docs/users_guide/9.2.1-notes.rst - docs/users_guide/exts/poly_kinds.rst - hadrian/src/Settings/Flavours/Development.hs - testsuite/tests/dependent/should_fail/T13780a.stderr - testsuite/tests/deriving/should_compile/T11416.hs - testsuite/tests/deriving/should_compile/T9359.hs - + testsuite/tests/gadt/SynDataRec.hs - testsuite/tests/gadt/all.T - + testsuite/tests/indexed-types/should_compile/T14111.hs - + testsuite/tests/indexed-types/should_compile/T8707.hs - testsuite/tests/indexed-types/should_compile/all.T - testsuite/tests/indexed-types/should_fail/T8368.stderr - testsuite/tests/indexed-types/should_fail/T8368a.stderr - testsuite/tests/module/all.T - + testsuite/tests/module/mod185.hs - + testsuite/tests/module/mod185.stderr - testsuite/tests/patsyn/should_fail/T15685.stderr - + testsuite/tests/perf/compiler/T18923.hs - testsuite/tests/perf/compiler/all.T - testsuite/tests/polykinds/T13659.stderr - testsuite/tests/polykinds/T16221a.stderr - testsuite/tests/th/T11145.stderr - testsuite/tests/th/T9692.hs - + testsuite/tests/typecheck/should_compile/T18891.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8730d5679a4a2a09db1683a5b680a9a250282917...5cb804dfbb39f214f8bfe4fbc0c1380825b3d912 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8730d5679a4a2a09db1683a5b680a9a250282917...5cb804dfbb39f214f8bfe4fbc0c1380825b3d912 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 8 18:09:06 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 08 Dec 2020 13:09:06 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/T19030 Message-ID: <5fcfc14249434_6b211805218557193@gitlab.mail> Ben Gamari pushed new branch wip/T19030 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T19030 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 8 18:47:10 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 08 Dec 2020 13:47:10 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/gc-events Message-ID: <5fcfca2e870b7_6b2113d8dc057161b@gitlab.mail> Ben Gamari pushed new branch wip/gc-events at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/gc-events You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 8 19:03:52 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 08 Dec 2020 14:03:52 -0500 Subject: [Git][ghc/ghc][wip/gc-events] users guide: Describe GC lifecycle events Message-ID: <5fcfce183b7a1_6b2132ee345738a6@gitlab.mail> Ben Gamari pushed to branch wip/gc-events at Glasgow Haskell Compiler / GHC Commits: 7b5a31a9 by Ben Gamari at 2020-12-08T14:02:58-05:00 users guide: Describe GC lifecycle events Every time I am asked about how to interpret these events I need to figure it out from scratch. It's well past time that the users guide properly documents these. - - - - - 2 changed files: - docs/users_guide/eventlog-formats.rst - docs/users_guide/runtime_control.rst Changes: ===================================== docs/users_guide/eventlog-formats.rst ===================================== @@ -207,9 +207,59 @@ Thread and scheduling events :base-ref:`Control.Concurrent.setThreadLabel`). +.. _gc-events: + Garbage collector events ~~~~~~~~~~~~~~~~~~~~~~~~ +The following events mark various points of the lifecycle of a moving garbage +collection. + +A typical garbage collection will look something like the following: + +1. A capability realizes that it needs a garbage collection (e.g. as a result + of running out of nursery) and requests a garbage collection collection. + This is marked by :event-type:`REQUEST_SEQ_GC` or + :event-type:`REQUEST_PAR_GC`. + +2. Other capabilities reach yield points and stop execution + (marked by :event-type:`STOP_THREAD` events) + +3. When all capabilities have suspended work on collection will begin, marked by + a :event-type:`GC_START` event. + +4. As parallel GC threads start working they will emit :event-type:`GC_WORK` events. + +5. If a parallel GC thread runs out of work it will emit a + :event-type:`GC_IDLE` event. If it is later handed more work it will emit + another :event-type:`GC_WORK` event. + +6. Eventually when the collection has finished a :event-type:`GC_DONE` event + will be emitted. + +7. A :event-type:`GC_END` event will be emitted marking the end of the GC cycle. + +8. A :event-type:`HEAP_SIZE` event will be emitted giving the + total allocations of the program up until now. + +9. A :event-type:`GC_STATS_GHC` event will be emitted + containing various details of the collection. + +10. In the case of a major collection, a + :event-type:`HEAP_LIVE` event will be emitted describing + the current size of the live on-heap data. + +11. In the case of the :ghc-flag:`-threaded` RTS, a + :event-type:`SPARK_COUNTERS` event will be emitted giving + details on how many sparks have been created, evaluated, and collected. + +12. As threads resume execution :event-type:`RUN_THREAD` + events will be emitted. + +Note that in the case of the concurrent non-moving collector additional events +will be emitted during the concurrent phase of collection. These are described +in :ref:`nonmoving-gc-events`. + .. event-type:: GC_START :tag: 9 @@ -685,6 +735,46 @@ These events mark various stages of the :rts-flag:`non-moving collection <--nonmoving-gc>` lifecycle. These are enabled with the ``+RTS -lg`` event-set. +A typical non-moving collection cycle will look something like the following: + +1. The preparatory phase of collection will emit the usual events associated + with a moving collection. See :ref:`gc-events` for details. + +2. The concurrent write barrier is enabled and the concurrent mark thread is + started. From this point forward mutator threads may emit + :event-type:`CONC_UPD_REM_SET_FLUSH` events, indicating that they have + flushed their capability-local update remembered sets. + +3. Concurrent marking begins, denoted by a :event-type:`CONC_MARK_BEGIN` event. + +4. When the mark queue is depleted a :event-type:`CONC_MARK_END` is emitted. + +5. If necessary (e.g. due to weak pointer marking), the marking process will + continue, returning to step (3) above. + +6. When the collector has done as much concurrent marking as it can it will + enter the post-mark synchronization phase of collection, denoted by a + :event-type:`CONC_SYNC_BEGIN` event. + +7. Mutator threads will suspend execution and, if necessary, flush their update + remembered sets (indicated by :event-type:`CONC_UPD_REM_SET_FLUSH` events). + +8. The collector will do any final marking necessary (indicated by + :event-type:`CONC_MARK_BEGIN` and :event-type:`CONC_MARK_END` events). + +9. The collector will do a small amount of sweeping, disable the write barrier, + emit a :event-type:`CONC_SYNC_END` event, and allow mutators to resume + +10. The collector will begin the concurrent sweep phase, indicated by a + :event-type:`CONC_SWEEP_BEGIN` event. + +11. Once sweeping has concluded a :event-type:`CONC_SWEEP_END` event will be + emitted and the concurrent collector thread will terminate. + +12. A :event-type:`NONMOVING_HEAP_CENSUS` event will be emitted describing the + fragmentation state of the non-moving heap. + + .. event-type:: CONC_MARK_BEGIN :tag: 200 @@ -742,8 +832,9 @@ with the ``+RTS -lg`` event-set. Non-moving heap census ~~~~~~~~~~~~~~~~~~~~~~ -The non-moving heap census events (enabled with the ``+RTS -ln`` event-set) are -intended to provide insight into fragmentation of the non-moving heap. +The non-moving heap census events (enabled with the :rts-flag:`+RTS -ln <-l>` +event-set) are intended to provide insight into fragmentation of the non-moving +heap. .. event-type:: NONMOVING_HEAP_CENSUS @@ -760,8 +851,8 @@ Ticky counters ~~~~~~~~~~~~~~ Programs compiled with :ghc-flag:`-ticky` and :ghc-flag:`-eventlog` and invoked -with ``+RTS -lT`` will emit periodic samples of the ticky entry counters to the -eventlog. +with :rts-flag:`+RTS -lT <-l>` will emit periodic samples of the ticky entry +counters to the eventlog. .. event-type:: TICKY_COUNTER_DEF ===================================== docs/users_guide/runtime_control.rst ===================================== @@ -1194,6 +1194,9 @@ When the program is linked with the :ghc-flag:`-eventlog` option - ``f`` — parallel sparks (fully accurate). Disabled by default. + - ``T`` — :rts-flag:`ticky-ticky profiler <-ticky>` events. Disabled by + default. + - ``u`` — user events. These are events emitted from Haskell code using functions such as ``Debug.Trace.traceEvent``. Enabled by default. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7b5a31a9aa8d149e07e62c2e60603109fa4effa2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7b5a31a9aa8d149e07e62c2e60603109fa4effa2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 8 19:11:55 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 08 Dec 2020 14:11:55 -0500 Subject: [Git][ghc/ghc][wip/gc-events] users guide: Describe GC lifecycle events Message-ID: <5fcfcffb1ad92_6b212077e005785ad@gitlab.mail> Ben Gamari pushed to branch wip/gc-events at Glasgow Haskell Compiler / GHC Commits: ace9c8c4 by Ben Gamari at 2020-12-08T14:11:36-05:00 users guide: Describe GC lifecycle events Every time I am asked about how to interpret these events I need to figure it out from scratch. It's well past time that the users guide properly documents these. - - - - - 2 changed files: - docs/users_guide/eventlog-formats.rst - docs/users_guide/runtime_control.rst Changes: ===================================== docs/users_guide/eventlog-formats.rst ===================================== @@ -207,9 +207,59 @@ Thread and scheduling events :base-ref:`Control.Concurrent.setThreadLabel`). +.. _gc-events: + Garbage collector events ~~~~~~~~~~~~~~~~~~~~~~~~ +The following events mark various points of the lifecycle of a moving garbage +collection. + +A typical garbage collection will look something like the following: + +1. A capability realizes that it needs a garbage collection (e.g. as a result + of running out of nursery) and requests a garbage collection. This is + marked by :event-type:`REQUEST_SEQ_GC` or :event-type:`REQUEST_PAR_GC`. + +2. As other capabilities reach yield points and suspend execution they emit + :event-type:`STOP_THREAD` events. + +3. When all capabilities have suspended execution, collection will begin, + marked by a :event-type:`GC_START` event. + +4. As individual parallel GC threads commence with scavenging they will emit + :event-type:`GC_WORK` events. + +5. If a parallel GC thread runs out of work it will emit a + :event-type:`GC_IDLE` event. If it is later handed more work it will emit + another :event-type:`GC_WORK` event. + +6. Eventually when the collection has finished a :event-type:`GC_DONE` event + will be emitted. + +7. A :event-type:`GC_END` event will be emitted marking the end of the GC cycle. + +8. A :event-type:`HEAP_SIZE` event will be emitted giving the + cumulative heap allocations of the program until now. + +9. A :event-type:`GC_STATS_GHC` event will be emitted + containing various details of the collection and heap state. + +10. In the case of a major collection, a + :event-type:`HEAP_LIVE` event will be emitted describing + the current size of the live on-heap data. + +11. In the case of the :ghc-flag:`-threaded` RTS, a + :event-type:`SPARK_COUNTERS` event will be emitted giving + details on how many sparks have been created, evaluated, and GC'd. + +12. As mutator threads resume execution they will emit :event-type:`RUN_THREAD` + events. + +Note that in the case of the concurrent non-moving collector additional events +will be emitted during the concurrent phase of collection. These are described +in :ref:`nonmoving-gc-events`. + .. event-type:: GC_START :tag: 9 @@ -685,6 +735,46 @@ These events mark various stages of the :rts-flag:`non-moving collection <--nonmoving-gc>` lifecycle. These are enabled with the ``+RTS -lg`` event-set. +A typical non-moving collection cycle will look something like the following: + +1. The preparatory phase of collection will emit the usual events associated + with a moving collection. See :ref:`gc-events` for details. + +2. The concurrent write barrier is enabled and the concurrent mark thread is + started. From this point forward mutator threads may emit + :event-type:`CONC_UPD_REM_SET_FLUSH` events, indicating that they have + flushed their capability-local update remembered sets. + +3. Concurrent marking begins, denoted by a :event-type:`CONC_MARK_BEGIN` event. + +4. When the mark queue is depleted a :event-type:`CONC_MARK_END` is emitted. + +5. If necessary (e.g. due to weak pointer marking), the marking process will + continue, returning to step (3) above. + +6. When the collector has done as much concurrent marking as it can it will + enter the post-mark synchronization phase of collection, denoted by a + :event-type:`CONC_SYNC_BEGIN` event. + +7. Mutator threads will suspend execution and, if necessary, flush their update + remembered sets (indicated by :event-type:`CONC_UPD_REM_SET_FLUSH` events). + +8. The collector will do any final marking necessary (indicated by + :event-type:`CONC_MARK_BEGIN` and :event-type:`CONC_MARK_END` events). + +9. The collector will do a small amount of sweeping, disable the write barrier, + emit a :event-type:`CONC_SYNC_END` event, and allow mutators to resume + +10. The collector will begin the concurrent sweep phase, indicated by a + :event-type:`CONC_SWEEP_BEGIN` event. + +11. Once sweeping has concluded a :event-type:`CONC_SWEEP_END` event will be + emitted and the concurrent collector thread will terminate. + +12. A :event-type:`NONMOVING_HEAP_CENSUS` event will be emitted describing the + fragmentation state of the non-moving heap. + + .. event-type:: CONC_MARK_BEGIN :tag: 200 @@ -742,8 +832,9 @@ with the ``+RTS -lg`` event-set. Non-moving heap census ~~~~~~~~~~~~~~~~~~~~~~ -The non-moving heap census events (enabled with the ``+RTS -ln`` event-set) are -intended to provide insight into fragmentation of the non-moving heap. +The non-moving heap census events (enabled with the :rts-flag:`+RTS -ln <-l>` +event-set) are intended to provide insight into fragmentation of the non-moving +heap. .. event-type:: NONMOVING_HEAP_CENSUS @@ -760,8 +851,8 @@ Ticky counters ~~~~~~~~~~~~~~ Programs compiled with :ghc-flag:`-ticky` and :ghc-flag:`-eventlog` and invoked -with ``+RTS -lT`` will emit periodic samples of the ticky entry counters to the -eventlog. +with :rts-flag:`+RTS -lT <-l>` will emit periodic samples of the ticky entry +counters to the eventlog. .. event-type:: TICKY_COUNTER_DEF ===================================== docs/users_guide/runtime_control.rst ===================================== @@ -1194,6 +1194,9 @@ When the program is linked with the :ghc-flag:`-eventlog` option - ``f`` — parallel sparks (fully accurate). Disabled by default. + - ``T`` — :rts-flag:`ticky-ticky profiler <-ticky>` events. Disabled by + default. + - ``u`` — user events. These are events emitted from Haskell code using functions such as ``Debug.Trace.traceEvent``. Enabled by default. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ace9c8c4e06d825579be5f4621169aff83c546ff -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ace9c8c4e06d825579be5f4621169aff83c546ff You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 8 19:40:46 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 08 Dec 2020 14:40:46 -0500 Subject: [Git][ghc/ghc][wip/gc-events] users guide: Describe GC lifecycle events Message-ID: <5fcfd6bed9277_6b21258bc705809e6@gitlab.mail> Ben Gamari pushed to branch wip/gc-events at Glasgow Haskell Compiler / GHC Commits: e1d86b13 by Ben Gamari at 2020-12-08T14:40:25-05:00 users guide: Describe GC lifecycle events Every time I am asked about how to interpret these events I need to figure it out from scratch. It's well past time that the users guide properly documents these. - - - - - 3 changed files: - docs/users_guide/eventlog-formats.rst - docs/users_guide/runtime_control.rst - rts/Stats.c Changes: ===================================== docs/users_guide/eventlog-formats.rst ===================================== @@ -207,9 +207,61 @@ Thread and scheduling events :base-ref:`Control.Concurrent.setThreadLabel`). +.. _gc-events: + Garbage collector events ~~~~~~~~~~~~~~~~~~~~~~~~ +The following events mark various points of the lifecycle of a moving garbage +collection. + +A typical garbage collection will look something like the following: + +1. A capability realizes that it needs a garbage collection (e.g. as a result + of running out of nursery) and requests a garbage collection. This is + marked by :event-type:`REQUEST_SEQ_GC` or :event-type:`REQUEST_PAR_GC`. + +2. As other capabilities reach yield points and suspend execution they emit + :event-type:`STOP_THREAD` events. + +3. When all capabilities have suspended execution, collection will begin, + marked by a :event-type:`GC_START` event. + +4. As individual parallel GC threads commence with scavenging they will emit + :event-type:`GC_WORK` events. + +5. If a parallel GC thread runs out of work it will emit a + :event-type:`GC_IDLE` event. If it is later handed more work it will emit + another :event-type:`GC_WORK` event. + +6. Eventually when scavenging has finished a :event-type:`GC_DONE` event + will be emitted by each GC thread. + +7. A bit of book-keeping is performed. + +8. A :event-type:`GC_END` event will be emitted marking the end of the GC cycle. + +9. A :event-type:`HEAP_SIZE` event will be emitted giving the + cumulative heap allocations of the program until now. + +10. A :event-type:`GC_STATS_GHC` event will be emitted + containing various details of the collection and heap state. + +11. In the case of a major collection, a + :event-type:`HEAP_LIVE` event will be emitted describing + the current size of the live on-heap data. + +12. In the case of the :ghc-flag:`-threaded` RTS, a + :event-type:`SPARK_COUNTERS` event will be emitted giving + details on how many sparks have been created, evaluated, and GC'd. + +13. As mutator threads resume execution they will emit :event-type:`RUN_THREAD` + events. + +Note that in the case of the concurrent non-moving collector additional events +will be emitted during the concurrent phase of collection. These are described +in :ref:`nonmoving-gc-events`. + .. event-type:: GC_START :tag: 9 @@ -685,6 +737,46 @@ These events mark various stages of the :rts-flag:`non-moving collection <--nonmoving-gc>` lifecycle. These are enabled with the ``+RTS -lg`` event-set. +A typical non-moving collection cycle will look something like the following: + +1. The preparatory phase of collection will emit the usual events associated + with a moving collection. See :ref:`gc-events` for details. + +2. The concurrent write barrier is enabled and the concurrent mark thread is + started. From this point forward mutator threads may emit + :event-type:`CONC_UPD_REM_SET_FLUSH` events, indicating that they have + flushed their capability-local update remembered sets. + +3. Concurrent marking begins, denoted by a :event-type:`CONC_MARK_BEGIN` event. + +4. When the mark queue is depleted a :event-type:`CONC_MARK_END` is emitted. + +5. If necessary (e.g. due to weak pointer marking), the marking process will + continue, returning to step (3) above. + +6. When the collector has done as much concurrent marking as it can it will + enter the post-mark synchronization phase of collection, denoted by a + :event-type:`CONC_SYNC_BEGIN` event. + +7. Mutator threads will suspend execution and, if necessary, flush their update + remembered sets (indicated by :event-type:`CONC_UPD_REM_SET_FLUSH` events). + +8. The collector will do any final marking necessary (indicated by + :event-type:`CONC_MARK_BEGIN` and :event-type:`CONC_MARK_END` events). + +9. The collector will do a small amount of sweeping, disable the write barrier, + emit a :event-type:`CONC_SYNC_END` event, and allow mutators to resume + +10. The collector will begin the concurrent sweep phase, indicated by a + :event-type:`CONC_SWEEP_BEGIN` event. + +11. Once sweeping has concluded a :event-type:`CONC_SWEEP_END` event will be + emitted and the concurrent collector thread will terminate. + +12. A :event-type:`NONMOVING_HEAP_CENSUS` event will be emitted describing the + fragmentation state of the non-moving heap. + + .. event-type:: CONC_MARK_BEGIN :tag: 200 @@ -742,8 +834,9 @@ with the ``+RTS -lg`` event-set. Non-moving heap census ~~~~~~~~~~~~~~~~~~~~~~ -The non-moving heap census events (enabled with the ``+RTS -ln`` event-set) are -intended to provide insight into fragmentation of the non-moving heap. +The non-moving heap census events (enabled with the :rts-flag:`+RTS -ln <-l>` +event-set) are intended to provide insight into fragmentation of the non-moving +heap. .. event-type:: NONMOVING_HEAP_CENSUS @@ -760,8 +853,8 @@ Ticky counters ~~~~~~~~~~~~~~ Programs compiled with :ghc-flag:`-ticky` and :ghc-flag:`-eventlog` and invoked -with ``+RTS -lT`` will emit periodic samples of the ticky entry counters to the -eventlog. +with :rts-flag:`+RTS -lT <-l>` will emit periodic samples of the ticky entry +counters to the eventlog. .. event-type:: TICKY_COUNTER_DEF ===================================== docs/users_guide/runtime_control.rst ===================================== @@ -1194,6 +1194,9 @@ When the program is linked with the :ghc-flag:`-eventlog` option - ``f`` — parallel sparks (fully accurate). Disabled by default. + - ``T`` — :rts-flag:`ticky-ticky profiler <-ticky>` events. Disabled by + default. + - ``u`` — user events. These are events emitted from Haskell code using functions such as ``Debug.Trace.traceEvent``. Enabled by default. ===================================== rts/Stats.c ===================================== @@ -570,7 +570,7 @@ stat_endGC (Capability *cap, gc_thread *initiating_gct, W_ live, W_ copied, W_ s // Emit events to the event log // Has to be emitted while all caps stopped for GC, but before GC_END. - // See trac.haskell.org/ThreadScope/wiki/RTSsummaryEvents + // See https://gitlab.haskell.org/ghc/ghc/-/wikis/RTSsummaryEvents // for a detailed design rationale of the current setup // of GC eventlog events. traceEventGcGlobalSync(cap); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e1d86b130349671116325c4d6cd85d2b0045ade7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e1d86b130349671116325c4d6cd85d2b0045ade7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 8 20:31:49 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 08 Dec 2020 15:31:49 -0500 Subject: [Git][ghc/ghc][master] Fix kind inference for data types. Again. Message-ID: <5fcfe2b585075_6b2129a0f045927b8@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 62ed6957 by Simon Peyton Jones at 2020-12-08T15:31:41-05:00 Fix kind inference for data types. Again. This patch fixes several aspects of kind inference for data type declarations, especially data /instance/ declarations Specifically 1. In kcConDecls/kcConDecl make it clear that the tc_res_kind argument is only used in the H98 case; and in that case there is no result kind signature; and hence no need for the disgusting splitPiTys in kcConDecls (now thankfully gone). The GADT case is a bit different to before, and much nicer. This is what fixes #18891. See Note [kcConDecls: kind-checking data type decls] 2. Do not look at the constructor decls of a data/newtype instance in tcDataFamInstanceHeader. See GHC.Tc.TyCl.Instance Note [Kind inference for data family instances]. This was a new realisation that arose when doing (1) This causes a few knock-on effects in the tests suite, because we require more information than before in the instance /header/. New user-manual material about this in "Kind inference in data type declarations" and "Kind inference for data/newtype instance declarations". 3. Minor improvement in kcTyClDecl, combining GADT and H98 cases 4. Fix #14111 and #8707 by allowing the header of a data instance to affect kind inferece for the the data constructor signatures; as described at length in Note [GADT return types] in GHC.Tc.TyCl This led to a modest refactoring of the arguments (and argument order) of tcConDecl/tcConDecls. 5. Fix #19000 by inverting the sense of the test in new_locs in GHC.Tc.Solver.Canonical.canDecomposableTyConAppOK. - - - - - 30 changed files: - compiler/GHC/Hs/Extension.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Instance.hs - docs/users_guide/9.2.1-notes.rst - docs/users_guide/exts/poly_kinds.rst - testsuite/tests/dependent/should_fail/T13780a.stderr - testsuite/tests/deriving/should_compile/T11416.hs - testsuite/tests/deriving/should_compile/T9359.hs - + testsuite/tests/gadt/SynDataRec.hs - testsuite/tests/gadt/all.T - + testsuite/tests/indexed-types/should_compile/T14111.hs - + testsuite/tests/indexed-types/should_compile/T8707.hs - testsuite/tests/indexed-types/should_compile/all.T - testsuite/tests/indexed-types/should_fail/T8368.stderr - testsuite/tests/indexed-types/should_fail/T8368a.stderr - testsuite/tests/patsyn/should_fail/T15685.stderr - testsuite/tests/polykinds/T13659.stderr - testsuite/tests/polykinds/T16221a.stderr - testsuite/tests/th/T11145.stderr - testsuite/tests/th/T9692.hs - + testsuite/tests/typecheck/should_compile/T18891.hs - testsuite/tests/typecheck/should_compile/UnliftedNewtypesUnassociatedFamily.hs - testsuite/tests/typecheck/should_compile/UnliftedNewtypesUnifySig.hs - testsuite/tests/typecheck/should_compile/all.T - + testsuite/tests/typecheck/should_fail/T18891a.hs - + testsuite/tests/typecheck/should_fail/T18891a.stderr - testsuite/tests/typecheck/should_fail/UnliftedNewtypesFamilyKindFail2.stderr - + testsuite/tests/typecheck/should_fail/UnliftedNewtypesUnassociatedFamilyFail.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/62ed6957463a9c0f711ea698d7ed4371e00fb122 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/62ed6957463a9c0f711ea698d7ed4371e00fb122 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 8 20:32:26 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 08 Dec 2020 15:32:26 -0500 Subject: [Git][ghc/ghc][master] hadrian: build the _l and _thr_l rts flavours in the develN flavours Message-ID: <5fcfe2da38581_6b2132ee345994e0@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 0abe3ddf by Adam Sandberg Ericsson at 2020-12-08T15:32:19-05:00 hadrian: build the _l and _thr_l rts flavours in the develN flavours The ghc binary requires the eventlog rts since fc644b1a643128041cfec25db84e417851e28bab - - - - - 1 changed file: - hadrian/src/Settings/Flavours/Development.hs Changes: ===================================== hadrian/src/Settings/Flavours/Development.hs ===================================== @@ -11,7 +11,7 @@ developmentFlavour ghcStage = defaultFlavour { name = "devel" ++ show (fromEnum ghcStage) , args = defaultBuilderArgs <> developmentArgs ghcStage <> defaultPackageArgs , libraryWays = pure [vanilla] - , rtsWays = pure [vanilla, threaded] + , rtsWays = pure [vanilla, logging, threaded, threadedLogging] , dynamicGhcPrograms = return False } developmentArgs :: Stage -> Args View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0abe3ddf85a915ab99ae4f87a85faf6ee5466ad3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0abe3ddf85a915ab99ae4f87a85faf6ee5466ad3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 8 21:03:22 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 08 Dec 2020 16:03:22 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: Fix kind inference for data types. Again. Message-ID: <5fcfea1a88f73_6b211e6fbe4624728@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 62ed6957 by Simon Peyton Jones at 2020-12-08T15:31:41-05:00 Fix kind inference for data types. Again. This patch fixes several aspects of kind inference for data type declarations, especially data /instance/ declarations Specifically 1. In kcConDecls/kcConDecl make it clear that the tc_res_kind argument is only used in the H98 case; and in that case there is no result kind signature; and hence no need for the disgusting splitPiTys in kcConDecls (now thankfully gone). The GADT case is a bit different to before, and much nicer. This is what fixes #18891. See Note [kcConDecls: kind-checking data type decls] 2. Do not look at the constructor decls of a data/newtype instance in tcDataFamInstanceHeader. See GHC.Tc.TyCl.Instance Note [Kind inference for data family instances]. This was a new realisation that arose when doing (1) This causes a few knock-on effects in the tests suite, because we require more information than before in the instance /header/. New user-manual material about this in "Kind inference in data type declarations" and "Kind inference for data/newtype instance declarations". 3. Minor improvement in kcTyClDecl, combining GADT and H98 cases 4. Fix #14111 and #8707 by allowing the header of a data instance to affect kind inferece for the the data constructor signatures; as described at length in Note [GADT return types] in GHC.Tc.TyCl This led to a modest refactoring of the arguments (and argument order) of tcConDecl/tcConDecls. 5. Fix #19000 by inverting the sense of the test in new_locs in GHC.Tc.Solver.Canonical.canDecomposableTyConAppOK. - - - - - 0abe3ddf by Adam Sandberg Ericsson at 2020-12-08T15:32:19-05:00 hadrian: build the _l and _thr_l rts flavours in the develN flavours The ghc binary requires the eventlog rts since fc644b1a643128041cfec25db84e417851e28bab - - - - - 056c1c56 by Andreas Klebinger at 2020-12-08T16:03:14-05:00 CodeGen: Make folds User/DefinerOfRegs INLINEABLE. Reduces allocation for the test case I was looking at by about 1.2%. Mostly from avoiding allocation of some folding functions which turn into let-no-escape bindings which just reuse their environment instead. We also force inlining in a few key places in CmmSink which helps a bit more. - - - - - f94a3141 by Andreas Klebinger at 2020-12-08T16:03:14-05:00 CmmSink: Force inlining of foldRegsDefd Helps avoid allocating the folding function. Improves perf for T3294 by about 1%. - - - - - d70e6142 by Andreas Klebinger at 2020-12-08T16:03:14-05:00 Cmm: Make a few types and utility function slightly stricter. About 0.6% reduction in allocations for the code I was looking at. Not a huge difference but no need to throw away performance. - - - - - c37de209 by Andreas Klebinger at 2020-12-08T16:03:14-05:00 Cmm.Sink: Optimize retaining of assignments, live sets. Sinking requires us to track live local regs after each cmm statement. We used to do this via "Set LocalReg". However we can replace this with a solution based on IntSet which is overall more efficient without losing much. The thing we lose is width of the variables, which isn't used by the sinking pass anyway. I also reworked how we keep assignments to regs mentioned in skipped assignments. I put the details into Note [Keeping assignemnts mentioned in skipped RHSs]. The gist of it is instead of keeping track of it via the use count which is a `IntMap Int` we now use the live regs set (IntSet) which is quite a bit faster. I think it also matches the semantics a lot better. The skipped (not discarded) assignment does in fact keep the regs on it's rhs alive so keeping track of this in the live set seems like the clearer solution as well. Improves allocations for T3294 by yet another 1%. - - - - - df97ab17 by Andreas Klebinger at 2020-12-08T16:03:14-05:00 GHC.Cmm.Opt: Be stricter in results. Optimization either returns Nothing if nothing is to be done or `Just <cmmExpr>` otherwise. There is no point in being lazy in `cmmExpr`. We usually inspect this element so the thunk gets forced not long after. We might eliminate it as dead code once in a blue moon but that's not a case worth optimizing for. Overall the impact of this is rather low. As Cmm.Opt doesn't allocate much (compared to the rest of GHC) to begin with. - - - - - ed940d47 by Andreas Klebinger at 2020-12-08T16:03:14-05:00 Bump time submodule. This should fix #19002. - - - - - 30 changed files: - compiler/GHC/Cmm/Expr.hs - + compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Liveness.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/Hs/Extension.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Utils/Outputable.hs - compiler/ghc.cabal.in - docs/users_guide/9.2.1-notes.rst - docs/users_guide/exts/poly_kinds.rst - hadrian/src/Settings/Flavours/Development.hs - libraries/time - testsuite/tests/dependent/should_fail/T13780a.stderr - testsuite/tests/deriving/should_compile/T11416.hs - testsuite/tests/deriving/should_compile/T9359.hs - + testsuite/tests/gadt/SynDataRec.hs - testsuite/tests/gadt/all.T - + testsuite/tests/indexed-types/should_compile/T14111.hs - + testsuite/tests/indexed-types/should_compile/T8707.hs - testsuite/tests/indexed-types/should_compile/all.T - testsuite/tests/indexed-types/should_fail/T8368.stderr - testsuite/tests/indexed-types/should_fail/T8368a.stderr - testsuite/tests/patsyn/should_fail/T15685.stderr - testsuite/tests/polykinds/T13659.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5cb804dfbb39f214f8bfe4fbc0c1380825b3d912...ed940d47e8a4abdeb0ce54fcd8db46274713a248 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5cb804dfbb39f214f8bfe4fbc0c1380825b3d912...ed940d47e8a4abdeb0ce54fcd8db46274713a248 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 8 21:07:18 2020 From: gitlab at gitlab.haskell.org (Ryan Scott) Date: Tue, 08 Dec 2020 16:07:18 -0500 Subject: [Git][ghc/ghc][wip/T18021] 7 commits: gitlab-ci: Fix copy-paste error Message-ID: <5fcfeb0687e97_6b2129e96786249de@gitlab.mail> Ryan Scott pushed to branch wip/T18021 at Glasgow Haskell Compiler / GHC Commits: e0b08c5f by Ben Gamari at 2020-12-03T13:01:47-05:00 gitlab-ci: Fix copy-paste error Also be more consistent in quoting. - - - - - 33ec3a06 by Ben Gamari at 2020-12-03T23:11:31-05:00 gitlab-ci: Run linters through ci.sh Ensuring that the right toolchain is used. - - - - - 4a437bc1 by Shayne Fletcher at 2020-12-05T09:06:38-05:00 Fix bad span calculations of post qualified imports - - - - - 8fac4b93 by Ben Gamari at 2020-12-05T09:07:13-05:00 testsuite: Add a test for #18923 - - - - - 62ed6957 by Simon Peyton Jones at 2020-12-08T15:31:41-05:00 Fix kind inference for data types. Again. This patch fixes several aspects of kind inference for data type declarations, especially data /instance/ declarations Specifically 1. In kcConDecls/kcConDecl make it clear that the tc_res_kind argument is only used in the H98 case; and in that case there is no result kind signature; and hence no need for the disgusting splitPiTys in kcConDecls (now thankfully gone). The GADT case is a bit different to before, and much nicer. This is what fixes #18891. See Note [kcConDecls: kind-checking data type decls] 2. Do not look at the constructor decls of a data/newtype instance in tcDataFamInstanceHeader. See GHC.Tc.TyCl.Instance Note [Kind inference for data family instances]. This was a new realisation that arose when doing (1) This causes a few knock-on effects in the tests suite, because we require more information than before in the instance /header/. New user-manual material about this in "Kind inference in data type declarations" and "Kind inference for data/newtype instance declarations". 3. Minor improvement in kcTyClDecl, combining GADT and H98 cases 4. Fix #14111 and #8707 by allowing the header of a data instance to affect kind inferece for the the data constructor signatures; as described at length in Note [GADT return types] in GHC.Tc.TyCl This led to a modest refactoring of the arguments (and argument order) of tcConDecl/tcConDecls. 5. Fix #19000 by inverting the sense of the test in new_locs in GHC.Tc.Solver.Canonical.canDecomposableTyConAppOK. - - - - - 0abe3ddf by Adam Sandberg Ericsson at 2020-12-08T15:32:19-05:00 hadrian: build the _l and _thr_l rts flavours in the develN flavours The ghc binary requires the eventlog rts since fc644b1a643128041cfec25db84e417851e28bab - - - - - 6d129f4c by Ryan Scott at 2020-12-08T16:06:23-05:00 Reject dodgy scoping in associated family instance RHSes Commit e63518f5d6a93be111f9108c0990a1162f88d615 tried to push all of the logic of detecting out-of-scope type variables on the RHSes of associated type family instances to `GHC.Tc.Validity` by deleting a similar check in the renamer. Unfortunately, this commit went a little too far, as there are some corner cases that `GHC.Tc.Validity` doesn't detect. Consider this example: ```hs class C a where data D a instance forall a. C Int where data instance D Int = MkD a ``` If this program isn't rejected by the time it reaches the typechecker, then GHC will believe the `a` in `MkD a` is existentially quantified and accept it. This is almost surely not what the user wants! The simplest way to reject programs like this is to restore the old validity check in the renamer (search for `improperly_scoped` in `rnFamEqn`). Note that this is technically a breaking change, since the program in the `polykinds/T9574` test case (which previously compiled) will now be rejected: ```hs instance Funct ('KProxy :: KProxy o) where type Codomain 'KProxy = NatTr (Proxy :: o -> *) ``` This is because the `o` on the RHS will now be rejected for being out of scope. Luckily, this is simple to repair: ```hs instance Funct ('KProxy :: KProxy o) where type Codomain ('KProxy @o) = NatTr (Proxy :: o -> *) ``` All of the discussion is now a part of the revamped `Note [Renaming associated types]` in `GHC.Rename.Module`. A different design would be to make associated type family instances have completely separate scoping from the parent instance declaration, much like how associated type family default declarations work today. See the discussion beginning at https://gitlab.haskell.org/ghc/ghc/-/issues/18021#note_265729 for more on this point. This, however, would break even more programs that are accepted today and likely warrants a GHC proposal before going forward. In the meantime, this patch fixes the issue described in #18021 in the least invasive way possible. There are programs that are accepted today that will no longer be accepted after this patch, but they are arguably pathological programs, and they are simple to repair. Fixes #18021. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - compiler/GHC/Hs/Extension.hs - compiler/GHC/Parser.y - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Instance.hs - docs/users_guide/9.2.1-notes.rst - docs/users_guide/exts/poly_kinds.rst - hadrian/src/Settings/Flavours/Development.hs - testsuite/tests/dependent/should_fail/T13780a.stderr - testsuite/tests/deriving/should_compile/T11416.hs - testsuite/tests/deriving/should_compile/T9359.hs - + testsuite/tests/gadt/SynDataRec.hs - testsuite/tests/gadt/all.T - + testsuite/tests/indexed-types/should_compile/T14111.hs - + testsuite/tests/indexed-types/should_compile/T8707.hs - testsuite/tests/indexed-types/should_compile/all.T - testsuite/tests/indexed-types/should_fail/T5515.stderr - testsuite/tests/indexed-types/should_fail/T8368.stderr - testsuite/tests/indexed-types/should_fail/T8368a.stderr - testsuite/tests/module/all.T - + testsuite/tests/module/mod185.hs - + testsuite/tests/module/mod185.stderr - testsuite/tests/patsyn/should_fail/T15685.stderr - + testsuite/tests/perf/compiler/T18923.hs - testsuite/tests/perf/compiler/all.T - testsuite/tests/polykinds/T13659.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/96ad03e1e9a417ee9201f89968a760da0fb2d683...6d129f4ce2eb9ba0baeade6c825816dc45d92ad7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/96ad03e1e9a417ee9201f89968a760da0fb2d683...6d129f4ce2eb9ba0baeade6c825816dc45d92ad7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 8 21:53:23 2020 From: gitlab at gitlab.haskell.org (Ryan Scott) Date: Tue, 08 Dec 2020 16:53:23 -0500 Subject: [Git][ghc/ghc][wip/T18389] 204 commits: SMP.h: Add C11-style atomic operations Message-ID: <5fcff5d319b29_6b21258bc706337fb@gitlab.mail> Ryan Scott pushed to branch wip/T18389 at Glasgow Haskell Compiler / GHC Commits: b9d4dd9c by Ben Gamari at 2020-10-24T20:44:17-04:00 SMP.h: Add C11-style atomic operations - - - - - ccf2d4b0 by Ben Gamari at 2020-10-24T20:59:39-04:00 rts: Infrastructure for testing with ThreadSanitizer - - - - - a61f66d6 by Ben Gamari at 2020-10-24T20:59:39-04:00 rts/CNF: Initialize all bdescrs in group It seems wise and cheap to ensure that the whole bdescr of all blocks of a compact group is valid, even if most cases only look at the flags field. - - - - - 65136c13 by Ben Gamari at 2020-10-24T20:59:39-04:00 rts/Capability: Intialize interrupt field Previously this was left uninitialized. Also clarify some comments. - - - - - b3ce6aca by Ben Gamari at 2020-10-24T20:59:39-04:00 rts/Task: Make comments proper Notes - - - - - d3890ac7 by Ben Gamari at 2020-10-24T20:59:39-04:00 rts/SpinLock: Move to proper atomics This is fairly straightforward; we just needed to use relaxed operations for the PROF_SPIN counters and a release store instead of a write barrier. - - - - - ef88712f by Ben Gamari at 2020-10-24T20:59:39-04:00 rts/OSThreads: Fix data race Previously we would race on the cached processor count. Avoiding this is straightforward; just use relaxed operations. - - - - - 33a719c3 by Ben Gamari at 2020-10-24T20:59:39-04:00 rts/ClosureMaros: Use relaxed atomics - - - - - f08951fd by Ben Gamari at 2020-10-24T20:59:39-04:00 configure: Bump minimum-supported gcc version to 4.7 Since the __atomic_* builtins are not supported until gcc 4.7. Given that this version was released in 2012 I think this is acceptable. - - - - - d584923a by Ben Gamari at 2020-10-24T20:59:39-04:00 testsuite: Fix thread leak in hs_try_putmvar00[13] - - - - - bf1b0bc7 by Ben Gamari at 2020-10-24T20:59:39-04:00 rts: Introduce SET_HDR_RELEASE Also ensure that we also store the info table pointer last to ensure that the synchronization covers all stores. - - - - - 1a2e9f5e by Ben Gamari at 2020-10-24T21:00:19-04:00 gitlab-ci: Add nightly-x86_64-linux-deb9-tsan job - - - - - 58a5b0e5 by GHC GitLab CI at 2020-10-24T21:00:19-04:00 testsuite: Mark setnumcapabilities001 as broken with TSAN Due to #18808. - - - - - d9bc7dea by GHC GitLab CI at 2020-10-24T21:00:19-04:00 testsuite: Skip divbyzero and derefnull under TSAN ThreadSanitizer changes the output of these tests. - - - - - fcc42a10 by Ben Gamari at 2020-10-24T21:00:19-04:00 testsuite: Skip high memory usage tests with TSAN ThreadSanitizer significantly increases the memory footprint of tests, so much so that it can send machines into OOM. - - - - - cae4bb3e by Ben Gamari at 2020-10-24T21:00:19-04:00 testsuite: Mark hie002 as high_memory_usage This test has a peak residency of 1GByte; this is large enough to classify as "high" in my book. - - - - - dae1b86a by Ben Gamari at 2020-10-24T21:00:19-04:00 testsuite: Mark T9872[abc] as high_memory_usage These all have a maximum residency of over 2 GB. - - - - - c5a0bb22 by Ben Gamari at 2020-10-24T21:00:19-04:00 gitlab-ci: Disable documentation in TSAN build Haddock chews through enough memory to cause the CI builders to OOM and there's frankly no reason to build documentation in this job anyways. - - - - - 4cb1232e by Ben Gamari at 2020-10-24T21:00:19-04:00 TSANUtils: Ensure that C11 atomics are supported - - - - - 7ed15f7f by Ben Gamari at 2020-10-24T21:00:19-04:00 testsuite: Mark T3807 as broken with TSAN Due to #18883. - - - - - f7e6f012 by Ben Gamari at 2020-10-24T21:00:19-04:00 testsuite: Mark T13702 as broken with TSAN due to #18884 - - - - - 16b136b0 by Ben Gamari at 2020-10-24T21:00:36-04:00 rts: Factor out logic to identify a good capability for running a task Not only does this make the control flow a bit clearer but it also allows us to add a TSAN suppression on this logic, which requires (harmless) data races. - - - - - 2781d68c by Ben Gamari at 2020-10-24T21:00:36-04:00 rts: Annotate benign race in waitForCapability - - - - - f6b4b492 by Ben Gamari at 2020-10-24T21:00:36-04:00 rts: Clarify locking behavior of releaseCapability_ - - - - - 65219810 by Ben Gamari at 2020-10-24T21:00:36-04:00 rts: Add assertions for task ownership of capabilities - - - - - 31fa87ec by Ben Gamari at 2020-10-24T21:00:36-04:00 rts: Use relaxed atomics on n_returning_tasks This mitigates the warning of a benign race on n_returning_tasks in shouldYieldCapability. See #17261. - - - - - 6517a2ea by Ben Gamari at 2020-10-24T21:00:36-04:00 rts: Mitigate races in capability interruption logic - - - - - 2e9ba3f2 by Ben Gamari at 2020-10-24T21:00:36-04:00 rts/Capability: Use relaxed operations for last_free_capability - - - - - e10dde37 by Ben Gamari at 2020-10-24T21:00:37-04:00 rts: Use relaxed operations for cap->running_task (TODO) This shouldn't be necessary since only the owning thread of the capability should be touching this. - - - - - 855325cd by Ben Gamari at 2020-10-24T21:00:37-04:00 rts/Schedule: Use relaxed operations for sched_state - - - - - 811f915d by Ben Gamari at 2020-10-24T21:00:37-04:00 rts: Accept data race in work-stealing implementation This race is okay since the task is owned by the capability pushing it. By Note [Ownership of Task] this means that the capability is free to write to `task->cap` without taking `task->lock`. Fixes #17276. - - - - - 8d2b3c3d by Ben Gamari at 2020-10-24T21:00:37-04:00 rts: Eliminate data races on pending_sync - - - - - f8871018 by Ben Gamari at 2020-10-24T21:00:37-04:00 rts/Schedule: Eliminate data races on recent_activity We cannot safely use relaxed atomics here. - - - - - d079b943 by Ben Gamari at 2020-10-24T21:00:37-04:00 rts: Avoid data races in message handling - - - - - 06f80497 by Ben Gamari at 2020-10-24T21:00:37-04:00 rts/Messages: Drop incredibly fishy write barrier executeMessage previously had a write barrier at the beginning of its loop apparently in an attempt to synchronize with another thread's writes to the Message. I would guess that the author had intended to use a load barrier here given that there are no globally-visible writes done in executeMessage. I've removed the redundant barrier since the necessary load barrier is now provided by the ACQUIRE_LOAD. - - - - - d4a87779 by Ben Gamari at 2020-10-24T21:00:38-04:00 rts/ThreadPaused: Avoid data races - - - - - 56778ab3 by Ben Gamari at 2020-10-24T21:00:38-04:00 rts/Schedule: Eliminate data races in run queue management - - - - - 086521f7 by Ben Gamari at 2020-10-24T21:00:38-04:00 rts: Eliminate shutdown data race on task counters - - - - - abad9778 by Ben Gamari at 2020-10-24T21:00:38-04:00 rts/Threads: Avoid data races (TODO) Replace barriers with appropriate ordering. Drop redundant barrier in tryWakeupThread (the RELEASE barrier will be provided by sendMessage's mutex release). We use relaxed operations on why_blocked and the stack although it's not clear to me why this is necessary. - - - - - 2f56be8a by Ben Gamari at 2020-10-24T21:00:39-04:00 rts/Messages: Annotate benign race - - - - - 7c0cdab1 by Ben Gamari at 2020-10-24T21:00:39-04:00 rts/RaiseAsync: Synchronize what_next read - - - - - 6cc2a8a5 by Ben Gamari at 2020-10-24T21:00:39-04:00 rts/Task: Move debugTrace to avoid data race Specifically, we need to hold all_tasks_mutex to read taskCount. - - - - - bbaec97d by Ben Gamari at 2020-10-24T21:00:39-04:00 Disable flawed assertion - - - - - dd175a92 by Ben Gamari at 2020-10-24T21:00:39-04:00 Document schedulePushWork race - - - - - 3416244b by Ben Gamari at 2020-10-24T21:00:40-04:00 Capabiliity: Properly fix data race on n_returning_tasks There is a real data race but can be made safe by using proper atomic (but relaxed) accesses. - - - - - dffd9432 by Ben Gamari at 2020-10-24T21:00:40-04:00 rts: Make write of to_cap->inbox atomic This is necessary since emptyInbox may read from to_cap->inbox without taking cap->lock. - - - - - 1f4cbc29 by Ben Gamari at 2020-10-24T21:00:57-04:00 rts/BlockAlloc: Use relaxed operations - - - - - d0d07cff by Ben Gamari at 2020-10-24T21:00:57-04:00 rts: Rework handling of mutlist scavenging statistics - - - - - 9e5c7f6d by Ben Gamari at 2020-10-24T21:00:57-04:00 rts: Avoid data races in StablePtr implementation This fixes two potentially problematic data races in the StablePtr implementation: * We would fail to RELEASE the stable pointer table when enlarging it, causing other cores to potentially see uninitialized memory. * We would fail to ACQUIRE when dereferencing a stable pointer. - - - - - 316add67 by Ben Gamari at 2020-10-24T21:00:57-04:00 rts/Storage: Use atomics - - - - - 5c23bc4c by Ben Gamari at 2020-10-24T21:00:58-04:00 rts/Updates: Use proper atomic operations - - - - - 3d0f033c by Ben Gamari at 2020-10-24T21:00:58-04:00 rts/Weak: Eliminate data races By taking all_tasks_mutex in stat_exit. Also better-document the fact that the task statistics are protected by all_tasks_mutex. - - - - - edb4b92b by Ben Gamari at 2020-10-24T21:01:18-04:00 rts/WSDeque: Rewrite with proper atomics After a few attempts at shoring up the previous implementation, I ended up turning to the literature and now use the proven implementation, > N.M. Lê, A. Pop, A.Cohen, and F.Z. Nardelli. "Correct and Efficient > Work-Stealing for Weak Memory Models". PPoPP'13, February 2013, > ACM 978-1-4503-1922/13/02. Note only is this approach formally proven correct under C11 semantics but it is also proved to be a bit faster in practice. - - - - - d39bbd3d by Ben Gamari at 2020-10-24T21:01:33-04:00 rts: Use relaxed atomics for whitehole spin stats - - - - - 8f802f38 by Ben Gamari at 2020-10-24T21:01:33-04:00 rts: Avoid lock order inversion during fork Fixes #17275. - - - - - cef667b0 by GHC GitLab CI at 2020-10-24T21:01:34-04:00 rts: Use proper relaxe operations in getCurrentThreadCPUTime Here we are doing lazy initialization; it's okay if we do the check more than once, hence relaxed operation is fine. - - - - - 8cf50eb1 by Ben Gamari at 2020-10-24T21:01:54-04:00 rts/STM: Use atomics This fixes a potentially harmful race where we failed to synchronize before looking at a TVar's current_value. Also did a bit of refactoring to avoid abstract over management of max_commits. - - - - - 88a7ce38 by Ben Gamari at 2020-10-24T21:01:54-04:00 rts/stm: Strengthen orderings to SEQ_CST instead of volatile Previously the `current_value`, `first_watch_queue_entry`, and `num_updates` fields of `StgTVar` were marked as `volatile` in an attempt to provide strong ordering. Of course, this isn't sufficient. We now use proper atomic operations. In most of these cases I strengthen the ordering all the way to SEQ_CST although it's possible that some could be weakened with some thought. - - - - - f97c59ce by Ben Gamari at 2020-10-24T21:02:11-04:00 Mitigate data races in event manager startup/shutdown - - - - - c7c3f8aa by Ben Gamari at 2020-10-24T21:02:22-04:00 rts: Accept benign races in Proftimer - - - - - 5a98dfca by Ben Gamari at 2020-10-24T21:02:22-04:00 rts: Pause timer while changing capability count This avoids #17289. - - - - - 01d95525 by Ben Gamari at 2020-10-24T21:02:22-04:00 Fix #17289 - - - - - 9a528985 by Ben Gamari at 2020-10-24T21:02:23-04:00 suppress #17289 (ticker) race - - - - - 1726ec41 by Ben Gamari at 2020-10-24T21:02:23-04:00 rts: Fix timer initialization Previously `initScheduler` would attempt to pause the ticker and in so doing acquire the ticker mutex. However, initTicker, which is responsible for initializing said mutex, hadn't been called yet. - - - - - bfbe4366 by Ben Gamari at 2020-10-24T21:02:23-04:00 rts: Fix races in Pthread timer backend shudown We can generally be pretty relaxed in the barriers here since the timer thread is a loop. - - - - - 297acc71 by Ben Gamari at 2020-10-24T21:02:44-04:00 rts/Stats: Hide a few unused unnecessarily global functions - - - - - aad1f803 by Ben Gamari at 2020-10-30T00:41:14-04:00 rts/GC: Use atomics - - - - - d0bc0517 by Ben Gamari at 2020-10-30T00:41:14-04:00 rts: Use RELEASE ordering in unlockClosure - - - - - d44f5232 by Ben Gamari at 2020-10-30T00:41:14-04:00 rts/Storage: Accept races on heap size counters - - - - - 4e4a7386 by Ben Gamari at 2020-10-30T00:41:14-04:00 rts: Join to concurrent mark thread during shutdown Previously we would take all capabilities but fail to join on the thread itself, potentially resulting in a leaked thread. - - - - - a80cc857 by GHC GitLab CI at 2020-10-30T00:41:14-04:00 rts: Fix race in GC CPU time accounting Ensure that the GC leader synchronizes with workers before calling stat_endGC. - - - - - 105d43db by Ben Gamari at 2020-10-30T14:02:19-04:00 rts/SpinLock: Separate out slow path Not only is this in general a good idea, but it turns out that GCC unrolls the retry loop, resulting is massive code bloat in critical parts of the RTS (e.g. `evacuate`). - - - - - f7b45cde by Ben Gamari at 2020-10-30T14:02:19-04:00 rts: Use relaxed ordering on spinlock counters - - - - - b1dda153 by Ben Gamari at 2020-11-01T12:58:36-05:00 rts/Stats: Protect with mutex While on face value this seems a bit heavy, I think it's far better than enforcing ordering on every access. - - - - - 5c2e6bce by Ben Gamari at 2020-11-01T12:58:36-05:00 rts: Tear down stats_mutex after exitHeapProfiling Since the latter wants to call getRTSStats. - - - - - ef25aaa1 by Ben Gamari at 2020-11-01T13:02:11-05:00 rts: Annotate hopefully "benign" races in freeGroup - - - - - 3a181553 by Ben Gamari at 2020-11-01T13:02:18-05:00 Strengthen ordering in releaseGCThreads - - - - - af474f62 by Ben Gamari at 2020-11-01T13:05:38-05:00 Suppress data race due to close This suppresses the other side of a race during shutdown. - - - - - b4686bff by Ben Gamari at 2020-11-01T13:09:59-05:00 Merge branch 'wip/tsan/ci' into wip/tsan/all - - - - - b8e66e0e by Ben Gamari at 2020-11-01T13:10:01-05:00 Merge branch 'wip/tsan/storage' into wip/tsan/all - - - - - 375512cf by Ben Gamari at 2020-11-01T13:10:02-05:00 Merge branch 'wip/tsan/wsdeque' into wip/tsan/all - - - - - 65ebf07e by Ben Gamari at 2020-11-01T13:10:03-05:00 Merge branch 'wip/tsan/misc' into wip/tsan/all - - - - - 55c375d0 by Ben Gamari at 2020-11-01T13:10:04-05:00 Merge branch 'wip/tsan/stm' into wip/tsan/all - - - - - a9f75fe2 by Ben Gamari at 2020-11-01T13:10:06-05:00 Merge branch 'wip/tsan/event-mgr' into wip/tsan/all - - - - - 8325d658 by Ben Gamari at 2020-11-01T13:10:24-05:00 Merge branch 'wip/tsan/timer' into wip/tsan/all - - - - - 07e82ba5 by Ben Gamari at 2020-11-01T13:10:35-05:00 Merge branch 'wip/tsan/stats' into wip/tsan/all - - - - - 638f38c5 by Ben Gamari at 2020-11-08T09:29:16-05:00 Merge remote-tracking branch 'origin/wip/tsan/all' - - - - - 22888798 by Ben Gamari at 2020-11-08T12:08:40-05:00 Fix haddock submodule The previous merge mistakenly reverted it. - - - - - d445cf05 by Ben Gamari at 2020-11-10T10:26:20-05:00 rts/linker: Fix relocation overflow in PE linker Previously the overflow check for the IMAGE_REL_AMD64_ADDR32NB relocation failed to account for the signed nature of the value. Specifically, the overflow check was: uint64_t v; v = S + A; if (v >> 32) { ... } However, `v` ultimately needs to fit into 32-bits as a signed value. Consequently, values `v > 2^31` in fact overflow yet this is not caught by the existing overflow check. Here we rewrite the overflow check to rather ensure that `INT32_MIN <= v <= INT32_MAX`. There is now quite a bit of repetition between the `IMAGE_REL_AMD64_REL32` and `IMAGE_REL_AMD64_ADDR32` cases but I am leaving fixing this for future work. This bug was first noticed by @awson. Fixes #15808. - - - - - 4c407f6e by Sylvain Henry at 2020-11-10T10:27:00-05:00 Export SPEC from GHC.Exts (#13681) - - - - - 7814cd5b by David Eichmann at 2020-11-10T10:27:35-05:00 ghc-heap: expose decoding from heap representation Co-authored-by: Sven Tennie <sven.tennie at gmail.com> Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> Co-authored-by: Ben Gamari <bgamari.foss at gmail.com> - - - - - fa344d33 by Richard Eisenberg at 2020-11-10T10:28:10-05:00 Add test case for #17186. This got fixed sometime recently; not worth it trying to figure out which commit. - - - - - 2e63a0fb by David Eichmann at 2020-11-10T10:28:46-05:00 Add code comments for StgInfoTable and StgStack structs - - - - - fcfda909 by Ben Gamari at 2020-11-11T03:19:59-05:00 nativeGen: Make makeImportsDoc take an NCGConfig rather than DynFlags It appears this was an oversight as there is no reason the full DynFlags is necessary. - - - - - 6e23695e by Ben Gamari at 2020-11-11T03:19:59-05:00 Move this_module into NCGConfig In various places in the NCG we need the Module currently being compiled. Let's move this into the environment instead of chewing threw another register. - - - - - c6264a2d by Ben Gamari at 2020-11-11T03:20:00-05:00 codeGen: Produce local symbols for module-internal functions It turns out that some important native debugging/profiling tools (e.g. perf) rely only on symbol tables for function name resolution (as opposed to using DWARF DIEs). However, previously GHC would emit temporary symbols (e.g. `.La42b`) to identify module-internal entities. Such symbols are dropped during linking and therefore not visible to runtime tools (in addition to having rather un-helpful unique names). For instance, `perf report` would often end up attributing all cost to the libc `frame_dummy` symbol since Haskell code was no covered by any proper symbol (see #17605). We now rather follow the model of C compilers and emit descriptively-named local symbols for module internal things. Since this will increase object file size this behavior can be disabled with the `-fno-expose-internal-symbols` flag. With this `perf record` can finally be used against Haskell executables. Even more, with `-g3` `perf annotate` provides inline source code. - - - - - 584058dd by Ben Gamari at 2020-11-11T03:20:00-05:00 Enable -fexpose-internal-symbols when debug level >=2 This seems like a reasonable default as the object file size increases by around 5%. - - - - - c34a4b98 by Ömer Sinan Ağacan at 2020-11-11T03:20:35-05:00 Fix and enable object unloading in GHCi Fixes #16525 by tracking dependencies between object file symbols and marking symbol liveness during garbage collection See Note [Object unloading] in CheckUnload.c for details. - - - - - 2782487f by Ray Shih at 2020-11-11T03:20:35-05:00 Add loadNativeObj and unloadNativeObj (This change is originally written by niteria) This adds two functions: * `loadNativeObj` * `unloadNativeObj` and implements them for Linux. They are useful if you want to load a shared object with Haskell code using the system linker and have GHC call dlclose() after the code is no longer referenced from the heap. Using the system linker allows you to load the shared object above outside the low-mem region. It also loads the DWARF sections in a way that `perf` understands. `dl_iterate_phdr` is what makes this implementation Linux specific. - - - - - 7a65f9e1 by GHC GitLab CI at 2020-11-11T03:20:35-05:00 rts: Introduce highMemDynamic - - - - - e9e1b2e7 by GHC GitLab CI at 2020-11-11T03:20:35-05:00 Introduce test for dynamic library unloading This uses the highMemDynamic flag introduced earlier to verify that dynamic objects are properly unloaded. - - - - - 5506f134 by Krzysztof Gogolewski at 2020-11-11T03:21:14-05:00 Force argument in setIdMult (#18925) - - - - - 787e93ae by Ben Gamari at 2020-11-11T23:14:11-05:00 testsuite: Add testcase for #18733 - - - - - 5353fd50 by Ben Gamari at 2020-11-12T10:05:30-05:00 compiler: Fix recompilation checking In ticket #18733 we noticed a rather serious deficiency in the current fingerprinting logic for recursive groups. I have described the old fingerprinting story and its problems in Note [Fingerprinting recursive groups] and have reworked the story accordingly to avoid these issues. Fixes #18733. - - - - - 63fa3997 by Sebastian Graf at 2020-11-13T14:29:39-05:00 Arity: Rework `ArityType` to fix monotonicity (#18870) As we found out in #18870, `andArityType` is not monotone, with potentially severe consequences for termination of fixed-point iteration. That showed in an abundance of "Exciting arity" DEBUG messages that are emitted whenever we do more than one step in fixed-point iteration. The solution necessitates also recording `OneShotInfo` info for `ABot` arity type. Thus we get the following definition for `ArityType`: ``` data ArityType = AT [OneShotInfo] Divergence ``` The majority of changes in this patch are the result of refactoring use sites of `ArityType` to match the new definition. The regression test `T18870` asserts that we indeed don't emit any DEBUG output anymore for a function where we previously would have. Similarly, there's a regression test `T18937` for #18937, which we expect to be broken for now. Fixes #18870. - - - - - 197d59fa by Sebastian Graf at 2020-11-13T14:29:39-05:00 Arity: Emit "Exciting arity" warning only after second iteration (#18937) See Note [Exciting arity] why we emit the warning at all and why we only do after the second iteration now. Fixes #18937. - - - - - de7ec9dd by David Eichmann at 2020-11-13T14:30:16-05:00 Add rts_listThreads and rts_listMiscRoots to RtsAPI.h These are used to find the current roots of the garbage collector. Co-authored-by: Sven Tennie's avatarSven Tennie <sven.tennie at gmail.com> Co-authored-by: Matthew Pickering's avatarMatthew Pickering <matthewtpickering at gmail.com> Co-authored-by: default avatarBen Gamari <bgamari.foss at gmail.com> - - - - - 24a86f09 by Ben Gamari at 2020-11-13T14:30:51-05:00 gitlab-ci: Cache cabal store in linting job - - - - - 0a7e592c by Ben Gamari at 2020-11-15T03:35:45-05:00 nativeGen/dwarf: Fix procedure end addresses Previously the `.debug_aranges` and `.debug_info` (DIE) DWARF information would claim that procedures (represented with a `DW_TAG_subprogram` DIE) would only span the range covered by their entry block. This omitted all of the continuation blocks (represented by `DW_TAG_lexical_block` DIEs), confusing `perf`. Fix this by introducing a end-of-procedure label and using this as the `DW_AT_high_pc` of procedure `DW_TAG_subprogram` DIEs Fixes #17605. - - - - - 1e19183d by Ben Gamari at 2020-11-15T03:35:45-05:00 nativeGen/dwarf: Only produce DW_AT_source_note DIEs in -g3 Standard debugging tools don't know how to understand these so let's not produce them unless asked. - - - - - ad73370f by Ben Gamari at 2020-11-15T03:35:45-05:00 nativeGen/dwarf: Use DW_AT_linkage instead of DW_AT_MIPS_linkage - - - - - a2539650 by Ben Gamari at 2020-11-15T03:35:45-05:00 gitlab-ci: Add DWARF release jobs for Debian 10, Fedora27 - - - - - d61adb3d by Ryan Scott at 2020-11-15T03:36:21-05:00 Name (tc)SplitForAll- functions more consistently There is a zoo of `splitForAll-` functions in `GHC.Core.Type` (as well as `tcSplitForAll-` functions in `GHC.Tc.Utils.TcType`) that all do very similar things, but vary in the particular form of type variable that they return. To make things worse, the names of these functions are often quite misleading. Some particularly egregious examples: * `splitForAllTys` returns `TyCoVar`s, but `splitSomeForAllTys` returns `VarBndr`s. * `splitSomeForAllTys` returns `VarBndr`s, but `tcSplitSomeForAllTys` returns `TyVar`s. * `splitForAllTys` returns `TyCoVar`s, but `splitForAllTysInvis` returns `InvisTVBinder`s. (This in particular arose in the context of #18939, and this finally motivated me to bite the bullet and improve the status quo vis-à-vis how we name these functions.) In an attempt to bring some sanity to how these functions are named, I have opted to rename most of these functions en masse to use consistent suffixes that describe the particular form of type variable that each function returns. In concrete terms, this amounts to: * Functions that return a `TyVar` now use the suffix `-TyVar`. This caused the following functions to be renamed: * `splitTyVarForAllTys` -> `splitForAllTyVars` * `splitForAllTy_ty_maybe` -> `splitForAllTyVar_maybe` * `tcSplitForAllTys` -> `tcSplitForAllTyVars` * `tcSplitSomeForAllTys` -> `tcSplitSomeForAllTyVars` * Functions that return a `CoVar` now use the suffix `-CoVar`. This caused the following functions to be renamed: * `splitForAllTy_co_maybe` -> `splitForAllCoVar_maybe` * Functions that return a `TyCoVar` now use the suffix `-TyCoVar`. This caused the following functions to be renamed: * `splitForAllTy` -> `splitForAllTyCoVar` * `splitForAllTys` -> `splitForAllTyCoVars` * `splitForAllTys'` -> `splitForAllTyCoVars'` * `splitForAllTy_maybe` -> `splitForAllTyCoVar_maybe` * Functions that return a `VarBndr` now use the suffix corresponding to the most relevant type synonym. This caused the following functions to be renamed: * `splitForAllVarBndrs` -> `splitForAllTyCoVarBinders` * `splitForAllTysInvis` -> `splitForAllInvisTVBinders` * `splitForAllTysReq` -> `splitForAllReqTVBinders` * `splitSomeForAllTys` -> `splitSomeForAllTyCoVarBndrs` * `tcSplitForAllVarBndrs` -> `tcSplitForAllTyVarBinders` * `tcSplitForAllTysInvis` -> `tcSplitForAllInvisTVBinders` * `tcSplitForAllTysReq` -> `tcSplitForAllReqTVBinders` * `tcSplitForAllTy_maybe` -> `tcSplitForAllTyVarBinder_maybe` Note that I left the following functions alone: * Functions that split apart things besides `ForAllTy`s, such as `splitFunTys` or `splitPiTys`. Thankfully, there are far fewer of these functions than there are functions that split apart `ForAllTy`s, so there isn't much of a pressing need to apply the new naming convention elsewhere. * Functions that split apart `ForAllCo`s in `Coercion`s, such as `GHC.Core.Coercion.splitForAllCo_maybe`. We could theoretically apply the new naming convention here, but then we'd have to figure out how to disambiguate `Type`-splitting functions from `Coercion`-splitting functions. Ultimately, the `Coercion`-splitting functions aren't used nearly as much as the `Type`-splitting functions, so I decided to leave the former alone. This is purely refactoring and should cause no change in behavior. - - - - - 645444af by Ryan Scott at 2020-11-15T03:36:21-05:00 Use tcSplitForAllInvisTyVars (not tcSplitForAllTyVars) in more places The use of `tcSplitForAllTyVars` in `tcDataFamInstHeader` was the immediate cause of #18939, and replacing it with a new `tcSplitForAllInvisTyVars` function (which behaves like `tcSplitForAllTyVars` but only splits invisible type variables) fixes the issue. However, this led me to realize that _most_ uses of `tcSplitForAllTyVars` in GHC really ought to be `tcSplitForAllInvisTyVars` instead. While I was in town, I opted to replace most uses of `tcSplitForAllTys` with `tcSplitForAllTysInvis` to reduce the likelihood of such bugs in the future. I say "most uses" above since there is one notable place where we _do_ want to use `tcSplitForAllTyVars`: in `GHC.Tc.Validity.forAllTyErr`, which produces the "`Illegal polymorphic type`" error message if you try to use a higher-rank `forall` without having `RankNTypes` enabled. Here, we really do want to split all `forall`s, not just invisible ones, or we run the risk of giving an inaccurate error message in the newly added `T18939_Fail` test case. I debated at some length whether I wanted to name the new function `tcSplitForAllInvisTyVars` or `tcSplitForAllTyVarsInvisible`, but in the end, I decided that I liked the former better. For consistency's sake, I opted to rename the existing `splitPiTysInvisible` and `splitPiTysInvisibleN` functions to `splitInvisPiTys` and `splitPiTysInvisN`, respectively, so that they use the same naming convention. As a consequence, this ended up requiring a `haddock` submodule bump. Fixes #18939. - - - - - 8887102f by Moritz Angermann at 2020-11-15T03:36:56-05:00 AArch64/arm64 adjustments This addes the necessary logic to support aarch64 on elf, as well as aarch64 on mach-o, which Apple calls arm64. We change architecture name to AArch64, which is the official arm naming scheme. - - - - - fc644b1a by Ben Gamari at 2020-11-15T03:37:31-05:00 ghc-bin: Build with eventlogging by default We now have all sorts of great facilities using the eventlog which were previously unavailable without building a custom GHC. Fix this by linking with `-eventlog` by default. - - - - - 52114fa0 by Sylvain Henry at 2020-11-16T11:48:47+01:00 Add Addr# atomic primops (#17751) This reuses the codegen used for ByteArray#'s atomic primops. - - - - - 8150f654 by Sebastian Graf at 2020-11-18T23:38:40-05:00 PmCheck: Print types of uncovered patterns (#18932) In order to avoid confusion as in #18932, we display the type of the match variables in the non-exhaustiveness warning, e.g. ``` T18932.hs:14:1: warning: [-Wincomplete-patterns] Pattern match(es) are non-exhaustive In an equation for ‘g’: Patterns of type ‘T a’, ‘T a’, ‘T a’ not matched: (MkT2 _) (MkT1 _) (MkT1 _) (MkT2 _) (MkT1 _) (MkT2 _) (MkT2 _) (MkT2 _) (MkT1 _) (MkT2 _) (MkT2 _) (MkT2 _) ... | 14 | g (MkT1 x) (MkT1 _) (MkT1 _) = x | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ``` It also allows us to omit the type signature on wildcard matches which we previously showed in only some situations, particularly `-XEmptyCase`. Fixes #18932. - - - - - 165352a2 by Krzysztof Gogolewski at 2020-11-20T02:08:36-05:00 Export indexError from GHC.Ix (#18579) - - - - - b57845c3 by Kamil Dworakowski at 2020-11-20T02:09:16-05:00 Clarify interruptible FFI wrt masking state - - - - - 321d1bd8 by Sebastian Graf at 2020-11-20T02:09:51-05:00 Fix strictness signatures of `prefetchValue*#` primops Their strictness signatures said the primops are strict in their first argument, which is wrong: Handing it a thunk will prefetch the pointer to the thunk, but not evaluate it. Hence not strict. The regression test `T8256` actually tests for laziness in the first argument, so GHC apparently never exploited the strictness signature. See also https://gitlab.haskell.org/ghc/ghc/-/issues/8256#note_310867, where this came up. - - - - - 0aec78b6 by Sebastian Graf at 2020-11-20T02:09:51-05:00 Demand: Interleave usage and strictness demands (#18903) As outlined in #18903, interleaving usage and strictness demands not only means a more compact demand representation, but also allows us to express demands that we weren't easily able to express before. Call demands are *relative* in the sense that a call demand `Cn(cd)` on `g` says "`g` is called `n` times. *Whenever `g` is called*, the result is used according to `cd`". Example from #18903: ```hs h :: Int -> Int h m = let g :: Int -> (Int,Int) g 1 = (m, 0) g n = (2 * n, 2 `div` n) {-# NOINLINE g #-} in case m of 1 -> 0 2 -> snd (g m) _ -> uncurry (+) (g m) ``` Without the interleaved representation, we would just get `L` for the strictness demand on `g`. Now we are able to express that whenever `g` is called, its second component is used strictly in denoting `g` by `1C1(P(1P(U),SP(U)))`. This would allow Nested CPR to unbox the division, for example. Fixes #18903. While fixing regressions, I also discovered and fixed #18957. Metric Decrease: T13253-spj - - - - - 3a55b3a2 by Sebastian Graf at 2020-11-20T02:09:51-05:00 Update user's guide entry on demand analysis and worker/wrapper The demand signature notation has been undocumented for a long time. The only source to understand it, apart from reading the `Outputable` instance, has been an outdated wiki page. Since the previous commits have reworked the demand lattice, I took it as an opportunity to also write some documentation about notation. - - - - - fc963932 by Greg Steuck at 2020-11-20T02:10:31-05:00 Find hadrian location more reliably in cabal-install output Fix #18944 - - - - - 9f40cf6c by Ben Gamari at 2020-11-20T02:11:07-05:00 rts/linker: Align bssSize to page size when mapping symbol extras We place symbol_extras right after bss. We also need to ensure that symbol_extras can be mprotect'd independently from the rest of the image. To ensure this we round up the size of bss to a page boundary, thus ensuring that symbol_extras is also page-aligned. - - - - - b739c319 by Ben Gamari at 2020-11-20T02:11:43-05:00 gitlab-ci: Add usage message to ci.sh - - - - - 802e9180 by Ben Gamari at 2020-11-20T02:11:43-05:00 gitlab-ci: Add VERBOSE environment variable And change the make build system's default behavior to V=0, greatly reducing build log sizes. - - - - - 2a8a979c by Ben Gamari at 2020-11-21T01:13:26-05:00 users-guide: A bit of clean-up in profiling flag documentation - - - - - 56804e33 by Ben Gamari at 2020-11-21T01:13:26-05:00 testsuite: Refactor CountParserDeps - - - - - 53ad67ea by Ben Gamari at 2020-11-21T01:13:26-05:00 Introduce -fprof-callers flag This introducing a new compiler flag to provide a convenient way to introduce profiler cost-centers on all occurrences of the named identifier. Closes #18566. - - - - - ecfd0278 by Sylvain Henry at 2020-11-21T01:14:09-05:00 Move Plugins into HscEnv (#17957) Loaded plugins have nothing to do in DynFlags so this patch moves them into HscEnv (session state). "DynFlags plugins" become "Driver plugins" to still be able to register static plugins. Bump haddock submodule - - - - - 72f2257c by Sylvain Henry at 2020-11-21T01:14:09-05:00 Don't initialize plugins in the Core2Core pipeline Some plugins can be added via TH (cf addCorePlugin). Initialize them in the driver instead of in the Core2Core pipeline. - - - - - ddbeeb3c by Ryan Scott at 2020-11-21T01:14:44-05:00 Add regression test for #10504 This issue was fixed at some point between GHC 8.0 and 8.2. Let's add a regression test to ensure that it stays fixed. Fixes #10504. - - - - - a4a6dc2a by Ben Gamari at 2020-11-21T01:15:21-05:00 dwarf: Apply info table offset consistently Previously we failed to apply the info table offset to the aranges and DIEs, meaning that we often failed to unwind in gdb. For some reason this only seemed to manifest in the RTS's Cmm closures. Nevertheless, now we can unwind completely up to `main` - - - - - 69bfbc21 by Ben Gamari at 2020-11-21T01:15:56-05:00 hadrian: Disable stripping when debug information is enabled - - - - - 7e93ae8b by Ben Gamari at 2020-11-21T13:13:29-05:00 rts: Post ticky entry counts to the eventlog We currently only post the entry counters, not the other global counters as in my experience the former are more useful. We use the heap profiler's census period to decide when to dump. Also spruces up the documentation surrounding ticky-ticky a bit. - - - - - bc9c3916 by Ben Gamari at 2020-11-22T06:28:10-05:00 Implement -ddump-c-backend argument To dump output of the C backend. - - - - - 901bc220 by Ben Gamari at 2020-11-22T12:39:02-05:00 Bump time submodule to 1.11.1 Also bumps directory, Cabal, hpc, time, and unix submodules. Closes #18847. - - - - - 92c0afbf by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Dump STG when ticky is enabled This changes the "ticky" modifier to enable dumping of final STG as this is generally needed to make sense of the ticky profiles. - - - - - d23fef68 by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Introduce notion of flavour transformers This extends Hadrian's notion of "flavour", as described in #18942. - - - - - 179d0bec by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Add a viaLlvmBackend modifier Note that this also slightly changes the semantics of these flavours as we only use LLVM for >= stage1 builds. - - - - - d4d95e51 by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Add profiled_ghc and no_dynamic_ghc modifiers - - - - - 6815603f by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Drop redundant flavour definitions Drop the profiled, LLVM, and ThreadSanitizer flavour definitions as these can now be realized with flavour transformers. - - - - - f88f4339 by Ben Gamari at 2020-11-24T02:43:20-05:00 rts: Flush eventlog buffers from flushEventLog As noted in #18043, flushTrace failed flush anything beyond the writer. This means that a significant amount of data sitting in capability-local event buffers may never get flushed, despite the users' pleads for us to flush. Fix this by making flushEventLog flush all of the event buffers before flushing the writer. Fixes #18043. - - - - - 7c03cc50 by Ben Gamari at 2020-11-24T02:43:55-05:00 gitlab-ci: Run LLVM job on appropriately-labelled MRs Namely, those marked with the ~"LLVM backend" label - - - - - 9b95d815 by Ben Gamari at 2020-11-24T02:43:55-05:00 gitlab-ci: Run LLVM builds on Debian 10 The current Debian 9 image doesn't provide LLVM 7. - - - - - 2ed3e6c0 by Ben Gamari at 2020-11-24T02:43:55-05:00 CmmToLlvm: Declare signature for memcmp Otherwise `opt` fails with: error: use of undefined value '@memcmp$def' - - - - - be5d74ca by Moritz Angermann at 2020-11-26T16:00:32-05:00 [Sized Cmm] properly retain sizes. This replaces all Word<N> = W<N># Word# and Int<N> = I<N># Int# with Word<N> = W<N># Word<N># and Int<N> = I<N># Int<N>#, thus providing us with properly sized primitives in the codegenerator instead of pretending they are all full machine words. This came up when implementing darwinpcs for arm64. The darwinpcs reqires us to pack function argugments in excess of registers on the stack. While most procedure call standards (pcs) assume arguments are just passed in 8 byte slots; and thus the caller does not know the exact signature to make the call, darwinpcs requires us to adhere to the prototype, and thus have the correct sizes. If we specify CInt in the FFI call, it should correspond to the C int, and not just be Word sized, when it's only half the size. This does change the expected output of T16402 but the new result is no less correct as it eliminates the narrowing (instead of the `and` as was previously done). Bumps the array, bytestring, text, and binary submodules. Co-Authored-By: Ben Gamari <ben at well-typed.com> Metric Increase: T13701 T14697 - - - - - a84e53f9 by Andreas Klebinger at 2020-11-26T16:00:32-05:00 RTS: Fix failed inlining of copy_tag. On windows using gcc-10 gcc failed to inline copy_tag into evacuate. To fix this we now set the always_inline attribute for the various copy* functions in Evac.c. The main motivation here is not the overhead of the function call, but rather that this allows the code to "specialize" for the size of the closure we copy which is often known at compile time. An earlier commit also tried to avoid evacuate_large inlining. But didn't quite succeed. So I also marked evacuate_large as noinline. Fixes #12416 - - - - - cdbd16f5 by Sylvain Henry at 2020-11-26T16:00:33-05:00 Fix toArgRep to support 64-bit reps on all systems [This is @Ericson2314 writing a commit message for @hsyl20's patch.] (Progress towards #11953, #17377, #17375) `Int64Rep` and `Word64Rep` are currently broken on 64-bit systems. This is because they should use "native arg rep" but instead use "large arg rep" as they do on 32-bit systems, which is either a non-concept or a 128-bit rep depending on one's vantage point. Now, these reps currently aren't used during 64-bit compilation, so the brokenness isn't observed, but I don't think that constitutes reasons not to fix it. Firstly, the linked issues there is a clearly expressed desire to use explicit-bitwidth constructs in more places. Secondly, per [1], there are other bugs that *do* manifest from not threading explicit-bitwidth information all the way through the compilation pipeline. One can therefore view this as one piece of the larger effort to do that, improve ergnomics, and squash remaining bugs. Also, this is needed for !3658. I could just merge this as part of that, but I'm keen on merging fixes "as they are ready" so the fixes that aren't ready are isolated and easier to debug. [1]: https://mail.haskell.org/pipermail/ghc-devs/2020-October/019332.html - - - - - a9378e69 by Tim Barnes at 2020-11-26T16:00:34-05:00 Set dynamic users-guide TOC spacing (fixes #18554) - - - - - 86a59d93 by Ben Gamari at 2020-11-26T16:00:34-05:00 rts: Use RTS_LIKELY in CHECK Most compilers probably already infer that `barf` diverges but it nevertheless doesn't hurt to be explicit. - - - - - 5757e82b by Matthew Pickering at 2020-11-26T16:00:35-05:00 Remove special case for GHC.ByteCode.Instr This was added in https://github.com/nomeata/ghc-heap-view/commit/34935206e51b9c86902481d84d2f368a6fd93423 GHC.ByteCode.Instr.BreakInfo no longer exists so the special case is dead code. Any check like this can be easily dealt with in client code. - - - - - d9c8b5b4 by Matthew Pickering at 2020-11-26T16:00:35-05:00 Split Up getClosureDataFromHeapRep Motivation 1. Don't enforce the repeated decoding of an info table, when the client can cache it (ghc-debug) 2. Allow the constructor information decoding to be overridden, this casues segfaults in ghc-debug - - - - - 3e3555cc by Andreas Klebinger at 2020-11-26T16:00:35-05:00 RegAlloc: Add missing raPlatformfield to RegAllocStatsSpill Fixes #18994 Co-Author: Benjamin Maurer <maurer.benjamin at gmail.com> - - - - - a1a75aa9 by Ben Gamari at 2020-11-27T06:20:41-05:00 rts: Allocate MBlocks with MAP_TOP_DOWN on Windows As noted in #18991, we would previously allocate heap in low memory. Due to this the linker, which typically *needs* low memory, would end up competing with the heap. In longer builds we end up running out of low memory entirely, leading to linking failures. - - - - - 75fc1ed5 by Sylvain Henry at 2020-11-28T15:40:23-05:00 Hadrian: fix detection of ghc-pkg for cross-compilers - - - - - 7cb5df96 by Sylvain Henry at 2020-11-28T15:40:23-05:00 hadrian: fix ghc-pkg uses (#17601) Make sure ghc-pkg doesn't read the compiler "settings" file by passing --no-user-package-db. - - - - - e3fd4226 by Ben Gamari at 2020-11-28T15:40:23-05:00 gitlab-ci: Introduce a nightly cross-compilation job This adds a job to test cross-compilation from x86-64 to AArch64 with Hadrian. Fixes #18234 - - - - - 698d3d96 by Ben Gamari at 2020-11-28T15:41:00-05:00 gitlab-ci: Only deploy GitLab Pages in ghc/ghc> The deployments are quite large and yet are currently only served for the ghc/ghc> project. - - - - - 625726f9 by David Eichmann at 2020-11-28T15:41:37-05:00 ghc-heap: partial TSO/STACK decoding Co-authored-by: Sven Tennie <sven.tennie at gmail.com> Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> Co-authored-by: Ben Gamari <bgamari.foss at gmail.com> - - - - - 22ea9c29 by Andreas Klebinger at 2020-11-28T15:42:13-05:00 Small optimization to CmmSink. Inside `regsUsedIn` we can avoid some thunks by specializing the recursion. In particular we avoid the thunk for `(f e z)` in the MachOp/Load branches, where we know this will evaluate to z. Reduces allocations for T3294 by ~1%. - - - - - bba42c62 by John Ericson at 2020-11-28T15:42:49-05:00 Make primop handler indentation more consistent - - - - - c82bc8e9 by John Ericson at 2020-11-28T15:42:49-05:00 Cleanup some primop constructor names Harmonize the internal (big sum type) names of the native vs fixed-sized number primops a bit. (Mainly by renaming the former.) No user-facing names are changed. - - - - - ae14f160 by Ben Gamari at 2020-11-28T15:43:25-05:00 testsuite: Mark T14702 as fragile on Windows Due to #18953. - - - - - 1bc104b0 by Ben Gamari at 2020-11-29T15:33:18-05:00 withTimings: Emit allocations counter This will allow us to back out the allocations per compiler pass from the eventlog. Note that we dump the allocation counter rather than the difference since this will allow us to determine how much work is done *between* `withTiming` blocks. - - - - - e992ea84 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 ThreadPaused: Don't zero slop until free vars are pushed When threadPaused blackholes a thunk it calls `OVERWRITING_CLOSURE` to zero the slop for the benefit of the sanity checker. Previously this was done *before* pushing the thunk's free variables to the update remembered set. Consequently we would pull zero'd pointers to the update remembered set. - - - - - e82cd140 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Fix regression from TSAN work The TSAN rework (specifically aad1f803) introduced a subtle regression in GC.c, swapping `g0` in place of `gen`. Whoops! Fixes #18997. - - - - - 35a5207e by GHC GitLab CI at 2020-11-29T15:33:54-05:00 rts/Messages: Add missing write barrier in THROWTO message update After a THROWTO message has been handle the message closure is overwritten by a NULL message. We must ensure that the original closure's pointers continue to be visible to the nonmoving GC. - - - - - 0120829f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Add missing write barrier in shrinkSmallByteArray - - - - - 8a4d8fb6 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 Updates: Don't zero slop until closure has been pushed Ensure that the the free variables have been pushed to the update remembered set before we zero the slop. - - - - - 2793cfdc by GHC GitLab CI at 2020-11-29T15:33:54-05:00 OSThreads: Fix error code checking pthread_join returns its error code and apparently doesn't set errno. - - - - - e391a16f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Don't join to mark_thread on shutdown The mark thread is not joinable as we detach from it on creation. - - - - - 60d088ab by Ben Gamari at 2020-11-29T15:33:54-05:00 nonmoving: Add reference to Ueno 2016 - - - - - 3aa60362 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Ensure that evacuated large objects are marked See Note [Non-moving GC: Marking evacuated objects]. - - - - - 8d304a99 by Ben Gamari at 2020-11-30T10:15:22-05:00 rts/m32: Refactor handling of allocator seeding Previously, in an attempt to reduce fragmentation, each new allocator would map a region of M32_MAX_PAGES fresh pages to seed itself. However, this ends up being extremely wasteful since it turns out that we often use fewer than this. Consequently, these pages end up getting freed which, ends up fragmenting our address space more than than we would have if we had naively allocated pages on-demand. Here we refactor m32 to avoid this waste while achieving the fragmentation mitigation previously desired. In particular, we move all page allocation into the global m32_alloc_page, which will pull a page from the free page pool. If the free page pool is empty we then refill it by allocating a region of M32_MAP_PAGES and adding them to the pool. Furthermore, we do away with the initial seeding entirely. That is, the allocator starts with no active pages: pages are rather allocated on an as-needed basis. On the whole this ends up being a pleasingly simple change, simultaneously making m32 more efficient, more robust, and simpler. Fixes #18980. - - - - - b6629289 by Ben Gamari at 2020-11-30T10:15:58-05:00 rts: Use CHECK instead of assert Use the GHC wrappers instead of <assert.h>. - - - - - 9f4efa6a by Ben Gamari at 2020-11-30T10:15:58-05:00 rts/linker: Replace some ASSERTs with CHECK In the past some people have confused ASSERT, which is for checking internal invariants, which CHECK, which should be used when checking things that might fail due to bad input (and therefore should be enabled even in the release compiler). Change some of these cases in the linker to use CHECK. - - - - - 0f8a4655 by Ryan Scott at 2020-11-30T10:16:34-05:00 Allow deploy:pages job to fail See #18973. - - - - - 49ebe369 by chessai at 2020-11-30T19:47:40-05:00 Optimisations in Data.Foldable (T17867) This PR concerns the following functions from `Data.Foldable`: * minimum * maximum * sum * product * minimumBy * maximumBy - Default implementations of these functions now use `foldl'` or `foldMap'`. - All have been marked with INLINEABLE to make room for further optimisations. - - - - - 4d79ef65 by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - 6af074ce by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - ab334262 by Viktor Dukhovni at 2020-11-30T19:48:17-05:00 dirty MVAR after mutating TSO queue head While the original head and tail of the TSO queue may be in the same generation as the MVAR, interior elements of the queue could be younger after a GC run and may then be exposed by putMVar operation that updates the queue head. Resolves #18919 - - - - - 5eb163f3 by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Don't allow shared libraries to be loaded multiple times - - - - - 490aa14d by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Initialise CCSs from native shared objects - - - - - 6ac3db5f by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Move shared library loading logic into Elf.c - - - - - b6698d73 by GHC GitLab CI at 2020-11-30T19:48:53-05:00 rts/linker: Don't declare dynamic objects with image_mapped This previously resulted in warnings due to spurious unmap failures. - - - - - b94a65af by jneira at 2020-11-30T19:49:31-05:00 Include tried paths in findToolDir error - - - - - 72a87fbc by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Move core flattening algorithm to Core.Unify This sets the stage for a later change, where this algorithm will be needed from GHC.Core.InstEnv. This commit also splits GHC.Core.Map into GHC.Core.Map.Type and GHC.Core.Map.Expr, in order to avoid module import cycles with GHC.Core. - - - - - 0dd45d0a by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Bump the # of commits searched for perf baseline The previous value of 75 meant that a feature branch with more than 75 commits would get spurious CI passes. This affects #18692, but does not fix that ticket, because if a baseline cannot be found, we should fail, not succeed. - - - - - 8bb52d91 by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Remove flattening variables This patch redesigns the flattener to simplify type family applications directly instead of using flattening meta-variables and skolems. The key new innovation is the CanEqLHS type and the new CEqCan constraint (Ct). A CanEqLHS is either a type variable or exactly-saturated type family application; either can now be rewritten using a CEqCan constraint in the inert set. Because the flattener no longer reduces all type family applications to variables, there was some performance degradation if a lengthy type family application is now flattened over and over (not making progress). To compensate, this patch contains some extra optimizations in the flattener, leading to a number of performance improvements. Close #18875. Close #18910. There are many extra parts of the compiler that had to be affected in writing this patch: * The family-application cache (formerly the flat-cache) sometimes stores coercions built from Given inerts. When these inerts get kicked out, we must kick out from the cache as well. (This was, I believe, true previously, but somehow never caused trouble.) Kicking out from the cache requires adding a filterTM function to TrieMap. * This patch obviates the need to distinguish "blocking" coercion holes from non-blocking ones (which, previously, arose from CFunEqCans). There is thus some simplification around coercion holes. * Extra commentary throughout parts of the code I read through, to preserve the knowledge I gained while working. * A change in the pure unifier around unifying skolems with other types. Unifying a skolem now leads to SurelyApart, not MaybeApart, as documented in Note [Binding when looking up instances] in GHC.Core.InstEnv. * Some more use of MCoercion where appropriate. * Previously, class-instance lookup automatically noticed that e.g. C Int was a "unifier" to a target [W] C (F Bool), because the F Bool was flattened to a variable. Now, a little more care must be taken around checking for unifying instances. * Previously, tcSplitTyConApp_maybe would split (Eq a => a). This is silly, because (=>) is not a tycon in Haskell. Fixed now, but there are some knock-on changes in e.g. TrieMap code and in the canonicaliser. * New function anyFreeVarsOf{Type,Co} to check whether a free variable satisfies a certain predicate. * Type synonyms now remember whether or not they are "forgetful"; a forgetful synonym drops at least one argument. This is useful when flattening; see flattenView. * The pattern-match completeness checker invokes the solver. This invocation might need to look through newtypes when checking representational equality. Thus, the desugarer needs to keep track of the in-scope variables to know what newtype constructors are in scope. I bet this bug was around before but never noticed. * Extra-constraints wildcards are no longer simplified before printing. See Note [Do not simplify ConstraintHoles] in GHC.Tc.Solver. * Whether or not there are Given equalities has become slightly subtler. See the new HasGivenEqs datatype. * Note [Type variable cycles in Givens] in GHC.Tc.Solver.Canonical explains a significant new wrinkle in the new approach. * See Note [What might match later?] in GHC.Tc.Solver.Interact, which explains the fix to #18910. * The inert_count field of InertCans wasn't actually used, so I removed it. Though I (Richard) did the implementation, Simon PJ was very involved in design and review. This updates the Haddock submodule to avoid #18932 by adding a type signature. ------------------------- Metric Decrease: T12227 T5030 T9872a T9872b T9872c Metric Increase: T9872d ------------------------- - - - - - d66660ba by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Rename the flattener to become the rewriter. Now that flattening doesn't produce flattening variables, it's not really flattening anything: it's rewriting. This change also means that the rewriter can no longer be confused the core flattener (in GHC.Core.Unify), which is sometimes used during type-checking. - - - - - add0aeae by Ben Gamari at 2020-12-01T19:58:17-05:00 rts: Introduce mmapAnonForLinker Previously most of the uses of mmapForLinker were mapping anonymous memory, resulting in a great deal of unnecessary repetition. Factor this out into a new helper. Also fixes a few places where error checking was missing or suboptimal. - - - - - 97d71646 by Ben Gamari at 2020-12-01T19:58:17-05:00 rts/linker: Introduce munmapForLinker Consolidates munmap calls to ensure consistent error handling. - - - - - d8872af0 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/Linker: Introduce Windows implementations for mmapForLinker, et al. - - - - - c35d0e03 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/m32: Introduce NEEDS_M32 macro Instead of relying on RTS_LINKER_USE_MMAP - - - - - 41c64eb5 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/linker: Use m32 to allocate symbol extras in PEi386 - - - - - e0b08c5f by Ben Gamari at 2020-12-03T13:01:47-05:00 gitlab-ci: Fix copy-paste error Also be more consistent in quoting. - - - - - 33ec3a06 by Ben Gamari at 2020-12-03T23:11:31-05:00 gitlab-ci: Run linters through ci.sh Ensuring that the right toolchain is used. - - - - - 4a437bc1 by Shayne Fletcher at 2020-12-05T09:06:38-05:00 Fix bad span calculations of post qualified imports - - - - - 8fac4b93 by Ben Gamari at 2020-12-05T09:07:13-05:00 testsuite: Add a test for #18923 - - - - - 62ed6957 by Simon Peyton Jones at 2020-12-08T15:31:41-05:00 Fix kind inference for data types. Again. This patch fixes several aspects of kind inference for data type declarations, especially data /instance/ declarations Specifically 1. In kcConDecls/kcConDecl make it clear that the tc_res_kind argument is only used in the H98 case; and in that case there is no result kind signature; and hence no need for the disgusting splitPiTys in kcConDecls (now thankfully gone). The GADT case is a bit different to before, and much nicer. This is what fixes #18891. See Note [kcConDecls: kind-checking data type decls] 2. Do not look at the constructor decls of a data/newtype instance in tcDataFamInstanceHeader. See GHC.Tc.TyCl.Instance Note [Kind inference for data family instances]. This was a new realisation that arose when doing (1) This causes a few knock-on effects in the tests suite, because we require more information than before in the instance /header/. New user-manual material about this in "Kind inference in data type declarations" and "Kind inference for data/newtype instance declarations". 3. Minor improvement in kcTyClDecl, combining GADT and H98 cases 4. Fix #14111 and #8707 by allowing the header of a data instance to affect kind inferece for the the data constructor signatures; as described at length in Note [GADT return types] in GHC.Tc.TyCl This led to a modest refactoring of the arguments (and argument order) of tcConDecl/tcConDecls. 5. Fix #19000 by inverting the sense of the test in new_locs in GHC.Tc.Solver.Canonical.canDecomposableTyConAppOK. - - - - - 0abe3ddf by Adam Sandberg Ericsson at 2020-12-08T15:32:19-05:00 hadrian: build the _l and _thr_l rts flavours in the develN flavours The ghc binary requires the eventlog rts since fc644b1a643128041cfec25db84e417851e28bab - - - - - d3e5a77c by Simon Peyton Jones at 2020-12-08T16:52:39-05:00 Work in progress on #18359 Joint work between Richard, Simon, Ryan - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - aclocal.m4 - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/Config.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/Dwarf/Constants.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/Monad.hs - compiler/GHC/CmmToAsm/PIC.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/Reg/Graph.hs - compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs - compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs - compiler/GHC/CmmToAsm/Reg/Linear.hs - compiler/GHC/CmmToAsm/Reg/Linear/FreeRegs.hs - compiler/GHC/CmmToAsm/Reg/Target.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8da38465bfce4dab706429ea3197f7b70d832320...d3e5a77c3dca22191704890384cdad4e60d3a30e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8da38465bfce4dab706429ea3197f7b70d832320...d3e5a77c3dca22191704890384cdad4e60d3a30e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 8 21:58:55 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 08 Dec 2020 16:58:55 -0500 Subject: [Git][ghc/ghc][wip/T19030] 4 commits: Fix kind inference for data types. Again. Message-ID: <5fcff71fa346a_6b211805218635784@gitlab.mail> Ben Gamari pushed to branch wip/T19030 at Glasgow Haskell Compiler / GHC Commits: 62ed6957 by Simon Peyton Jones at 2020-12-08T15:31:41-05:00 Fix kind inference for data types. Again. This patch fixes several aspects of kind inference for data type declarations, especially data /instance/ declarations Specifically 1. In kcConDecls/kcConDecl make it clear that the tc_res_kind argument is only used in the H98 case; and in that case there is no result kind signature; and hence no need for the disgusting splitPiTys in kcConDecls (now thankfully gone). The GADT case is a bit different to before, and much nicer. This is what fixes #18891. See Note [kcConDecls: kind-checking data type decls] 2. Do not look at the constructor decls of a data/newtype instance in tcDataFamInstanceHeader. See GHC.Tc.TyCl.Instance Note [Kind inference for data family instances]. This was a new realisation that arose when doing (1) This causes a few knock-on effects in the tests suite, because we require more information than before in the instance /header/. New user-manual material about this in "Kind inference in data type declarations" and "Kind inference for data/newtype instance declarations". 3. Minor improvement in kcTyClDecl, combining GADT and H98 cases 4. Fix #14111 and #8707 by allowing the header of a data instance to affect kind inferece for the the data constructor signatures; as described at length in Note [GADT return types] in GHC.Tc.TyCl This led to a modest refactoring of the arguments (and argument order) of tcConDecl/tcConDecls. 5. Fix #19000 by inverting the sense of the test in new_locs in GHC.Tc.Solver.Canonical.canDecomposableTyConAppOK. - - - - - 0abe3ddf by Adam Sandberg Ericsson at 2020-12-08T15:32:19-05:00 hadrian: build the _l and _thr_l rts flavours in the develN flavours The ghc binary requires the eventlog rts since fc644b1a643128041cfec25db84e417851e28bab - - - - - b48ef08d by Ben Gamari at 2020-12-08T16:57:23-05:00 ghci: Take editor from VISUAL environment variable Following the example of `git`, as noted in #19030. Fixes #19030. - - - - - ecb8b369 by Ben Gamari at 2020-12-08T16:58:01-05:00 users guide: Fix syntasx errors - - - - - 30 changed files: - compiler/GHC/Hs/Extension.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Instance.hs - docs/users_guide/9.2.1-notes.rst - docs/users_guide/exts/poly_kinds.rst - docs/users_guide/ghci.rst - docs/users_guide/using-optimisation.rst - ghc/GHCi/UI.hs - hadrian/src/Settings/Flavours/Development.hs - testsuite/tests/dependent/should_fail/T13780a.stderr - testsuite/tests/deriving/should_compile/T11416.hs - testsuite/tests/deriving/should_compile/T9359.hs - + testsuite/tests/gadt/SynDataRec.hs - testsuite/tests/gadt/all.T - + testsuite/tests/indexed-types/should_compile/T14111.hs - + testsuite/tests/indexed-types/should_compile/T8707.hs - testsuite/tests/indexed-types/should_compile/all.T - testsuite/tests/indexed-types/should_fail/T8368.stderr - testsuite/tests/indexed-types/should_fail/T8368a.stderr - testsuite/tests/patsyn/should_fail/T15685.stderr - testsuite/tests/polykinds/T13659.stderr - testsuite/tests/polykinds/T16221a.stderr - testsuite/tests/th/T11145.stderr - testsuite/tests/th/T9692.hs - + testsuite/tests/typecheck/should_compile/T18891.hs - testsuite/tests/typecheck/should_compile/UnliftedNewtypesUnassociatedFamily.hs - testsuite/tests/typecheck/should_compile/UnliftedNewtypesUnifySig.hs - testsuite/tests/typecheck/should_compile/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a16764daf1a77f3983bf14e970c0ad6869312557...ecb8b36971a883594f4d2651b57bff1fffbf04ea -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a16764daf1a77f3983bf14e970c0ad6869312557...ecb8b36971a883594f4d2651b57bff1fffbf04ea You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 9 03:43:29 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 08 Dec 2020 22:43:29 -0500 Subject: [Git][ghc/ghc][master] 5 commits: CodeGen: Make folds User/DefinerOfRegs INLINEABLE. Message-ID: <5fd047e142bcc_6b21258bc706602f0@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 51e3bb6d by Andreas Klebinger at 2020-12-08T22:43:21-05:00 CodeGen: Make folds User/DefinerOfRegs INLINEABLE. Reduces allocation for the test case I was looking at by about 1.2%. Mostly from avoiding allocation of some folding functions which turn into let-no-escape bindings which just reuse their environment instead. We also force inlining in a few key places in CmmSink which helps a bit more. - - - - - 69ae10c3 by Andreas Klebinger at 2020-12-08T22:43:21-05:00 CmmSink: Force inlining of foldRegsDefd Helps avoid allocating the folding function. Improves perf for T3294 by about 1%. - - - - - 6e3da800 by Andreas Klebinger at 2020-12-08T22:43:21-05:00 Cmm: Make a few types and utility function slightly stricter. About 0.6% reduction in allocations for the code I was looking at. Not a huge difference but no need to throw away performance. - - - - - aef44d7f by Andreas Klebinger at 2020-12-08T22:43:21-05:00 Cmm.Sink: Optimize retaining of assignments, live sets. Sinking requires us to track live local regs after each cmm statement. We used to do this via "Set LocalReg". However we can replace this with a solution based on IntSet which is overall more efficient without losing much. The thing we lose is width of the variables, which isn't used by the sinking pass anyway. I also reworked how we keep assignments to regs mentioned in skipped assignments. I put the details into Note [Keeping assignemnts mentioned in skipped RHSs]. The gist of it is instead of keeping track of it via the use count which is a `IntMap Int` we now use the live regs set (IntSet) which is quite a bit faster. I think it also matches the semantics a lot better. The skipped (not discarded) assignment does in fact keep the regs on it's rhs alive so keeping track of this in the live set seems like the clearer solution as well. Improves allocations for T3294 by yet another 1%. - - - - - 59f2249b by Andreas Klebinger at 2020-12-08T22:43:21-05:00 GHC.Cmm.Opt: Be stricter in results. Optimization either returns Nothing if nothing is to be done or `Just <cmmExpr>` otherwise. There is no point in being lazy in `cmmExpr`. We usually inspect this element so the thunk gets forced not long after. We might eliminate it as dead code once in a blue moon but that's not a case worth optimizing for. Overall the impact of this is rather low. As Cmm.Opt doesn't allocate much (compared to the rest of GHC) to begin with. - - - - - 9 changed files: - compiler/GHC/Cmm/Expr.hs - + compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Liveness.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/Utils/Outputable.hs - compiler/ghc.cabal.in Changes: ===================================== compiler/GHC/Cmm/Expr.hs ===================================== @@ -53,14 +53,14 @@ import GHC.Types.Basic (Alignment, mkAlignment, alignmentOf) ----------------------------------------------------------------------------- data CmmExpr - = CmmLit CmmLit -- Literal + = CmmLit !CmmLit -- Literal | CmmLoad !CmmExpr !CmmType -- Read memory location | CmmReg !CmmReg -- Contents of register | CmmMachOp MachOp [CmmExpr] -- Machine operation (+, -, *, etc.) | CmmStackSlot Area {-# UNPACK #-} !Int -- addressing expression of a stack slot -- See Note [CmmStackSlot aliasing] - | CmmRegOff !CmmReg Int + | CmmRegOff !CmmReg !Int -- CmmRegOff reg i -- ** is shorthand only, meaning ** -- CmmMachOp (MO_Add rep) [x, CmmLit (CmmInt (fromIntegral i) rep)] @@ -173,16 +173,16 @@ Now, the assignments of y go away, -} data CmmLit - = CmmInt !Integer Width + = CmmInt !Integer !Width -- Interpretation: the 2's complement representation of the value -- is truncated to the specified size. This is easier than trying -- to keep the value within range, because we don't know whether -- it will be used as a signed or unsigned value (the CmmType doesn't -- distinguish between signed & unsigned). - | CmmFloat Rational Width + | CmmFloat Rational !Width | CmmVec [CmmLit] -- Vector literal | CmmLabel CLabel -- Address of label - | CmmLabelOff CLabel Int -- Address of label + byte offset + | CmmLabelOff CLabel !Int -- Address of label + byte offset -- Due to limitations in the C backend, the following -- MUST ONLY be used inside the info table indicated by label2 @@ -191,7 +191,7 @@ data CmmLit -- Don't use it at all unless tablesNextToCode. -- It is also used inside the NCG during when generating -- position-independent code. - | CmmLabelDiffOff CLabel CLabel Int Width -- label1 - label2 + offset + | CmmLabelDiffOff CLabel CLabel !Int !Width -- label1 - label2 + offset -- In an expression, the width just has the effect of MO_SS_Conv -- from wordWidth to the desired width. -- @@ -363,6 +363,7 @@ instance DefinerOfRegs LocalReg CmmReg where foldRegsDefd _ _ z (CmmGlobal _) = z instance UserOfRegs GlobalReg CmmReg where + {-# INLINEABLE foldRegsUsed #-} foldRegsUsed _ _ z (CmmLocal _) = z foldRegsUsed _ f z (CmmGlobal reg) = f z reg @@ -379,6 +380,7 @@ instance Ord r => DefinerOfRegs r r where instance (Ord r, UserOfRegs r CmmReg) => UserOfRegs r CmmExpr where -- The (Ord r) in the context is necessary here -- See Note [Recursive superclasses] in GHC.Tc.TyCl.Instance + {-# INLINEABLE foldRegsUsed #-} foldRegsUsed platform f !z e = expr z e where expr z (CmmLit _) = z expr z (CmmLoad addr _) = foldRegsUsed platform f z addr ===================================== compiler/GHC/Cmm/LRegSet.hs ===================================== @@ -0,0 +1,53 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module GHC.Cmm.LRegSet ( + LRegSet, + LRegKey, + + emptyLRegSet, + nullLRegSet, + insertLRegSet, + elemLRegSet, + + deleteFromLRegSet, + sizeLRegSet, + + plusLRegSet, + elemsLRegSet + ) where + +import GHC.Prelude +import GHC.Types.Unique +import GHC.Cmm.Expr + +import Data.IntSet as IntSet + +-- Compact sets for membership tests of local variables. + +type LRegSet = IntSet.IntSet +type LRegKey = Int + +emptyLRegSet :: LRegSet +emptyLRegSet = IntSet.empty + +nullLRegSet :: LRegSet -> Bool +nullLRegSet = IntSet.null + +insertLRegSet :: LocalReg -> LRegSet -> LRegSet +insertLRegSet l = IntSet.insert (getKey (getUnique l)) + +elemLRegSet :: LocalReg -> LRegSet -> Bool +elemLRegSet l = IntSet.member (getKey (getUnique l)) + +deleteFromLRegSet :: LRegSet -> LocalReg -> LRegSet +deleteFromLRegSet set reg = IntSet.delete (getKey . getUnique $ reg) set + +sizeLRegSet :: IntSet -> Int +sizeLRegSet = IntSet.size + +plusLRegSet :: IntSet -> IntSet -> IntSet +plusLRegSet = IntSet.union + +elemsLRegSet :: IntSet -> [Int] +elemsLRegSet = IntSet.toList ===================================== compiler/GHC/Cmm/Liveness.hs ===================================== @@ -6,9 +6,12 @@ module GHC.Cmm.Liveness ( CmmLocalLive , cmmLocalLiveness + , cmmLocalLivenessL , cmmGlobalLiveness , liveLattice + , liveLatticeL , gen_kill + , gen_killL ) where @@ -22,11 +25,14 @@ import GHC.Cmm.Dataflow.Block import GHC.Cmm.Dataflow.Collections import GHC.Cmm.Dataflow import GHC.Cmm.Dataflow.Label +import GHC.Cmm.LRegSet import GHC.Data.Maybe import GHC.Utils.Outputable import GHC.Utils.Panic +import GHC.Types.Unique + ----------------------------------------------------------------------------- -- Calculating what variables are live on entry to a basic block ----------------------------------------------------------------------------- @@ -92,3 +98,66 @@ xferLive platform (BlockCC eNode middle xNode) fBase = in mapSingleton (entryLabel eNode) result {-# SPECIALIZE xferLive :: Platform -> TransferFun (CmmLive LocalReg) #-} {-# SPECIALIZE xferLive :: Platform -> TransferFun (CmmLive GlobalReg) #-} + +----------------------------------------------------------------------------- +-- | Specialization that only retains the keys for local variables. +-- +-- Local variablas are mostly glorified Ints, and some parts of the compiler +-- really don't care about anything but the Int part. So we can avoid some +-- overhead by computing a IntSet instead of a Set LocalReg which (unsurprisingly) +-- is quite a bit faster. +----------------------------------------------------------------------------- + +type BlockEntryLivenessL = LabelMap LRegSet + +-- | The dataflow lattice +liveLatticeL :: DataflowLattice LRegSet +liveLatticeL = DataflowLattice emptyLRegSet add + where + add (OldFact old) (NewFact new) = + let !join = plusLRegSet old new + in changedIf (sizeLRegSet join > sizeLRegSet old) join + + +cmmLocalLivenessL :: Platform -> CmmGraph -> BlockEntryLivenessL +cmmLocalLivenessL platform graph = + check $ analyzeCmmBwd liveLatticeL (xferLiveL platform) graph mapEmpty + where + entry = g_entry graph + check facts = + noLiveOnEntryL entry (expectJust "check" $ mapLookup entry facts) facts + +-- | On entry to the procedure, there had better not be any LocalReg's live-in. +noLiveOnEntryL :: BlockId -> LRegSet -> a -> a +noLiveOnEntryL bid in_fact x = + if nullLRegSet in_fact then x + else pprPanic "LocalReg's live-in to graph" (ppr bid <+> ppr reg_uniques) + where + -- We convert the int's to uniques so that the printing matches that + -- of registers. + reg_uniques = map mkUniqueGrimily $ elemsLRegSet in_fact + + + + +gen_killL + :: (DefinerOfRegs LocalReg n, UserOfRegs LocalReg n) + => Platform -> n -> LRegSet -> LRegSet +gen_killL platform node set = + let !afterKill = foldRegsDefd platform deleteFromLRegSet set node + in foldRegsUsed platform (flip insertLRegSet) afterKill node +{-# INLINE gen_killL #-} + +xferLiveL + :: ( UserOfRegs LocalReg (CmmNode O O) + , DefinerOfRegs LocalReg (CmmNode O O) + , UserOfRegs LocalReg (CmmNode O C) + , DefinerOfRegs LocalReg (CmmNode O C) + ) + => Platform -> TransferFun LRegSet +xferLiveL platform (BlockCC eNode middle xNode) fBase = + let joined = gen_killL platform xNode $! joinOutFacts liveLatticeL xNode fBase + !result = foldNodesBwdOO (gen_killL platform) middle joined + in mapSingleton (entryLabel eNode) result + + ===================================== compiler/GHC/Cmm/Node.hs ===================================== @@ -318,6 +318,7 @@ foreignTargetHints target -- Instances of register and slot users / definers instance UserOfRegs LocalReg (CmmNode e x) where + {-# INLINEABLE foldRegsUsed #-} foldRegsUsed platform f !z n = case n of CmmAssign _ expr -> fold f z expr CmmStore addr rval -> fold f (fold f z addr) rval @@ -332,6 +333,7 @@ instance UserOfRegs LocalReg (CmmNode e x) where fold f z n = foldRegsUsed platform f z n instance UserOfRegs GlobalReg (CmmNode e x) where + {-# INLINEABLE foldRegsUsed #-} foldRegsUsed platform f !z n = case n of CmmAssign _ expr -> fold f z expr CmmStore addr rval -> fold f (fold f z addr) rval @@ -348,10 +350,12 @@ instance UserOfRegs GlobalReg (CmmNode e x) where instance (Ord r, UserOfRegs r CmmReg) => UserOfRegs r ForeignTarget where -- The (Ord r) in the context is necessary here -- See Note [Recursive superclasses] in GHC.Tc.TyCl.Instance + {-# INLINEABLE foldRegsUsed #-} foldRegsUsed _ _ !z (PrimTarget _) = z foldRegsUsed platform f !z (ForeignTarget e _) = foldRegsUsed platform f z e instance DefinerOfRegs LocalReg (CmmNode e x) where + {-# INLINEABLE foldRegsDefd #-} foldRegsDefd platform f !z n = case n of CmmAssign lhs _ -> fold f z lhs CmmUnsafeForeignCall _ fs _ -> fold f z fs @@ -362,6 +366,7 @@ instance DefinerOfRegs LocalReg (CmmNode e x) where fold f z n = foldRegsDefd platform f z n instance DefinerOfRegs GlobalReg (CmmNode e x) where + {-# INLINEABLE foldRegsDefd #-} foldRegsDefd platform f !z n = case n of CmmAssign lhs _ -> fold f z lhs CmmUnsafeForeignCall tgt _ _ -> fold f z (foreignTargetRegs tgt) ===================================== compiler/GHC/Cmm/Opt.hs ===================================== @@ -58,7 +58,7 @@ cmmMachOpFoldM -> Maybe CmmExpr cmmMachOpFoldM _ op [CmmLit (CmmInt x rep)] - = Just $ case op of + = Just $! case op of MO_S_Neg _ -> CmmLit (CmmInt (-x) rep) MO_Not _ -> CmmLit (CmmInt (complement x) rep) @@ -90,13 +90,13 @@ cmmMachOpFoldM platform conv_outer [CmmMachOp conv_inner [x]] -- but remember to use the signedness from the widening, just in case -- the final conversion is a widen. | rep1 < rep2 && rep2 > rep3 -> - Just $ cmmMachOpFold platform (intconv signed1 rep1 rep3) [x] + Just $! cmmMachOpFold platform (intconv signed1 rep1 rep3) [x] -- Nested widenings: collapse if the signedness is the same | rep1 < rep2 && rep2 < rep3 && signed1 == signed2 -> - Just $ cmmMachOpFold platform (intconv signed1 rep1 rep3) [x] + Just $! cmmMachOpFold platform (intconv signed1 rep1 rep3) [x] -- Nested narrowings: collapse | rep1 > rep2 && rep2 > rep3 -> - Just $ cmmMachOpFold platform (MO_UU_Conv rep1 rep3) [x] + Just $! cmmMachOpFold platform (MO_UU_Conv rep1 rep3) [x] | otherwise -> Nothing where @@ -117,34 +117,34 @@ cmmMachOpFoldM platform mop [CmmLit (CmmInt x xrep), CmmLit (CmmInt y _)] = case mop of -- for comparisons: don't forget to narrow the arguments before -- comparing, since they might be out of range. - MO_Eq _ -> Just $ CmmLit (CmmInt (if x_u == y_u then 1 else 0) (wordWidth platform)) - MO_Ne _ -> Just $ CmmLit (CmmInt (if x_u /= y_u then 1 else 0) (wordWidth platform)) - - MO_U_Gt _ -> Just $ CmmLit (CmmInt (if x_u > y_u then 1 else 0) (wordWidth platform)) - MO_U_Ge _ -> Just $ CmmLit (CmmInt (if x_u >= y_u then 1 else 0) (wordWidth platform)) - MO_U_Lt _ -> Just $ CmmLit (CmmInt (if x_u < y_u then 1 else 0) (wordWidth platform)) - MO_U_Le _ -> Just $ CmmLit (CmmInt (if x_u <= y_u then 1 else 0) (wordWidth platform)) - - MO_S_Gt _ -> Just $ CmmLit (CmmInt (if x_s > y_s then 1 else 0) (wordWidth platform)) - MO_S_Ge _ -> Just $ CmmLit (CmmInt (if x_s >= y_s then 1 else 0) (wordWidth platform)) - MO_S_Lt _ -> Just $ CmmLit (CmmInt (if x_s < y_s then 1 else 0) (wordWidth platform)) - MO_S_Le _ -> Just $ CmmLit (CmmInt (if x_s <= y_s then 1 else 0) (wordWidth platform)) - - MO_Add r -> Just $ CmmLit (CmmInt (x + y) r) - MO_Sub r -> Just $ CmmLit (CmmInt (x - y) r) - MO_Mul r -> Just $ CmmLit (CmmInt (x * y) r) - MO_U_Quot r | y /= 0 -> Just $ CmmLit (CmmInt (x_u `quot` y_u) r) - MO_U_Rem r | y /= 0 -> Just $ CmmLit (CmmInt (x_u `rem` y_u) r) - MO_S_Quot r | y /= 0 -> Just $ CmmLit (CmmInt (x `quot` y) r) - MO_S_Rem r | y /= 0 -> Just $ CmmLit (CmmInt (x `rem` y) r) - - MO_And r -> Just $ CmmLit (CmmInt (x .&. y) r) - MO_Or r -> Just $ CmmLit (CmmInt (x .|. y) r) - MO_Xor r -> Just $ CmmLit (CmmInt (x `xor` y) r) - - MO_Shl r -> Just $ CmmLit (CmmInt (x `shiftL` fromIntegral y) r) - MO_U_Shr r -> Just $ CmmLit (CmmInt (x_u `shiftR` fromIntegral y) r) - MO_S_Shr r -> Just $ CmmLit (CmmInt (x `shiftR` fromIntegral y) r) + MO_Eq _ -> Just $! CmmLit (CmmInt (if x_u == y_u then 1 else 0) (wordWidth platform)) + MO_Ne _ -> Just $! CmmLit (CmmInt (if x_u /= y_u then 1 else 0) (wordWidth platform)) + + MO_U_Gt _ -> Just $! CmmLit (CmmInt (if x_u > y_u then 1 else 0) (wordWidth platform)) + MO_U_Ge _ -> Just $! CmmLit (CmmInt (if x_u >= y_u then 1 else 0) (wordWidth platform)) + MO_U_Lt _ -> Just $! CmmLit (CmmInt (if x_u < y_u then 1 else 0) (wordWidth platform)) + MO_U_Le _ -> Just $! CmmLit (CmmInt (if x_u <= y_u then 1 else 0) (wordWidth platform)) + + MO_S_Gt _ -> Just $! CmmLit (CmmInt (if x_s > y_s then 1 else 0) (wordWidth platform)) + MO_S_Ge _ -> Just $! CmmLit (CmmInt (if x_s >= y_s then 1 else 0) (wordWidth platform)) + MO_S_Lt _ -> Just $! CmmLit (CmmInt (if x_s < y_s then 1 else 0) (wordWidth platform)) + MO_S_Le _ -> Just $! CmmLit (CmmInt (if x_s <= y_s then 1 else 0) (wordWidth platform)) + + MO_Add r -> Just $! CmmLit (CmmInt (x + y) r) + MO_Sub r -> Just $! CmmLit (CmmInt (x - y) r) + MO_Mul r -> Just $! CmmLit (CmmInt (x * y) r) + MO_U_Quot r | y /= 0 -> Just $! CmmLit (CmmInt (x_u `quot` y_u) r) + MO_U_Rem r | y /= 0 -> Just $! CmmLit (CmmInt (x_u `rem` y_u) r) + MO_S_Quot r | y /= 0 -> Just $! CmmLit (CmmInt (x `quot` y) r) + MO_S_Rem r | y /= 0 -> Just $! CmmLit (CmmInt (x `rem` y) r) + + MO_And r -> Just $! CmmLit (CmmInt (x .&. y) r) + MO_Or r -> Just $! CmmLit (CmmInt (x .|. y) r) + MO_Xor r -> Just $! CmmLit (CmmInt (x `xor` y) r) + + MO_Shl r -> Just $! CmmLit (CmmInt (x `shiftL` fromIntegral y) r) + MO_U_Shr r -> Just $! CmmLit (CmmInt (x_u `shiftR` fromIntegral y) r) + MO_S_Shr r -> Just $! CmmLit (CmmInt (x `shiftR` fromIntegral y) r) _ -> Nothing @@ -162,7 +162,7 @@ cmmMachOpFoldM platform mop [CmmLit (CmmInt x xrep), CmmLit (CmmInt y _)] cmmMachOpFoldM platform op [x@(CmmLit _), y] | not (isLit y) && isCommutableMachOp op - = Just (cmmMachOpFold platform op [y, x]) + = Just $! (cmmMachOpFold platform op [y, x]) -- Turn (a+b)+c into a+(b+c) where possible. Because literals are -- moved to the right, it is more likely that we will find @@ -183,7 +183,7 @@ cmmMachOpFoldM platform op [x@(CmmLit _), y] cmmMachOpFoldM platform mop1 [CmmMachOp mop2 [arg1,arg2], arg3] | mop2 `associates_with` mop1 && not (isLit arg1) && not (isPicReg arg1) - = Just (cmmMachOpFold platform mop2 [arg1, cmmMachOpFold platform mop1 [arg2,arg3]]) + = Just $! (cmmMachOpFold platform mop2 [arg1, cmmMachOpFold platform mop1 [arg2,arg3]]) where MO_Add{} `associates_with` MO_Sub{} = True mop1 `associates_with` mop2 = @@ -192,7 +192,7 @@ cmmMachOpFoldM platform mop1 [CmmMachOp mop2 [arg1,arg2], arg3] -- special case: (a - b) + c ==> a + (c - b) cmmMachOpFoldM platform mop1@(MO_Add{}) [CmmMachOp mop2@(MO_Sub{}) [arg1,arg2], arg3] | not (isLit arg1) && not (isPicReg arg1) - = Just (cmmMachOpFold platform mop1 [arg1, cmmMachOpFold platform mop2 [arg3,arg2]]) + = Just $! (cmmMachOpFold platform mop1 [arg1, cmmMachOpFold platform mop2 [arg3,arg2]]) -- special case: (PicBaseReg + lit) + N ==> PicBaseReg + (lit+N) -- @@ -205,27 +205,27 @@ cmmMachOpFoldM platform mop1@(MO_Add{}) [CmmMachOp mop2@(MO_Sub{}) [arg1,arg2], cmmMachOpFoldM _ MO_Add{} [ CmmMachOp op at MO_Add{} [pic, CmmLit lit] , CmmLit (CmmInt n rep) ] | isPicReg pic - = Just $ CmmMachOp op [pic, CmmLit $ cmmOffsetLit lit off ] + = Just $! CmmMachOp op [pic, CmmLit $ cmmOffsetLit lit off ] where off = fromIntegral (narrowS rep n) -- Make a RegOff if we can cmmMachOpFoldM _ (MO_Add _) [CmmReg reg, CmmLit (CmmInt n rep)] - = Just $ cmmRegOff reg (fromIntegral (narrowS rep n)) + = Just $! cmmRegOff reg (fromIntegral (narrowS rep n)) cmmMachOpFoldM _ (MO_Add _) [CmmRegOff reg off, CmmLit (CmmInt n rep)] - = Just $ cmmRegOff reg (off + fromIntegral (narrowS rep n)) + = Just $! cmmRegOff reg (off + fromIntegral (narrowS rep n)) cmmMachOpFoldM _ (MO_Sub _) [CmmReg reg, CmmLit (CmmInt n rep)] - = Just $ cmmRegOff reg (- fromIntegral (narrowS rep n)) + = Just $! cmmRegOff reg (- fromIntegral (narrowS rep n)) cmmMachOpFoldM _ (MO_Sub _) [CmmRegOff reg off, CmmLit (CmmInt n rep)] - = Just $ cmmRegOff reg (off - fromIntegral (narrowS rep n)) + = Just $! cmmRegOff reg (off - fromIntegral (narrowS rep n)) -- Fold label(+/-)offset into a CmmLit where possible cmmMachOpFoldM _ (MO_Add _) [CmmLit lit, CmmLit (CmmInt i rep)] - = Just $ CmmLit (cmmOffsetLit lit (fromIntegral (narrowU rep i))) + = Just $! CmmLit (cmmOffsetLit lit (fromIntegral (narrowU rep i))) cmmMachOpFoldM _ (MO_Add _) [CmmLit (CmmInt i rep), CmmLit lit] - = Just $ CmmLit (cmmOffsetLit lit (fromIntegral (narrowU rep i))) + = Just $! CmmLit (cmmOffsetLit lit (fromIntegral (narrowU rep i))) cmmMachOpFoldM _ (MO_Sub _) [CmmLit lit, CmmLit (CmmInt i rep)] - = Just $ CmmLit (cmmOffsetLit lit (fromIntegral (negate (narrowU rep i)))) + = Just $! CmmLit (cmmOffsetLit lit (fromIntegral (negate (narrowU rep i)))) -- Comparison of literal with widened operand: perform the comparison @@ -245,7 +245,7 @@ cmmMachOpFoldM platform cmp [CmmMachOp conv [x], CmmLit (CmmInt i _)] -- and the literal fits in the smaller size: i == narrow_fn rep i -- then we can do the comparison at the smaller size - = Just (cmmMachOpFold platform narrow_cmp [x, CmmLit (CmmInt i rep)]) + = Just $! (cmmMachOpFold platform narrow_cmp [x, CmmLit (CmmInt i rep)]) where maybe_conversion (MO_UU_Conv from to) | to > from @@ -320,8 +320,8 @@ cmmMachOpFoldM platform mop [x, (CmmLit (CmmInt 1 rep))] MO_Mul _ -> Just x MO_S_Quot _ -> Just x MO_U_Quot _ -> Just x - MO_S_Rem _ -> Just $ CmmLit (CmmInt 0 rep) - MO_U_Rem _ -> Just $ CmmLit (CmmInt 0 rep) + MO_S_Rem _ -> Just $! CmmLit (CmmInt 0 rep) + MO_U_Rem _ -> Just $! CmmLit (CmmInt 0 rep) -- Comparisons; trickier -- See Note [Comparison operators] @@ -346,18 +346,18 @@ cmmMachOpFoldM platform mop [x, (CmmLit (CmmInt n _))] = case mop of MO_Mul rep | Just p <- exactLog2 n -> - Just (cmmMachOpFold platform (MO_Shl rep) [x, CmmLit (CmmInt p rep)]) + Just $! (cmmMachOpFold platform (MO_Shl rep) [x, CmmLit (CmmInt p rep)]) MO_U_Quot rep | Just p <- exactLog2 n -> - Just (cmmMachOpFold platform (MO_U_Shr rep) [x, CmmLit (CmmInt p rep)]) + Just $! (cmmMachOpFold platform (MO_U_Shr rep) [x, CmmLit (CmmInt p rep)]) MO_U_Rem rep | Just _ <- exactLog2 n -> - Just (cmmMachOpFold platform (MO_And rep) [x, CmmLit (CmmInt (n - 1) rep)]) + Just $! (cmmMachOpFold platform (MO_And rep) [x, CmmLit (CmmInt (n - 1) rep)]) MO_S_Quot rep | Just p <- exactLog2 n, CmmReg _ <- x -> -- We duplicate x in signedQuotRemHelper, hence require -- it is a reg. FIXME: remove this restriction. - Just (cmmMachOpFold platform (MO_S_Shr rep) + Just $! (cmmMachOpFold platform (MO_S_Shr rep) [signedQuotRemHelper rep p, CmmLit (CmmInt p rep)]) MO_S_Rem rep | Just p <- exactLog2 n, @@ -366,7 +366,7 @@ cmmMachOpFoldM platform mop [x, (CmmLit (CmmInt n _))] -- We replace (x `rem` 2^p) by (x - (x `quot` 2^p) * 2^p). -- Moreover, we fuse MO_S_Shr (last operation of MO_S_Quot) -- and MO_S_Shl (multiplication by 2^p) into a single MO_And operation. - Just (cmmMachOpFold platform (MO_Sub rep) + Just $! (cmmMachOpFold platform (MO_Sub rep) [x, cmmMachOpFold platform (MO_And rep) [signedQuotRemHelper rep p, CmmLit (CmmInt (- n) rep)]]) _ -> Nothing ===================================== compiler/GHC/Cmm/Sink.hs ===================================== @@ -1,4 +1,6 @@ {-# LANGUAGE GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} + module GHC.Cmm.Sink ( cmmSink ) where @@ -8,6 +10,7 @@ import GHC.Prelude import GHC.Cmm import GHC.Cmm.Opt import GHC.Cmm.Liveness +import GHC.Cmm.LRegSet import GHC.Cmm.Utils import GHC.Cmm.Dataflow.Block import GHC.Cmm.Dataflow.Label @@ -16,29 +19,13 @@ import GHC.Cmm.Dataflow.Graph import GHC.Platform.Regs import GHC.Platform -import GHC.Types.Unique import GHC.Types.Unique.FM import qualified Data.IntSet as IntSet import Data.List (partition) -import qualified Data.Set as Set import Data.Maybe --- Compact sets for membership tests of local variables. - -type LRegSet = IntSet.IntSet - -emptyLRegSet :: LRegSet -emptyLRegSet = IntSet.empty - -nullLRegSet :: LRegSet -> Bool -nullLRegSet = IntSet.null - -insertLRegSet :: LocalReg -> LRegSet -> LRegSet -insertLRegSet l = IntSet.insert (getKey (getUnique l)) - -elemLRegSet :: LocalReg -> LRegSet -> Bool -elemLRegSet l = IntSet.member (getKey (getUnique l)) +import GHC.Exts (inline) -- ----------------------------------------------------------------------------- -- Sinking and inlining @@ -167,8 +154,8 @@ type Assignments = [Assignment] cmmSink :: Platform -> CmmGraph -> CmmGraph cmmSink platform graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks where - liveness = cmmLocalLiveness platform graph - getLive l = mapFindWithDefault Set.empty l liveness + liveness = cmmLocalLivenessL platform graph + getLive l = mapFindWithDefault emptyLRegSet l liveness blocks = revPostorder graph @@ -188,8 +175,8 @@ cmmSink platform graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks -- Annotate the middle nodes with the registers live *after* -- the node. This will help us decide whether we can inline -- an assignment in the current node or not. - live = Set.unions (map getLive succs) - live_middle = gen_kill platform last live + live = IntSet.unions (map getLive succs) + live_middle = gen_killL platform last live ann_middles = annotate platform live_middle (blockToList middle) -- Now sink and inline in this block @@ -201,7 +188,7 @@ cmmSink platform graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks -- one predecessor), so identify the join points and the set -- of registers live in them. (joins, nonjoins) = partition (`mapMember` join_pts) succs - live_in_joins = Set.unions (map getLive joins) + live_in_joins = IntSet.unions (map getLive joins) -- We do not want to sink an assignment into multiple branches, -- so identify the set of registers live in multiple successors. @@ -210,26 +197,28 @@ cmmSink platform graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks -- now live in multiple branches. init_live_sets = map getLive nonjoins live_in_multi live_sets r = - case filter (Set.member r) live_sets of + case filter (elemLRegSet r) live_sets of (_one:_two:_) -> True _ -> False -- Now, drop any assignments that we will not sink any further. (dropped_last, assigs'') = dropAssignments platform drop_if init_live_sets assigs' + drop_if :: (LocalReg, CmmExpr, AbsMem) + -> [LRegSet] -> (Bool, [LRegSet]) drop_if a@(r,rhs,_) live_sets = (should_drop, live_sets') where should_drop = conflicts platform a final_last || not (isTrivial platform rhs) && live_in_multi live_sets r - || r `Set.member` live_in_joins + || r `elemLRegSet` live_in_joins live_sets' | should_drop = live_sets | otherwise = map upd live_sets - upd set | r `Set.member` set = set `Set.union` live_rhs + upd set | r `elemLRegSet` set = set `IntSet.union` live_rhs | otherwise = set - live_rhs = foldRegsUsed platform extendRegSet emptyRegSet rhs + live_rhs = foldRegsUsed platform (flip insertLRegSet) emptyLRegSet rhs final_middle = foldl' blockSnoc middle' dropped_last @@ -266,9 +255,9 @@ isTrivial _ _ = False -- -- annotate each node with the set of registers live *after* the node -- -annotate :: Platform -> LocalRegSet -> [CmmNode O O] -> [(LocalRegSet, CmmNode O O)] +annotate :: Platform -> LRegSet -> [CmmNode O O] -> [(LRegSet, CmmNode O O)] annotate platform live nodes = snd $ foldr ann (live,[]) nodes - where ann n (live,nodes) = (gen_kill platform n live, (live,n) : nodes) + where ann n (live,nodes) = (gen_killL platform n live, (live,n) : nodes) -- -- Find the blocks that have multiple successors (join points) @@ -285,13 +274,13 @@ findJoinPoints blocks = mapFilter (>1) succ_counts -- filter the list of assignments to remove any assignments that -- are not live in a continuation. -- -filterAssignments :: Platform -> LocalRegSet -> Assignments -> Assignments +filterAssignments :: Platform -> LRegSet -> Assignments -> Assignments filterAssignments platform live assigs = reverse (go assigs []) where go [] kept = kept go (a@(r,_,_):as) kept | needed = go as (a:kept) | otherwise = go as kept where - needed = r `Set.member` live + needed = r `elemLRegSet` live || any (conflicts platform a) (map toNode kept) -- Note that we must keep assignments that are -- referred to by other assignments we have @@ -312,7 +301,7 @@ filterAssignments platform live assigs = reverse (go assigs []) -- walk :: Platform - -> [(LocalRegSet, CmmNode O O)] -- nodes of the block, annotated with + -> [(LRegSet, CmmNode O O)] -- nodes of the block, annotated with -- the set of registers live *after* -- this node. @@ -366,11 +355,11 @@ shouldSink _ _other = Nothing -- out of inlining, but the inliner will see that r is live -- after the instruction and choose not to inline r in the rhs. -- -shouldDiscard :: CmmNode e x -> LocalRegSet -> Bool +shouldDiscard :: CmmNode e x -> LRegSet -> Bool shouldDiscard node live = case node of CmmAssign r (CmmReg r') | r == r' -> True - CmmAssign (CmmLocal r) _ -> not (r `Set.member` live) + CmmAssign (CmmLocal r) _ -> not (r `elemLRegSet` live) _otherwise -> False @@ -403,8 +392,9 @@ dropAssignments platform should_drop state assigs -- inlining opens up opportunities for doing so. tryToInline - :: Platform - -> LocalRegSet -- set of registers live after this + :: forall x. Platform + -> LRegSet -- set of registers live after this + -- -> LocalRegSet -- set of registers live after this -- node. We cannot inline anything -- that is live after the node, unless -- it is small enough to duplicate. @@ -415,35 +405,42 @@ tryToInline , Assignments -- Remaining assignments ) -tryToInline platform live node assigs = go usages node emptyLRegSet assigs +tryToInline platform liveAfter node assigs = + -- pprTrace "tryToInline assig length:" (ppr $ length assigs) $ + go usages liveAfter node emptyLRegSet assigs where usages :: UniqFM LocalReg Int -- Maps each LocalReg to a count of how often it is used usages = foldLocalRegsUsed platform addUsage emptyUFM node - go _usages node _skipped [] = (node, []) + go :: UniqFM LocalReg Int -> LRegSet -> CmmNode O x -> LRegSet -> Assignments + -> (CmmNode O x, Assignments) + go _usages _live node _skipped [] = (node, []) - go usages node skipped (a@(l,rhs,_) : rest) - | cannot_inline = dont_inline - | occurs_none = discard -- Note [discard during inlining] - | occurs_once = inline_and_discard - | isTrivial platform rhs = inline_and_keep - | otherwise = dont_inline + go usages live node skipped (a@(l,rhs,_) : rest) + | cannot_inline = dont_inline + | occurs_none = discard -- Note [discard during inlining] + | occurs_once = inline_and_discard + | isTrivial platform rhs = inline_and_keep + | otherwise = dont_inline where - inline_and_discard = go usages' inl_node skipped rest + inline_and_discard = go usages' live inl_node skipped rest where usages' = foldLocalRegsUsed platform addUsage usages rhs - discard = go usages node skipped rest + discard = go usages live node skipped rest dont_inline = keep node -- don't inline the assignment, keep it inline_and_keep = keep inl_node -- inline the assignment, keep it + keep :: CmmNode O x -> (CmmNode O x, Assignments) keep node' = (final_node, a : rest') - where (final_node, rest') = go usages' node' (insertLRegSet l skipped) rest - usages' = foldLocalRegsUsed platform (\m r -> addToUFM m r 2) - usages rhs - -- we must not inline anything that is mentioned in the RHS - -- of a binding that we have already skipped, so we set the - -- usages of the regs on the RHS to 2. + where (final_node, rest') = go usages live' node' (insertLRegSet l skipped) rest + + -- Avoid discarding of assignments to vars on the rhs. + -- See Note [Keeping assignemnts mentioned in skipped RHSs] + -- usages' = foldLocalRegsUsed platform (\m r -> addToUFM m r 2) + -- usages rhs + live' = inline foldLocalRegsUsed platform (\m r -> insertLRegSet r m) + live rhs cannot_inline = skipped `regsUsedIn` rhs -- Note [dependent assignments] || l `elemLRegSet` skipped @@ -451,7 +448,7 @@ tryToInline platform live node assigs = go usages node emptyLRegSet assigs -- How often is l used in the current node. l_usages = lookupUFM usages l - l_live = l `elemRegSet` live + l_live = l `elemLRegSet` live occurs_once = not l_live && l_usages == Just 1 occurs_none = not l_live && l_usages == Nothing @@ -467,6 +464,27 @@ tryToInline platform live node assigs = go usages node emptyLRegSet assigs inl_exp (CmmMachOp op args) = cmmMachOpFold platform op args inl_exp other = other +{- Note [Keeping assignemnts mentioned in skipped RHSs] + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + If we have to assignments: [z = y, y = e1] and we skip + z we *must* retain the assignment y = e1. This is because + we might inline "z = y" into another node later on so we + must ensure y is still defined at this point. + + If we dropped the assignment of "y = e1" then we would end up + referencing a variable which hasn't been mentioned after + inlining. + + We use a hack to do this. + + We pretend the regs from the rhs are live after the current + node. Since we only discard assignments to variables + which are dead after the current block this prevents discarding of the + assignment. It still allows inlining should e1 be a trivial rhs + however. + +-} {- Note [improveConditional] @@ -610,18 +628,34 @@ conflicts platform (r, rhs, addr) node -- (7) otherwise, no conflict | otherwise = False +{- Note [Inlining foldRegsDefd] + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + foldRegsDefd is, after optimization, *not* a small function so + it's only marked INLINEABLE, but not INLINE. + + However in some specific cases we call it *very* often making it + important to avoid the overhead of allocating the folding function. + + So we simply force inlining via the magic inline function. + For T3294 this improves allocation with -O by ~1%. + +-} + -- Returns True if node defines any global registers that are used in the -- Cmm expression globalRegistersConflict :: Platform -> CmmExpr -> CmmNode e x -> Bool globalRegistersConflict platform expr node = - foldRegsDefd platform (\b r -> b || regUsedIn platform (CmmGlobal r) expr) + -- See Note [Inlining foldRegsDefd] + inline foldRegsDefd platform (\b r -> b || regUsedIn platform (CmmGlobal r) expr) False node -- Returns True if node defines any local registers that are used in the -- Cmm expression localRegistersConflict :: Platform -> CmmExpr -> CmmNode e x -> Bool localRegistersConflict platform expr node = - foldRegsDefd platform (\b r -> b || regUsedIn platform (CmmLocal r) expr) + -- See Note [Inlining foldRegsDefd] + inline foldRegsDefd platform (\b r -> b || regUsedIn platform (CmmLocal r) expr) False node -- Note [Sinking and calls] ===================================== compiler/GHC/Cmm/Utils.hs ===================================== @@ -264,9 +264,11 @@ cmmOffset platform e byte_off = case e of CmmStackSlot area off -> CmmStackSlot area (off - byte_off) -- note stack area offsets increase towards lower addresses CmmMachOp (MO_Add rep) [expr, CmmLit (CmmInt byte_off1 _rep)] - -> CmmMachOp (MO_Add rep) [expr, CmmLit (CmmInt (byte_off1 + toInteger byte_off) rep)] - _ -> CmmMachOp (MO_Add width) [e, CmmLit (CmmInt (toInteger byte_off) width)] - where width = cmmExprWidth platform e + -> let !lit_off = (byte_off1 + toInteger byte_off) + in CmmMachOp (MO_Add rep) [expr, CmmLit (CmmInt lit_off rep)] + _ -> let !width = cmmExprWidth platform e + in + CmmMachOp (MO_Add width) [e, CmmLit (CmmInt (toInteger byte_off) width)] -- Smart constructor for CmmRegOff. Same caveats as cmmOffset above. cmmRegOff :: CmmReg -> Int -> CmmExpr ===================================== compiler/GHC/Utils/Outputable.hs ===================================== @@ -115,6 +115,7 @@ import Data.Int import qualified Data.IntMap as IM import Data.Set (Set) import qualified Data.Set as Set +import qualified Data.IntSet as IntSet import Data.String import Data.Word import System.IO ( Handle ) @@ -863,6 +864,9 @@ instance (Outputable a) => Outputable (NonEmpty a) where instance (Outputable a) => Outputable (Set a) where ppr s = braces (fsep (punctuate comma (map ppr (Set.toList s)))) +instance Outputable IntSet.IntSet where + ppr s = braces (fsep (punctuate comma (map ppr (IntSet.toList s)))) + instance (Outputable a, Outputable b) => Outputable (a, b) where ppr (x,y) = parens (sep [ppr x <> comma, ppr y]) ===================================== compiler/ghc.cabal.in ===================================== @@ -205,6 +205,7 @@ Library GHC.Cmm.Switch GHC.Cmm.Switch.Implement GHC.CmmToAsm + GHC.Cmm.LRegSet GHC.CmmToAsm.BlockLayout GHC.CmmToAsm.CFG GHC.CmmToAsm.CFG.Dominators View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0abe3ddf85a915ab99ae4f87a85faf6ee5466ad3...59f2249b4f4f3b1a5f2d0bc1b2923e0652b7de8f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0abe3ddf85a915ab99ae4f87a85faf6ee5466ad3...59f2249b4f4f3b1a5f2d0bc1b2923e0652b7de8f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 9 03:44:03 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 08 Dec 2020 22:44:03 -0500 Subject: [Git][ghc/ghc][master] Bump time submodule. Message-ID: <5fd04803aba1e_6b211e6fbe466708d@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 54b88eac by Andreas Klebinger at 2020-12-08T22:43:57-05:00 Bump time submodule. This should fix #19002. - - - - - 1 changed file: - libraries/time Changes: ===================================== libraries/time ===================================== @@ -1 +1 @@ -Subproject commit c25d6a76702b454426e149fb590da5cb69f3bd0a +Subproject commit df292e1a74c6a87c2c1c889679074dd46ad39461 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/54b88eacbf9d13f2b1d070932a742ec74419c3f5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/54b88eacbf9d13f2b1d070932a742ec74419c3f5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 9 08:01:07 2020 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Wed, 09 Dec 2020 03:01:07 -0500 Subject: [Git][ghc/ghc][wip/ghc-dynamic-census] Profiling: Allow heap profiling to be controlled dynamically. Message-ID: <5fd08443be287_6b2129e96786816db@gitlab.mail> Matthew Pickering pushed to branch wip/ghc-dynamic-census at Glasgow Haskell Compiler / GHC Commits: 98a96754 by Matthew Pickering at 2020-12-09T07:52:06+00:00 Profiling: Allow heap profiling to be controlled dynamically. This patch exposes three new functions in `GHC.Profiling` which allow heap profiling to be enabled and disabled dynamically. 1. startHeapProfTimer - Starts heap profiling with the given RTS options 2. stopHeapProfTimer - Stops heap profiling 3. requestHeapCensus - Perform a heap census on the next context switch, regardless of whether the timer is enabled or not. - - - - - 12 changed files: - docs/users_guide/9.2.1-notes.rst - docs/users_guide/profiling.rst - includes/Rts.h - includes/rts/Flags.h - + includes/rts/prof/Heap.h - libraries/base/GHC/Profiling.hs - libraries/base/GHC/RTS/Flags.hsc - rts/Proftimer.c - rts/Proftimer.h - rts/RtsFlags.c - rts/Schedule.c - rts/rts.cabal.in Changes: ===================================== docs/users_guide/9.2.1-notes.rst ===================================== @@ -47,7 +47,13 @@ Compiler - There is a significant refactoring in the solver; any type-checker plugins will have to be updated, as GHC no longer uses flattening skolems or flattening metavariables. - + +- The heap profiler can now be controlled from within a Haskell program using + functions in ``GHC.Profiling``. Profiling can be started and stopped or a heap + census requested at a specific point in the program. + There is a new RTS flag :rts-flag:`--no-automatic-heap-samples` which can be + used to stop heap profiling starting when a program starts. + ``ghc-prim`` library ~~~~~~~~~~~~~~~~~~~~ ===================================== docs/users_guide/profiling.rst ===================================== @@ -459,7 +459,7 @@ compiled program. :type: dynamic Deprecated alias for :ghc-flag:`-fprof-auto-exported` - + .. ghc-flag:: -caf-all :shortdesc: *(deprecated)* Alias for :ghc-flag:`-fprof-cafs` :type: dynamic @@ -885,6 +885,14 @@ There are three more options which relate to heap profiling: profiles are always sampled with the frequency of the RTS clock. See :ref:`prof-time-options` for changing that. +.. rts-flag:: --no-automatic-heap-samples + + :since: 9.2.1 + + Don't start heap profiling from the start of program execution. If this + option is enabled, it's expected that the user will manually start heap + profiling or request specific samples using functions from ``GHC.Profiling``. + .. rts-flag:: -xt Include the memory occupied by threads in a heap profile. Each ===================================== includes/Rts.h ===================================== @@ -194,6 +194,7 @@ void _assertFail(const char *filename, unsigned int linenum) /* Profiling information */ #include "rts/prof/CCS.h" +#include "rts/prof/Heap.h" #include "rts/prof/LDV.h" /* Parallel information */ ===================================== includes/rts/Flags.h ===================================== @@ -145,6 +145,7 @@ typedef struct _PROFILING_FLAGS { Time heapProfileInterval; /* time between samples */ uint32_t heapProfileIntervalTicks; /* ticks between samples (derived) */ bool includeTSOs; + bool startHeapProfileAtStartup; /* true if we start profiling from program startup */ bool showCCSOnException; ===================================== includes/rts/prof/Heap.h ===================================== @@ -0,0 +1,24 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The University of Glasgow, 2009 + * + * Heap Census Profiling + * + * Do not #include this file directly: #include "Rts.h" instead. + * + * To understand the structure of the RTS headers, see the wiki: + * https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes + * + * ---------------------------------------------------------------------------*/ + +#pragma once + +/* ----------------------------------------------------------------------------- + * Fine-grained control over heap census profiling which can be called from + * Haskell to restrict the profile to portion(s) of the execution. + * See the module GHC.Profiling. + * ---------------------------------------------------------------------------*/ + +void requestHeapCensus ( void ); +void startHeapProfTimer ( void ); +void stopHeapProfTimer ( void ); ===================================== libraries/base/GHC/Profiling.hs ===================================== @@ -2,7 +2,14 @@ {-# LANGUAGE NoImplicitPrelude #-} -- | @since 4.7.0.0 -module GHC.Profiling where +module GHC.Profiling ( -- * Cost Centre Profiling + startProfTimer + , stopProfTimer + -- * Heap Profiling + , startHeapProfTimer + , stopHeapProfTimer + , requestHeapCensus + )where import GHC.Base @@ -17,3 +24,20 @@ foreign import ccall stopProfTimer :: IO () -- -- @since 4.7.0.0 foreign import ccall startProfTimer :: IO () + +-- | Request a heap census on the next context switch. The census can be +-- requested whether or not the heap profiling timer is running. +-- +-- @since 4.16.0.0 +foreign import ccall requestHeapCensus :: IO () + +-- | Start heap profiling. This is called normally by the RTS on start-up, +-- but can be disabled using the rts flag `--no-automatic-heap-samples` +-- +-- @since 4.16.0.0 +foreign import ccall startHeapProfTimer :: IO () + +-- | Stop heap profiling. +-- +-- @since 4.16.0.0 +foreign import ccall stopHeapProfTimer :: IO () ===================================== libraries/base/GHC/RTS/Flags.hsc ===================================== @@ -289,6 +289,7 @@ data ProfFlags = ProfFlags , heapProfileInterval :: RtsTime -- ^ time between samples , heapProfileIntervalTicks :: Word -- ^ ticks between samples (derived) , includeTSOs :: Bool + , startHeapProfileAtStartup :: Bool , showCCSOnException :: Bool , maxRetainerSetSize :: Word , ccsLength :: Word @@ -586,6 +587,8 @@ getProfFlags = do <*> #{peek PROFILING_FLAGS, heapProfileIntervalTicks} ptr <*> (toBool <$> (#{peek PROFILING_FLAGS, includeTSOs} ptr :: IO CBool)) + <*> (toBool <$> + (#{peek PROFILING_FLAGS, startHeapProfileAtStartup} ptr :: IO CBool)) <*> (toBool <$> (#{peek PROFILING_FLAGS, showCCSOnException} ptr :: IO CBool)) <*> #{peek PROFILING_FLAGS, maxRetainerSetSize} ptr ===================================== rts/Proftimer.c ===================================== @@ -18,7 +18,12 @@ static bool do_prof_ticks = false; // enable profiling ticks #endif -static bool do_heap_prof_ticks = false; // enable heap profiling ticks +static bool do_heap_prof_ticks = false; // Whether the timer is currently ticking down +static bool heap_prof_timer_active = false; // Whether the timer is enabled at all + +/* The heap_prof_timer_active flag controls whether heap profiling is enabled +at all, once it is enabled, the `do_heap_prof_ticks` flag controls whether the +counter is currently counting down. This is paused, for example, in Schedule.c. */ // Sampling of Ticky-Ticky profiler to eventlog #if defined(TICKY_TICKY) && defined(TRACING) @@ -51,18 +56,36 @@ startProfTimer( void ) void stopHeapProfTimer( void ) { - RELAXED_STORE(&do_heap_prof_ticks, false); + RELAXED_STORE(&heap_prof_timer_active, false); + pauseHeapProfTimer(); } void startHeapProfTimer( void ) { + RELAXED_STORE(&heap_prof_timer_active, true); + resumeHeapProfTimer(); +} + +void +pauseHeapProfTimer ( void ) { + RELAXED_STORE(&do_heap_prof_ticks, false); +} + + +void +resumeHeapProfTimer ( void ) { if (RtsFlags.ProfFlags.doHeapProfile && RtsFlags.ProfFlags.heapProfileIntervalTicks > 0) { - do_heap_prof_ticks = true; + RELAXED_STORE(&do_heap_prof_ticks, true); } } +void +requestHeapCensus( void ){ + RELAXED_STORE(&performHeapProfile, true); +} + void initProfTimer( void ) { @@ -70,7 +93,12 @@ initProfTimer( void ) ticks_to_heap_profile = RtsFlags.ProfFlags.heapProfileIntervalTicks; - startHeapProfTimer(); + /* This might look a bit strange but the heap profile timer can + be toggled on/off from within Haskell by calling the startHeapProf + function from within Haskell */ + if (RtsFlags.ProfFlags.startHeapProfileAtStartup){ + startHeapProfTimer(); + } } uint32_t total_ticks = 0; @@ -99,7 +127,7 @@ handleProfTick(void) } #endif - if (RELAXED_LOAD(&do_heap_prof_ticks)) { + if (RELAXED_LOAD(&do_heap_prof_ticks) && RELAXED_LOAD(&heap_prof_timer_active)) { ticks_to_heap_profile--; if (ticks_to_heap_profile <= 0) { ticks_to_heap_profile = RtsFlags.ProfFlags.heapProfileIntervalTicks; ===================================== rts/Proftimer.h ===================================== @@ -12,9 +12,8 @@ void initProfTimer ( void ); void handleProfTick ( void ); - -void stopHeapProfTimer ( void ); -void startHeapProfTimer ( void ); +void pauseHeapProfTimer ( void ); +void resumeHeapProfTimer ( void ); extern bool performHeapProfile; extern bool performTickySample; ===================================== rts/RtsFlags.c ===================================== @@ -211,6 +211,7 @@ void initRtsFlagsDefaults(void) RtsFlags.ProfFlags.doHeapProfile = false; RtsFlags.ProfFlags.heapProfileInterval = USToTime(100000); // 100ms + RtsFlags.ProfFlags.startHeapProfileAtStartup = true; #if defined(PROFILING) RtsFlags.ProfFlags.includeTSOs = false; @@ -390,6 +391,10 @@ usage_text[] = { " -hT Produce a heap profile grouped by closure type", #endif /* PROFILING */ +" -i Time between heap profile samples (seconds, default: 0.1)", +" --no-automatic-heap-samples Do not start the heap profile interval timer,", +" rely on the user to trigger samples from their application", + #if defined(TRACING) "", " -ol Send binary eventlog to (default: .eventlog)", @@ -415,7 +420,6 @@ usage_text[] = { " the initial enabled event classes are 'sgpu'", #endif -" -i Time between heap profile samples (seconds, default: 0.1)", "", #if defined(TICKY_TICKY) " -r Produce ticky-ticky statistics (with -rstderr for stderr)", @@ -1080,6 +1084,12 @@ error = true; } break; } + else if (strequal("no-automatic-heap-samples", + &rts_argv[arg][2])) { + OPTION_SAFE; + RtsFlags.ProfFlags.startHeapProfileAtStartup = false; + break; + } else { OPTION_SAFE; errorBelch("unknown RTS option: %s",rts_argv[arg]); ===================================== rts/Schedule.c ===================================== @@ -415,7 +415,7 @@ run_thread: // that. cap->r.rCurrentTSO = t; - startHeapProfTimer(); + resumeHeapProfTimer(); // ---------------------------------------------------------------------- // Run the current thread @@ -533,7 +533,7 @@ run_thread: // ---------------------------------------------------------------------- // Costs for the scheduler are assigned to CCS_SYSTEM - stopHeapProfTimer(); + pauseHeapProfTimer(); #if defined(PROFILING) cap->r.rCCCS = CCS_SYSTEM; #endif ===================================== rts/rts.cabal.in ===================================== @@ -180,6 +180,7 @@ library rts/Types.h rts/Utils.h rts/prof/CCS.h + rts/prof/Heap.h rts/prof/LDV.h rts/storage/Block.h rts/storage/ClosureMacros.h View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/98a96754b8024d49f606018fba5eaca627224df9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/98a96754b8024d49f606018fba5eaca627224df9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 9 08:03:49 2020 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Wed, 09 Dec 2020 03:03:49 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/generic-block-traversal Message-ID: <5fd084e57c730_6b21258bc706824f1@gitlab.mail> Matthew Pickering pushed new branch wip/generic-block-traversal at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/generic-block-traversal You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 9 08:08:51 2020 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Wed, 09 Dec 2020 03:08:51 -0500 Subject: [Git][ghc/ghc][wip/t19038] ghc-heap: Allow more control about decoding CCS fields Message-ID: <5fd08613e2696_6b2132ee34684126@gitlab.mail> Matthew Pickering pushed to branch wip/t19038 at Glasgow Haskell Compiler / GHC Commits: 060a96a0 by Matthew Pickering at 2020-12-09T08:08:39+00:00 ghc-heap: Allow more control about decoding CCS fields We have to be careful not to decode too much, too eagerly, as in ghc-debug this will lead to references to memory locations outside of the currently copied closure. Fixes #19038 - - - - - 5 changed files: - libraries/ghc-heap/GHC/Exts/Heap.hs - libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingDisabled.hsc - libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc - libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/PeekProfInfo_ProfilingDisabled.hsc - libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/PeekProfInfo_ProfilingEnabled.hsc Changes: ===================================== libraries/ghc-heap/GHC/Exts/Heap.hs ===================================== @@ -71,6 +71,7 @@ import GHC.Exts.Heap.InfoTable #endif import GHC.Exts.Heap.Utils import qualified GHC.Exts.Heap.FFIClosures as FFIClosures +import qualified GHC.Exts.Heap.ProfInfo.PeekProfInfo as PPI import Control.Monad import Data.Bits @@ -170,13 +171,19 @@ getClosureDataFromHeapObject x = do getClosureDataFromHeapRep :: ByteArray# -> Ptr StgInfoTable -> [b] -> IO (GenClosure b) getClosureDataFromHeapRep heapRep infoTablePtr pts = do itbl <- peekItbl infoTablePtr - getClosureDataFromHeapRepPrim (dataConNames infoTablePtr) itbl heapRep pts + getClosureDataFromHeapRepPrim (dataConNames infoTablePtr) PPI.peekTopCCS itbl heapRep pts getClosureDataFromHeapRepPrim :: IO (String, String, String) -- ^ A continuation used to decode the constructor description field, -- in ghc-debug this code can lead to segfaults because dataConNames -- will dereference a random part of memory. + -> (Ptr a -> IO (Maybe CostCentreStack)) + -- ^ A continuation which is used to decode a cost centre stack + -- In ghc-debug, this code will need to call back into the debuggee to + -- fetch the representation of the CCS before decoding it. Using + -- `peekTopCCS` for this argument can lead to segfaults in ghc-debug as + -- the CCS argument will point outside the copied closure. -> StgInfoTable -- ^ The `StgInfoTable` of the closure, extracted from the heap -- representation. @@ -191,7 +198,7 @@ getClosureDataFromHeapRepPrim -- `b` is some representation of a pointer e.g. `Any` or `Ptr Any`. -> IO (GenClosure b) -- ^ Heap representation of the closure. -getClosureDataFromHeapRepPrim getConDesc itbl heapRep pts = do +getClosureDataFromHeapRepPrim getConDesc decodeCCS itbl heapRep pts = do let -- heapRep as a list of words. rawHeapWords :: [Word] rawHeapWords = [W# (indexWordArray# heapRep i) | I# i <- [0.. end] ] @@ -343,7 +350,7 @@ getClosureDataFromHeapRepPrim getConDesc itbl heapRep pts = do } TSO | [ u_lnk, u_gbl_lnk, tso_stack, u_trec, u_blk_ex, u_bq] <- pts -> withArray rawHeapWords (\ptr -> do - fields <- FFIClosures.peekTSOFields ptr + fields <- FFIClosures.peekTSOFields decodeCCS ptr pure $ TSOClosure { info = itbl , link = u_lnk ===================================== libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingDisabled.hsc ===================================== @@ -30,8 +30,8 @@ data TSOFields = TSOFields { } -- | Get non-pointer fields from @StgTSO_@ (@TSO.h@) -peekTSOFields :: Ptr tsoPtr -> IO TSOFields -peekTSOFields ptr = do +peekTSOFields :: (Ptr a -> IO (Maybe CostCentreStack)) -> Ptr tsoPtr -> IO TSOFields +peekTSOFields decodeCCS ptr = do what_next' <- (#peek struct StgTSO_, what_next) ptr why_blocked' <- (#peek struct StgTSO_, why_blocked) ptr flags' <- (#peek struct StgTSO_, flags) ptr @@ -40,7 +40,7 @@ peekTSOFields ptr = do dirty' <- (#peek struct StgTSO_, dirty) ptr alloc_limit' <- (#peek struct StgTSO_, alloc_limit) ptr tot_stack_size' <- (#peek struct StgTSO_, tot_stack_size) ptr - tso_prof' <- peekStgTSOProfInfo ptr + tso_prof' <- peekStgTSOProfInfo decodeCCS ptr return TSOFields { tso_what_next = parseWhatNext what_next', ===================================== libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc ===================================== @@ -30,8 +30,8 @@ data TSOFields = TSOFields { } -- | Get non-pointer fields from @StgTSO_@ (@TSO.h@) -peekTSOFields :: Ptr tsoPtr -> IO TSOFields -peekTSOFields ptr = do +peekTSOFields :: (Ptr a -> IO (Maybe CostCentreStack)) -> Ptr tsoPtr -> IO TSOFields +peekTSOFields decodeCCS ptr = do what_next' <- (#peek struct StgTSO_, what_next) ptr why_blocked' <- (#peek struct StgTSO_, why_blocked) ptr flags' <- (#peek struct StgTSO_, flags) ptr @@ -40,7 +40,7 @@ peekTSOFields ptr = do dirty' <- (#peek struct StgTSO_, dirty) ptr alloc_limit' <- (#peek struct StgTSO_, alloc_limit) ptr tot_stack_size' <- (#peek struct StgTSO_, tot_stack_size) ptr - tso_prof' <- peekStgTSOProfInfo ptr + tso_prof' <- peekStgTSOProfInfo decodeCCS ptr return TSOFields { tso_what_next = parseWhatNext what_next', ===================================== libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/PeekProfInfo_ProfilingDisabled.hsc ===================================== @@ -1,5 +1,6 @@ module GHC.Exts.Heap.ProfInfo.PeekProfInfo_ProfilingDisabled( peekStgTSOProfInfo + , peekTopCCS ) where import Prelude @@ -8,5 +9,8 @@ import GHC.Exts.Heap.ProfInfo.Types -- | This implementation is used when PROFILING is undefined. -- It always returns 'Nothing', because there is no profiling info available. -peekStgTSOProfInfo :: Ptr tsoPtr -> IO (Maybe StgTSOProfInfo) -peekStgTSOProfInfo _ = return Nothing +peekStgTSOProfInfo :: (Ptr a -> IO (Maybe CostCentreStack)) -> Ptr tsoPtr -> IO (Maybe StgTSOProfInfo) +peekStgTSOProfInfo _ _ = return Nothing + +peekTopCCS :: Ptr a -> IO (Maybe CostCentreStack) +peekTopCCS _ = return Nothing ===================================== libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/PeekProfInfo_ProfilingEnabled.hsc ===================================== @@ -3,6 +3,7 @@ module GHC.Exts.Heap.ProfInfo.PeekProfInfo_ProfilingEnabled( peekStgTSOProfInfo + , peekTopCCS ) where #if __GLASGOW_HASKELL__ >= 811 @@ -33,16 +34,20 @@ import Prelude type AddressSet = IntSet type AddressMap = IntMap -peekStgTSOProfInfo :: Ptr a -> IO (Maybe StgTSOProfInfo) -peekStgTSOProfInfo tsoPtr = do +peekStgTSOProfInfo :: (Ptr b -> IO (Maybe CostCentreStack)) -> Ptr a -> IO (Maybe StgTSOProfInfo) +peekStgTSOProfInfo decodeCCS tsoPtr = do cccs_ptr <- peekByteOff tsoPtr cccsOffset - costCenterCacheRef <- newIORef IntMap.empty - cccs' <- peekCostCentreStack IntSet.empty costCenterCacheRef cccs_ptr + cccs' <- decodeCCS cccs_ptr return $ Just StgTSOProfInfo { cccs = cccs' } +peekTopCCS :: Ptr b -> IO (Maybe CostCentreStack) +peekTopCCS cccs_ptr = do + costCenterCacheRef <- newIORef IntMap.empty + peekCostCentreStack IntSet.empty costCenterCacheRef cccs_ptr + cccsOffset :: Int cccsOffset = (#const OFFSET_StgTSO_cccs) + (#size StgHeader) @@ -162,4 +167,7 @@ import GHC.Exts.Heap.ProfInfo.Types peekStgTSOProfInfo :: Ptr a -> IO (Maybe StgTSOProfInfo) peekStgTSOProfInfo _ = return Nothing + +peekTopCCS :: Ptr a -> IO (Maybe CostCentreStack) +peekTopCCS _ = return Nothing #endif View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/060a96a0d93e47b34f8f919ade0479f649a028bb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/060a96a0d93e47b34f8f919ade0479f649a028bb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 9 14:40:37 2020 From: gitlab at gitlab.haskell.org (Ryan Scott) Date: Wed, 09 Dec 2020 09:40:37 -0500 Subject: [Git][ghc/ghc][wip/T18021] Reject dodgy scoping in associated family instance RHSes Message-ID: <5fd0e1e5dca92_6b213272ce070904e@gitlab.mail> Ryan Scott pushed to branch wip/T18021 at Glasgow Haskell Compiler / GHC Commits: 1004abbf by Ryan Scott at 2020-12-09T09:40:09-05:00 Reject dodgy scoping in associated family instance RHSes Commit e63518f5d6a93be111f9108c0990a1162f88d615 tried to push all of the logic of detecting out-of-scope type variables on the RHSes of associated type family instances to `GHC.Tc.Validity` by deleting a similar check in the renamer. Unfortunately, this commit went a little too far, as there are some corner cases that `GHC.Tc.Validity` doesn't detect. Consider this example: ```hs class C a where data D a instance forall a. C Int where data instance D Int = MkD a ``` If this program isn't rejected by the time it reaches the typechecker, then GHC will believe the `a` in `MkD a` is existentially quantified and accept it. This is almost surely not what the user wants! The simplest way to reject programs like this is to restore the old validity check in the renamer (search for `improperly_scoped` in `rnFamEqn`). Note that this is technically a breaking change, since the program in the `polykinds/T9574` test case (which previously compiled) will now be rejected: ```hs instance Funct ('KProxy :: KProxy o) where type Codomain 'KProxy = NatTr (Proxy :: o -> *) ``` This is because the `o` on the RHS will now be rejected for being out of scope. Luckily, this is simple to repair: ```hs instance Funct ('KProxy :: KProxy o) where type Codomain ('KProxy @o) = NatTr (Proxy :: o -> *) ``` All of the discussion is now a part of the revamped `Note [Renaming associated types]` in `GHC.Rename.Module`. A different design would be to make associated type family instances have completely separate scoping from the parent instance declaration, much like how associated type family default declarations work today. See the discussion beginning at https://gitlab.haskell.org/ghc/ghc/-/issues/18021#note_265729 for more on this point. This, however, would break even more programs that are accepted today and likely warrants a GHC proposal before going forward. In the meantime, this patch fixes the issue described in #18021 in the least invasive way possible. There are programs that are accepted today that will no longer be accepted after this patch, but they are arguably pathological programs, and they are simple to repair. Fixes #18021. - - - - - 8 changed files: - compiler/GHC/Rename/Module.hs - docs/users_guide/9.2.1-notes.rst - testsuite/tests/indexed-types/should_fail/T5515.stderr - + testsuite/tests/polykinds/T9574.stderr - testsuite/tests/polykinds/all.T - + testsuite/tests/rename/should_fail/T18021.hs - + testsuite/tests/rename/should_fail/T18021.stderr - testsuite/tests/rename/should_fail/all.T Changes: ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -661,12 +661,13 @@ rnClsInstDecl (ClsInstDecl { cid_poly_ty = inst_ty, cid_binds = mbinds rnFamEqn :: HsDocContext -> AssocTyFamInfo -> FreeKiTyVars - -- ^ Kind variables from the equation's RHS to be implicitly bound - -- if no explicit forall. + -- ^ Additional kind variables to implicitly bind if there is no + -- explicit forall. (See the comments on @all_imp_vars@ below for a + -- more detailed explanation.) -> FamEqn GhcPs rhs -> (HsDocContext -> rhs -> RnM (rhs', FreeVars)) -> RnM (FamEqn GhcRn rhs', FreeVars) -rnFamEqn doc atfi rhs_kvars +rnFamEqn doc atfi extra_kvars (FamEqn { feqn_tycon = tycon , feqn_bndrs = outer_bndrs , feqn_pats = pats @@ -679,15 +680,19 @@ rnFamEqn doc atfi rhs_kvars -- Note [forall-or-nothing rule] in GHC.Hs.Type), which means -- ignoring: -- - -- - pat_kity_vars_with_dups, the variables mentioned in the LHS of - -- the equation, and - -- - rhs_kvars, the kind variables mentioned in an outermost kind - -- signature on the RHS of the equation. (See - -- Note [Implicit quantification in type synonyms] in - -- GHC.Rename.HsType for why these are implicitly quantified in the - -- absence of an explicit forall). + -- - pat_kity_vars, the free variables mentioned in the type patterns + -- on the LHS of the equation, and + -- - extra_kvars, which is one of the following: + -- * For type family instances, extra_kvars are the free kind + -- variables mentioned in an outermost kind signature on the RHS + -- of the equation. + -- (See Note [Implicit quantification in type synonyms] in + -- GHC.Rename.HsType.) + -- * For data family instances, extra_kvars are the free kind + -- variables mentioned in the explicit return kind, if one is + -- provided. (e.g., the `k` in `data instance T :: k -> Type`). -- - -- For example: + -- Some examples: -- -- @ -- type family F a b @@ -695,8 +700,20 @@ rnFamEqn doc atfi rhs_kvars -- -- all_imp_vars = [] -- type instance F [(a, b)] c = a -> b -> c -- -- all_imp_vars = [a, b, c] + -- + -- type family G :: Maybe a + -- type instance forall a. G = (Nothing :: Maybe a) + -- -- all_imp_vars = [] + -- type instance G = (Nothing :: Maybe a) + -- -- all_imp_vars = [a] + -- + -- data family H :: k -> Type + -- data instance forall k. H :: k -> Type where ... + -- -- all_imp_vars = [] + -- data instance H :: k -> Type where ... + -- -- all_imp_vars = [k] -- @ - ; let all_imp_vars = pat_kity_vars_with_dups ++ rhs_kvars + ; let all_imp_vars = pat_kity_vars ++ extra_kvars ; bindHsOuterTyVarBndrs doc mb_cls all_imp_vars outer_bndrs $ \rn_outer_bndrs -> do { (pats', pat_fvs) <- rnLHsTypeArgs (FamPatCtx tycon) pats @@ -714,8 +731,7 @@ rnFamEqn doc atfi rhs_kvars rn_outer_bndrs groups :: [NonEmpty (Located RdrName)] - groups = equivClasses cmpLocated $ - pat_kity_vars_with_dups + groups = equivClasses cmpLocated pat_kity_vars ; nms_dups <- mapM (lookupOccRn . unLoc) $ [ tv | (tv :| (_:_)) <- groups ] -- Add to the used variables @@ -725,10 +741,24 @@ rnFamEqn doc atfi rhs_kvars -- of the instance decl. See -- Note [Unused type variables in family instances] ; let nms_used = extendNameSetList rhs_fvs $ - inst_tvs ++ nms_dups + nms_dups {- (a) -} ++ inst_head_tvs {- (b) -} all_nms = hsOuterTyVarNames rn_outer_bndrs' ; warnUnusedTypePatterns all_nms nms_used + -- For associated family instances, if a type variable from the + -- parent instance declaration is mentioned on the RHS of the + -- associated family instance but not bound on the LHS, then reject + -- that type variable as being out of scope. + -- See Note [Renaming associated types] + ; let lhs_bound_vars = extendNameSetList pat_fvs all_nms + improperly_scoped cls_tkv = + cls_tkv `elemNameSet` rhs_fvs + -- Mentioned on the RHS... + && not (cls_tkv `elemNameSet` lhs_bound_vars) + -- ...but not bound on the LHS. + bad_tvs = filter improperly_scoped inst_head_tvs + ; unless (null bad_tvs) (badAssocRhs bad_tvs) + ; let eqn_fvs = rhs_fvs `plusFV` pat_fvs -- See Note [Type family equations and occurrences] all_fvs = case atfi of @@ -754,12 +784,12 @@ rnFamEqn doc atfi rhs_kvars -- The type variables from the instance head, if we are dealing with an -- associated type family instance. - inst_tvs = case atfi of - NonAssocTyFamEqn _ -> [] - AssocTyFamDeflt _ -> [] - AssocTyFamInst _ inst_tvs -> inst_tvs + inst_head_tvs = case atfi of + NonAssocTyFamEqn _ -> [] + AssocTyFamDeflt _ -> [] + AssocTyFamInst _ inst_head_tvs -> inst_head_tvs - pat_kity_vars_with_dups = extractHsTyArgRdrKiTyVars pats + pat_kity_vars = extractHsTyArgRdrKiTyVars pats -- It is crucial that extractHsTyArgRdrKiTyVars return -- duplicate occurrences, since they're needed to help -- determine unused binders on the LHS. @@ -769,11 +799,18 @@ rnFamEqn doc atfi rhs_kvars -- -- type instance F a b c = Either a b -- ^^^^^ - lhs_loc = case map lhsTypeArgSrcSpan pats ++ map getLoc rhs_kvars of + lhs_loc = case map lhsTypeArgSrcSpan pats ++ map getLoc extra_kvars of [] -> panic "rnFamEqn.lhs_loc" [loc] -> loc (loc:locs) -> loc `combineSrcSpans` last locs + badAssocRhs :: [Name] -> RnM () + badAssocRhs ns + = addErr (hang (text "The RHS of an associated type declaration mentions" + <+> text "out-of-scope variable" <> plural ns + <+> pprWithCommas (quotes . ppr) ns) + 2 (text "All such variables must be bound on the LHS")) + rnTyFamInstDecl :: AssocTyFamInfo -> TyFamInstDecl GhcPs -> RnM (TyFamInstDecl GhcRn, FreeVars) @@ -829,9 +866,9 @@ rnTyFamInstEqn :: AssocTyFamInfo -> TyFamInstEqn GhcPs -> RnM (TyFamInstEqn GhcRn, FreeVars) rnTyFamInstEqn atfi eqn@(FamEqn { feqn_tycon = tycon, feqn_rhs = rhs }) - = rnFamEqn (TySynCtx tycon) atfi rhs_kvs eqn rnTySyn + = rnFamEqn (TySynCtx tycon) atfi extra_kvs eqn rnTySyn where - rhs_kvs = extractHsTyRdrTyVarsKindVars rhs + extra_kvs = extractHsTyRdrTyVarsKindVars rhs rnTyFamDefltDecl :: Name -> TyFamDefltDecl GhcPs @@ -844,9 +881,9 @@ rnDataFamInstDecl :: AssocTyFamInfo rnDataFamInstDecl atfi (DataFamInstDecl { dfid_eqn = eqn@(FamEqn { feqn_tycon = tycon , feqn_rhs = rhs })}) - = do { let rhs_kvs = extractDataDefnKindVars rhs + = do { let extra_kvs = extractDataDefnKindVars rhs ; (eqn', fvs) <- - rnFamEqn (TyDataCtx tycon) atfi rhs_kvs eqn rnDataDefn + rnFamEqn (TyDataCtx tycon) atfi extra_kvs eqn rnDataDefn ; return (DataFamInstDecl { dfid_eqn = eqn' }, fvs) } -- Renaming of the associated types in instances. @@ -927,58 +964,131 @@ Relevant tickets: #3699, #10586, #10982 and #11451. Note [Renaming associated types] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Check that the RHS of the decl mentions only type variables that are explicitly -bound on the LHS. For example, this is not ok - class C a b where - type F a x :: * - instance C (p,q) r where - type F (p,q) x = (x, r) -- BAD: mentions 'r' -c.f. #5515 - -Kind variables, on the other hand, are allowed to be implicitly or explicitly -bound. As examples, this (#9574) is acceptable: - class Funct f where - type Codomain f :: * - instance Funct ('KProxy :: KProxy o) where - -- o is implicitly bound by the kind signature - -- of the LHS type pattern ('KProxy) - type Codomain 'KProxy = NatTr (Proxy :: o -> *) -And this (#14131) is also acceptable: - data family Nat :: k -> k -> * - -- k is implicitly bound by an invisible kind pattern - newtype instance Nat :: (k -> *) -> (k -> *) -> * where - Nat :: (forall xx. f xx -> g xx) -> Nat f g -We could choose to disallow this, but then associated type families would not -be able to be as expressive as top-level type synonyms. For example, this type -synonym definition is allowed: - type T = (Nothing :: Maybe a) -So for parity with type synonyms, we also allow: - type family T :: Maybe a - type instance T = (Nothing :: Maybe a) - -All this applies only for *instance* declarations. In *class* -declarations there is no RHS to worry about, and the class variables -can all be in scope (#5862): +When renaming a type/data family instance, be it top-level or associated with +a class, we must check that all of the type variables mentioned on the RHS are +properly scoped. Specifically, the rule is this: + + Every variable mentioned on the RHS of a type instance declaration + (whether associated or not) must be either + * Mentioned on the LHS, or + * Mentioned in an outermost kind signature on the RHS + (see Note [Implicit quantification in type synonyms]) + +Here is a simple example of something we should reject: + + class C a b where + type F a x + instance C Int Bool where + type F Int x = z + +Here, `z` is mentioned on the RHS of the associated instance without being +mentioned on the LHS, nor is `z` mentioned in an outermost kind signature. The +renamer will reject `z` as being out of scope without much fuss. + +Things get slightly trickier when the instance header itself binds type +variables. Consider this example (adapted from #5515): + + instance C (p,q) z where + type F (p,q) x = (x, z) + +According to the rule above, this instance is improperly scoped. However, due +to the way GHC's renamer works, `z` is /technically/ in scope, as GHC will +always bring type variables from an instance header into scope over the +associated type family instances. As a result, the renamer won't simply reject +the `z` as being out of scope (like it would for the `type F Int x = z` +example) unless further action is taken. It is important to reject this sort of +thing in the renamer, because if it is allowed to make it through to the +typechecker, unexpected shenanigans can occur (see #18021 for examples). + +To prevent these sorts of shenanigans, we reject programs like the one above +with an extra validity check in rnFamEqn. For each type variable bound in the +parent instance head, we check if it is mentioned on the RHS of the associated +family instance but not bound on the LHS. If any of the instance-head-bound +variables meet these criteria, we throw an error. +(See rnFamEqn.improperly_scoped for how this is implemented.) + +Some additional wrinkles: + +* This Note only applies to *instance* declarations. In *class* declarations + there is no RHS to worry about, and the class variables can all be in scope + (#5862): + class Category (x :: k -> k -> *) where type Ob x :: k -> Constraint id :: Ob x a => x a a (.) :: (Ob x a, Ob x b, Ob x c) => x b c -> x a b -> x a c -Here 'k' is in scope in the kind signature, just like 'x'. -Although type family equations can bind type variables with explicit foralls, -it need not be the case that all variables that appear on the RHS must be bound -by a forall. For instance, the following is acceptable: + Here 'k' is in scope in the kind signature, just like 'x'. + +* Although type family equations can bind type variables with explicit foralls, + it need not be the case that all variables that appear on the RHS must be + bound by a forall. For instance, the following is acceptable: + + class C4 a where + type T4 a b + instance C4 (Maybe a) where + type forall b. T4 (Maybe a) b = Either a b + + Even though `a` is not bound by the forall, this is still accepted because `a` + was previously bound by the `instance C4 (Maybe a)` part. (see #16116). + +* In addition to the validity check in rnFamEqn.improperly_scoped, there is an + additional check in GHC.Tc.Validity.checkFamPatBinders that checks each family + instance equation for type variables used on the RHS but not bound on the + LHS. This is not made redundant by rmFamEqn.improperly_scoped, as there are + programs that each check will reject that the other check will not catch: + + - checkValidFamPats is used on all forms of family instances, whereas + rmFamEqn.improperly_scoped only checks associated family instances. Since + checkFamPatBinders occurs after typechecking, it can catch programs that + introduce dodgy scoping by way of type synonyms (see #7536), which is + impractical to accomplish in the renamer. + - rnFamEqn.improperly_scoped catches some programs that, if allowed to escape + the renamer, would accidentally be accepted by the typechecker. Here is one + such program (#18021): + + class C5 a where + data family D a + + instance forall a. C5 Int where + data instance D Int = MkD a + + If this is not rejected in the renamer, the typechecker would treat this + program as though the `a` were existentially quantified, like so: + + data instance D Int = forall a. MkD a + + This is likely not what the user intended! + + Here is another such program (#9574): + + class Funct f where + type Codomain f + instance Funct ('KProxy :: KProxy o) where + type Codomain 'KProxy = NatTr (Proxy :: o -> Type) + + Where: + + data Proxy (a :: k) = Proxy + data KProxy (t :: Type) = KProxy + data NatTr (c :: o -> Type) - class C a where - type T a b - instance C (Maybe a) where - type forall b. T (Maybe a) b = Either a b + Note that the `o` in the `Codomain 'KProxy` instance should be considered + improperly scoped. It does not meet the criteria for being explicitly + quantified, as it is not mentioned by name on the LHS, nor does it meet the + criteria for being implicitly quantified, as it is used in a RHS kind + signature that is not outermost (see Note [Implicit quantification in type + synonyms]). However, `o` /is/ bound by the instance header, so if this + program is not rejected by the renamer, the typechecker would treat it as + though you had written this: -Even though `a` is not bound by the forall, this is still accepted because `a` -was previously bound by the `instance C (Maybe a)` part. (see #16116). + instance Funct ('KProxy :: KProxy o) where + type Codomain ('KProxy @o) = NatTr (Proxy :: o -> Type) -In each case, the function which detects improperly bound variables on the RHS -is GHC.Tc.Validity.checkValidFamPats. + Although this is a valid program, it's probably a stretch too far to turn + `type Codomain 'KProxy = ...` into `type Codomain ('KProxy @o) = ...` here. + If the user really wants the latter, it is simple enough to communicate + their intent by mentioning `o` on the LHS by name. Note [Type family equations and occurrences] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== docs/users_guide/9.2.1-notes.rst ===================================== @@ -18,6 +18,34 @@ Language more restrictive than before. See the user manual :ref:`kind-inference-data-family-instances`. This is a breaking change, albeit a fairly obscure one that corrects a specification bug. +* GHC is stricter about checking for out-of-scope type variables on the + right-hand sides of associated type family instances that are not bound on + the left-hand side. As a result, some programs that were accidentally + accepted in previous versions of GHC will now be rejected, such as this + example: :: + + class Funct f where + type Codomain f + instance Funct ('KProxy :: KProxy o) where + type Codomain 'KProxy = NatTr (Proxy :: o -> Type) + + Where: :: + + data Proxy (a :: k) = Proxy + data KProxy (t :: Type) = KProxy + data NatTr (c :: o -> Type) + + GHC will now reject the ``o`` on the right-hand side of the ``Codomain`` + instance as being out of scope, as it does not meet the requirements for + being explicitly bound (as it is not mentioned on the left-hand side) nor + implicitly bound (as it is not mentioned in an *outermost* kind signature, + as required by :ref:`scoping-class-params`). This program can be repaired in + a backwards-compatible way by mentioning ``o`` on the left-hand side: :: + + instance Funct ('KProxy :: KProxy o) where + type Codomain ('KProxy @o) = NatTr (Proxy :: o -> Type) + -- Alternatively, + -- type Codomain ('KProxy :: KProxy o) = NatTr (Proxy :: o -> Type) Compiler ~~~~~~~~ @@ -52,7 +80,7 @@ Compiler - There is a significant refactoring in the solver; any type-checker plugins will have to be updated, as GHC no longer uses flattening skolems or flattening metavariables. - + ``ghc-prim`` library ~~~~~~~~~~~~~~~~~~~~ ===================================== testsuite/tests/indexed-types/should_fail/T5515.stderr ===================================== @@ -1,24 +1,8 @@ -T5515.hs:6:16: error: - • Expecting one more argument to ‘ctx’ - Expected a type, but ‘ctx’ has kind ‘* -> Constraint’ - • In the first argument of ‘Arg’, namely ‘ctx’ - In the first argument of ‘ctx’, namely ‘(Arg ctx)’ - In the class declaration for ‘Bome’ +T5515.hs:9:3: error: + The RHS of an associated type declaration mentions out-of-scope variable ‘a’ + All such variables must be bound on the LHS -T5515.hs:14:1: error: - • Type variable ‘a’ is mentioned in the RHS, - but not bound on the LHS of the family instance - • In the type instance declaration for ‘Arg’ - In the instance declaration for ‘Some f’ - -T5515.hs:14:10: error: - • Could not deduce (C f a0) - from the context: C f a - bound by an instance declaration: - forall f a. C f a => Some f - at T5515.hs:14:10-24 - The type variable ‘a0’ is ambiguous - • In the ambiguity check for an instance declaration - To defer the ambiguity check to use sites, enable AllowAmbiguousTypes - In the instance declaration for ‘Some f’ +T5515.hs:15:3: error: + The RHS of an associated type declaration mentions out-of-scope variable ‘a’ + All such variables must be bound on the LHS ===================================== testsuite/tests/polykinds/T9574.stderr ===================================== @@ -0,0 +1,4 @@ + +T9574.hs:13:5: error: + The RHS of an associated type declaration mentions out-of-scope variable ‘o’ + All such variables must be bound on the LHS ===================================== testsuite/tests/polykinds/all.T ===================================== @@ -107,7 +107,7 @@ test('T9725', normal, compile, ['']) test('T9750', normal, compile, ['']) test('T9569', normal, compile, ['']) test('T9838', normal, multimod_compile, ['T9838.hs','-v0']) -test('T9574', normal, compile, ['']) +test('T9574', normal, compile_fail, ['']) test('T9833', normal, compile, ['']) test('T7908', normal, compile, ['']) test('PolyInstances', normal, compile, ['']) ===================================== testsuite/tests/rename/should_fail/T18021.hs ===================================== @@ -0,0 +1,18 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +module T18021 where + +class C a where + data D a + +instance forall a. C Int where + data instance D Int = MkD1 a + +class X a b + +instance forall a. C Bool where + data instance D Bool = MkD2 + deriving (X a) ===================================== testsuite/tests/rename/should_fail/T18021.stderr ===================================== @@ -0,0 +1,8 @@ + +T18021.hs:12:3: error: + The RHS of an associated type declaration mentions out-of-scope variable ‘a’ + All such variables must be bound on the LHS + +T18021.hs:17:3: error: + The RHS of an associated type declaration mentions out-of-scope variable ‘a’ + All such variables must be bound on the LHS ===================================== testsuite/tests/rename/should_fail/all.T ===================================== @@ -156,6 +156,7 @@ test('T16504', normal, compile_fail, ['']) test('T14548', normal, compile_fail, ['']) test('T16610', normal, compile_fail, ['']) test('T17593', normal, compile_fail, ['']) +test('T18021', normal, compile_fail, ['']) test('T18145', normal, compile_fail, ['']) test('T18240a', normal, compile_fail, ['']) test('T18240b', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1004abbf38a0447da80befd21a8457ca69708ad2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1004abbf38a0447da80befd21a8457ca69708ad2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 9 17:02:04 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Wed, 09 Dec 2020 12:02:04 -0500 Subject: [Git][ghc/ghc][wip/T18962-simpl] Implement as separate analysis instead; feed on that in Simplifier Message-ID: <5fd1030c4106_6b211e6fbe47147b2@gitlab.mail> Sebastian Graf pushed to branch wip/T18962-simpl at Glasgow Haskell Compiler / GHC Commits: e8be408f by Sebastian Graf at 2020-12-09T18:01:51+01:00 Implement as separate analysis instead; feed on that in Simplifier - - - - - 11 changed files: - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/StaticArgs.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/Id.hs - compiler/GHC/Types/Id/Info.hs - compiler/GHC/Types/Unique/FM.hs - compiler/GHC/Types/Var/Env.hs Changes: ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -808,7 +808,7 @@ occAnalRecBind env lvl imp_rule_edges pairs body_usage bndrs = map fst pairs bndr_set = mkVarSet bndrs - rhs_env = env `addInScope` bndrs `addInterestingStaticArgs` pairs + rhs_env = env `addInScope` bndrs ----------------------------- @@ -1082,10 +1082,8 @@ mk_loop_breaker :: Id -> Id mk_loop_breaker bndr = bndr `setIdOccInfo` occ' where - occ' = strongLoopBreaker { occ_tail = tail_info - , occ_static_args = static_args } - tail_info = tailCallInfo (idOccInfo bndr) - static_args = staticArgsInfo (idOccInfo bndr) + occ' = strongLoopBreaker { occ_tail = tail_info } + tail_info = tailCallInfo (idOccInfo bndr) mk_non_loop_breaker :: VarSet -> Id -> Id -- See Note [Weak loop breakers] @@ -1977,7 +1975,6 @@ occAnal env (Let bind body) body_usage of { (final_usage, new_binds) -> (final_usage, mkLets new_binds body') }} - occAnalArgs :: OccEnv -> [CoreExpr] -> [OneShots] -> (UsageDetails, [CoreExpr]) occAnalArgs _ [] _ = (emptyDetails, []) @@ -2035,7 +2032,7 @@ occAnalApp env (Var fun, args, ticks) `orElse` (Var fun, fun) -- See Note [The binder-swap substitution] - fun_uds = mkOneOcc env fun_id' int_cxt args + fun_uds = mkOneOcc fun_id' int_cxt n_args all_uds = fun_uds `andUDs` final_args_uds !(args_uds, args') = occAnalArgs env args one_shots @@ -2053,6 +2050,7 @@ occAnalApp env (Var fun, args, ticks) -- See Note [Arguments of let-bound constructors] n_val_args = valArgCount args + n_args = length args int_cxt = case occ_encl env of OccScrut -> IsInteresting _other | n_val_args > 0 -> IsInteresting @@ -2219,15 +2217,12 @@ data OccEnv , occ_unf_act :: Id -> Bool -- Which Id unfoldings are active , occ_rule_act :: Activation -> Bool -- Which rules are active -- See Note [Finding rule RHS free vars] - -- lkj , occ_sat_args :: ![Staticness Var] -- It's not worth the bother - , occ_sat_env :: VarEnv [Var] -- TODO shadowing of lambda binders -- See Note [The binder-swap substitution] , occ_bs_env :: VarEnv (OutExpr, OutId) , occ_bs_rng :: VarSet -- Vars free in the range of occ_bs_env -- Domain is Global and Local Ids -- Range is just Local Ids - -- FIXME: Why is this not an InScopeSet?!! } @@ -2270,8 +2265,6 @@ initOccEnv , occ_unf_act = \_ -> True , occ_rule_act = \_ -> True - , occ_sat_env = emptyVarEnv - , occ_bs_env = emptyVarEnv , occ_bs_rng = emptyVarSet } @@ -2280,11 +2273,9 @@ noBinderSwaps (OccEnv { occ_bs_env = bs_env }) = isEmptyVarEnv bs_env scrutCtxt :: OccEnv -> [CoreAlt] -> OccEnv scrutCtxt env alts - = env { occ_encl = encl, occ_one_shots = [] } + | interesting_alts = env { occ_encl = OccScrut, occ_one_shots = [] } + | otherwise = env { occ_encl = OccVanilla, occ_one_shots = [] } where - encl - | interesting_alts = OccScrut - | otherwise = OccVanilla interesting_alts = case alts of [] -> False [alt] -> not (isDefaultAlt alt) @@ -2310,19 +2301,9 @@ isRhsEnv (OccEnv { occ_encl = cxt }) = case cxt of addInScope :: OccEnv -> [Var] -> OccEnv -- See Note [The binder-swap substitution] addInScope env@(OccEnv { occ_bs_env = swap_env, occ_bs_rng = rng_vars }) bndrs - | any (`elemVarSet` rng_vars) bndrs = env { occ_bs_env = emptyVarEnv, occ_sat_env = emptyVarEnv, occ_bs_rng = emptyVarSet } + | any (`elemVarSet` rng_vars) bndrs = env { occ_bs_env = emptyVarEnv, occ_bs_rng = emptyVarSet } | otherwise = env { occ_bs_env = swap_env `delVarEnvList` bndrs } --- | Extends 'occ_sat_env' with the expected static argument binders for the --- interesting cases (singleton recursive groups). -addInterestingStaticArgs :: OccEnv -> [(Id, CoreExpr)] -> OccEnv -addInterestingStaticArgs env [(fn, rhs)] - = env { occ_sat_env = extendVarEnv (occ_sat_env env) fn bndrs } - where - (bndrs, _body) = collectBinders rhs -addInterestingStaticArgs env _ - = env - oneShotGroup :: OccEnv -> [CoreBndr] -> ( OccEnv , [CoreBndr] ) @@ -2374,8 +2355,8 @@ markJoinOneShots mb_join_arity bndrs | otherwise = b addAppCtxt :: OccEnv -> [Arg CoreBndr] -> OccEnv -addAppCtxt env@(OccEnv { occ_one_shots = oss }) args - = env { occ_one_shots = replicate (valArgCount args) OneShotLam ++ oss } +addAppCtxt env@(OccEnv { occ_one_shots = ctxt }) args + = env { occ_one_shots = replicate (valArgCount args) OneShotLam ++ ctxt } -------------------- transClosureFV :: VarEnv VarSet -> VarEnv VarSet @@ -2703,24 +2684,17 @@ andUDs, orUDs andUDs = combineUsageDetailsWith addOccInfo orUDs = combineUsageDetailsWith orOccInfo -mkOneOcc :: OccEnv -> Id -> InterestingCxt -> [CoreArg] -> UsageDetails -mkOneOcc env id int_cxt args +mkOneOcc ::Id -> InterestingCxt -> JoinArity -> UsageDetails +mkOneOcc id int_cxt arity | isLocalId id = emptyDetails { ud_env = unitVarEnv id occ_info } | otherwise = emptyDetails where - n_args = length args - static_args - | Just decl_vars <- lookupVarEnv (occ_sat_env env) id - = mkStaticArgs $ zipWith asStaticArg decl_vars args - | otherwise -- not interesting for SAT - = noStaticArgs - occ_info = OneOcc { occ_in_lam = NotInsideLam - , occ_n_br = oneBranch - , occ_int_cxt = int_cxt - , occ_tail = AlwaysTailCalled n_args - , occ_static_args = static_args } + occ_info = OneOcc { occ_in_lam = NotInsideLam + , occ_n_br = oneBranch + , occ_int_cxt = int_cxt + , occ_tail = AlwaysTailCalled arity } addManyOccId :: UsageDetails -> Id -> UsageDetails -- Add the non-committal (id :-> noOccInfo) to the usage details @@ -2974,22 +2948,16 @@ tagRecBinders lvl body_uds triples = ASSERT(not will_be_joins) -- Should be AlwaysTailCalled if Nothing -- we are making join points! - rhs_uds' = foldr1 andUDs rhs_udss' - -- 3. Compute final usage details from adjusted RHS details - adj_uds = body_uds `andUDs` rhs_uds' + adj_uds = foldr andUDs body_uds rhs_udss' -- 4. Tag each binder with its adjusted details - bndrs' = [ setBinderOcc (adj_occ{occ_static_args = rhs_static_args}) bndr - | bndr <- bndrs - , let adj_occ = lookupDetails adj_uds bndr - , let rhs_static_args = staticArgsInfo (lookupDetails rhs_uds' bndr) - ] + bndrs' = [ setBinderOcc (lookupDetails adj_uds bndr) bndr + | bndr <- bndrs ] -- 5. Drop the binders from the adjusted details and return usage' = adj_uds `delDetailsList` bndrs in - pprTrace "tagRecBinders" (ppr bndrs' $$ ppr body_uds $$ ppr rhs_udss' $$ ppr adj_uds $$ ppr (map idOccInfo bndrs')) $ (usage', bndrs') setBinderOcc :: OccInfo -> CoreBndr -> CoreBndr @@ -3100,16 +3068,8 @@ unravels; so ignoring INLINE pragmas on recursive things isn't good either. See Invariant 2a of Note [Invariants on join points] in GHC.Core --} -asStaticArg :: Var -> CoreArg -> Staticness Var -asStaticArg v arg - | isId v, Var id <- arg, v == id = Static v - | isTyVar v, Type t <- arg, mkTyVarTy v `eqType` t = Static v - | isCoVar v, Coercion co <- arg, mkCoVarCo v `eqCoercion` co = Static v - | otherwise = NotStatic -{- ************************************************************************ * * \subsection{Operations over OccInfo} @@ -3120,8 +3080,7 @@ asStaticArg v arg markMany, markInsideLam, markNonTail :: OccInfo -> OccInfo markMany IAmDead = IAmDead -markMany occ = ManyOccs { occ_tail = occ_tail occ - , occ_static_args = occ_static_args occ } +markMany occ = ManyOccs { occ_tail = occ_tail occ } markInsideLam occ@(OneOcc {}) = occ { occ_in_lam = IsInsideLam } markInsideLam occ = occ @@ -3133,36 +3092,29 @@ addOccInfo, orOccInfo :: OccInfo -> OccInfo -> OccInfo addOccInfo a1 a2 = ASSERT( not (isDeadOcc a1 || isDeadOcc a2) ) ManyOccs { occ_tail = tailCallInfo a1 `andTailCallInfo` - tailCallInfo a2 - , occ_static_args = staticArgsInfo a1 `andStaticArgs` - staticArgsInfo a2} + tailCallInfo a2 } -- Both branches are at least One -- (Argument is never IAmDead) -- (orOccInfo orig new) is used -- when combining occurrence info from branches of a case -orOccInfo (OneOcc { occ_in_lam = in_lam1 - , occ_n_br = nbr1 - , occ_int_cxt = int_cxt1 - , occ_tail = tail1 - , occ_static_args = static_args1 }) - (OneOcc { occ_in_lam = in_lam2 - , occ_n_br = nbr2 - , occ_int_cxt = int_cxt2 - , occ_tail = tail2 - , occ_static_args = static_args2 }) - = OneOcc { occ_n_br = nbr1 + nbr2 - , occ_in_lam = in_lam1 `mappend` in_lam2 - , occ_int_cxt = int_cxt1 `mappend` int_cxt2 - , occ_tail = tail1 `andTailCallInfo` tail2 - , occ_static_args = static_args1 `andStaticArgs` static_args2 } +orOccInfo (OneOcc { occ_in_lam = in_lam1 + , occ_n_br = nbr1 + , occ_int_cxt = int_cxt1 + , occ_tail = tail1 }) + (OneOcc { occ_in_lam = in_lam2 + , occ_n_br = nbr2 + , occ_int_cxt = int_cxt2 + , occ_tail = tail2 }) + = OneOcc { occ_n_br = nbr1 + nbr2 + , occ_in_lam = in_lam1 `mappend` in_lam2 + , occ_int_cxt = int_cxt1 `mappend` int_cxt2 + , occ_tail = tail1 `andTailCallInfo` tail2 } orOccInfo a1 a2 = ASSERT( not (isDeadOcc a1 || isDeadOcc a2) ) ManyOccs { occ_tail = tailCallInfo a1 `andTailCallInfo` - tailCallInfo a2 - , occ_static_args = staticArgsInfo a1 `andStaticArgs` - staticArgsInfo a2 } + tailCallInfo a2 } andTailCallInfo :: TailCallInfo -> TailCallInfo -> TailCallInfo andTailCallInfo info@(AlwaysTailCalled arity1) (AlwaysTailCalled arity2) ===================================== compiler/GHC/Core/Opt/Pipeline.hs ===================================== @@ -37,7 +37,7 @@ import GHC.Core.Opt.Monad import GHC.Core.Opt.FloatIn ( floatInwards ) import GHC.Core.Opt.FloatOut ( floatOutwards ) import GHC.Core.Opt.LiberateCase ( liberateCase ) -import GHC.Core.Opt.StaticArgs ( doStaticArgs ) +import GHC.Core.Opt.StaticArgs ( doStaticArgs, satAnalProgram ) import GHC.Core.Opt.Specialise ( specProgram) import GHC.Core.Opt.SpecConstr ( specConstrProgram) import GHC.Core.Opt.DmdAnal @@ -749,9 +749,11 @@ simplifyPgmIO pass@(CoreDoSimplify max_iterations mode) , () <- sz `seq` () -- Force it = do { -- Occurrence analysis - let { tagged_binds = {-# SCC "OccAnal" #-} + let { tagged_binds0 = {-# SCC "OccAnal" #-} occurAnalysePgm this_mod active_unf active_rule rules binds + ; tagged_binds = {-# SCC "SAT" #-} + satAnalProgram tagged_binds0 } ; Err.dumpIfSet_dyn dflags Opt_D_dump_occur_anal "Occurrence analysis" FormatCore ===================================== compiler/GHC/Core/Opt/Simplify.hs ===================================== @@ -21,6 +21,7 @@ import GHC.Core.Opt.Simplify.Monad import GHC.Core.Type hiding ( substTy, substTyVar, extendTvSubst, extendCvSubst ) import GHC.Core.Opt.Simplify.Env import GHC.Core.Opt.Simplify.Utils +import GHC.Core.Opt.StaticArgs ( saTransform ) import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr ) import GHC.Types.Literal ( litIsLifted ) --, mkLitInt ) -- temporalily commented out. See #8326 import GHC.Types.SourceText @@ -3786,9 +3787,23 @@ simplLetUnfolding env top_lvl cont_mb id new_rhs rhs_ty arity unf = simplStableUnfolding env top_lvl cont_mb id rhs_ty arity unf | isExitJoinId id = return noUnfolding -- See Note [Do not inline exit join points] in GHC.Core.Opt.Exitify + | Just static_args <- isStrongLoopBreakerWithStaticArgs id + , (lam_bndrs, lam_body) <- collectBinders new_rhs + = do { unf_rhs <- saTransform id static_args lam_bndrs lam_body + ; pprTraceM "simplLetUnfolding" (ppr id $$ ppr static_args $$ ppr unf_rhs) + ; mkLetUnfolding (seUnfoldingOpts env) top_lvl InlineRhs id unf_rhs } | otherwise = mkLetUnfolding (seUnfoldingOpts env) top_lvl InlineRhs id new_rhs +isStrongLoopBreakerWithStaticArgs :: Id -> Maybe [Staticness ()] +isStrongLoopBreakerWithStaticArgs id + | isStrongLoopBreaker $ idOccInfo id + , static_args <- getStaticArgs $ idStaticArgs id + , notNull static_args + = Just static_args + | otherwise + = Nothing + ------------------- mkLetUnfolding :: UnfoldingOpts -> TopLevelFlag -> UnfoldingSource -> InId -> OutExpr -> SimplM Unfolding @@ -3797,10 +3812,13 @@ mkLetUnfolding uf_opts top_lvl src id new_rhs return (mkUnfolding uf_opts src is_top_lvl is_bottoming new_rhs) -- We make an unfolding *even for loop-breakers*. -- Reason: (a) It might be useful to know that they are WHNF - -- (b) In GHC.Iface.Tidy we currently assume that, if we want to - -- expose the unfolding then indeed we *have* an unfolding - -- to expose. (We could instead use the RHS, but currently - -- we don't.) The simple thing is always to have one. + -- (b) They might have static arguments, in which case we + -- provide a non-rec unfolding that specialises for those + -- (c) And even without static arguments, in GHC.Iface.Tidy we + -- currently assume that, if we want to expose the unfolding + -- then indeed we *have* an unfolding to expose. (We could + -- instead use the RHS, but currently we don't.) The simple + -- thing is always to have one. where is_top_lvl = isTopLevel top_lvl is_bottoming = isDeadEndId id ===================================== compiler/GHC/Core/Opt/StaticArgs.hs ===================================== @@ -50,10 +50,11 @@ The previous patch, to fix polymorphic floatout demand signatures, is essential to make this work well! -} -module GHC.Core.Opt.StaticArgs ( doStaticArgs ) where +module GHC.Core.Opt.StaticArgs ( satAnalProgram, doStaticArgs, saTransform ) where import GHC.Prelude +import GHC.Builtin.Names ( unboundKey ) import GHC.Types.Var import GHC.Core import GHC.Core.Utils @@ -64,19 +65,161 @@ import GHC.Types.Name import GHC.Types.Var.Env import GHC.Types.Unique.Supply import GHC.Utils.Misc -import GHC.Types.Basic (Staticness(..)) +import GHC.Types.Basic ( Staticness(..), StaticArgs, mkStaticArgs, noStaticArgs, andStaticArgs ) import GHC.Types.Unique.FM import GHC.Types.Var.Set -import GHC.Types.Unique import GHC.Types.Unique.Set import GHC.Utils.Outputable import GHC.Utils.Panic +import GHC.Data.FastString +import GHC.Data.Maybe import Data.List (mapAccumL) -import GHC.Data.FastString +import Data.Bifunctor (second) #include "HsVersions.h" +satAnalProgram :: CoreProgram -> CoreProgram +satAnalProgram bs = map (snd . satAnalBind initSatEnv) bs + +-- | Lambda binders ('TyVar's, 'CoVar's and 'Id's) of a let-bound RHS, thus +-- parameters to a function. +type Params = [Var] + +data SatEnv + = SE + { se_params_env :: !(IdEnv Params) + -- ^ Lambda binders of interesting Id's. If a param is static, then all + -- occurrences must have the 'Var' listed here in its position! + , se_in_scope :: !InScopeSet + -- ^ Needed for handling shadowing properly. See 'addInScopeVars'. + } + +initSatEnv :: SatEnv +initSatEnv = SE emptyVarEnv emptyInScopeSet + +addInterestingId :: SatEnv -> Id -> Params -> SatEnv +addInterestingId env id params = + env { se_params_env = extendVarEnv (se_params_env env) id params } + +lookupInterestingId :: SatEnv -> Id -> Maybe Params +lookupInterestingId env id = lookupVarEnv (se_params_env env) id + +addInScopeVar :: SatEnv -> Var -> SatEnv +addInScopeVar env v = addInScopeVars env [v] + +addInScopeVars :: SatEnv -> [Var] -> SatEnv +addInScopeVars se vars = se { se_in_scope = in_scope', se_params_env = env' } + where + in_scope = se_in_scope se + in_scope' = extendInScopeSetList in_scope vars + env = se_params_env se + var_set = mkVarSet vars + env' + | any (`elemInScopeSet` in_scope) vars + = mapVarEnv (hideShadowedParams var_set) $ delVarEnvList env vars + | otherwise + = env + +hideShadowedParams :: VarSet -> Params -> Params +hideShadowedParams shadowing_vars = map_if shadowed hide_param + where + map_if :: (a -> Bool) -> (a -> a) -> [a] -> [a] + map_if p f = map (\a -> if p a then f a else a) + shadowed param = param `elemVarSet` shadowing_vars + -- unboundKey is guaranteed not to occur anywhere in the program! + -- See Note [Shadowed Params] TODO + hide_param param = param `setVarUnique` unboundKey + +newtype SatOccs = SO (IdEnv StaticArgs) + +emptySatOccs :: SatOccs +emptySatOccs = SO emptyVarEnv + +addSatOccs :: SatOccs -> Id -> StaticArgs -> SatOccs +addSatOccs (SO env) fn static_args = + SO $ extendVarEnv_C andStaticArgs env fn static_args + +combineSatOccs :: SatOccs -> SatOccs -> SatOccs +combineSatOccs (SO a) (SO b) = SO $ plusVarEnv_C andStaticArgs a b + +combineSatOccsList :: [SatOccs] -> SatOccs +combineSatOccsList occs = foldl' combineSatOccs emptySatOccs occs + +peelSatOccs :: SatOccs -> Id -> (StaticArgs, SatOccs) +peelSatOccs (SO env) fn = case delLookupVarEnv env fn of + (mb_sa, env') -> (mb_sa `orElse` noStaticArgs, SO env') + +satAnalBind :: SatEnv -> CoreBind -> (SatOccs, CoreBind) +satAnalBind env (NonRec id rhs) = (occs, NonRec id rhs') + where + (occs, rhs') = satAnalExpr (env `addInScopeVar` id) rhs +satAnalBind env (Rec [(fn, rhs)]) + | notNull bndrs + = (occs', Rec [(fn', rhs')]) + where + (bndrs, rhs_body) = collectBinders rhs + env' = addInterestingId (env `addInScopeVars` (fn:bndrs)) fn bndrs + (occs, rhs_body') = satAnalExpr env' rhs_body + rhs' = mkLams bndrs rhs_body' + (static_args, occs') = peelSatOccs occs fn + fn' = setIdStaticArgs fn static_args +satAnalBind env (Rec pairs) = (combineSatOccsList occss, Rec pairs') + where + ids = map fst pairs + env' = env `addInScopeVars` ids + (occss, rhss') = mapAndUnzip (satAnalExpr env' . snd) pairs + pairs' = zip ids rhss' + +satAnalExpr :: SatEnv -> CoreExpr -> (SatOccs, CoreExpr) +satAnalExpr _ e@(Lit _) = (emptySatOccs, e) +satAnalExpr _ e@(Coercion _) = (emptySatOccs, e) +satAnalExpr _ e@(Type _) = (emptySatOccs, e) +satAnalExpr _ e@(Var _) = (emptySatOccs, e) -- boring! See the App case +satAnalExpr env (Tick t e) = second (Tick t) $ satAnalExpr env e +satAnalExpr env (Cast e c) = second (flip Cast c) $ satAnalExpr env e +satAnalExpr env e at App{} = uncurry (satAnalApp env) (collectArgs e) +satAnalExpr env e at Lam{} = (occs, mkLams bndrs body') + where + (bndrs, body) = collectBinders e + (occs, body') = satAnalExpr (env `addInScopeVars` bndrs) body +satAnalExpr env (Let bnd body) = (occs, Let bnd' body') + where + (occs_bind, bnd') = satAnalBind env bnd' + (occs_body, body') = satAnalExpr (env `addInScopeVars` bindersOf bnd) body + !occs = combineSatOccs occs_body occs_bind +satAnalExpr env (Case scrut bndr ty alts) = (occs, Case scrut' bndr ty alts') + where + (occs_scrut, scrut') = satAnalExpr env scrut + alt_env = env `addInScopeVar` bndr + (occs_alts, alts') = mapAndUnzip (satAnalAlt alt_env) alts + occs = combineSatOccsList (occs_scrut:occs_alts) + +satAnalAlt :: SatEnv -> CoreAlt -> (SatOccs, CoreAlt) +satAnalAlt env (dc, bndrs, rhs) = (occs, (dc, bndrs, rhs')) + where + (occs, rhs') = satAnalExpr (env `addInScopeVars` bndrs) rhs + +satAnalApp :: SatEnv -> CoreExpr -> [CoreArg] -> (SatOccs, CoreExpr) +satAnalApp env head args = (add_static_args_info occs, expr') + where + (occs_head, head') = satAnalExpr env head + (occs_args, args') = mapAndUnzip (satAnalExpr env) args + occs = combineSatOccsList (occs_head:occs_args) + expr' = mkApps head' args' + add_static_args_info occs + | Var fn <- head, Just params <- lookupInterestingId env fn + = addSatOccs occs fn (mkStaticArgs $ zipWith asStaticArg params args) + | otherwise + = occs + +asStaticArg :: Var -> CoreArg -> Staticness () +asStaticArg v arg + | isId v, Var id <- arg, v == id = Static () + | isTyVar v, Type t <- arg, mkTyVarTy v `eqType` t = Static () + | isCoVar v, Coercion co <- arg, mkCoVarCo v `eqCoercion` co = Static () + | otherwise = NotStatic + doStaticArgs :: UniqSupply -> CoreProgram -> CoreProgram doStaticArgs us binds = snd $ mapAccumL sat_bind_threaded_us us binds where @@ -261,9 +404,6 @@ type SatM result = UniqSM result runSAT :: UniqSupply -> SatM a -> a runSAT = initUs_ -newUnique :: SatM Unique -newUnique = getUniqueM - {- ************************************************************************ @@ -371,7 +511,8 @@ saTransformMaybe :: Id -> Maybe SATInfo -> [Id] -> CoreExpr -> SatM CoreBind saTransformMaybe binder maybe_arg_staticness rhs_binders rhs_body | Just arg_staticness <- maybe_arg_staticness , should_transform arg_staticness - = saTransform binder arg_staticness rhs_binders rhs_body + = do { new_rhs <- saTransform binder arg_staticness rhs_binders rhs_body + ; return (NonRec binder new_rhs) } | otherwise = return (Rec [(binder, mkLams rhs_binders rhs_body)]) where @@ -379,11 +520,12 @@ saTransformMaybe binder maybe_arg_staticness rhs_binders rhs_body where n_static_args = count isStaticValue staticness -saTransform :: Id -> SATInfo -> [Id] -> CoreExpr -> SatM CoreBind +saTransform :: MonadUnique m => Id -> [Staticness a] -> [Id] -> CoreExpr -> m CoreExpr saTransform binder arg_staticness rhs_binders rhs_body - = do { shadow_lam_bndrs <- mapM clone binders_w_staticness - ; uniq <- newUnique - ; return (NonRec binder (mk_new_rhs uniq shadow_lam_bndrs)) } + = do { MASSERT( arg_staticness `leLength` rhs_binders ) + ; shadow_lam_bndrs <- mapM clone binders_w_staticness + ; uniq <- getUniqueM + ; return (mk_new_rhs uniq shadow_lam_bndrs) } where -- Running example: foldr -- foldr \alpha \beta c n xs = e, for some e @@ -400,7 +542,7 @@ saTransform binder arg_staticness rhs_binders rhs_body non_static_args = [v | (v, NotStatic) <- binders_w_staticness] clone (bndr, NotStatic) = return bndr - clone (bndr, _ ) = do { uniq <- newUnique + clone (bndr, _ ) = do { uniq <- getUniqueM ; return (setVarUnique bndr uniq) } -- new_rhs = \alpha beta c n xs -> ===================================== compiler/GHC/Core/Ppr.hs ===================================== @@ -464,6 +464,7 @@ instance Outputable IdInfo where ppr info = showAttributes [ (has_prag, text "InlPrag=" <> pprInlineDebug prag_info) , (has_occ, text "Occ=" <> ppr occ_info) + , (has_static_args, text "SA=" <> ppr static_args) , (has_dmd, text "Dmd=" <> ppr dmd_info) , (has_lbv , text "OS=" <> ppr lbv_info) , (has_arity, text "Arity=" <> int arity) @@ -480,6 +481,9 @@ instance Outputable IdInfo where occ_info = occInfo info has_occ = not (isManyOccs occ_info) + static_args = staticArgsInfo info + has_static_args = static_args /= noStaticArgs + dmd_info = demandInfo info has_dmd = not $ isTopDmd dmd_info ===================================== compiler/GHC/Core/Unfold.hs ===================================== @@ -51,7 +51,7 @@ import GHC.Core.DataCon import GHC.Types.Literal import GHC.Builtin.PrimOps import GHC.Types.Id.Info -import GHC.Types.Basic ( Arity, InlineSpec(..), inlinePragmaSpec, staticArgsInfo, noStaticArgs ) +import GHC.Types.Basic ( Arity, InlineSpec(..), inlinePragmaSpec, noStaticArgs ) import GHC.Core.Type import GHC.Builtin.Names import GHC.Builtin.Types.Prim ( realWorldStatePrimTy ) @@ -1096,7 +1096,7 @@ callSiteInline dflags id active_unfolding lone_variable arg_infos cont_info DFunUnfolding {} -> Nothing -- Never unfold a DFun where b ==> t = not b || t - has_static_args id = staticArgsInfo (idOccInfo id) /= noStaticArgs + has_static_args id = idStaticArgs id /= noStaticArgs -- | Report the inlining of an identifier's RHS to the user, if requested. traceInline :: DynFlags -> Id -> String -> SDoc -> a -> a ===================================== compiler/GHC/Types/Basic.hs ===================================== @@ -69,8 +69,7 @@ module GHC.Types.Basic ( isAlwaysTailCalled, Staticness(..), - StaticArgs, staticArgsInfo, - mkStaticArgs, noStaticArgs, getStaticArgs, andStaticArgs, + StaticArgs, mkStaticArgs, noStaticArgs, getStaticArgs, andStaticArgs, EP(..), @@ -116,6 +115,7 @@ import GHC.Utils.Misc import GHC.Types.SourceText import Data.Data import Data.Bits +import Data.List ( dropWhileEnd ) import qualified Data.Semigroup as Semi {- @@ -919,8 +919,7 @@ OccInfo here, safely at the bottom -- | identifier Occurrence Information data OccInfo - = ManyOccs { occ_tail :: !TailCallInfo - , occ_static_args :: {-# UNPACK #-} !StaticArgs } + = ManyOccs { occ_tail :: !TailCallInfo } -- ^ There are many occurrences, or unknown occurrences | IAmDead -- ^ Marks unused variables. Sometimes useful for @@ -929,15 +928,13 @@ data OccInfo | OneOcc { occ_in_lam :: !InsideLam , occ_n_br :: {-# UNPACK #-} !BranchCount , occ_int_cxt :: !InterestingCxt - , occ_tail :: !TailCallInfo - , occ_static_args :: {-# UNPACK #-} !StaticArgs } + , occ_tail :: !TailCallInfo } -- ^ Occurs exactly once (per branch), not inside a rule -- | This identifier breaks a loop of mutually recursive functions. The field -- marks whether it is only a loop breaker due to a reference in a rule | IAmALoopBreaker { occ_rules_only :: !RulesOnly - , occ_tail :: !TailCallInfo - , occ_static_args :: {-# UNPACK #-} !StaticArgs } + , occ_tail :: !TailCallInfo } -- Note [LoopBreaker OccInfo] deriving (Eq) @@ -962,14 +959,6 @@ newtype StaticArgs = StaticArgs { unwrapStaticArgs :: Word } noStaticArgs :: StaticArgs noStaticArgs = StaticArgs zeroBits --- | All one bit vector; all arguments are static -allStaticArgs :: StaticArgs -allStaticArgs = StaticArgs (complement zeroBits) - -staticArgsInfo :: OccInfo -> StaticArgs -staticArgsInfo IAmDead = allStaticArgs -- should be a neutral element to @andStaticArgs@ -staticArgsInfo occ = occ_static_args occ - -- | The maximum number of static arguments we can express mAX_STATIC_ARGS :: Int mAX_STATIC_ARGS = 32 `min` finiteBitSize (unwrapStaticArgs noStaticArgs) @@ -980,7 +969,12 @@ mkStaticArgs = StaticArgs . take mAX_STATIC_ARGS getStaticArgs :: StaticArgs -> [Staticness ()] -getStaticArgs (StaticArgs n) = map (to_static . testBit n) [0..finiteBitSize n - 1] +getStaticArgs sa@(StaticArgs n) + | sa == noStaticArgs + = [] + | otherwise + = dropWhileEnd (== NotStatic) -- trim trailing @NotStatic at s + $ map (to_static . testBit n) [0..finiteBitSize n - 1] where to_static True = Static () to_static False = NotStatic @@ -988,6 +982,19 @@ getStaticArgs (StaticArgs n) = map (to_static . testBit n) [0..finiteBitSize n - andStaticArgs :: StaticArgs -> StaticArgs -> StaticArgs andStaticArgs (StaticArgs sa1) (StaticArgs sa2) = StaticArgs $ sa1 .&. sa2 +instance Outputable StaticArgs where + ppr = hcat . map pp_bit . getStaticArgs + where + pp_bit NotStatic = char '.' + pp_bit Static{} = char 'S' + +_pprShortStaticArgs :: StaticArgs -> SDoc +_pprShortStaticArgs static_args + | static_args == noStaticArgs = empty + | otherwise = char 'S' <> brackets (int n_static_args) + where + n_static_args = count isStatic (getStaticArgs static_args) + {- Note [LoopBreaker OccInfo] ~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1001,12 +1008,10 @@ See OccurAnal Note [Weak loop breakers] -} noOccInfo :: OccInfo -noOccInfo = ManyOccs { occ_tail = NoTailCallInfo, occ_static_args = noStaticArgs } +noOccInfo = ManyOccs { occ_tail = NoTailCallInfo } isNoOccInfo :: OccInfo -> Bool -isNoOccInfo ManyOccs { occ_tail = NoTailCallInfo - , occ_static_args = static_args } - = static_args == noStaticArgs +isNoOccInfo ManyOccs { occ_tail = NoTailCallInfo } = True isNoOccInfo _ = False isManyOccs :: OccInfo -> Bool @@ -1079,8 +1084,8 @@ instance Outputable TailCallInfo where ----------------- strongLoopBreaker, weakLoopBreaker :: OccInfo -strongLoopBreaker = IAmALoopBreaker False NoTailCallInfo noStaticArgs -weakLoopBreaker = IAmALoopBreaker True NoTailCallInfo noStaticArgs +strongLoopBreaker = IAmALoopBreaker False NoTailCallInfo +weakLoopBreaker = IAmALoopBreaker True NoTailCallInfo isWeakLoopBreaker :: OccInfo -> Bool isWeakLoopBreaker (IAmALoopBreaker{}) = True @@ -1106,36 +1111,27 @@ zapFragileOcc occ = zapOccTailCallInfo occ instance Outputable OccInfo where -- only used for debugging; never parsed. KSW 1999-07 - ppr (ManyOccs tails static_args) = pprShortTailCallInfo tails <> pprShortStaticArgs static_args + ppr (ManyOccs tails) = pprShortTailCallInfo tails ppr IAmDead = text "Dead" - ppr (IAmALoopBreaker rule_only tails static_args) - = text "LoopBreaker" <> pp_ro <> pp_tail <> pp_sas + ppr (IAmALoopBreaker rule_only tails) + = text "LoopBreaker" <> pp_ro <> pp_tail where pp_ro | rule_only = char '!' | otherwise = empty pp_tail = pprShortTailCallInfo tails - pp_sas = pprShortStaticArgs static_args - ppr (OneOcc inside_lam one_branch int_cxt tail_info static_args) - = text "Once" <> pp_lam inside_lam <> ppr one_branch <> pp_args int_cxt <> pp_tail <> pp_sas + ppr (OneOcc inside_lam one_branch int_cxt tail_info) + = text "Once" <> pp_lam inside_lam <> ppr one_branch <> pp_args int_cxt <> pp_tail where pp_lam IsInsideLam = char 'L' pp_lam NotInsideLam = empty pp_args IsInteresting = char '!' pp_args NotInteresting = empty pp_tail = pprShortTailCallInfo tail_info - pp_sas = pprShortStaticArgs static_args pprShortTailCallInfo :: TailCallInfo -> SDoc pprShortTailCallInfo (AlwaysTailCalled ar) = char 'T' <> brackets (int ar) pprShortTailCallInfo NoTailCallInfo = empty -pprShortStaticArgs :: StaticArgs -> SDoc -pprShortStaticArgs static_args - | static_args == noStaticArgs = empty - | otherwise = char 'S' <> brackets (int n_static_args) - where - n_static_args = count isStatic (getStaticArgs static_args) - data Staticness a = Static a | NotStatic ===================================== compiler/GHC/Types/Id.hs ===================================== @@ -55,7 +55,7 @@ module GHC.Types.Id ( globaliseId, localiseId, setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo, zapLamIdInfo, zapIdDemandInfo, zapIdUsageInfo, zapIdUsageEnvInfo, - zapIdUsedOnceInfo, zapIdTailCallInfo, + zapIdUsedOnceInfo, zapIdTailCallInfo, zapIdStaticArgs, zapFragileIdInfo, zapIdStrictness, zapStableUnfolding, transferPolyIdInfo, scaleIdBy, scaleVarBy, @@ -98,6 +98,7 @@ module GHC.Types.Id ( idCafInfo, idLFInfo_maybe, idOneShotInfo, idStateHackOneShotInfo, idOccInfo, + idStaticArgs, isNeverLevPolyId, -- ** Writing 'IdInfo' fields @@ -108,6 +109,7 @@ module GHC.Types.Id ( setIdSpecialisation, setIdCafInfo, setIdOccInfo, zapIdOccInfo, + setIdStaticArgs, setIdLFInfo, setIdDemandInfo, @@ -784,6 +786,15 @@ setIdOccInfo id occ_info = modifyIdInfo (`setOccInfo` occ_info) id zapIdOccInfo :: Id -> Id zapIdOccInfo b = b `setIdOccInfo` noOccInfo +idStaticArgs :: Id -> StaticArgs +idStaticArgs id = staticArgsInfo (idInfo id) + +setIdStaticArgs :: Id -> StaticArgs -> Id +setIdStaticArgs id static_args = modifyIdInfo (`setStaticArgsInfo` static_args) id + +zapIdStaticArgs :: Id -> Id +zapIdStaticArgs b = b `setIdStaticArgs` noStaticArgs + {- --------------------------------- -- INLINING ===================================== compiler/GHC/Types/Id/Info.hs ===================================== @@ -75,6 +75,9 @@ module GHC.Types.Id.Info ( ppCafInfo, mayHaveCafRefs, cafInfo, setCafInfo, + -- ** Static arguments + StaticArgs, staticArgsInfo, setStaticArgsInfo, + -- ** The LambdaFormInfo type LambdaFormInfo(..), lfInfo, setLFInfo, @@ -128,6 +131,7 @@ infixl 1 `setRuleInfo`, `setStrictnessInfo`, `setCprInfo`, `setDemandInfo`, + `setStaticArgsInfo`, `setNeverLevPoly`, `setLevityInfoWithType` @@ -278,6 +282,7 @@ data IdInfo -- 4% in some programs. See #17497 and associated MR. -- -- See documentation of the getters for what these packed fields mean. + staticArgsInfo :: {-# UNPACK #-} !StaticArgs, lfInfo :: !(Maybe LambdaFormInfo) } @@ -415,6 +420,9 @@ setStrictnessInfo info dd = dd `seq` info { strictnessInfo = dd } setCprInfo :: IdInfo -> CprSig -> IdInfo setCprInfo info cpr = cpr `seq` info { cprInfo = cpr } +setStaticArgsInfo :: IdInfo -> StaticArgs -> IdInfo +setStaticArgsInfo info sa = info { staticArgsInfo = sa } + -- | Basic 'IdInfo' that carries no useful information whatsoever vanillaIdInfo :: IdInfo vanillaIdInfo @@ -432,6 +440,7 @@ vanillaIdInfo bitfieldSetOneShotInfo NoOneShotInfo $ bitfieldSetLevityInfo NoLevityInfo $ emptyBitField, + staticArgsInfo = noStaticArgs, lfInfo = Nothing } ===================================== compiler/GHC/Types/Unique/FM.hs ===================================== @@ -70,6 +70,7 @@ module GHC.Types.Unique.FM ( isNullUFM, lookupUFM, lookupUFM_Directly, lookupWithDefaultUFM, lookupWithDefaultUFM_Directly, + delLookupUFM, nonDetEltsUFM, eltsUFM, nonDetKeysUFM, ufmToSet_Directly, nonDetUFMToList, ufmToIntMap, unsafeIntMapToUFM, @@ -338,6 +339,11 @@ lookupWithDefaultUFM (UFM m) v k = M.findWithDefault v (getKey $ getUnique k) m lookupWithDefaultUFM_Directly :: UniqFM key elt -> elt -> Unique -> elt lookupWithDefaultUFM_Directly (UFM m) v u = M.findWithDefault v (getKey u) m +delLookupUFM :: Uniquable key => UniqFM key elt -> key -> (Maybe elt, UniqFM key elt) +delLookupUFM (UFM m) k = (mb_v, UFM m') + where + (mb_v, m') = M.updateLookupWithKey (\_key _elt -> Nothing) (getKey $ getUnique k) m + eltsUFM :: UniqFM key elt -> [elt] eltsUFM (UFM m) = M.elems m ===================================== compiler/GHC/Types/Var/Env.hs ===================================== @@ -16,7 +16,7 @@ module GHC.Types.Var.Env ( plusVarEnvList, alterVarEnv, delVarEnvList, delVarEnv, minusVarEnv, - lookupVarEnv, lookupVarEnv_NF, lookupWithDefaultVarEnv, + lookupVarEnv, lookupVarEnv_NF, lookupWithDefaultVarEnv, delLookupVarEnv, mapVarEnv, zipVarEnv, modifyVarEnv, modifyVarEnv_Directly, isEmptyVarEnv, @@ -488,6 +488,7 @@ lookupVarEnv :: VarEnv a -> Var -> Maybe a filterVarEnv :: (a -> Bool) -> VarEnv a -> VarEnv a lookupVarEnv_NF :: VarEnv a -> Var -> a lookupWithDefaultVarEnv :: VarEnv a -> a -> Var -> a +delLookupVarEnv :: VarEnv a -> Var -> (Maybe a, VarEnv a) elemVarEnv :: Var -> VarEnv a -> Bool elemVarEnvByKey :: Unique -> VarEnv a -> Bool disjointVarEnv :: VarEnv a -> VarEnv a -> Bool @@ -509,6 +510,7 @@ minusVarEnv = minusUFM plusVarEnv = plusUFM plusVarEnvList = plusUFMList lookupVarEnv = lookupUFM +delLookupVarEnv = delLookupUFM filterVarEnv = filterUFM lookupWithDefaultVarEnv = lookupWithDefaultUFM mapVarEnv = mapUFM View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e8be408f19106e1f4887f94b20c8841794d62075 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e8be408f19106e1f4887f94b20c8841794d62075 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 9 17:39:14 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Wed, 09 Dec 2020 12:39:14 -0500 Subject: [Git][ghc/ghc][wip/T17656] 9 commits: Fix kind inference for data types. Again. Message-ID: <5fd10bc2abda2_6b2133294b87208e8@gitlab.mail> Simon Peyton Jones pushed to branch wip/T17656 at Glasgow Haskell Compiler / GHC Commits: 62ed6957 by Simon Peyton Jones at 2020-12-08T15:31:41-05:00 Fix kind inference for data types. Again. This patch fixes several aspects of kind inference for data type declarations, especially data /instance/ declarations Specifically 1. In kcConDecls/kcConDecl make it clear that the tc_res_kind argument is only used in the H98 case; and in that case there is no result kind signature; and hence no need for the disgusting splitPiTys in kcConDecls (now thankfully gone). The GADT case is a bit different to before, and much nicer. This is what fixes #18891. See Note [kcConDecls: kind-checking data type decls] 2. Do not look at the constructor decls of a data/newtype instance in tcDataFamInstanceHeader. See GHC.Tc.TyCl.Instance Note [Kind inference for data family instances]. This was a new realisation that arose when doing (1) This causes a few knock-on effects in the tests suite, because we require more information than before in the instance /header/. New user-manual material about this in "Kind inference in data type declarations" and "Kind inference for data/newtype instance declarations". 3. Minor improvement in kcTyClDecl, combining GADT and H98 cases 4. Fix #14111 and #8707 by allowing the header of a data instance to affect kind inferece for the the data constructor signatures; as described at length in Note [GADT return types] in GHC.Tc.TyCl This led to a modest refactoring of the arguments (and argument order) of tcConDecl/tcConDecls. 5. Fix #19000 by inverting the sense of the test in new_locs in GHC.Tc.Solver.Canonical.canDecomposableTyConAppOK. - - - - - 0abe3ddf by Adam Sandberg Ericsson at 2020-12-08T15:32:19-05:00 hadrian: build the _l and _thr_l rts flavours in the develN flavours The ghc binary requires the eventlog rts since fc644b1a643128041cfec25db84e417851e28bab - - - - - 51e3bb6d by Andreas Klebinger at 2020-12-08T22:43:21-05:00 CodeGen: Make folds User/DefinerOfRegs INLINEABLE. Reduces allocation for the test case I was looking at by about 1.2%. Mostly from avoiding allocation of some folding functions which turn into let-no-escape bindings which just reuse their environment instead. We also force inlining in a few key places in CmmSink which helps a bit more. - - - - - 69ae10c3 by Andreas Klebinger at 2020-12-08T22:43:21-05:00 CmmSink: Force inlining of foldRegsDefd Helps avoid allocating the folding function. Improves perf for T3294 by about 1%. - - - - - 6e3da800 by Andreas Klebinger at 2020-12-08T22:43:21-05:00 Cmm: Make a few types and utility function slightly stricter. About 0.6% reduction in allocations for the code I was looking at. Not a huge difference but no need to throw away performance. - - - - - aef44d7f by Andreas Klebinger at 2020-12-08T22:43:21-05:00 Cmm.Sink: Optimize retaining of assignments, live sets. Sinking requires us to track live local regs after each cmm statement. We used to do this via "Set LocalReg". However we can replace this with a solution based on IntSet which is overall more efficient without losing much. The thing we lose is width of the variables, which isn't used by the sinking pass anyway. I also reworked how we keep assignments to regs mentioned in skipped assignments. I put the details into Note [Keeping assignemnts mentioned in skipped RHSs]. The gist of it is instead of keeping track of it via the use count which is a `IntMap Int` we now use the live regs set (IntSet) which is quite a bit faster. I think it also matches the semantics a lot better. The skipped (not discarded) assignment does in fact keep the regs on it's rhs alive so keeping track of this in the live set seems like the clearer solution as well. Improves allocations for T3294 by yet another 1%. - - - - - 59f2249b by Andreas Klebinger at 2020-12-08T22:43:21-05:00 GHC.Cmm.Opt: Be stricter in results. Optimization either returns Nothing if nothing is to be done or `Just <cmmExpr>` otherwise. There is no point in being lazy in `cmmExpr`. We usually inspect this element so the thunk gets forced not long after. We might eliminate it as dead code once in a blue moon but that's not a case worth optimizing for. Overall the impact of this is rather low. As Cmm.Opt doesn't allocate much (compared to the rest of GHC) to begin with. - - - - - 54b88eac by Andreas Klebinger at 2020-12-08T22:43:57-05:00 Bump time submodule. This should fix #19002. - - - - - 8f86d163 by Simon Peyton Jones at 2020-12-09T10:34:14+00:00 Kill floatEqualities completely This WIP patch over-delivers on #17656. I say "over-delivers" because instead of improving floatEqualities, it kills it off entirely. Instead we use level numbers. There is plenty of dead code to delete, and Notes to write, but for now this a proof of concept, to enable code review. It validates. - - - - - 30 changed files: - compiler/GHC/Cmm/Expr.hs - + compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Liveness.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/Hs/Extension.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Interact.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Utils/Unify.hs - compiler/GHC/Utils/Outputable.hs - compiler/ghc.cabal.in - docs/users_guide/9.2.1-notes.rst - docs/users_guide/exts/poly_kinds.rst - hadrian/src/Settings/Flavours/Development.hs - libraries/time - testsuite/tests/dependent/should_fail/T13780a.stderr - testsuite/tests/deriving/should_compile/T11416.hs - testsuite/tests/deriving/should_compile/T9359.hs - + testsuite/tests/gadt/SynDataRec.hs - testsuite/tests/gadt/all.T - testsuite/tests/ghci.debugger/scripts/break012.stdout The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6313ae215c19bbde5e1c11c503e8cf51e893b6ea...8f86d1634093d0280675184987df1d6a779dd04d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6313ae215c19bbde5e1c11c503e8cf51e893b6ea...8f86d1634093d0280675184987df1d6a779dd04d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 9 18:20:02 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 09 Dec 2020 13:20:02 -0500 Subject: [Git][ghc/ghc][wip/gc-events] users guide: Fix syntax errors Message-ID: <5fd11552519c_6b2131d5c3872684e@gitlab.mail> Ben Gamari pushed to branch wip/gc-events at Glasgow Haskell Compiler / GHC Commits: 09eeb4a0 by Ben Gamari at 2020-12-09T13:19:42-05:00 users guide: Fix syntax errors - - - - - 1 changed file: - docs/users_guide/using-optimisation.rst Changes: ===================================== docs/users_guide/using-optimisation.rst ===================================== @@ -1197,16 +1197,16 @@ by saying ``-fno-wombat``. This is the full syntax for cardinalities, demands and sub-demands in BNF: - .. code-block:: + .. code-block:: none - card ::= B | A | 1 | U | S | M semantics as in the table above + card ::= B | A | 1 | U | S | M semantics as in the table above - d ::= card sd card = how often, sd = how deep - | card abbreviation: Same as "card card" + d ::= card sd card = how often, sd = how deep + | card abbreviation: Same as "card card" - sd ::= card polymorphic sub-demand, card at every level - | P(d,d,..) product sub-demand - | Ccard(sd) call sub-demand + sd ::= card polymorphic sub-demand, card at every level + | P(d,d,..) product sub-demand + | Ccard(sd) call sub-demand For example, ``fst`` is strict in its argument, and also in the first component of the argument. It will not evaluate the argument's second @@ -1234,17 +1234,17 @@ by saying ``-fno-wombat``. We summarise a function's demand properties in its *demand signature*. This is the general syntax: - .. code-block:: - - {x->dx,y->dy,z->dz...}...div - ^ ^ ^ ^ ^ ^ - | | | | | | - | \---+---+------/ | - | | | - demand on free demand on divergence - variables arguments information - (omitted if empty) (omitted if - no information) + .. code-block:: none + + {x->dx,y->dy,z->dz...}...div + ^ ^ ^ ^ ^ ^ + | | | | | | + | \---+---+------/ | + | | | + demand on free demand on divergence + variables arguments information + (omitted if empty) (omitted if + no information) We summarise ``fst``'s demand properties in its *demand signature* ````, which just says "If ``fst`` is applied to one argument, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/09eeb4a0747093e317933301f2e20f30c666f689 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/09eeb4a0747093e317933301f2e20f30c666f689 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 9 19:19:09 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 09 Dec 2020 14:19:09 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/T7275 Message-ID: <5fd1232d353b2_6b213272cb8739972@gitlab.mail> Ben Gamari pushed new branch wip/T7275 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T7275 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 9 21:23:46 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 09 Dec 2020 16:23:46 -0500 Subject: [Git][ghc/ghc][wip/T7275] 2 commits: rts: Break up census logic Message-ID: <5fd140626005a_6b213272cb87677b@gitlab.mail> Ben Gamari pushed to branch wip/T7275 at Glasgow Haskell Compiler / GHC Commits: 8e9210ff by Ben Gamari at 2020-12-09T16:14:02-05:00 rts: Break up census logic Move the logic for taking censuses of "normal" and pinned blocks to their own functions. - - - - - 48beb603 by Ben Gamari at 2020-12-09T16:16:32-05:00 rts: Implement heap census support for pinned objects It turns out that this was fairly straightforward to implement since we are now pretty careful about zeroing slop. - - - - - 1 changed file: - rts/ProfHeap.c Changes: ===================================== rts/ProfHeap.c ===================================== @@ -1103,214 +1103,240 @@ heapCensusCompactList(Census *census, bdescr *bd) } } -/* ----------------------------------------------------------------------------- - * Code to perform a heap census. - * -------------------------------------------------------------------------- */ static void -heapCensusChain( Census *census, bdescr *bd ) +heapCensusPinnedBlock( Census *census, bdescr *bd ) { - StgPtr p; - const StgInfoTable *info; - size_t size; - bool prim; - - for (; bd != NULL; bd = bd->link) { - - // HACK: pretend a pinned block is just one big ARR_WORDS - // owned by CCS_PINNED. These blocks can be full of holes due - // to alignment constraints so we can't traverse the memory - // and do a proper census. - if (bd->flags & BF_PINNED) { - StgClosure arr; - SET_HDR(&arr, &stg_ARR_WORDS_info, CCS_PINNED); - heapProfObject(census, &arr, bd->blocks * BLOCK_SIZE_W, true); + StgWord *p = (StgWord *) bd->start; + while (p < bd->free) { + if (*(StgWord *) p == 0) { + p++; continue; } - p = bd->start; - - // When we shrink a large ARR_WORDS, we do not adjust the free pointer - // of the associated block descriptor, thus introducing slop at the end - // of the object. This slop remains after GC, violating the assumption - // of the loop below that all slop has been eliminated (#11627). - // The slop isn't always zeroed (e.g. in non-profiling mode, cf - // OVERWRITING_CLOSURE_OFS). - // Consequently, we handle large ARR_WORDS objects as a special case. - if (bd->flags & BF_LARGE - && get_itbl((StgClosure *)p)->type == ARR_WORDS) { - size = arr_words_sizeW((StgArrBytes *)p); - prim = true; - heapProfObject(census, (StgClosure *)p, size, prim); - continue; + ASSERT(LOOKS_LIKE_CLOSURE_PTR(p)); + const StgInfoTable *info = get_itbl((StgClosure *) p); + switch (info->type) { + case ARR_WORDS: + { + StgArrBytes *arr = (StgArrBytes *) p; + const size_t size = arr_words_sizeW(arr); + heapProfObject(census, (StgClosure *)p, size, /*prim*/ true); + p += size; + break; + } + default: + barf("heapCensusPinnedBlock: Unknown object: %p (info=%p, type=%d)", p, info, info->type); } + } +} +/* + * Take a census of the contents of a "normal" (e.g. not large, not pinned, not + * compact) heap block. + */ +static void +heapCensusNormalBlock(Census *census, bdescr *bd) +{ + StgPtr p = bd->start; + while (p < bd->free) { + const StgInfoTable *info = get_itbl((const StgClosure *)p); + bool prim = false; + size_t size; - while (p < bd->free) { - info = get_itbl((const StgClosure *)p); - prim = false; - - switch (info->type) { + switch (info->type) { - case THUNK: - size = thunk_sizeW_fromITBL(info); - break; + case THUNK: + size = thunk_sizeW_fromITBL(info); + break; - case THUNK_1_1: - case THUNK_0_2: - case THUNK_2_0: - size = sizeofW(StgThunkHeader) + 2; - break; + case THUNK_1_1: + case THUNK_0_2: + case THUNK_2_0: + size = sizeofW(StgThunkHeader) + 2; + break; - case THUNK_1_0: - case THUNK_0_1: - case THUNK_SELECTOR: - size = sizeofW(StgThunkHeader) + 1; - break; + case THUNK_1_0: + case THUNK_0_1: + case THUNK_SELECTOR: + size = sizeofW(StgThunkHeader) + 1; + break; - case FUN: - case BLACKHOLE: - case BLOCKING_QUEUE: - case FUN_1_0: - case FUN_0_1: - case FUN_1_1: - case FUN_0_2: - case FUN_2_0: - case CONSTR: - case CONSTR_NOCAF: - case CONSTR_1_0: - case CONSTR_0_1: - case CONSTR_1_1: - case CONSTR_0_2: - case CONSTR_2_0: - size = sizeW_fromITBL(info); - break; + case FUN: + case BLACKHOLE: + case BLOCKING_QUEUE: + case FUN_1_0: + case FUN_0_1: + case FUN_1_1: + case FUN_0_2: + case FUN_2_0: + case CONSTR: + case CONSTR_NOCAF: + case CONSTR_1_0: + case CONSTR_0_1: + case CONSTR_1_1: + case CONSTR_0_2: + case CONSTR_2_0: + size = sizeW_fromITBL(info); + break; - case IND: - // Special case/Delicate Hack: INDs don't normally - // appear, since we're doing this heap census right - // after GC. However, GarbageCollect() also does - // resurrectThreads(), which can update some - // blackholes when it calls raiseAsync() on the - // resurrected threads. So we know that any IND will - // be the size of a BLACKHOLE. - size = BLACKHOLE_sizeW(); - break; + case IND: + // Special case/Delicate Hack: INDs don't normally + // appear, since we're doing this heap census right + // after GC. However, GarbageCollect() also does + // resurrectThreads(), which can update some + // blackholes when it calls raiseAsync() on the + // resurrected threads. So we know that any IND will + // be the size of a BLACKHOLE. + size = BLACKHOLE_sizeW(); + break; - case BCO: - prim = true; - size = bco_sizeW((StgBCO *)p); - break; + case BCO: + prim = true; + size = bco_sizeW((StgBCO *)p); + break; - case MVAR_CLEAN: - case MVAR_DIRTY: - case TVAR: - case WEAK: - case PRIM: - case MUT_PRIM: - case MUT_VAR_CLEAN: - case MUT_VAR_DIRTY: - prim = true; - size = sizeW_fromITBL(info); - break; + case MVAR_CLEAN: + case MVAR_DIRTY: + case TVAR: + case WEAK: + case PRIM: + case MUT_PRIM: + case MUT_VAR_CLEAN: + case MUT_VAR_DIRTY: + prim = true; + size = sizeW_fromITBL(info); + break; - case AP: - size = ap_sizeW((StgAP *)p); - break; + case AP: + size = ap_sizeW((StgAP *)p); + break; - case PAP: - size = pap_sizeW((StgPAP *)p); - break; + case PAP: + size = pap_sizeW((StgPAP *)p); + break; - case AP_STACK: - size = ap_stack_sizeW((StgAP_STACK *)p); - break; + case AP_STACK: + size = ap_stack_sizeW((StgAP_STACK *)p); + break; - case ARR_WORDS: - prim = true; - size = arr_words_sizeW((StgArrBytes*)p); - break; + case ARR_WORDS: + prim = true; + size = arr_words_sizeW((StgArrBytes*)p); + break; - case MUT_ARR_PTRS_CLEAN: - case MUT_ARR_PTRS_DIRTY: - case MUT_ARR_PTRS_FROZEN_CLEAN: - case MUT_ARR_PTRS_FROZEN_DIRTY: - prim = true; - size = mut_arr_ptrs_sizeW((StgMutArrPtrs *)p); - break; + case MUT_ARR_PTRS_CLEAN: + case MUT_ARR_PTRS_DIRTY: + case MUT_ARR_PTRS_FROZEN_CLEAN: + case MUT_ARR_PTRS_FROZEN_DIRTY: + prim = true; + size = mut_arr_ptrs_sizeW((StgMutArrPtrs *)p); + break; - case SMALL_MUT_ARR_PTRS_CLEAN: - case SMALL_MUT_ARR_PTRS_DIRTY: - case SMALL_MUT_ARR_PTRS_FROZEN_CLEAN: - case SMALL_MUT_ARR_PTRS_FROZEN_DIRTY: - prim = true; - size = small_mut_arr_ptrs_sizeW((StgSmallMutArrPtrs *)p); - break; + case SMALL_MUT_ARR_PTRS_CLEAN: + case SMALL_MUT_ARR_PTRS_DIRTY: + case SMALL_MUT_ARR_PTRS_FROZEN_CLEAN: + case SMALL_MUT_ARR_PTRS_FROZEN_DIRTY: + prim = true; + size = small_mut_arr_ptrs_sizeW((StgSmallMutArrPtrs *)p); + break; - case TSO: - prim = true; + case TSO: + prim = true; #if defined(PROFILING) - if (RtsFlags.ProfFlags.includeTSOs) { - size = sizeofW(StgTSO); - break; - } else { - // Skip this TSO and move on to the next object - p += sizeofW(StgTSO); - continue; - } -#else + if (RtsFlags.ProfFlags.includeTSOs) { size = sizeofW(StgTSO); break; + } else { + // Skip this TSO and move on to the next object + p += sizeofW(StgTSO); + continue; + } +#else + size = sizeofW(StgTSO); + break; #endif - case STACK: - prim = true; + case STACK: + prim = true; #if defined(PROFILING) - if (RtsFlags.ProfFlags.includeTSOs) { - size = stack_sizeW((StgStack*)p); - break; - } else { - // Skip this TSO and move on to the next object - p += stack_sizeW((StgStack*)p); - continue; - } -#else + if (RtsFlags.ProfFlags.includeTSOs) { size = stack_sizeW((StgStack*)p); break; + } else { + // Skip this TSO and move on to the next object + p += stack_sizeW((StgStack*)p); + continue; + } +#else + size = stack_sizeW((StgStack*)p); + break; #endif - case TREC_CHUNK: - prim = true; - size = sizeofW(StgTRecChunk); - break; + case TREC_CHUNK: + prim = true; + size = sizeofW(StgTRecChunk); + break; - case COMPACT_NFDATA: - barf("heapCensus, found compact object in the wrong list"); - break; + case COMPACT_NFDATA: + barf("heapCensus, found compact object in the wrong list"); + break; - default: - barf("heapCensus, unknown object: %d", info->type); - } + default: + barf("heapCensus, unknown object: %d", info->type); + } + + heapProfObject(census,(StgClosure*)p,size,prim); + + p += size; + + /* skip over slop, see Note [slop on the heap] */ + while (p < bd->free && !*p) p++; + /* Note [skipping slop in the heap profiler] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * + * We make sure to zero slop that can remain after a major GC so + * here we can assume any slop words we see until the block's free + * pointer are zero. Since info pointers are always nonzero we can + * use this to scan for the next valid heap closure. + * + * Note that not all types of slop are relevant here, only the ones + * that can reman after major GC. So essentially just large objects + * and pinned objects. All other closures will have been packed nice + * and thight into fresh blocks. + */ + } +} - heapProfObject(census,(StgClosure*)p,size,prim); - - p += size; - - /* skip over slop, see Note [slop on the heap] */ - while (p < bd->free && !*p) p++; - /* Note [skipping slop in the heap profiler] - * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - * - * We make sure to zero slop that can remain after a major GC so - * here we can assume any slop words we see until the block's free - * pointer are zero. Since info pointers are always nonzero we can - * use this to scan for the next valid heap closure. - * - * Note that not all types of slop are relevant here, only the ones - * that can reman after major GC. So essentially just large objects - * and pinned objects. All other closures will have been packed nice - * and thight into fresh blocks. - */ +/* ----------------------------------------------------------------------------- + * Code to perform a heap census. + * -------------------------------------------------------------------------- */ +static void +heapCensusChain( Census *census, bdescr *bd ) +{ + for (; bd != NULL; bd = bd->link) { + StgPtr p = bd->start; + + // When we shrink a large ARR_WORDS, we do not adjust the free pointer + // of the associated block descriptor, thus introducing slop at the end + // of the object. This slop remains after GC, violating the assumption + // of the loop below that all slop has been eliminated (#11627). + // The slop isn't always zeroed (e.g. in non-profiling mode, cf + // OVERWRITING_CLOSURE_OFS). + // Consequently, we handle large ARR_WORDS objects as a special case. + if (bd->flags & BF_LARGE + && get_itbl((StgClosure *)p)->type == ARR_WORDS) { + size_t size = arr_words_sizeW((StgArrBytes *)p); + bool prim = true; + heapProfObject(census, (StgClosure *)p, size, prim); + continue; } + + if (bd->flags & BF_PINNED) { + heapCensusPinnedBlock(census, bd); + continue; + } + + heapCensusNormalBlock(census, bd); } } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9bcaaaabfa80e58912cb4f0a26c3d3f94c6519aa...48beb6035a1727e8688fef9f974d52dfca1d1fab -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9bcaaaabfa80e58912cb4f0a26c3d3f94c6519aa...48beb6035a1727e8688fef9f974d52dfca1d1fab You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 9 21:25:31 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 09 Dec 2020 16:25:31 -0500 Subject: [Git][ghc/ghc][wip/T7275] 4 commits: Fix kind inference for data types. Again. Message-ID: <5fd140cb3c1e7_6b211e6fbe47696ab@gitlab.mail> Ben Gamari pushed to branch wip/T7275 at Glasgow Haskell Compiler / GHC Commits: 62ed6957 by Simon Peyton Jones at 2020-12-08T15:31:41-05:00 Fix kind inference for data types. Again. This patch fixes several aspects of kind inference for data type declarations, especially data /instance/ declarations Specifically 1. In kcConDecls/kcConDecl make it clear that the tc_res_kind argument is only used in the H98 case; and in that case there is no result kind signature; and hence no need for the disgusting splitPiTys in kcConDecls (now thankfully gone). The GADT case is a bit different to before, and much nicer. This is what fixes #18891. See Note [kcConDecls: kind-checking data type decls] 2. Do not look at the constructor decls of a data/newtype instance in tcDataFamInstanceHeader. See GHC.Tc.TyCl.Instance Note [Kind inference for data family instances]. This was a new realisation that arose when doing (1) This causes a few knock-on effects in the tests suite, because we require more information than before in the instance /header/. New user-manual material about this in "Kind inference in data type declarations" and "Kind inference for data/newtype instance declarations". 3. Minor improvement in kcTyClDecl, combining GADT and H98 cases 4. Fix #14111 and #8707 by allowing the header of a data instance to affect kind inferece for the the data constructor signatures; as described at length in Note [GADT return types] in GHC.Tc.TyCl This led to a modest refactoring of the arguments (and argument order) of tcConDecl/tcConDecls. 5. Fix #19000 by inverting the sense of the test in new_locs in GHC.Tc.Solver.Canonical.canDecomposableTyConAppOK. - - - - - 0abe3ddf by Adam Sandberg Ericsson at 2020-12-08T15:32:19-05:00 hadrian: build the _l and _thr_l rts flavours in the develN flavours The ghc binary requires the eventlog rts since fc644b1a643128041cfec25db84e417851e28bab - - - - - d6167537 by Ben Gamari at 2020-12-09T16:25:25-05:00 rts: Break up census logic Move the logic for taking censuses of "normal" and pinned blocks to their own functions. - - - - - f93230f4 by Ben Gamari at 2020-12-09T16:25:25-05:00 rts: Implement heap census support for pinned objects It turns out that this was fairly straightforward to implement since we are now pretty careful about zeroing slop. - - - - - 30 changed files: - compiler/GHC/Hs/Extension.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Instance.hs - docs/users_guide/9.2.1-notes.rst - docs/users_guide/exts/poly_kinds.rst - hadrian/src/Settings/Flavours/Development.hs - rts/ProfHeap.c - testsuite/tests/dependent/should_fail/T13780a.stderr - testsuite/tests/deriving/should_compile/T11416.hs - testsuite/tests/deriving/should_compile/T9359.hs - + testsuite/tests/gadt/SynDataRec.hs - testsuite/tests/gadt/all.T - + testsuite/tests/indexed-types/should_compile/T14111.hs - + testsuite/tests/indexed-types/should_compile/T8707.hs - testsuite/tests/indexed-types/should_compile/all.T - testsuite/tests/indexed-types/should_fail/T8368.stderr - testsuite/tests/indexed-types/should_fail/T8368a.stderr - testsuite/tests/patsyn/should_fail/T15685.stderr - testsuite/tests/polykinds/T13659.stderr - testsuite/tests/polykinds/T16221a.stderr - testsuite/tests/th/T11145.stderr - testsuite/tests/th/T9692.hs - + testsuite/tests/typecheck/should_compile/T18891.hs - testsuite/tests/typecheck/should_compile/UnliftedNewtypesUnassociatedFamily.hs - testsuite/tests/typecheck/should_compile/UnliftedNewtypesUnifySig.hs - testsuite/tests/typecheck/should_compile/all.T - + testsuite/tests/typecheck/should_fail/T18891a.hs - + testsuite/tests/typecheck/should_fail/T18891a.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/48beb6035a1727e8688fef9f974d52dfca1d1fab...f93230f4eeb1b79871c7a53a2b7af921f6804c3f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/48beb6035a1727e8688fef9f974d52dfca1d1fab...f93230f4eeb1b79871c7a53a2b7af921f6804c3f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 9 21:33:17 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 09 Dec 2020 16:33:17 -0500 Subject: [Git][ghc/ghc][wip/T7275] rts: Further simplify Message-ID: <5fd1429d81c38_6b211e6fbe477449e@gitlab.mail> Ben Gamari pushed to branch wip/T7275 at Glasgow Haskell Compiler / GHC Commits: a3a14e24 by Ben Gamari at 2020-12-09T16:33:03-05:00 rts: Further simplify - - - - - 1 changed file: - rts/ProfHeap.c Changes: ===================================== rts/ProfHeap.c ===================================== @@ -1103,41 +1103,21 @@ heapCensusCompactList(Census *census, bdescr *bd) } } -static void -heapCensusPinnedBlock( Census *census, bdescr *bd ) -{ - StgWord *p = (StgWord *) bd->start; - while (p < bd->free) { - if (*(StgWord *) p == 0) { - p++; - continue; - } - - ASSERT(LOOKS_LIKE_CLOSURE_PTR(p)); - const StgInfoTable *info = get_itbl((StgClosure *) p); - switch (info->type) { - case ARR_WORDS: - { - StgArrBytes *arr = (StgArrBytes *) p; - const size_t size = arr_words_sizeW(arr); - heapProfObject(census, (StgClosure *)p, size, /*prim*/ true); - p += size; - break; - } - default: - barf("heapCensusPinnedBlock: Unknown object: %p (info=%p, type=%d)", p, info, info->type); - } - } -} - /* - * Take a census of the contents of a "normal" (e.g. not large, not pinned, not - * compact) heap block. + * Take a census of the contents of a "normal" (e.g. not large, not compact) + * heap block. This can, however, handle PINNED blocks. */ static void -heapCensusNormalBlock(Census *census, bdescr *bd) +heapCensusBlock(Census *census, bdescr *bd) { StgPtr p = bd->start; + + // In the case of PINNED blocks there can be (zeroed) slop at the beginning + // due to object alignment. + if (bd->flags & BD_PINNED) { + while (p < bd->free && !*p) p++; + } + while (p < bd->free) { const StgInfoTable *info = get_itbl((const StgClosure *)p); bool prim = false; @@ -1331,11 +1311,6 @@ heapCensusChain( Census *census, bdescr *bd ) continue; } - if (bd->flags & BF_PINNED) { - heapCensusPinnedBlock(census, bd); - continue; - } - heapCensusNormalBlock(census, bd); } } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a3a14e24af7ca67bbc87b85e5e081588455a5ebc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a3a14e24af7ca67bbc87b85e5e081588455a5ebc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 9 21:34:17 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 09 Dec 2020 16:34:17 -0500 Subject: [Git][ghc/ghc][wip/gc-events] users guide: Fix syntax errors Message-ID: <5fd142d9c0c26_6b2131d5c3877508a@gitlab.mail> Ben Gamari pushed to branch wip/gc-events at Glasgow Haskell Compiler / GHC Commits: 8087a524 by Ben Gamari at 2020-12-09T16:34:11-05:00 users guide: Fix syntax errors Fixes errors introduced by 3a55b3a2574f913d046f3a6f82db48d7f6df32e3. - - - - - 1 changed file: - docs/users_guide/using-optimisation.rst Changes: ===================================== docs/users_guide/using-optimisation.rst ===================================== @@ -1197,16 +1197,16 @@ by saying ``-fno-wombat``. This is the full syntax for cardinalities, demands and sub-demands in BNF: - .. code-block:: + .. code-block:: none - card ::= B | A | 1 | U | S | M semantics as in the table above + card ::= B | A | 1 | U | S | M semantics as in the table above - d ::= card sd card = how often, sd = how deep - | card abbreviation: Same as "card card" + d ::= card sd card = how often, sd = how deep + | card abbreviation: Same as "card card" - sd ::= card polymorphic sub-demand, card at every level - | P(d,d,..) product sub-demand - | Ccard(sd) call sub-demand + sd ::= card polymorphic sub-demand, card at every level + | P(d,d,..) product sub-demand + | Ccard(sd) call sub-demand For example, ``fst`` is strict in its argument, and also in the first component of the argument. It will not evaluate the argument's second @@ -1234,17 +1234,17 @@ by saying ``-fno-wombat``. We summarise a function's demand properties in its *demand signature*. This is the general syntax: - .. code-block:: + .. code-block:: none - {x->dx,y->dy,z->dz...}...div - ^ ^ ^ ^ ^ ^ - | | | | | | - | \---+---+------/ | - | | | - demand on free demand on divergence - variables arguments information - (omitted if empty) (omitted if - no information) + {x->dx,y->dy,z->dz...}...div + ^ ^ ^ ^ ^ ^ + | | | | | | + | \---+---+------/ | + | | | + demand on free demand on divergence + variables arguments information + (omitted if empty) (omitted if + no information) We summarise ``fst``'s demand properties in its *demand signature* ````, which just says "If ``fst`` is applied to one argument, @@ -1260,13 +1260,11 @@ by saying ``-fno-wombat``. **Call sub-demands** - Consider ``maybe``: + Consider ``maybe``: :: - .. code-block:: - - maybe :: b -> (a -> b) -> Maybe a -> b - maybe n _ Nothing = n - maybe _ s (Just a) = s a + maybe :: b -> (a -> b) -> Maybe a -> b + maybe n _ Nothing = n + maybe _ s (Just a) = s a We give it demand signature ``<1C1(U)>``. The ``C1(U)`` is a *call sub-demand* that says "Called at most once, where the result is used View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8087a524c35af0f6fa04e2e1bbc5a0a726c91b72 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8087a524c35af0f6fa04e2e1bbc5a0a726c91b72 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 9 21:53:56 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 09 Dec 2020 16:53:56 -0500 Subject: [Git][ghc/ghc][wip/T7275] rts: Further simplify Message-ID: <5fd1477475327_6b213272cb878626d@gitlab.mail> Ben Gamari pushed to branch wip/T7275 at Glasgow Haskell Compiler / GHC Commits: bcefe62f by Ben Gamari at 2020-12-09T16:53:50-05:00 rts: Further simplify - - - - - 1 changed file: - rts/ProfHeap.c Changes: ===================================== rts/ProfHeap.c ===================================== @@ -1103,41 +1103,21 @@ heapCensusCompactList(Census *census, bdescr *bd) } } -static void -heapCensusPinnedBlock( Census *census, bdescr *bd ) -{ - StgWord *p = (StgWord *) bd->start; - while (p < bd->free) { - if (*(StgWord *) p == 0) { - p++; - continue; - } - - ASSERT(LOOKS_LIKE_CLOSURE_PTR(p)); - const StgInfoTable *info = get_itbl((StgClosure *) p); - switch (info->type) { - case ARR_WORDS: - { - StgArrBytes *arr = (StgArrBytes *) p; - const size_t size = arr_words_sizeW(arr); - heapProfObject(census, (StgClosure *)p, size, /*prim*/ true); - p += size; - break; - } - default: - barf("heapCensusPinnedBlock: Unknown object: %p (info=%p, type=%d)", p, info, info->type); - } - } -} - /* - * Take a census of the contents of a "normal" (e.g. not large, not pinned, not - * compact) heap block. + * Take a census of the contents of a "normal" (e.g. not large, not compact) + * heap block. This can, however, handle PINNED blocks. */ static void -heapCensusNormalBlock(Census *census, bdescr *bd) +heapCensusBlock(Census *census, bdescr *bd) { StgPtr p = bd->start; + + // In the case of PINNED blocks there can be (zeroed) slop at the beginning + // due to object alignment. + if (bd->flags & BF_PINNED) { + while (p < bd->free && !*p) p++; + } + while (p < bd->free) { const StgInfoTable *info = get_itbl((const StgClosure *)p); bool prim = false; @@ -1331,12 +1311,7 @@ heapCensusChain( Census *census, bdescr *bd ) continue; } - if (bd->flags & BF_PINNED) { - heapCensusPinnedBlock(census, bd); - continue; - } - - heapCensusNormalBlock(census, bd); + heapCensusBlock(census, bd); } } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bcefe62f03fd89006e5539883aeae2a8286ea083 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bcefe62f03fd89006e5539883aeae2a8286ea083 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 9 23:31:02 2020 From: gitlab at gitlab.haskell.org (Alan Zimmerman) Date: Wed, 09 Dec 2020 18:31:02 -0500 Subject: [Git][ghc/ghc][wip/az/exactprint] WIP on delta printing. Message-ID: <5fd15e36387c_6b2131d5c388252f2@gitlab.mail> Alan Zimmerman pushed to branch wip/az/exactprint at Glasgow Haskell Compiler / GHC Commits: b5e22827 by Alan Zimmerman at 2020-12-09T23:29:49+00:00 WIP on delta printing. Making progress - - - - - 30 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/ThToHs.hs - libraries/Cabal - libraries/directory - libraries/hpc - libraries/time - libraries/unix - testsuite/tests/ghc-api/annotations/InTreeAnnotations1.stderr - testsuite/tests/parser/should_compile/DumpParsedAst.stderr - testsuite/tests/parser/should_compile/DumpRenamedAst.stderr - testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr - testsuite/tests/parser/should_compile/KindSigs.stderr - testsuite/tests/printer/Ppr001.hs - testsuite/tests/printer/Ppr004.hs - testsuite/tests/printer/Ppr024.hs - testsuite/tests/printer/Ppr025.hs - utils/check-exact/Main.hs - utils/check-exact/Test.hs - + utils/check-exact/cases/LayoutLet2.hs - + utils/check-exact/cases/LayoutLet3.hs - + utils/check-exact/cases/LayoutLet4.hs - + utils/check-exact/cases/Rename1.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b5e22827c9eab303bc0f77b6339e5d525e8d1f84 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b5e22827c9eab303bc0f77b6339e5d525e8d1f84 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 9 23:36:18 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Wed, 09 Dec 2020 18:36:18 -0500 Subject: [Git][ghc/ghc][wip/T17656] Wibbles Message-ID: <5fd15f72ec09a_6b211e6fbe48275d5@gitlab.mail> Simon Peyton Jones pushed to branch wip/T17656 at Glasgow Haskell Compiler / GHC Commits: d1ff4302 by Simon Peyton Jones at 2020-12-09T23:35:41+00:00 Wibbles - - - - - 6 changed files: - compiler/GHC/Runtime/Heap/Inspect.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Utils/Unify.hs Changes: ===================================== compiler/GHC/Runtime/Heap/Inspect.hs ===================================== @@ -577,7 +577,7 @@ newOpenVar = liftTcM (do { kind <- newOpenTypeKind ~~~~~~~~~~~~~~~~~~~~~~ In the GHCi debugger we use unification variables whose MetaInfo is RuntimeUnkTv. The special property of a RuntimeUnkTv is that it can -unify with a polytype (see GHC.Tc.Utils.Unify.metaTyVarUpdateOK). +unify with a polytype (see GHC.Tc.Utils.Unify.checkTypeEq). If we don't do this `:print ` will fail if the type of has nested `forall`s or `=>`s. ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -907,7 +907,7 @@ That is the entire point of qlUnify! Wrinkles: * We must not make an occurs-check; we use occCheckExpand for that. -* metaTyVarUpdateOK also checks for various other things, including +* checkTypeEq also checks for various other things, including - foralls, and predicate types (which we want to allow here) - type families (relates to a very specific and exotic performance question, that is unlikely to bite here) ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -1674,11 +1674,11 @@ solveWanteds wc@(WC { wc_simple = simples, wc_impl = implics, wc_holes = holes } -- Any insoluble constraints are in 'simples' and so get rewritten -- See Note [Rewrite insolubles] in GHC.Tc.Solver.Monad - ; (_floated_eqs, implics2) <- solveNestedImplications $ - implics `unionBags` wc_impl wc1 + ; implics2 <- solveNestedImplications $ + implics `unionBags` wc_impl wc1 ; dflags <- getDynFlags - ; unif_happened <- getUnificationFlag + ; unif_happened <- resetUnificationFlag ; solved_wc <- simpl_loop 0 (solverIterations dflags) unif_happened (wc1 { wc_impl = implics2 }) @@ -1704,17 +1704,12 @@ simpl_loop n limit unif_happened wc@(WC { wc_simple = simples }) addErrTcS (hang (text "solveWanteds: too many iterations" <+> parens (text "limit =" <+> ppr limit)) 2 (vcat [ text "Unsolved:" <+> ppr wc --- , ppUnless (isEmptyBag floated_eqs) $ --- text "Floated equalities:" <+> ppr floated_eqs , text "Set limit with -fconstraint-solver-iterations=n; n=0 for no limit" ])) ; return wc } | unif_happened = simplify_again n limit True wc - -- Put floated_eqs first so they get solved first - -- NB: the floated_eqs may include /derived/ equalities - -- arising from fundeps inside an implication | superClassesMightHelp wc = -- We still have unsolved goals, and apparently no way to solve them, @@ -1747,55 +1742,33 @@ simplify_again n limit no_new_given_scs ; wc1 <- solveSimpleWanteds simples - ; (_floated_eqs2, implics2) <- solveNestedImplications $ - implics `unionBags` (wc_impl wc1) - ; unif_happened <- getUnificationFlag - ; simpl_loop (n+1) limit unif_happened (wc1 { wc_impl = implics2 }) + ; implics2 <- solveNestedImplications $ + implics `unionBags` (wc_impl wc1) -{- - -- See Note [Cutting off simpl_loop] - -- We have already tried to solve the nested implications once - -- Try again only if we have unified some meta-variables - -- (which is a bit like adding more givens), or we have some - -- new Given superclasses - ; let new_implics = wc_impl wc1 - ; if no_new_given_scs && - isEmptyBag new_implics - - then -- Do not even try to solve the implications - simpl_loop (n+1) limit emptyBag (wc1 { wc_impl = implics }) - - else -- Try to solve the implications - do { (floated_eqs2, implics2) <- solveNestedImplications $ - implics `unionBags` new_implics - ; simpl_loop (n+1) limit floated_eqs2 (wc1 { wc_impl = implics2 }) } --} - } + ; unif_happened <- resetUnificationFlag + ; simpl_loop (n+1) limit unif_happened (wc1 { wc_impl = implics2 }) } solveNestedImplications :: Bag Implication - -> TcS (Cts, Bag Implication) + -> TcS (Bag Implication) -- Precondition: the TcS inerts may contain unsolved simples which have -- to be converted to givens before we go inside a nested implication. solveNestedImplications implics | isEmptyBag implics - = return (emptyBag, emptyBag) + = return (emptyBag) | otherwise = do { traceTcS "solveNestedImplications starting {" empty - ; (floated_eqs_s, unsolved_implics) <- mapAndUnzipBagM solveImplication implics - ; let floated_eqs = concatBag floated_eqs_s + ; unsolved_implics <- mapBagM solveImplication implics -- ... and we are back in the original TcS inerts -- Notice that the original includes the _insoluble_simples so it was safe to ignore -- them in the beginning of this function. ; traceTcS "solveNestedImplications end }" $ - vcat [ text "all floated_eqs =" <+> ppr floated_eqs - , text "unsolved_implics =" <+> ppr unsolved_implics ] + vcat [ text "unsolved_implics =" <+> ppr unsolved_implics ] - ; return (floated_eqs, catBagMaybes unsolved_implics) } + ; return (catBagMaybes unsolved_implics) } solveImplication :: Implication -- Wanted - -> TcS (Cts, -- All wanted or derived floated equalities: var = type - Maybe Implication) -- Simplified implication (empty or singleton) + -> TcS (Maybe Implication) -- Simplified implication (empty or singleton) -- Precondition: The TcS monad contains an empty worklist and given-only inerts -- which after trying to solve this implication we must restore to their original value solveImplication imp@(Implic { ic_tclvl = tclvl @@ -1806,7 +1779,7 @@ solveImplication imp@(Implic { ic_tclvl = tclvl , ic_info = info , ic_status = status }) | isSolvedStatus status - = return (emptyCts, Just imp) -- Do nothing + = return (Just imp) -- Do nothing | otherwise -- Even for IC_Insoluble it is worth doing more work -- The insoluble stuff might be in one sub-implication @@ -1828,7 +1801,7 @@ solveImplication imp@(Implic { ic_tclvl = tclvl ; residual_wanted <- solveWanteds wanteds -- solveWanteds, *not* solveWantedsAndDrop, because -- we want to retain derived equalities so we can float - -- them out in floatEqualities + -- them out in floatEqualities. ; (has_eqs, given_insols) <- getHasGivenEqs tclvl -- Call getHasGivenEqs /after/ solveWanteds, because @@ -1837,10 +1810,6 @@ solveImplication imp@(Implic { ic_tclvl = tclvl ; return (has_eqs, given_insols, residual_wanted) } - ; (floated_eqs, residual_wanted) - <- floatEqualities skols given_ids ev_binds_var - has_given_eqs residual_wanted - ; traceTcS "solveImplication 2" (ppr given_insols $$ ppr residual_wanted) ; let final_wanted = residual_wanted `addInsols` given_insols @@ -1854,12 +1823,11 @@ solveImplication imp@(Implic { ic_tclvl = tclvl ; tcvs <- TcS.getTcEvTyCoVars ev_binds_var ; traceTcS "solveImplication end }" $ vcat [ text "has_given_eqs =" <+> ppr has_given_eqs - , text "floated_eqs =" <+> ppr floated_eqs , text "res_implic =" <+> ppr res_implic , text "implication evbinds =" <+> ppr (evBindMapBinds evbinds) , text "implication tvcs =" <+> ppr tcvs ] - ; return (floated_eqs, res_implic) } + ; return res_implic } -- TcLevels must be strictly increasing (see (ImplicInv) in -- Note [TcLevel and untouchable type variables] in GHC.Tc.Utils.TcType), @@ -2532,6 +2500,7 @@ no evidence for a fundep equality), but equality superclasses do matter (since they carry evidence). -} +{- floatEqualities :: [TcTyVar] -> [EvId] -> EvBindsVar -> HasGivenEqs -> WantedConstraints -> TcS (Cts, WantedConstraints) @@ -2553,7 +2522,6 @@ floatEqualities :: [TcTyVar] -> [EvId] -> EvBindsVar -> HasGivenEqs floatEqualities _ _ _ _ wanteds = return (emptyBag, wanteds) -{- floatEqualities skols given_ids ev_binds_var has_given_eqs wanteds@(WC { wc_simple = simples }) | MaybeGivenEqs <- has_given_eqs -- There are some given equalities, so don't float ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -2270,8 +2270,8 @@ canEqCanLHS2 ev eq_rel swapped lhs1 ps_xi1 lhs2 ps_xi2 mco -- This function handles the case where one side is a tyvar and the other is -- a type family application. Which to put on the left? --- If the tyvar is a meta-tyvar, put it on the left, as this may be our only --- shot to unify. +-- If the tyvar is a touchable meta-tyvar, put it on the left, as this may +-- be our only shot to unify. -- Otherwise, put the function on the left, because it's generally better to -- rewrite away function calls. This makes types smaller. And it seems necessary: -- [W] F alpha ~ alpha @@ -2279,8 +2279,6 @@ canEqCanLHS2 ev eq_rel swapped lhs1 ps_xi1 lhs2 ps_xi2 mco -- [W] G alpha beta ~ Int ( where we have type instance G a a = a ) -- If we end up with a stuck alpha ~ F alpha, we won't be able to solve this. -- Test case: indexed-types/should_compile/CEqCanOccursCheck --- It would probably work to always put the variable on the left, but we think --- it would be less efficient. canEqTyVarFunEq :: CtEvidence -- :: lhs ~ (rhs |> mco) -- or (rhs |> mco) ~ lhs if swapped -> EqRel -> SwapFlag @@ -2342,7 +2340,11 @@ unifyTest ev tv1 rhs does_not_escape tv_lvl fv | isTyVar fv = tv_lvl `deeperThanOrSame` tcTyVarLevel fv - | otherwise = True -- Coercion variables + | otherwise = True + -- Coercion variables are not an escape risk + -- If an implication binds a coercion variable, it'll have equalities, + -- so the "intervening given equalities" test above will catch it + -- Coercion holes get filled with coercions, so again no problem. is_promotable fv | isTyVar fv ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -31,7 +31,7 @@ module GHC.Tc.Solver.Monad ( panicTcS, traceTcS, traceFireTcS, bumpStepCountTcS, csTraceTcS, wrapErrTcS, wrapWarnTcS, - getUnificationFlag, setUnificationFlag, + resetUnificationFlag, setUnificationFlag, -- Evidence creation and transformation MaybeNew(..), freshGoals, isFresh, getEvExpr, @@ -1512,12 +1512,24 @@ addInertForAll new_qci = do { ics <- getInertCans ; ics1 <- add_qci ics - -- C.f add_given_eq + -- Update given equalities. Painful! C.f updateGivenEqs ; tclvl <- getTcLevel - ; let ics2 | tclvl `strictlyDeeperThan` inert_given_eq_lvl ics1 - = ics1 { inert_given_eq_lvl = tclvl } - | otherwise - = ics1 + ; let ics2 | not_equality = ics1 + | otherwise = ics1 { inert_given_eq_lvl = ge_lvl' + , inert_given_eqs = geqs' } + !(IC { inert_given_eq_lvl = ge_lvl + , inert_given_eqs = geqs }) = ics1 + + not_equality = isClassPred pred && not (isEqPred pred) + -- True <=> definitely not an equality + -- Heads like (f a) might be an equality + + pred = qci_pred new_qci + is_eq_pred = isEqPred pred -- Definitely an equality + geqs' = geqs || is_eq_pred + + ge_lvl' | tclvl `strictlyDeeperThan` ge_lvl = tclvl + | otherwise = ge_lvl ; setInertCans ics2 } where @@ -1602,13 +1614,13 @@ add_item :: TcLevel -> InertCans -> Ct -> InertCans add_item tc_lvl ics@(IC { inert_funeqs = funeqs, inert_eqs = eqs }) item@(CEqCan { cc_lhs = lhs }) - = add_given_eq tc_lvl item $ + = updateGivenEqs tc_lvl item $ case lhs of TyFamLHS tc tys -> ics { inert_funeqs = addCanFunEq funeqs tc tys item } TyVarLHS tv -> ics { inert_eqs = addTyEq eqs tv item } add_item tc_lvl ics@(IC { inert_irreds = irreds }) item@(CIrredCan {}) - = add_given_eq tc_lvl item $ -- An Irred might turn out to be an + = updateGivenEqs tc_lvl item $ -- An Irred might turn out to be an -- equality, so we play safe ics { inert_irreds = irreds `Bag.snocBag` item } @@ -1619,15 +1631,15 @@ add_item _ _ item = pprPanic "upd_inert set: can't happen! Inserting " $ ppr item -- Can't be CNonCanonical because they only land in inert_irreds -add_given_eq :: TcLevel -> Ct -> InertCans -> InertCans +updateGivenEqs :: TcLevel -> Ct -> InertCans -> InertCans -- Set the inert_given_eq_level to the current level (tclvl) -- if the constraint is a given equality that should prevent -- filling in an outer unification variable. -- See See Note [When does an implication have given equalities?] -- -- ToDo: what about Quantified Constraints? -add_given_eq tclvl ct inerts@(IC { inert_given_eq_lvl = ge_lvl - , inert_given_eqs = geqs }) +updateGivenEqs tclvl ct inerts@(IC { inert_given_eq_lvl = ge_lvl + , inert_given_eqs = geqs }) | not (isGivenCt ct) = inerts | not_equality ct = inerts -- See Note [Let-bound skolems] | otherwise = inerts { inert_given_eq_lvl = ge_lvl' @@ -1651,7 +1663,9 @@ add_given_eq tclvl ct inerts@(IC { inert_given_eq_lvl = ge_lvl not_equality :: Ct -> Bool -- True <=> definitely not an equality of any kind - not_equality (CEqCan { cc_lhs = TyVarLHS tv }) = isLocalSkolem tclvl tv + -- except for a let-bound skolem, which doesn't count + -- See Note [Let-bound skolems] + not_equality (CEqCan { cc_lhs = TyVarLHS tv }) = not (isOuterTyVar tclvl tv) not_equality (CDictCan {}) = True not_equality _ = False @@ -2184,81 +2198,38 @@ getHasGivenEqs :: TcLevel -- TcLevel of this implication , Cts ) -- Insoluble equalities arising from givens -- See Note [When does an implication have given equalities?] getHasGivenEqs tclvl - = do { inerts@(IC { inert_irreds = irreds --- , inert_insts = qc_insts --- , inert_eqs = ieqs, inert_funeqs = funeqs - , inert_given_eqs = given_eqs + = do { inerts@(IC { inert_irreds = irreds + , inert_given_eqs = given_eqs , inert_given_eq_lvl = ge_lvl }) <- getInertCans -{- - ; let has_given_eqs = foldMap check_local_given_ct irreds - S.<> foldMap (lift_equal_ct_list check_local_given_tv_eq) ieqs - S.<> foldMapFunEqs (lift_equal_ct_list check_local_given_ct) funeqs - S.<> foldMap qc_eq_inst_given_here qc_insts --} ; let insols = filterBag insolubleEqCt irreds - -- Specifically includes ones that originated in some + -- Specifically includes ones that originated in some -- outer context but were refined to an insoluble by -- a local equality; so do /not/ add ct_given_here. + has_ge | given_eqs = LocalGivenEqs + | ge_lvl == tclvl = MaybeGivenEqs + | otherwise = NoGivenEqs + ; traceTcS "getHasGivenEqs" $ vcat [ text "given_eqs:" <+> ppr given_eqs , text "ge_lvl:" <+> ppr ge_lvl , text "ambient level:" <+> ppr tclvl , text "Inerts:" <+> ppr inerts , text "Insols:" <+> ppr insols] - ; let has_ge | given_eqs = LocalGivenEqs --- | ge_lvl == tclvl = MaybeGivenEqs - | otherwise = NoGivenEqs ; return (has_ge, insols) } - where -{- - check_local_given_ct :: Ct -> HasGivenEqs - check_local_given_ct ct = check_local_given_ev (ctEvidence ct) - - check_local_given_ev :: CtEvidence -> HasGivenEqs - check_local_given_ev ev - | not (given_bound_here ev) = NoGivenEqs - | mentionsOuterVar tclvl ev = MaybeGivenEqs - | otherwise = LocalGivenEqs - - lift_equal_ct_list :: (Ct -> HasGivenEqs) -> EqualCtList -> HasGivenEqs - -- returns NoGivenEqs for non-singleton lists, as Given lists are always - -- singletons - lift_equal_ct_list check (EqualCtList (ct :| [])) = check ct - lift_equal_ct_list _ _ = NoGivenEqs - - check_local_given_tv_eq :: Ct -> HasGivenEqs - check_local_given_tv_eq (CEqCan { cc_lhs = TyVarLHS tv, cc_ev = ev}) - | not (given_bound_here ev) = NoGivenEqs - | not (isLocalSkolem tclvl tv) = MaybeGivenEqs - | otherwise = NoGivenEqs -- See Note [Let-bound skolems] - check_local_given_tv_eq other_ct - = check_local_given_ct other_ct - - qc_eq_inst_given_here :: QCInst -> HasGivenEqs - -- True of a quantified constraint (which are always Given) - -- for an equality, bound by this implication - qc_eq_inst_given_here (QCI { qci_ev = ev, qci_pred = pred }) - | isEqPred pred = check_local_given_ev ev - | otherwise = NoGivenEqs - - given_bound_here :: CtEvidence -> Bool - -- True for a Given bound by the current implication, - -- i.e. the current level - given_bound_here ev = isGiven ev - && tclvl == ctLocLevel (ctEvLoc ev) --} mentionsOuterVar :: TcLevel -> CtEvidence -> Bool mentionsOuterVar tclvl ev - = anyFreeVarsOfType (not . isLocalSkolem tclvl) $ + = anyFreeVarsOfType (isOuterTyVar tclvl) $ ctEvPred ev -isLocalSkolem :: TcLevel -> TyCoVar -> Bool -isLocalSkolem tclvl tv - | isTyVar tv = tclvl `sameDepthAs` tcTyVarLevel tv - -- Includes CycleBreakerTvs which are meta-tyvars - | otherwise = True -- Coercion variables; doesn't much matter +isOuterTyVar :: TcLevel -> TyCoVar -> Bool +-- True of a type variable that comes from a +-- shallower level than the ambient level (tclvl) +isOuterTyVar tclvl tv + | isTyVar tv = tclvl `strictlyDeeperThan` tcTyVarLevel tv + -- Includes CycleBreakerTvs which are meta-tyvars + | otherwise = False -- Coercion variables; doesn't much matter -- | Returns Given constraints that might, -- potentially, match the given pred. This is used when checking to see if a @@ -2926,16 +2897,16 @@ bumpStepCountTcS = TcS $ \env -> do { let ref = tcs_count env ; n <- TcM.readTcRef ref ; TcM.writeTcRef ref (n+1) } -getUnificationFlag :: TcS Bool +resetUnificationFlag :: TcS Bool -- We are at ambient level i --- If the unification flag = Just i, set it to Nothing and return True --- Otherwise return False -getUnificationFlag +-- If the unification flag = Just i, reset it to Nothing and return True +-- Otherwise leave it unchanged and return False +resetUnificationFlag = TcS $ \env -> do { let ref = tcs_unif_lvl env ; ambient_lvl <- TcM.getTcLevel ; mb_lvl <- TcM.readTcRef ref - ; TcM.traceTc "getUnificationFlag" $ + ; TcM.traceTc "resetUnificationFlag" $ vcat [ text "ambient:" <+> ppr ambient_lvl , text "unif_lvl:" <+> ppr mb_lvl ] ; case mb_lvl of ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -37,7 +37,7 @@ module GHC.Tc.Utils.Unify ( matchExpectedFunKind, matchActualFunTySigma, matchActualFunTysRho, - metaTyVarUpdateOK, occCheckForErrors, MetaTyVarUpdateResult(..), + occCheckForErrors, MetaTyVarUpdateResult(..), checkTyVarEq, checkTyFamEq, checkTypeEq, AreTypeFamiliesOK(..) ) where @@ -1435,9 +1435,9 @@ uUnfilledVar2 origin t_or_k swapped tv1 ty2 go dflags cur_lvl | isTouchableMetaTyVar cur_lvl tv1 , canSolveByUnification (metaTyVarInfo tv1) ty2 - , MTVU_OK ty2' <- metaTyVarUpdateOK dflags NoTypeFamilies tv1 ty2 + , MTVU_OK {} <- checkTyVarEq dflags NoTypeFamilies tv1 ty2 -- See Note [Prevent unification with type families] about the NoTypeFamilies: - = do { co_k <- uType KindLevel kind_origin (tcTypeKind ty2') (tyVarKind tv1) + = do { co_k <- uType KindLevel kind_origin (tcTypeKind ty2) (tyVarKind tv1) ; traceTc "uUnfilledVar2 ok" $ vcat [ ppr tv1 <+> dcolon <+> ppr (tyVarKind tv1) , ppr ty2 <+> dcolon <+> ppr (tcTypeKind ty2) @@ -1447,8 +1447,8 @@ uUnfilledVar2 origin t_or_k swapped tv1 ty2 -- Only proceed if the kinds match -- NB: tv1 should still be unfilled, despite the kind unification -- because tv1 is not free in ty2 (or, hence, in its kind) - then do { writeMetaTyVar tv1 ty2' - ; return (mkTcNomReflCo ty2') } + then do { writeMetaTyVar tv1 ty2 + ; return (mkTcNomReflCo ty2) } else defer } -- This cannot be solved now. See GHC.Tc.Solver.Canonical -- Note [Equalities with incompatible kinds] @@ -1912,73 +1912,6 @@ instance Outputable AreTypeFamiliesOK where ppr YesTypeFamilies = text "YesTypeFamilies" ppr NoTypeFamilies = text "NoTypeFamilies" -metaTyVarUpdateOK :: DynFlags - -> AreTypeFamiliesOK -- allow type families in RHS? - -> TcTyVar -- tv :: k1 - -> TcType -- ty :: k2 - -> MetaTyVarUpdateResult TcType -- possibly-expanded ty --- (metaTyVarUpdateOK tv ty) --- Checks that the equality tv~ty is OK to be used to rewrite --- other equalities. Equivalently, checks the conditions for CEqCan --- (a) that tv doesn't occur in ty (occurs check) --- (b) that ty does not have any foralls or (perhaps) type functions --- (c) that ty does not have any blocking coercion holes --- See Note [Equalities with incompatible kinds] in "GHC.Tc.Solver.Canonical" --- --- Used in two places: --- - In the eager unifier: uUnfilledVar2 --- - In the canonicaliser: GHC.Tc.Solver.Canonical.canEqTyVar2 --- Note that in the latter case tv is not necessarily a meta-tyvar, --- despite the name of this function. - --- We have two possible outcomes: --- (1) Return the type to update the type variable with, --- [we know the update is ok] --- (2) Return Nothing, --- [the update might be dodgy] --- --- Note that "Nothing" does not mean "definite error". For example --- type family F a --- type instance F Int = Int --- consider --- a ~ F a --- This is perfectly reasonable, if we later get a ~ Int. For now, though, --- we return Nothing, leaving it to the later constraint simplifier to --- sort matters out. --- --- See Note [Refactoring hazard: metaTyVarUpdateOK] - -metaTyVarUpdateOK dflags ty_fam_ok tv rhs_ty - = case checkTyVarEq dflags ty_fam_ok tv rhs_ty of - _ | bad_tyvar_tv -> MTVU_Bad - MTVU_OK _ -> MTVU_OK rhs_ty - MTVU_Bad -> MTVU_Bad -- forall, predicate, type function - MTVU_HoleBlocker -> MTVU_HoleBlocker -- coercion hole - MTVU_Occurs -> case occCheckExpand [tv] rhs_ty of - Just expanded_ty -> MTVU_OK expanded_ty - Nothing -> MTVU_Occurs - where - bad_tyvar_tv, bad_rhs :: Bool - - -- True <=> we have alpha ~ ty, where alpha is a TyVarTv - -- and ty is not a tyvar - bad_tyvar_tv | MetaTv { mtv_info = TyVarTv } <- tcTyVarDetails tv - = bad_rhs - | otherwise - = False - - -- True <=> RHS is not a tyvar, or - -- (if a unification variable) is not a TyVarTv - bad_rhs = case tcGetTyVar_maybe rhs_ty of - Nothing -> True - Just tv -> case tcTyVarDetails tv of - MetaTv { mtv_info = info } - -> case info of - TyVarTv -> False - _ -> True - SkolemTv {} -> False - RuntimeUnk -> False - checkTyVarEq :: DynFlags -> AreTypeFamiliesOK -> TcTyVar -> TcType -> MetaTyVarUpdateResult () checkTyVarEq dflags ty_fam_ok tv ty = inline checkTypeEq dflags ty_fam_ok (TyVarLHS tv) ty @@ -2002,6 +1935,14 @@ checkTypeEq :: DynFlags -> AreTypeFamiliesOK -> CanEqLHS -> TcType -- (d) a blocking coercion hole -- (e) an occurrence of the LHS (occurs check) -- +-- Note that an occurs-check does not mean "definite error". For example +-- type family F a +-- type instance F Int = Int +-- consider +-- b0 ~ F b0 +-- This is perfectly reasonable, if we later get b0 ~ Int. But we +-- certainly can't unify b0 := F b0 +-- -- For (a), (b), and (c) we check only the top level of the type, NOT -- inside the kinds of variables it mentions. For (d) we look deeply -- in coercions when the LHS is a tyvar (but skip coercions for type family @@ -2009,7 +1950,7 @@ checkTypeEq :: DynFlags -> AreTypeFamiliesOK -> CanEqLHS -> TcType -- -- checkTypeEq is called from -- * checkTyFamEq, checkTyVarEq (which inline it to specialise away the --- case-analysis on 'lhs' +-- case-analysis on 'lhs') -- * checkEqCanLHSFinish, which does not know the form of 'lhs' checkTypeEq dflags ty_fam_ok lhs ty = go ty View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d1ff4302a8e92852d90d754f1d2de1ed509d4468 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d1ff4302a8e92852d90d754f1d2de1ed509d4468 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 9 23:55:34 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 09 Dec 2020 18:55:34 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 9 commits: CodeGen: Make folds User/DefinerOfRegs INLINEABLE. Message-ID: <5fd163f645d5d_6b2174471c836771@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 51e3bb6d by Andreas Klebinger at 2020-12-08T22:43:21-05:00 CodeGen: Make folds User/DefinerOfRegs INLINEABLE. Reduces allocation for the test case I was looking at by about 1.2%. Mostly from avoiding allocation of some folding functions which turn into let-no-escape bindings which just reuse their environment instead. We also force inlining in a few key places in CmmSink which helps a bit more. - - - - - 69ae10c3 by Andreas Klebinger at 2020-12-08T22:43:21-05:00 CmmSink: Force inlining of foldRegsDefd Helps avoid allocating the folding function. Improves perf for T3294 by about 1%. - - - - - 6e3da800 by Andreas Klebinger at 2020-12-08T22:43:21-05:00 Cmm: Make a few types and utility function slightly stricter. About 0.6% reduction in allocations for the code I was looking at. Not a huge difference but no need to throw away performance. - - - - - aef44d7f by Andreas Klebinger at 2020-12-08T22:43:21-05:00 Cmm.Sink: Optimize retaining of assignments, live sets. Sinking requires us to track live local regs after each cmm statement. We used to do this via "Set LocalReg". However we can replace this with a solution based on IntSet which is overall more efficient without losing much. The thing we lose is width of the variables, which isn't used by the sinking pass anyway. I also reworked how we keep assignments to regs mentioned in skipped assignments. I put the details into Note [Keeping assignemnts mentioned in skipped RHSs]. The gist of it is instead of keeping track of it via the use count which is a `IntMap Int` we now use the live regs set (IntSet) which is quite a bit faster. I think it also matches the semantics a lot better. The skipped (not discarded) assignment does in fact keep the regs on it's rhs alive so keeping track of this in the live set seems like the clearer solution as well. Improves allocations for T3294 by yet another 1%. - - - - - 59f2249b by Andreas Klebinger at 2020-12-08T22:43:21-05:00 GHC.Cmm.Opt: Be stricter in results. Optimization either returns Nothing if nothing is to be done or `Just <cmmExpr>` otherwise. There is no point in being lazy in `cmmExpr`. We usually inspect this element so the thunk gets forced not long after. We might eliminate it as dead code once in a blue moon but that's not a case worth optimizing for. Overall the impact of this is rather low. As Cmm.Opt doesn't allocate much (compared to the rest of GHC) to begin with. - - - - - 54b88eac by Andreas Klebinger at 2020-12-08T22:43:57-05:00 Bump time submodule. This should fix #19002. - - - - - 87adc0bd by Kirill Elagin at 2020-12-09T18:55:21-05:00 doc: Clarify the default for -fomit-yields “Yield points enabled” is confusing (and probably wrong? I am not 100% sure what it means). Change it to a simple “on”. Undo this change from 2c23fff2e03e77187dc4d01f325f5f43a0e7cad2. - - - - - d88a5fde by Kirill Elagin at 2020-12-09T18:55:21-05:00 doc: Extra-clarify -fomit-yields Be more clear on what this optimisation being on by default means in terms of yields. - - - - - e4f41000 by Sergei Trofimovich at 2020-12-09T18:55:23-05:00 rts/linker/Elf.c: add missing <dlfcn.h> include (musl support) The change fixes build failure on musl: ``` rts/linker/Elf.c:2031:3: error: warning: implicit declaration of function 'dlclose'; did you mean 'close'? [-Wimplicit-function-declaration] 2031 | dlclose(nc->dlopen_handle); | ^~~~~~~ | close ``` Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - 12 changed files: - compiler/GHC/Cmm/Expr.hs - + compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Liveness.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/Utils/Outputable.hs - compiler/ghc.cabal.in - docs/users_guide/using-optimisation.rst - libraries/time - rts/linker/Elf.c Changes: ===================================== compiler/GHC/Cmm/Expr.hs ===================================== @@ -53,14 +53,14 @@ import GHC.Types.Basic (Alignment, mkAlignment, alignmentOf) ----------------------------------------------------------------------------- data CmmExpr - = CmmLit CmmLit -- Literal + = CmmLit !CmmLit -- Literal | CmmLoad !CmmExpr !CmmType -- Read memory location | CmmReg !CmmReg -- Contents of register | CmmMachOp MachOp [CmmExpr] -- Machine operation (+, -, *, etc.) | CmmStackSlot Area {-# UNPACK #-} !Int -- addressing expression of a stack slot -- See Note [CmmStackSlot aliasing] - | CmmRegOff !CmmReg Int + | CmmRegOff !CmmReg !Int -- CmmRegOff reg i -- ** is shorthand only, meaning ** -- CmmMachOp (MO_Add rep) [x, CmmLit (CmmInt (fromIntegral i) rep)] @@ -173,16 +173,16 @@ Now, the assignments of y go away, -} data CmmLit - = CmmInt !Integer Width + = CmmInt !Integer !Width -- Interpretation: the 2's complement representation of the value -- is truncated to the specified size. This is easier than trying -- to keep the value within range, because we don't know whether -- it will be used as a signed or unsigned value (the CmmType doesn't -- distinguish between signed & unsigned). - | CmmFloat Rational Width + | CmmFloat Rational !Width | CmmVec [CmmLit] -- Vector literal | CmmLabel CLabel -- Address of label - | CmmLabelOff CLabel Int -- Address of label + byte offset + | CmmLabelOff CLabel !Int -- Address of label + byte offset -- Due to limitations in the C backend, the following -- MUST ONLY be used inside the info table indicated by label2 @@ -191,7 +191,7 @@ data CmmLit -- Don't use it at all unless tablesNextToCode. -- It is also used inside the NCG during when generating -- position-independent code. - | CmmLabelDiffOff CLabel CLabel Int Width -- label1 - label2 + offset + | CmmLabelDiffOff CLabel CLabel !Int !Width -- label1 - label2 + offset -- In an expression, the width just has the effect of MO_SS_Conv -- from wordWidth to the desired width. -- @@ -363,6 +363,7 @@ instance DefinerOfRegs LocalReg CmmReg where foldRegsDefd _ _ z (CmmGlobal _) = z instance UserOfRegs GlobalReg CmmReg where + {-# INLINEABLE foldRegsUsed #-} foldRegsUsed _ _ z (CmmLocal _) = z foldRegsUsed _ f z (CmmGlobal reg) = f z reg @@ -379,6 +380,7 @@ instance Ord r => DefinerOfRegs r r where instance (Ord r, UserOfRegs r CmmReg) => UserOfRegs r CmmExpr where -- The (Ord r) in the context is necessary here -- See Note [Recursive superclasses] in GHC.Tc.TyCl.Instance + {-# INLINEABLE foldRegsUsed #-} foldRegsUsed platform f !z e = expr z e where expr z (CmmLit _) = z expr z (CmmLoad addr _) = foldRegsUsed platform f z addr ===================================== compiler/GHC/Cmm/LRegSet.hs ===================================== @@ -0,0 +1,53 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module GHC.Cmm.LRegSet ( + LRegSet, + LRegKey, + + emptyLRegSet, + nullLRegSet, + insertLRegSet, + elemLRegSet, + + deleteFromLRegSet, + sizeLRegSet, + + plusLRegSet, + elemsLRegSet + ) where + +import GHC.Prelude +import GHC.Types.Unique +import GHC.Cmm.Expr + +import Data.IntSet as IntSet + +-- Compact sets for membership tests of local variables. + +type LRegSet = IntSet.IntSet +type LRegKey = Int + +emptyLRegSet :: LRegSet +emptyLRegSet = IntSet.empty + +nullLRegSet :: LRegSet -> Bool +nullLRegSet = IntSet.null + +insertLRegSet :: LocalReg -> LRegSet -> LRegSet +insertLRegSet l = IntSet.insert (getKey (getUnique l)) + +elemLRegSet :: LocalReg -> LRegSet -> Bool +elemLRegSet l = IntSet.member (getKey (getUnique l)) + +deleteFromLRegSet :: LRegSet -> LocalReg -> LRegSet +deleteFromLRegSet set reg = IntSet.delete (getKey . getUnique $ reg) set + +sizeLRegSet :: IntSet -> Int +sizeLRegSet = IntSet.size + +plusLRegSet :: IntSet -> IntSet -> IntSet +plusLRegSet = IntSet.union + +elemsLRegSet :: IntSet -> [Int] +elemsLRegSet = IntSet.toList ===================================== compiler/GHC/Cmm/Liveness.hs ===================================== @@ -6,9 +6,12 @@ module GHC.Cmm.Liveness ( CmmLocalLive , cmmLocalLiveness + , cmmLocalLivenessL , cmmGlobalLiveness , liveLattice + , liveLatticeL , gen_kill + , gen_killL ) where @@ -22,11 +25,14 @@ import GHC.Cmm.Dataflow.Block import GHC.Cmm.Dataflow.Collections import GHC.Cmm.Dataflow import GHC.Cmm.Dataflow.Label +import GHC.Cmm.LRegSet import GHC.Data.Maybe import GHC.Utils.Outputable import GHC.Utils.Panic +import GHC.Types.Unique + ----------------------------------------------------------------------------- -- Calculating what variables are live on entry to a basic block ----------------------------------------------------------------------------- @@ -92,3 +98,66 @@ xferLive platform (BlockCC eNode middle xNode) fBase = in mapSingleton (entryLabel eNode) result {-# SPECIALIZE xferLive :: Platform -> TransferFun (CmmLive LocalReg) #-} {-# SPECIALIZE xferLive :: Platform -> TransferFun (CmmLive GlobalReg) #-} + +----------------------------------------------------------------------------- +-- | Specialization that only retains the keys for local variables. +-- +-- Local variablas are mostly glorified Ints, and some parts of the compiler +-- really don't care about anything but the Int part. So we can avoid some +-- overhead by computing a IntSet instead of a Set LocalReg which (unsurprisingly) +-- is quite a bit faster. +----------------------------------------------------------------------------- + +type BlockEntryLivenessL = LabelMap LRegSet + +-- | The dataflow lattice +liveLatticeL :: DataflowLattice LRegSet +liveLatticeL = DataflowLattice emptyLRegSet add + where + add (OldFact old) (NewFact new) = + let !join = plusLRegSet old new + in changedIf (sizeLRegSet join > sizeLRegSet old) join + + +cmmLocalLivenessL :: Platform -> CmmGraph -> BlockEntryLivenessL +cmmLocalLivenessL platform graph = + check $ analyzeCmmBwd liveLatticeL (xferLiveL platform) graph mapEmpty + where + entry = g_entry graph + check facts = + noLiveOnEntryL entry (expectJust "check" $ mapLookup entry facts) facts + +-- | On entry to the procedure, there had better not be any LocalReg's live-in. +noLiveOnEntryL :: BlockId -> LRegSet -> a -> a +noLiveOnEntryL bid in_fact x = + if nullLRegSet in_fact then x + else pprPanic "LocalReg's live-in to graph" (ppr bid <+> ppr reg_uniques) + where + -- We convert the int's to uniques so that the printing matches that + -- of registers. + reg_uniques = map mkUniqueGrimily $ elemsLRegSet in_fact + + + + +gen_killL + :: (DefinerOfRegs LocalReg n, UserOfRegs LocalReg n) + => Platform -> n -> LRegSet -> LRegSet +gen_killL platform node set = + let !afterKill = foldRegsDefd platform deleteFromLRegSet set node + in foldRegsUsed platform (flip insertLRegSet) afterKill node +{-# INLINE gen_killL #-} + +xferLiveL + :: ( UserOfRegs LocalReg (CmmNode O O) + , DefinerOfRegs LocalReg (CmmNode O O) + , UserOfRegs LocalReg (CmmNode O C) + , DefinerOfRegs LocalReg (CmmNode O C) + ) + => Platform -> TransferFun LRegSet +xferLiveL platform (BlockCC eNode middle xNode) fBase = + let joined = gen_killL platform xNode $! joinOutFacts liveLatticeL xNode fBase + !result = foldNodesBwdOO (gen_killL platform) middle joined + in mapSingleton (entryLabel eNode) result + + ===================================== compiler/GHC/Cmm/Node.hs ===================================== @@ -318,6 +318,7 @@ foreignTargetHints target -- Instances of register and slot users / definers instance UserOfRegs LocalReg (CmmNode e x) where + {-# INLINEABLE foldRegsUsed #-} foldRegsUsed platform f !z n = case n of CmmAssign _ expr -> fold f z expr CmmStore addr rval -> fold f (fold f z addr) rval @@ -332,6 +333,7 @@ instance UserOfRegs LocalReg (CmmNode e x) where fold f z n = foldRegsUsed platform f z n instance UserOfRegs GlobalReg (CmmNode e x) where + {-# INLINEABLE foldRegsUsed #-} foldRegsUsed platform f !z n = case n of CmmAssign _ expr -> fold f z expr CmmStore addr rval -> fold f (fold f z addr) rval @@ -348,10 +350,12 @@ instance UserOfRegs GlobalReg (CmmNode e x) where instance (Ord r, UserOfRegs r CmmReg) => UserOfRegs r ForeignTarget where -- The (Ord r) in the context is necessary here -- See Note [Recursive superclasses] in GHC.Tc.TyCl.Instance + {-# INLINEABLE foldRegsUsed #-} foldRegsUsed _ _ !z (PrimTarget _) = z foldRegsUsed platform f !z (ForeignTarget e _) = foldRegsUsed platform f z e instance DefinerOfRegs LocalReg (CmmNode e x) where + {-# INLINEABLE foldRegsDefd #-} foldRegsDefd platform f !z n = case n of CmmAssign lhs _ -> fold f z lhs CmmUnsafeForeignCall _ fs _ -> fold f z fs @@ -362,6 +366,7 @@ instance DefinerOfRegs LocalReg (CmmNode e x) where fold f z n = foldRegsDefd platform f z n instance DefinerOfRegs GlobalReg (CmmNode e x) where + {-# INLINEABLE foldRegsDefd #-} foldRegsDefd platform f !z n = case n of CmmAssign lhs _ -> fold f z lhs CmmUnsafeForeignCall tgt _ _ -> fold f z (foreignTargetRegs tgt) ===================================== compiler/GHC/Cmm/Opt.hs ===================================== @@ -58,7 +58,7 @@ cmmMachOpFoldM -> Maybe CmmExpr cmmMachOpFoldM _ op [CmmLit (CmmInt x rep)] - = Just $ case op of + = Just $! case op of MO_S_Neg _ -> CmmLit (CmmInt (-x) rep) MO_Not _ -> CmmLit (CmmInt (complement x) rep) @@ -90,13 +90,13 @@ cmmMachOpFoldM platform conv_outer [CmmMachOp conv_inner [x]] -- but remember to use the signedness from the widening, just in case -- the final conversion is a widen. | rep1 < rep2 && rep2 > rep3 -> - Just $ cmmMachOpFold platform (intconv signed1 rep1 rep3) [x] + Just $! cmmMachOpFold platform (intconv signed1 rep1 rep3) [x] -- Nested widenings: collapse if the signedness is the same | rep1 < rep2 && rep2 < rep3 && signed1 == signed2 -> - Just $ cmmMachOpFold platform (intconv signed1 rep1 rep3) [x] + Just $! cmmMachOpFold platform (intconv signed1 rep1 rep3) [x] -- Nested narrowings: collapse | rep1 > rep2 && rep2 > rep3 -> - Just $ cmmMachOpFold platform (MO_UU_Conv rep1 rep3) [x] + Just $! cmmMachOpFold platform (MO_UU_Conv rep1 rep3) [x] | otherwise -> Nothing where @@ -117,34 +117,34 @@ cmmMachOpFoldM platform mop [CmmLit (CmmInt x xrep), CmmLit (CmmInt y _)] = case mop of -- for comparisons: don't forget to narrow the arguments before -- comparing, since they might be out of range. - MO_Eq _ -> Just $ CmmLit (CmmInt (if x_u == y_u then 1 else 0) (wordWidth platform)) - MO_Ne _ -> Just $ CmmLit (CmmInt (if x_u /= y_u then 1 else 0) (wordWidth platform)) - - MO_U_Gt _ -> Just $ CmmLit (CmmInt (if x_u > y_u then 1 else 0) (wordWidth platform)) - MO_U_Ge _ -> Just $ CmmLit (CmmInt (if x_u >= y_u then 1 else 0) (wordWidth platform)) - MO_U_Lt _ -> Just $ CmmLit (CmmInt (if x_u < y_u then 1 else 0) (wordWidth platform)) - MO_U_Le _ -> Just $ CmmLit (CmmInt (if x_u <= y_u then 1 else 0) (wordWidth platform)) - - MO_S_Gt _ -> Just $ CmmLit (CmmInt (if x_s > y_s then 1 else 0) (wordWidth platform)) - MO_S_Ge _ -> Just $ CmmLit (CmmInt (if x_s >= y_s then 1 else 0) (wordWidth platform)) - MO_S_Lt _ -> Just $ CmmLit (CmmInt (if x_s < y_s then 1 else 0) (wordWidth platform)) - MO_S_Le _ -> Just $ CmmLit (CmmInt (if x_s <= y_s then 1 else 0) (wordWidth platform)) - - MO_Add r -> Just $ CmmLit (CmmInt (x + y) r) - MO_Sub r -> Just $ CmmLit (CmmInt (x - y) r) - MO_Mul r -> Just $ CmmLit (CmmInt (x * y) r) - MO_U_Quot r | y /= 0 -> Just $ CmmLit (CmmInt (x_u `quot` y_u) r) - MO_U_Rem r | y /= 0 -> Just $ CmmLit (CmmInt (x_u `rem` y_u) r) - MO_S_Quot r | y /= 0 -> Just $ CmmLit (CmmInt (x `quot` y) r) - MO_S_Rem r | y /= 0 -> Just $ CmmLit (CmmInt (x `rem` y) r) - - MO_And r -> Just $ CmmLit (CmmInt (x .&. y) r) - MO_Or r -> Just $ CmmLit (CmmInt (x .|. y) r) - MO_Xor r -> Just $ CmmLit (CmmInt (x `xor` y) r) - - MO_Shl r -> Just $ CmmLit (CmmInt (x `shiftL` fromIntegral y) r) - MO_U_Shr r -> Just $ CmmLit (CmmInt (x_u `shiftR` fromIntegral y) r) - MO_S_Shr r -> Just $ CmmLit (CmmInt (x `shiftR` fromIntegral y) r) + MO_Eq _ -> Just $! CmmLit (CmmInt (if x_u == y_u then 1 else 0) (wordWidth platform)) + MO_Ne _ -> Just $! CmmLit (CmmInt (if x_u /= y_u then 1 else 0) (wordWidth platform)) + + MO_U_Gt _ -> Just $! CmmLit (CmmInt (if x_u > y_u then 1 else 0) (wordWidth platform)) + MO_U_Ge _ -> Just $! CmmLit (CmmInt (if x_u >= y_u then 1 else 0) (wordWidth platform)) + MO_U_Lt _ -> Just $! CmmLit (CmmInt (if x_u < y_u then 1 else 0) (wordWidth platform)) + MO_U_Le _ -> Just $! CmmLit (CmmInt (if x_u <= y_u then 1 else 0) (wordWidth platform)) + + MO_S_Gt _ -> Just $! CmmLit (CmmInt (if x_s > y_s then 1 else 0) (wordWidth platform)) + MO_S_Ge _ -> Just $! CmmLit (CmmInt (if x_s >= y_s then 1 else 0) (wordWidth platform)) + MO_S_Lt _ -> Just $! CmmLit (CmmInt (if x_s < y_s then 1 else 0) (wordWidth platform)) + MO_S_Le _ -> Just $! CmmLit (CmmInt (if x_s <= y_s then 1 else 0) (wordWidth platform)) + + MO_Add r -> Just $! CmmLit (CmmInt (x + y) r) + MO_Sub r -> Just $! CmmLit (CmmInt (x - y) r) + MO_Mul r -> Just $! CmmLit (CmmInt (x * y) r) + MO_U_Quot r | y /= 0 -> Just $! CmmLit (CmmInt (x_u `quot` y_u) r) + MO_U_Rem r | y /= 0 -> Just $! CmmLit (CmmInt (x_u `rem` y_u) r) + MO_S_Quot r | y /= 0 -> Just $! CmmLit (CmmInt (x `quot` y) r) + MO_S_Rem r | y /= 0 -> Just $! CmmLit (CmmInt (x `rem` y) r) + + MO_And r -> Just $! CmmLit (CmmInt (x .&. y) r) + MO_Or r -> Just $! CmmLit (CmmInt (x .|. y) r) + MO_Xor r -> Just $! CmmLit (CmmInt (x `xor` y) r) + + MO_Shl r -> Just $! CmmLit (CmmInt (x `shiftL` fromIntegral y) r) + MO_U_Shr r -> Just $! CmmLit (CmmInt (x_u `shiftR` fromIntegral y) r) + MO_S_Shr r -> Just $! CmmLit (CmmInt (x `shiftR` fromIntegral y) r) _ -> Nothing @@ -162,7 +162,7 @@ cmmMachOpFoldM platform mop [CmmLit (CmmInt x xrep), CmmLit (CmmInt y _)] cmmMachOpFoldM platform op [x@(CmmLit _), y] | not (isLit y) && isCommutableMachOp op - = Just (cmmMachOpFold platform op [y, x]) + = Just $! (cmmMachOpFold platform op [y, x]) -- Turn (a+b)+c into a+(b+c) where possible. Because literals are -- moved to the right, it is more likely that we will find @@ -183,7 +183,7 @@ cmmMachOpFoldM platform op [x@(CmmLit _), y] cmmMachOpFoldM platform mop1 [CmmMachOp mop2 [arg1,arg2], arg3] | mop2 `associates_with` mop1 && not (isLit arg1) && not (isPicReg arg1) - = Just (cmmMachOpFold platform mop2 [arg1, cmmMachOpFold platform mop1 [arg2,arg3]]) + = Just $! (cmmMachOpFold platform mop2 [arg1, cmmMachOpFold platform mop1 [arg2,arg3]]) where MO_Add{} `associates_with` MO_Sub{} = True mop1 `associates_with` mop2 = @@ -192,7 +192,7 @@ cmmMachOpFoldM platform mop1 [CmmMachOp mop2 [arg1,arg2], arg3] -- special case: (a - b) + c ==> a + (c - b) cmmMachOpFoldM platform mop1@(MO_Add{}) [CmmMachOp mop2@(MO_Sub{}) [arg1,arg2], arg3] | not (isLit arg1) && not (isPicReg arg1) - = Just (cmmMachOpFold platform mop1 [arg1, cmmMachOpFold platform mop2 [arg3,arg2]]) + = Just $! (cmmMachOpFold platform mop1 [arg1, cmmMachOpFold platform mop2 [arg3,arg2]]) -- special case: (PicBaseReg + lit) + N ==> PicBaseReg + (lit+N) -- @@ -205,27 +205,27 @@ cmmMachOpFoldM platform mop1@(MO_Add{}) [CmmMachOp mop2@(MO_Sub{}) [arg1,arg2], cmmMachOpFoldM _ MO_Add{} [ CmmMachOp op at MO_Add{} [pic, CmmLit lit] , CmmLit (CmmInt n rep) ] | isPicReg pic - = Just $ CmmMachOp op [pic, CmmLit $ cmmOffsetLit lit off ] + = Just $! CmmMachOp op [pic, CmmLit $ cmmOffsetLit lit off ] where off = fromIntegral (narrowS rep n) -- Make a RegOff if we can cmmMachOpFoldM _ (MO_Add _) [CmmReg reg, CmmLit (CmmInt n rep)] - = Just $ cmmRegOff reg (fromIntegral (narrowS rep n)) + = Just $! cmmRegOff reg (fromIntegral (narrowS rep n)) cmmMachOpFoldM _ (MO_Add _) [CmmRegOff reg off, CmmLit (CmmInt n rep)] - = Just $ cmmRegOff reg (off + fromIntegral (narrowS rep n)) + = Just $! cmmRegOff reg (off + fromIntegral (narrowS rep n)) cmmMachOpFoldM _ (MO_Sub _) [CmmReg reg, CmmLit (CmmInt n rep)] - = Just $ cmmRegOff reg (- fromIntegral (narrowS rep n)) + = Just $! cmmRegOff reg (- fromIntegral (narrowS rep n)) cmmMachOpFoldM _ (MO_Sub _) [CmmRegOff reg off, CmmLit (CmmInt n rep)] - = Just $ cmmRegOff reg (off - fromIntegral (narrowS rep n)) + = Just $! cmmRegOff reg (off - fromIntegral (narrowS rep n)) -- Fold label(+/-)offset into a CmmLit where possible cmmMachOpFoldM _ (MO_Add _) [CmmLit lit, CmmLit (CmmInt i rep)] - = Just $ CmmLit (cmmOffsetLit lit (fromIntegral (narrowU rep i))) + = Just $! CmmLit (cmmOffsetLit lit (fromIntegral (narrowU rep i))) cmmMachOpFoldM _ (MO_Add _) [CmmLit (CmmInt i rep), CmmLit lit] - = Just $ CmmLit (cmmOffsetLit lit (fromIntegral (narrowU rep i))) + = Just $! CmmLit (cmmOffsetLit lit (fromIntegral (narrowU rep i))) cmmMachOpFoldM _ (MO_Sub _) [CmmLit lit, CmmLit (CmmInt i rep)] - = Just $ CmmLit (cmmOffsetLit lit (fromIntegral (negate (narrowU rep i)))) + = Just $! CmmLit (cmmOffsetLit lit (fromIntegral (negate (narrowU rep i)))) -- Comparison of literal with widened operand: perform the comparison @@ -245,7 +245,7 @@ cmmMachOpFoldM platform cmp [CmmMachOp conv [x], CmmLit (CmmInt i _)] -- and the literal fits in the smaller size: i == narrow_fn rep i -- then we can do the comparison at the smaller size - = Just (cmmMachOpFold platform narrow_cmp [x, CmmLit (CmmInt i rep)]) + = Just $! (cmmMachOpFold platform narrow_cmp [x, CmmLit (CmmInt i rep)]) where maybe_conversion (MO_UU_Conv from to) | to > from @@ -320,8 +320,8 @@ cmmMachOpFoldM platform mop [x, (CmmLit (CmmInt 1 rep))] MO_Mul _ -> Just x MO_S_Quot _ -> Just x MO_U_Quot _ -> Just x - MO_S_Rem _ -> Just $ CmmLit (CmmInt 0 rep) - MO_U_Rem _ -> Just $ CmmLit (CmmInt 0 rep) + MO_S_Rem _ -> Just $! CmmLit (CmmInt 0 rep) + MO_U_Rem _ -> Just $! CmmLit (CmmInt 0 rep) -- Comparisons; trickier -- See Note [Comparison operators] @@ -346,18 +346,18 @@ cmmMachOpFoldM platform mop [x, (CmmLit (CmmInt n _))] = case mop of MO_Mul rep | Just p <- exactLog2 n -> - Just (cmmMachOpFold platform (MO_Shl rep) [x, CmmLit (CmmInt p rep)]) + Just $! (cmmMachOpFold platform (MO_Shl rep) [x, CmmLit (CmmInt p rep)]) MO_U_Quot rep | Just p <- exactLog2 n -> - Just (cmmMachOpFold platform (MO_U_Shr rep) [x, CmmLit (CmmInt p rep)]) + Just $! (cmmMachOpFold platform (MO_U_Shr rep) [x, CmmLit (CmmInt p rep)]) MO_U_Rem rep | Just _ <- exactLog2 n -> - Just (cmmMachOpFold platform (MO_And rep) [x, CmmLit (CmmInt (n - 1) rep)]) + Just $! (cmmMachOpFold platform (MO_And rep) [x, CmmLit (CmmInt (n - 1) rep)]) MO_S_Quot rep | Just p <- exactLog2 n, CmmReg _ <- x -> -- We duplicate x in signedQuotRemHelper, hence require -- it is a reg. FIXME: remove this restriction. - Just (cmmMachOpFold platform (MO_S_Shr rep) + Just $! (cmmMachOpFold platform (MO_S_Shr rep) [signedQuotRemHelper rep p, CmmLit (CmmInt p rep)]) MO_S_Rem rep | Just p <- exactLog2 n, @@ -366,7 +366,7 @@ cmmMachOpFoldM platform mop [x, (CmmLit (CmmInt n _))] -- We replace (x `rem` 2^p) by (x - (x `quot` 2^p) * 2^p). -- Moreover, we fuse MO_S_Shr (last operation of MO_S_Quot) -- and MO_S_Shl (multiplication by 2^p) into a single MO_And operation. - Just (cmmMachOpFold platform (MO_Sub rep) + Just $! (cmmMachOpFold platform (MO_Sub rep) [x, cmmMachOpFold platform (MO_And rep) [signedQuotRemHelper rep p, CmmLit (CmmInt (- n) rep)]]) _ -> Nothing ===================================== compiler/GHC/Cmm/Sink.hs ===================================== @@ -1,4 +1,6 @@ {-# LANGUAGE GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} + module GHC.Cmm.Sink ( cmmSink ) where @@ -8,6 +10,7 @@ import GHC.Prelude import GHC.Cmm import GHC.Cmm.Opt import GHC.Cmm.Liveness +import GHC.Cmm.LRegSet import GHC.Cmm.Utils import GHC.Cmm.Dataflow.Block import GHC.Cmm.Dataflow.Label @@ -16,29 +19,13 @@ import GHC.Cmm.Dataflow.Graph import GHC.Platform.Regs import GHC.Platform -import GHC.Types.Unique import GHC.Types.Unique.FM import qualified Data.IntSet as IntSet import Data.List (partition) -import qualified Data.Set as Set import Data.Maybe --- Compact sets for membership tests of local variables. - -type LRegSet = IntSet.IntSet - -emptyLRegSet :: LRegSet -emptyLRegSet = IntSet.empty - -nullLRegSet :: LRegSet -> Bool -nullLRegSet = IntSet.null - -insertLRegSet :: LocalReg -> LRegSet -> LRegSet -insertLRegSet l = IntSet.insert (getKey (getUnique l)) - -elemLRegSet :: LocalReg -> LRegSet -> Bool -elemLRegSet l = IntSet.member (getKey (getUnique l)) +import GHC.Exts (inline) -- ----------------------------------------------------------------------------- -- Sinking and inlining @@ -167,8 +154,8 @@ type Assignments = [Assignment] cmmSink :: Platform -> CmmGraph -> CmmGraph cmmSink platform graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks where - liveness = cmmLocalLiveness platform graph - getLive l = mapFindWithDefault Set.empty l liveness + liveness = cmmLocalLivenessL platform graph + getLive l = mapFindWithDefault emptyLRegSet l liveness blocks = revPostorder graph @@ -188,8 +175,8 @@ cmmSink platform graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks -- Annotate the middle nodes with the registers live *after* -- the node. This will help us decide whether we can inline -- an assignment in the current node or not. - live = Set.unions (map getLive succs) - live_middle = gen_kill platform last live + live = IntSet.unions (map getLive succs) + live_middle = gen_killL platform last live ann_middles = annotate platform live_middle (blockToList middle) -- Now sink and inline in this block @@ -201,7 +188,7 @@ cmmSink platform graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks -- one predecessor), so identify the join points and the set -- of registers live in them. (joins, nonjoins) = partition (`mapMember` join_pts) succs - live_in_joins = Set.unions (map getLive joins) + live_in_joins = IntSet.unions (map getLive joins) -- We do not want to sink an assignment into multiple branches, -- so identify the set of registers live in multiple successors. @@ -210,26 +197,28 @@ cmmSink platform graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks -- now live in multiple branches. init_live_sets = map getLive nonjoins live_in_multi live_sets r = - case filter (Set.member r) live_sets of + case filter (elemLRegSet r) live_sets of (_one:_two:_) -> True _ -> False -- Now, drop any assignments that we will not sink any further. (dropped_last, assigs'') = dropAssignments platform drop_if init_live_sets assigs' + drop_if :: (LocalReg, CmmExpr, AbsMem) + -> [LRegSet] -> (Bool, [LRegSet]) drop_if a@(r,rhs,_) live_sets = (should_drop, live_sets') where should_drop = conflicts platform a final_last || not (isTrivial platform rhs) && live_in_multi live_sets r - || r `Set.member` live_in_joins + || r `elemLRegSet` live_in_joins live_sets' | should_drop = live_sets | otherwise = map upd live_sets - upd set | r `Set.member` set = set `Set.union` live_rhs + upd set | r `elemLRegSet` set = set `IntSet.union` live_rhs | otherwise = set - live_rhs = foldRegsUsed platform extendRegSet emptyRegSet rhs + live_rhs = foldRegsUsed platform (flip insertLRegSet) emptyLRegSet rhs final_middle = foldl' blockSnoc middle' dropped_last @@ -266,9 +255,9 @@ isTrivial _ _ = False -- -- annotate each node with the set of registers live *after* the node -- -annotate :: Platform -> LocalRegSet -> [CmmNode O O] -> [(LocalRegSet, CmmNode O O)] +annotate :: Platform -> LRegSet -> [CmmNode O O] -> [(LRegSet, CmmNode O O)] annotate platform live nodes = snd $ foldr ann (live,[]) nodes - where ann n (live,nodes) = (gen_kill platform n live, (live,n) : nodes) + where ann n (live,nodes) = (gen_killL platform n live, (live,n) : nodes) -- -- Find the blocks that have multiple successors (join points) @@ -285,13 +274,13 @@ findJoinPoints blocks = mapFilter (>1) succ_counts -- filter the list of assignments to remove any assignments that -- are not live in a continuation. -- -filterAssignments :: Platform -> LocalRegSet -> Assignments -> Assignments +filterAssignments :: Platform -> LRegSet -> Assignments -> Assignments filterAssignments platform live assigs = reverse (go assigs []) where go [] kept = kept go (a@(r,_,_):as) kept | needed = go as (a:kept) | otherwise = go as kept where - needed = r `Set.member` live + needed = r `elemLRegSet` live || any (conflicts platform a) (map toNode kept) -- Note that we must keep assignments that are -- referred to by other assignments we have @@ -312,7 +301,7 @@ filterAssignments platform live assigs = reverse (go assigs []) -- walk :: Platform - -> [(LocalRegSet, CmmNode O O)] -- nodes of the block, annotated with + -> [(LRegSet, CmmNode O O)] -- nodes of the block, annotated with -- the set of registers live *after* -- this node. @@ -366,11 +355,11 @@ shouldSink _ _other = Nothing -- out of inlining, but the inliner will see that r is live -- after the instruction and choose not to inline r in the rhs. -- -shouldDiscard :: CmmNode e x -> LocalRegSet -> Bool +shouldDiscard :: CmmNode e x -> LRegSet -> Bool shouldDiscard node live = case node of CmmAssign r (CmmReg r') | r == r' -> True - CmmAssign (CmmLocal r) _ -> not (r `Set.member` live) + CmmAssign (CmmLocal r) _ -> not (r `elemLRegSet` live) _otherwise -> False @@ -403,8 +392,9 @@ dropAssignments platform should_drop state assigs -- inlining opens up opportunities for doing so. tryToInline - :: Platform - -> LocalRegSet -- set of registers live after this + :: forall x. Platform + -> LRegSet -- set of registers live after this + -- -> LocalRegSet -- set of registers live after this -- node. We cannot inline anything -- that is live after the node, unless -- it is small enough to duplicate. @@ -415,35 +405,42 @@ tryToInline , Assignments -- Remaining assignments ) -tryToInline platform live node assigs = go usages node emptyLRegSet assigs +tryToInline platform liveAfter node assigs = + -- pprTrace "tryToInline assig length:" (ppr $ length assigs) $ + go usages liveAfter node emptyLRegSet assigs where usages :: UniqFM LocalReg Int -- Maps each LocalReg to a count of how often it is used usages = foldLocalRegsUsed platform addUsage emptyUFM node - go _usages node _skipped [] = (node, []) + go :: UniqFM LocalReg Int -> LRegSet -> CmmNode O x -> LRegSet -> Assignments + -> (CmmNode O x, Assignments) + go _usages _live node _skipped [] = (node, []) - go usages node skipped (a@(l,rhs,_) : rest) - | cannot_inline = dont_inline - | occurs_none = discard -- Note [discard during inlining] - | occurs_once = inline_and_discard - | isTrivial platform rhs = inline_and_keep - | otherwise = dont_inline + go usages live node skipped (a@(l,rhs,_) : rest) + | cannot_inline = dont_inline + | occurs_none = discard -- Note [discard during inlining] + | occurs_once = inline_and_discard + | isTrivial platform rhs = inline_and_keep + | otherwise = dont_inline where - inline_and_discard = go usages' inl_node skipped rest + inline_and_discard = go usages' live inl_node skipped rest where usages' = foldLocalRegsUsed platform addUsage usages rhs - discard = go usages node skipped rest + discard = go usages live node skipped rest dont_inline = keep node -- don't inline the assignment, keep it inline_and_keep = keep inl_node -- inline the assignment, keep it + keep :: CmmNode O x -> (CmmNode O x, Assignments) keep node' = (final_node, a : rest') - where (final_node, rest') = go usages' node' (insertLRegSet l skipped) rest - usages' = foldLocalRegsUsed platform (\m r -> addToUFM m r 2) - usages rhs - -- we must not inline anything that is mentioned in the RHS - -- of a binding that we have already skipped, so we set the - -- usages of the regs on the RHS to 2. + where (final_node, rest') = go usages live' node' (insertLRegSet l skipped) rest + + -- Avoid discarding of assignments to vars on the rhs. + -- See Note [Keeping assignemnts mentioned in skipped RHSs] + -- usages' = foldLocalRegsUsed platform (\m r -> addToUFM m r 2) + -- usages rhs + live' = inline foldLocalRegsUsed platform (\m r -> insertLRegSet r m) + live rhs cannot_inline = skipped `regsUsedIn` rhs -- Note [dependent assignments] || l `elemLRegSet` skipped @@ -451,7 +448,7 @@ tryToInline platform live node assigs = go usages node emptyLRegSet assigs -- How often is l used in the current node. l_usages = lookupUFM usages l - l_live = l `elemRegSet` live + l_live = l `elemLRegSet` live occurs_once = not l_live && l_usages == Just 1 occurs_none = not l_live && l_usages == Nothing @@ -467,6 +464,27 @@ tryToInline platform live node assigs = go usages node emptyLRegSet assigs inl_exp (CmmMachOp op args) = cmmMachOpFold platform op args inl_exp other = other +{- Note [Keeping assignemnts mentioned in skipped RHSs] + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + If we have to assignments: [z = y, y = e1] and we skip + z we *must* retain the assignment y = e1. This is because + we might inline "z = y" into another node later on so we + must ensure y is still defined at this point. + + If we dropped the assignment of "y = e1" then we would end up + referencing a variable which hasn't been mentioned after + inlining. + + We use a hack to do this. + + We pretend the regs from the rhs are live after the current + node. Since we only discard assignments to variables + which are dead after the current block this prevents discarding of the + assignment. It still allows inlining should e1 be a trivial rhs + however. + +-} {- Note [improveConditional] @@ -610,18 +628,34 @@ conflicts platform (r, rhs, addr) node -- (7) otherwise, no conflict | otherwise = False +{- Note [Inlining foldRegsDefd] + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + foldRegsDefd is, after optimization, *not* a small function so + it's only marked INLINEABLE, but not INLINE. + + However in some specific cases we call it *very* often making it + important to avoid the overhead of allocating the folding function. + + So we simply force inlining via the magic inline function. + For T3294 this improves allocation with -O by ~1%. + +-} + -- Returns True if node defines any global registers that are used in the -- Cmm expression globalRegistersConflict :: Platform -> CmmExpr -> CmmNode e x -> Bool globalRegistersConflict platform expr node = - foldRegsDefd platform (\b r -> b || regUsedIn platform (CmmGlobal r) expr) + -- See Note [Inlining foldRegsDefd] + inline foldRegsDefd platform (\b r -> b || regUsedIn platform (CmmGlobal r) expr) False node -- Returns True if node defines any local registers that are used in the -- Cmm expression localRegistersConflict :: Platform -> CmmExpr -> CmmNode e x -> Bool localRegistersConflict platform expr node = - foldRegsDefd platform (\b r -> b || regUsedIn platform (CmmLocal r) expr) + -- See Note [Inlining foldRegsDefd] + inline foldRegsDefd platform (\b r -> b || regUsedIn platform (CmmLocal r) expr) False node -- Note [Sinking and calls] ===================================== compiler/GHC/Cmm/Utils.hs ===================================== @@ -264,9 +264,11 @@ cmmOffset platform e byte_off = case e of CmmStackSlot area off -> CmmStackSlot area (off - byte_off) -- note stack area offsets increase towards lower addresses CmmMachOp (MO_Add rep) [expr, CmmLit (CmmInt byte_off1 _rep)] - -> CmmMachOp (MO_Add rep) [expr, CmmLit (CmmInt (byte_off1 + toInteger byte_off) rep)] - _ -> CmmMachOp (MO_Add width) [e, CmmLit (CmmInt (toInteger byte_off) width)] - where width = cmmExprWidth platform e + -> let !lit_off = (byte_off1 + toInteger byte_off) + in CmmMachOp (MO_Add rep) [expr, CmmLit (CmmInt lit_off rep)] + _ -> let !width = cmmExprWidth platform e + in + CmmMachOp (MO_Add width) [e, CmmLit (CmmInt (toInteger byte_off) width)] -- Smart constructor for CmmRegOff. Same caveats as cmmOffset above. cmmRegOff :: CmmReg -> Int -> CmmExpr ===================================== compiler/GHC/Utils/Outputable.hs ===================================== @@ -115,6 +115,7 @@ import Data.Int import qualified Data.IntMap as IM import Data.Set (Set) import qualified Data.Set as Set +import qualified Data.IntSet as IntSet import Data.String import Data.Word import System.IO ( Handle ) @@ -863,6 +864,9 @@ instance (Outputable a) => Outputable (NonEmpty a) where instance (Outputable a) => Outputable (Set a) where ppr s = braces (fsep (punctuate comma (map ppr (Set.toList s)))) +instance Outputable IntSet.IntSet where + ppr s = braces (fsep (punctuate comma (map ppr (IntSet.toList s)))) + instance (Outputable a, Outputable b) => Outputable (a, b) where ppr (x,y) = parens (sep [ppr x <> comma, ppr y]) ===================================== compiler/ghc.cabal.in ===================================== @@ -205,6 +205,7 @@ Library GHC.Cmm.Switch GHC.Cmm.Switch.Implement GHC.CmmToAsm + GHC.Cmm.LRegSet GHC.CmmToAsm.BlockLayout GHC.CmmToAsm.CFG GHC.CmmToAsm.CFG.Dominators ===================================== docs/users_guide/using-optimisation.rst ===================================== @@ -720,7 +720,7 @@ by saying ``-fno-wombat``. :reverse: -fno-omit-yields :category: - :default: yield points enabled + :default: on (yields are *not* inserted) Tells GHC to omit heap checks when no allocation is being performed. While this improves binary sizes by about 5%, it ===================================== libraries/time ===================================== @@ -1 +1 @@ -Subproject commit c25d6a76702b454426e149fb590da5cb69f3bd0a +Subproject commit df292e1a74c6a87c2c1c889679074dd46ad39461 ===================================== rts/linker/Elf.c ===================================== @@ -32,6 +32,9 @@ #include #include #include +#if defined(HAVE_DLFCN_H) +#include +#endif #if defined(HAVE_SYS_STAT_H) #include #endif View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ed940d47e8a4abdeb0ce54fcd8db46274713a248...e4f41000077c2da09b2ca7ffc623aefff21da6ee -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ed940d47e8a4abdeb0ce54fcd8db46274713a248...e4f41000077c2da09b2ca7ffc623aefff21da6ee You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 10 00:26:01 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 09 Dec 2020 19:26:01 -0500 Subject: [Git][ghc/ghc][wip/gc-events] 4 commits: Fix kind inference for data types. Again. Message-ID: <5fd16b197201f_6b211805218839194@gitlab.mail> Ben Gamari pushed to branch wip/gc-events at Glasgow Haskell Compiler / GHC Commits: 62ed6957 by Simon Peyton Jones at 2020-12-08T15:31:41-05:00 Fix kind inference for data types. Again. This patch fixes several aspects of kind inference for data type declarations, especially data /instance/ declarations Specifically 1. In kcConDecls/kcConDecl make it clear that the tc_res_kind argument is only used in the H98 case; and in that case there is no result kind signature; and hence no need for the disgusting splitPiTys in kcConDecls (now thankfully gone). The GADT case is a bit different to before, and much nicer. This is what fixes #18891. See Note [kcConDecls: kind-checking data type decls] 2. Do not look at the constructor decls of a data/newtype instance in tcDataFamInstanceHeader. See GHC.Tc.TyCl.Instance Note [Kind inference for data family instances]. This was a new realisation that arose when doing (1) This causes a few knock-on effects in the tests suite, because we require more information than before in the instance /header/. New user-manual material about this in "Kind inference in data type declarations" and "Kind inference for data/newtype instance declarations". 3. Minor improvement in kcTyClDecl, combining GADT and H98 cases 4. Fix #14111 and #8707 by allowing the header of a data instance to affect kind inferece for the the data constructor signatures; as described at length in Note [GADT return types] in GHC.Tc.TyCl This led to a modest refactoring of the arguments (and argument order) of tcConDecl/tcConDecls. 5. Fix #19000 by inverting the sense of the test in new_locs in GHC.Tc.Solver.Canonical.canDecomposableTyConAppOK. - - - - - 0abe3ddf by Adam Sandberg Ericsson at 2020-12-08T15:32:19-05:00 hadrian: build the _l and _thr_l rts flavours in the develN flavours The ghc binary requires the eventlog rts since fc644b1a643128041cfec25db84e417851e28bab - - - - - a8a80e05 by Ben Gamari at 2020-12-09T19:25:41-05:00 users guide: Fix syntax errors Fixes errors introduced by 3a55b3a2574f913d046f3a6f82db48d7f6df32e3. - - - - - af3300fb by Ben Gamari at 2020-12-09T19:25:41-05:00 users guide: Describe GC lifecycle events Every time I am asked about how to interpret these events I need to figure it out from scratch. It's well past time that the users guide properly documents these. - - - - - 30 changed files: - compiler/GHC/Hs/Extension.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Instance.hs - docs/users_guide/9.2.1-notes.rst - docs/users_guide/eventlog-formats.rst - docs/users_guide/exts/poly_kinds.rst - docs/users_guide/runtime_control.rst - docs/users_guide/using-optimisation.rst - hadrian/src/Settings/Flavours/Development.hs - rts/Stats.c - testsuite/tests/dependent/should_fail/T13780a.stderr - testsuite/tests/deriving/should_compile/T11416.hs - testsuite/tests/deriving/should_compile/T9359.hs - + testsuite/tests/gadt/SynDataRec.hs - testsuite/tests/gadt/all.T - + testsuite/tests/indexed-types/should_compile/T14111.hs - + testsuite/tests/indexed-types/should_compile/T8707.hs - testsuite/tests/indexed-types/should_compile/all.T - testsuite/tests/indexed-types/should_fail/T8368.stderr - testsuite/tests/indexed-types/should_fail/T8368a.stderr - testsuite/tests/patsyn/should_fail/T15685.stderr - testsuite/tests/polykinds/T13659.stderr - testsuite/tests/polykinds/T16221a.stderr - testsuite/tests/th/T11145.stderr - testsuite/tests/th/T9692.hs - + testsuite/tests/typecheck/should_compile/T18891.hs - testsuite/tests/typecheck/should_compile/UnliftedNewtypesUnassociatedFamily.hs - testsuite/tests/typecheck/should_compile/UnliftedNewtypesUnifySig.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8087a524c35af0f6fa04e2e1bbc5a0a726c91b72...af3300fb1c9af8d85a6ec07d8fa63e937c7e6ead -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8087a524c35af0f6fa04e2e1bbc5a0a726c91b72...af3300fb1c9af8d85a6ec07d8fa63e937c7e6ead You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 10 04:27:45 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 09 Dec 2020 23:27:45 -0500 Subject: [Git][ghc/ghc][wip/nonmoving-fixes] 51 commits: Hadrian: fix detection of ghc-pkg for cross-compilers Message-ID: <5fd1a3c1f38ac_6b2133294b886644b@gitlab.mail> Ben Gamari pushed to branch wip/nonmoving-fixes at Glasgow Haskell Compiler / GHC Commits: 75fc1ed5 by Sylvain Henry at 2020-11-28T15:40:23-05:00 Hadrian: fix detection of ghc-pkg for cross-compilers - - - - - 7cb5df96 by Sylvain Henry at 2020-11-28T15:40:23-05:00 hadrian: fix ghc-pkg uses (#17601) Make sure ghc-pkg doesn't read the compiler "settings" file by passing --no-user-package-db. - - - - - e3fd4226 by Ben Gamari at 2020-11-28T15:40:23-05:00 gitlab-ci: Introduce a nightly cross-compilation job This adds a job to test cross-compilation from x86-64 to AArch64 with Hadrian. Fixes #18234 - - - - - 698d3d96 by Ben Gamari at 2020-11-28T15:41:00-05:00 gitlab-ci: Only deploy GitLab Pages in ghc/ghc> The deployments are quite large and yet are currently only served for the ghc/ghc> project. - - - - - 625726f9 by David Eichmann at 2020-11-28T15:41:37-05:00 ghc-heap: partial TSO/STACK decoding Co-authored-by: Sven Tennie <sven.tennie at gmail.com> Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> Co-authored-by: Ben Gamari <bgamari.foss at gmail.com> - - - - - 22ea9c29 by Andreas Klebinger at 2020-11-28T15:42:13-05:00 Small optimization to CmmSink. Inside `regsUsedIn` we can avoid some thunks by specializing the recursion. In particular we avoid the thunk for `(f e z)` in the MachOp/Load branches, where we know this will evaluate to z. Reduces allocations for T3294 by ~1%. - - - - - bba42c62 by John Ericson at 2020-11-28T15:42:49-05:00 Make primop handler indentation more consistent - - - - - c82bc8e9 by John Ericson at 2020-11-28T15:42:49-05:00 Cleanup some primop constructor names Harmonize the internal (big sum type) names of the native vs fixed-sized number primops a bit. (Mainly by renaming the former.) No user-facing names are changed. - - - - - ae14f160 by Ben Gamari at 2020-11-28T15:43:25-05:00 testsuite: Mark T14702 as fragile on Windows Due to #18953. - - - - - 1bc104b0 by Ben Gamari at 2020-11-29T15:33:18-05:00 withTimings: Emit allocations counter This will allow us to back out the allocations per compiler pass from the eventlog. Note that we dump the allocation counter rather than the difference since this will allow us to determine how much work is done *between* `withTiming` blocks. - - - - - e992ea84 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 ThreadPaused: Don't zero slop until free vars are pushed When threadPaused blackholes a thunk it calls `OVERWRITING_CLOSURE` to zero the slop for the benefit of the sanity checker. Previously this was done *before* pushing the thunk's free variables to the update remembered set. Consequently we would pull zero'd pointers to the update remembered set. - - - - - e82cd140 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Fix regression from TSAN work The TSAN rework (specifically aad1f803) introduced a subtle regression in GC.c, swapping `g0` in place of `gen`. Whoops! Fixes #18997. - - - - - 35a5207e by GHC GitLab CI at 2020-11-29T15:33:54-05:00 rts/Messages: Add missing write barrier in THROWTO message update After a THROWTO message has been handle the message closure is overwritten by a NULL message. We must ensure that the original closure's pointers continue to be visible to the nonmoving GC. - - - - - 0120829f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Add missing write barrier in shrinkSmallByteArray - - - - - 8a4d8fb6 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 Updates: Don't zero slop until closure has been pushed Ensure that the the free variables have been pushed to the update remembered set before we zero the slop. - - - - - 2793cfdc by GHC GitLab CI at 2020-11-29T15:33:54-05:00 OSThreads: Fix error code checking pthread_join returns its error code and apparently doesn't set errno. - - - - - e391a16f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Don't join to mark_thread on shutdown The mark thread is not joinable as we detach from it on creation. - - - - - 60d088ab by Ben Gamari at 2020-11-29T15:33:54-05:00 nonmoving: Add reference to Ueno 2016 - - - - - 3aa60362 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Ensure that evacuated large objects are marked See Note [Non-moving GC: Marking evacuated objects]. - - - - - 8d304a99 by Ben Gamari at 2020-11-30T10:15:22-05:00 rts/m32: Refactor handling of allocator seeding Previously, in an attempt to reduce fragmentation, each new allocator would map a region of M32_MAX_PAGES fresh pages to seed itself. However, this ends up being extremely wasteful since it turns out that we often use fewer than this. Consequently, these pages end up getting freed which, ends up fragmenting our address space more than than we would have if we had naively allocated pages on-demand. Here we refactor m32 to avoid this waste while achieving the fragmentation mitigation previously desired. In particular, we move all page allocation into the global m32_alloc_page, which will pull a page from the free page pool. If the free page pool is empty we then refill it by allocating a region of M32_MAP_PAGES and adding them to the pool. Furthermore, we do away with the initial seeding entirely. That is, the allocator starts with no active pages: pages are rather allocated on an as-needed basis. On the whole this ends up being a pleasingly simple change, simultaneously making m32 more efficient, more robust, and simpler. Fixes #18980. - - - - - b6629289 by Ben Gamari at 2020-11-30T10:15:58-05:00 rts: Use CHECK instead of assert Use the GHC wrappers instead of <assert.h>. - - - - - 9f4efa6a by Ben Gamari at 2020-11-30T10:15:58-05:00 rts/linker: Replace some ASSERTs with CHECK In the past some people have confused ASSERT, which is for checking internal invariants, which CHECK, which should be used when checking things that might fail due to bad input (and therefore should be enabled even in the release compiler). Change some of these cases in the linker to use CHECK. - - - - - 0f8a4655 by Ryan Scott at 2020-11-30T10:16:34-05:00 Allow deploy:pages job to fail See #18973. - - - - - 49ebe369 by chessai at 2020-11-30T19:47:40-05:00 Optimisations in Data.Foldable (T17867) This PR concerns the following functions from `Data.Foldable`: * minimum * maximum * sum * product * minimumBy * maximumBy - Default implementations of these functions now use `foldl'` or `foldMap'`. - All have been marked with INLINEABLE to make room for further optimisations. - - - - - 4d79ef65 by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - 6af074ce by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - ab334262 by Viktor Dukhovni at 2020-11-30T19:48:17-05:00 dirty MVAR after mutating TSO queue head While the original head and tail of the TSO queue may be in the same generation as the MVAR, interior elements of the queue could be younger after a GC run and may then be exposed by putMVar operation that updates the queue head. Resolves #18919 - - - - - 5eb163f3 by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Don't allow shared libraries to be loaded multiple times - - - - - 490aa14d by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Initialise CCSs from native shared objects - - - - - 6ac3db5f by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Move shared library loading logic into Elf.c - - - - - b6698d73 by GHC GitLab CI at 2020-11-30T19:48:53-05:00 rts/linker: Don't declare dynamic objects with image_mapped This previously resulted in warnings due to spurious unmap failures. - - - - - b94a65af by jneira at 2020-11-30T19:49:31-05:00 Include tried paths in findToolDir error - - - - - 72a87fbc by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Move core flattening algorithm to Core.Unify This sets the stage for a later change, where this algorithm will be needed from GHC.Core.InstEnv. This commit also splits GHC.Core.Map into GHC.Core.Map.Type and GHC.Core.Map.Expr, in order to avoid module import cycles with GHC.Core. - - - - - 0dd45d0a by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Bump the # of commits searched for perf baseline The previous value of 75 meant that a feature branch with more than 75 commits would get spurious CI passes. This affects #18692, but does not fix that ticket, because if a baseline cannot be found, we should fail, not succeed. - - - - - 8bb52d91 by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Remove flattening variables This patch redesigns the flattener to simplify type family applications directly instead of using flattening meta-variables and skolems. The key new innovation is the CanEqLHS type and the new CEqCan constraint (Ct). A CanEqLHS is either a type variable or exactly-saturated type family application; either can now be rewritten using a CEqCan constraint in the inert set. Because the flattener no longer reduces all type family applications to variables, there was some performance degradation if a lengthy type family application is now flattened over and over (not making progress). To compensate, this patch contains some extra optimizations in the flattener, leading to a number of performance improvements. Close #18875. Close #18910. There are many extra parts of the compiler that had to be affected in writing this patch: * The family-application cache (formerly the flat-cache) sometimes stores coercions built from Given inerts. When these inerts get kicked out, we must kick out from the cache as well. (This was, I believe, true previously, but somehow never caused trouble.) Kicking out from the cache requires adding a filterTM function to TrieMap. * This patch obviates the need to distinguish "blocking" coercion holes from non-blocking ones (which, previously, arose from CFunEqCans). There is thus some simplification around coercion holes. * Extra commentary throughout parts of the code I read through, to preserve the knowledge I gained while working. * A change in the pure unifier around unifying skolems with other types. Unifying a skolem now leads to SurelyApart, not MaybeApart, as documented in Note [Binding when looking up instances] in GHC.Core.InstEnv. * Some more use of MCoercion where appropriate. * Previously, class-instance lookup automatically noticed that e.g. C Int was a "unifier" to a target [W] C (F Bool), because the F Bool was flattened to a variable. Now, a little more care must be taken around checking for unifying instances. * Previously, tcSplitTyConApp_maybe would split (Eq a => a). This is silly, because (=>) is not a tycon in Haskell. Fixed now, but there are some knock-on changes in e.g. TrieMap code and in the canonicaliser. * New function anyFreeVarsOf{Type,Co} to check whether a free variable satisfies a certain predicate. * Type synonyms now remember whether or not they are "forgetful"; a forgetful synonym drops at least one argument. This is useful when flattening; see flattenView. * The pattern-match completeness checker invokes the solver. This invocation might need to look through newtypes when checking representational equality. Thus, the desugarer needs to keep track of the in-scope variables to know what newtype constructors are in scope. I bet this bug was around before but never noticed. * Extra-constraints wildcards are no longer simplified before printing. See Note [Do not simplify ConstraintHoles] in GHC.Tc.Solver. * Whether or not there are Given equalities has become slightly subtler. See the new HasGivenEqs datatype. * Note [Type variable cycles in Givens] in GHC.Tc.Solver.Canonical explains a significant new wrinkle in the new approach. * See Note [What might match later?] in GHC.Tc.Solver.Interact, which explains the fix to #18910. * The inert_count field of InertCans wasn't actually used, so I removed it. Though I (Richard) did the implementation, Simon PJ was very involved in design and review. This updates the Haddock submodule to avoid #18932 by adding a type signature. ------------------------- Metric Decrease: T12227 T5030 T9872a T9872b T9872c Metric Increase: T9872d ------------------------- - - - - - d66660ba by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Rename the flattener to become the rewriter. Now that flattening doesn't produce flattening variables, it's not really flattening anything: it's rewriting. This change also means that the rewriter can no longer be confused the core flattener (in GHC.Core.Unify), which is sometimes used during type-checking. - - - - - add0aeae by Ben Gamari at 2020-12-01T19:58:17-05:00 rts: Introduce mmapAnonForLinker Previously most of the uses of mmapForLinker were mapping anonymous memory, resulting in a great deal of unnecessary repetition. Factor this out into a new helper. Also fixes a few places where error checking was missing or suboptimal. - - - - - 97d71646 by Ben Gamari at 2020-12-01T19:58:17-05:00 rts/linker: Introduce munmapForLinker Consolidates munmap calls to ensure consistent error handling. - - - - - d8872af0 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/Linker: Introduce Windows implementations for mmapForLinker, et al. - - - - - c35d0e03 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/m32: Introduce NEEDS_M32 macro Instead of relying on RTS_LINKER_USE_MMAP - - - - - 41c64eb5 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/linker: Use m32 to allocate symbol extras in PEi386 - - - - - e0b08c5f by Ben Gamari at 2020-12-03T13:01:47-05:00 gitlab-ci: Fix copy-paste error Also be more consistent in quoting. - - - - - 33ec3a06 by Ben Gamari at 2020-12-03T23:11:31-05:00 gitlab-ci: Run linters through ci.sh Ensuring that the right toolchain is used. - - - - - 4a437bc1 by Shayne Fletcher at 2020-12-05T09:06:38-05:00 Fix bad span calculations of post qualified imports - - - - - 8fac4b93 by Ben Gamari at 2020-12-05T09:07:13-05:00 testsuite: Add a test for #18923 - - - - - 62ed6957 by Simon Peyton Jones at 2020-12-08T15:31:41-05:00 Fix kind inference for data types. Again. This patch fixes several aspects of kind inference for data type declarations, especially data /instance/ declarations Specifically 1. In kcConDecls/kcConDecl make it clear that the tc_res_kind argument is only used in the H98 case; and in that case there is no result kind signature; and hence no need for the disgusting splitPiTys in kcConDecls (now thankfully gone). The GADT case is a bit different to before, and much nicer. This is what fixes #18891. See Note [kcConDecls: kind-checking data type decls] 2. Do not look at the constructor decls of a data/newtype instance in tcDataFamInstanceHeader. See GHC.Tc.TyCl.Instance Note [Kind inference for data family instances]. This was a new realisation that arose when doing (1) This causes a few knock-on effects in the tests suite, because we require more information than before in the instance /header/. New user-manual material about this in "Kind inference in data type declarations" and "Kind inference for data/newtype instance declarations". 3. Minor improvement in kcTyClDecl, combining GADT and H98 cases 4. Fix #14111 and #8707 by allowing the header of a data instance to affect kind inferece for the the data constructor signatures; as described at length in Note [GADT return types] in GHC.Tc.TyCl This led to a modest refactoring of the arguments (and argument order) of tcConDecl/tcConDecls. 5. Fix #19000 by inverting the sense of the test in new_locs in GHC.Tc.Solver.Canonical.canDecomposableTyConAppOK. - - - - - 0abe3ddf by Adam Sandberg Ericsson at 2020-12-08T15:32:19-05:00 hadrian: build the _l and _thr_l rts flavours in the develN flavours The ghc binary requires the eventlog rts since fc644b1a643128041cfec25db84e417851e28bab - - - - - a8a80e05 by Ben Gamari at 2020-12-09T19:25:41-05:00 users guide: Fix syntax errors Fixes errors introduced by 3a55b3a2574f913d046f3a6f82db48d7f6df32e3. - - - - - af3300fb by Ben Gamari at 2020-12-09T19:25:41-05:00 users guide: Describe GC lifecycle events Every time I am asked about how to interpret these events I need to figure it out from scratch. It's well past time that the users guide properly documents these. - - - - - c57baeb7 by Ben Gamari at 2020-12-09T23:25:30-05:00 nonmoving: Fix small CPP bug Previously an incorrect semicolon meant that we would fail to call busy_wait_nop when spinning. - - - - - 82b6b3a6 by Ben Gamari at 2020-12-09T23:25:30-05:00 nonmoving: Don't push objects during deadlock detect GC Previously we would push large objects and compact regions to the mark queue during the deadlock detect GC, resulting in failure to detect deadlocks. - - - - - 28 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Axiom.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FamInstEnv.hs - compiler/GHC/Core/InstEnv.hs - + compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Map.hs → compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/Opt/CSE.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/TyCon/Env.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/Maybe.hs - compiler/GHC/Data/TrieMap.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b416189e4004506b89f06f147be37e76f4cd507f...82b6b3a6d41cc02ba6232e53ee7e9cd00f5a2a82 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b416189e4004506b89f06f147be37e76f4cd507f...82b6b3a6d41cc02ba6232e53ee7e9cd00f5a2a82 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 10 04:29:10 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 09 Dec 2020 23:29:10 -0500 Subject: [Git][ghc/ghc][wip/nonmoving-fixes] 2 commits: nonmoving: Fix small CPP bug Message-ID: <5fd1a416c6722_6b213272ce0866877@gitlab.mail> Ben Gamari pushed to branch wip/nonmoving-fixes at Glasgow Haskell Compiler / GHC Commits: cc9c6b5b by Ben Gamari at 2020-12-09T23:29:00-05:00 nonmoving: Fix small CPP bug Previously an incorrect semicolon meant that we would fail to call busy_wait_nop when spinning. - - - - - 62265eb3 by Ben Gamari at 2020-12-09T23:29:00-05:00 nonmoving: Don't push objects during deadlock detect GC Previously we would push large objects and compact regions to the mark queue during the deadlock detect GC, resulting in failure to detect deadlocks. - - - - - 2 changed files: - rts/sm/Evac.c - rts/sm/NonMovingMark.c Changes: ===================================== rts/sm/Evac.c ===================================== @@ -406,7 +406,9 @@ evacuate_large(StgPtr p) __atomic_fetch_or(&bd->flags, BF_NONMOVING, __ATOMIC_ACQ_REL); // See Note [Non-moving GC: Marking evacuated objects]. - markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, (StgClosure *) p); + if (major_gc && !deadlock_detect_gc) { + markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, (StgClosure *) p); + } } initBdescr(bd, new_gen, new_gen->to); @@ -563,7 +565,9 @@ evacuate_compact (StgPtr p) __atomic_fetch_or(&bd->flags, BF_NONMOVING, __ATOMIC_RELAXED); // See Note [Non-moving GC: Marking evacuated objects]. - markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, (StgClosure *) str); + if (major_gc && !deadlock_detect_gc) { + markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, (StgClosure *) str); + } } initBdescr(bd, new_gen, new_gen->to); ===================================== rts/sm/NonMovingMark.c ===================================== @@ -737,9 +737,11 @@ void updateRemembSetPushStack(Capability *cap, StgStack *stack) // The concurrent GC has claimed the right to mark the stack. // Wait until it finishes marking before proceeding with // mutation. - while (needs_upd_rem_set_mark((StgClosure *) stack)); + while (needs_upd_rem_set_mark((StgClosure *) stack)) #if defined(PARALLEL_GC) busy_wait_nop(); // TODO: Spinning here is unfortunate +#else + ; #endif return; } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/82b6b3a6d41cc02ba6232e53ee7e9cd00f5a2a82...62265eb38a56eebc24401b43895a9fe65f545d0f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/82b6b3a6d41cc02ba6232e53ee7e9cd00f5a2a82...62265eb38a56eebc24401b43895a9fe65f545d0f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 10 04:36:29 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 09 Dec 2020 23:36:29 -0500 Subject: [Git][ghc/ghc][wip/nonmoving-fixes] 12 commits: CodeGen: Make folds User/DefinerOfRegs INLINEABLE. Message-ID: <5fd1a5cd42626_6b2133294b8867043@gitlab.mail> Ben Gamari pushed to branch wip/nonmoving-fixes at Glasgow Haskell Compiler / GHC Commits: 51e3bb6d by Andreas Klebinger at 2020-12-08T22:43:21-05:00 CodeGen: Make folds User/DefinerOfRegs INLINEABLE. Reduces allocation for the test case I was looking at by about 1.2%. Mostly from avoiding allocation of some folding functions which turn into let-no-escape bindings which just reuse their environment instead. We also force inlining in a few key places in CmmSink which helps a bit more. - - - - - 69ae10c3 by Andreas Klebinger at 2020-12-08T22:43:21-05:00 CmmSink: Force inlining of foldRegsDefd Helps avoid allocating the folding function. Improves perf for T3294 by about 1%. - - - - - 6e3da800 by Andreas Klebinger at 2020-12-08T22:43:21-05:00 Cmm: Make a few types and utility function slightly stricter. About 0.6% reduction in allocations for the code I was looking at. Not a huge difference but no need to throw away performance. - - - - - aef44d7f by Andreas Klebinger at 2020-12-08T22:43:21-05:00 Cmm.Sink: Optimize retaining of assignments, live sets. Sinking requires us to track live local regs after each cmm statement. We used to do this via "Set LocalReg". However we can replace this with a solution based on IntSet which is overall more efficient without losing much. The thing we lose is width of the variables, which isn't used by the sinking pass anyway. I also reworked how we keep assignments to regs mentioned in skipped assignments. I put the details into Note [Keeping assignemnts mentioned in skipped RHSs]. The gist of it is instead of keeping track of it via the use count which is a `IntMap Int` we now use the live regs set (IntSet) which is quite a bit faster. I think it also matches the semantics a lot better. The skipped (not discarded) assignment does in fact keep the regs on it's rhs alive so keeping track of this in the live set seems like the clearer solution as well. Improves allocations for T3294 by yet another 1%. - - - - - 59f2249b by Andreas Klebinger at 2020-12-08T22:43:21-05:00 GHC.Cmm.Opt: Be stricter in results. Optimization either returns Nothing if nothing is to be done or `Just <cmmExpr>` otherwise. There is no point in being lazy in `cmmExpr`. We usually inspect this element so the thunk gets forced not long after. We might eliminate it as dead code once in a blue moon but that's not a case worth optimizing for. Overall the impact of this is rather low. As Cmm.Opt doesn't allocate much (compared to the rest of GHC) to begin with. - - - - - 54b88eac by Andreas Klebinger at 2020-12-08T22:43:57-05:00 Bump time submodule. This should fix #19002. - - - - - efed364c by Ben Gamari at 2020-12-10T04:35:12+00:00 nonmoving: Fix small CPP bug Previously an incorrect semicolon meant that we would fail to call busy_wait_nop when spinning. - - - - - 5ebffe27 by GHC GitLab CI at 2020-12-10T04:35:12+00:00 nonmoving: Assert deadlock-gc promotion invariant When performing a deadlock-detection GC we must ensure that all objects end up in the non-moving generation. Assert this in scavenge. - - - - - e0b09393 by GHC GitLab CI at 2020-12-10T04:35:12+00:00 nonmoving: Ensure deadlock detection promotion works Previously the deadlock-detection promotion logic in alloc_for_copy was just plain wrong: it failed to fire when gct->evac_gen_no != oldest_gen->gen_no. The fix is simple: move the - - - - - 36b05a16 by GHC GitLab CI at 2020-12-10T04:35:12+00:00 nonmoving: Refactor alloc_for_copy Pull the cold non-moving allocation path out of alloc_for_copy. - - - - - 31e56294 by Ben Gamari at 2020-12-10T04:35:12+00:00 nonmoving: Don't push objects during deadlock detect GC Previously we would push large objects and compact regions to the mark queue during the deadlock detect GC, resulting in failure to detect deadlocks. - - - - - 5cc21366 by GHC GitLab CI at 2020-12-10T04:35:12+00:00 nonmoving: Add comments to nonmovingResurrectThreads - - - - - 13 changed files: - compiler/GHC/Cmm/Expr.hs - + compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Liveness.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/Utils/Outputable.hs - compiler/ghc.cabal.in - libraries/time - rts/sm/Evac.c - rts/sm/NonMovingMark.c - rts/sm/Scav.c Changes: ===================================== compiler/GHC/Cmm/Expr.hs ===================================== @@ -53,14 +53,14 @@ import GHC.Types.Basic (Alignment, mkAlignment, alignmentOf) ----------------------------------------------------------------------------- data CmmExpr - = CmmLit CmmLit -- Literal + = CmmLit !CmmLit -- Literal | CmmLoad !CmmExpr !CmmType -- Read memory location | CmmReg !CmmReg -- Contents of register | CmmMachOp MachOp [CmmExpr] -- Machine operation (+, -, *, etc.) | CmmStackSlot Area {-# UNPACK #-} !Int -- addressing expression of a stack slot -- See Note [CmmStackSlot aliasing] - | CmmRegOff !CmmReg Int + | CmmRegOff !CmmReg !Int -- CmmRegOff reg i -- ** is shorthand only, meaning ** -- CmmMachOp (MO_Add rep) [x, CmmLit (CmmInt (fromIntegral i) rep)] @@ -173,16 +173,16 @@ Now, the assignments of y go away, -} data CmmLit - = CmmInt !Integer Width + = CmmInt !Integer !Width -- Interpretation: the 2's complement representation of the value -- is truncated to the specified size. This is easier than trying -- to keep the value within range, because we don't know whether -- it will be used as a signed or unsigned value (the CmmType doesn't -- distinguish between signed & unsigned). - | CmmFloat Rational Width + | CmmFloat Rational !Width | CmmVec [CmmLit] -- Vector literal | CmmLabel CLabel -- Address of label - | CmmLabelOff CLabel Int -- Address of label + byte offset + | CmmLabelOff CLabel !Int -- Address of label + byte offset -- Due to limitations in the C backend, the following -- MUST ONLY be used inside the info table indicated by label2 @@ -191,7 +191,7 @@ data CmmLit -- Don't use it at all unless tablesNextToCode. -- It is also used inside the NCG during when generating -- position-independent code. - | CmmLabelDiffOff CLabel CLabel Int Width -- label1 - label2 + offset + | CmmLabelDiffOff CLabel CLabel !Int !Width -- label1 - label2 + offset -- In an expression, the width just has the effect of MO_SS_Conv -- from wordWidth to the desired width. -- @@ -363,6 +363,7 @@ instance DefinerOfRegs LocalReg CmmReg where foldRegsDefd _ _ z (CmmGlobal _) = z instance UserOfRegs GlobalReg CmmReg where + {-# INLINEABLE foldRegsUsed #-} foldRegsUsed _ _ z (CmmLocal _) = z foldRegsUsed _ f z (CmmGlobal reg) = f z reg @@ -379,6 +380,7 @@ instance Ord r => DefinerOfRegs r r where instance (Ord r, UserOfRegs r CmmReg) => UserOfRegs r CmmExpr where -- The (Ord r) in the context is necessary here -- See Note [Recursive superclasses] in GHC.Tc.TyCl.Instance + {-# INLINEABLE foldRegsUsed #-} foldRegsUsed platform f !z e = expr z e where expr z (CmmLit _) = z expr z (CmmLoad addr _) = foldRegsUsed platform f z addr ===================================== compiler/GHC/Cmm/LRegSet.hs ===================================== @@ -0,0 +1,53 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module GHC.Cmm.LRegSet ( + LRegSet, + LRegKey, + + emptyLRegSet, + nullLRegSet, + insertLRegSet, + elemLRegSet, + + deleteFromLRegSet, + sizeLRegSet, + + plusLRegSet, + elemsLRegSet + ) where + +import GHC.Prelude +import GHC.Types.Unique +import GHC.Cmm.Expr + +import Data.IntSet as IntSet + +-- Compact sets for membership tests of local variables. + +type LRegSet = IntSet.IntSet +type LRegKey = Int + +emptyLRegSet :: LRegSet +emptyLRegSet = IntSet.empty + +nullLRegSet :: LRegSet -> Bool +nullLRegSet = IntSet.null + +insertLRegSet :: LocalReg -> LRegSet -> LRegSet +insertLRegSet l = IntSet.insert (getKey (getUnique l)) + +elemLRegSet :: LocalReg -> LRegSet -> Bool +elemLRegSet l = IntSet.member (getKey (getUnique l)) + +deleteFromLRegSet :: LRegSet -> LocalReg -> LRegSet +deleteFromLRegSet set reg = IntSet.delete (getKey . getUnique $ reg) set + +sizeLRegSet :: IntSet -> Int +sizeLRegSet = IntSet.size + +plusLRegSet :: IntSet -> IntSet -> IntSet +plusLRegSet = IntSet.union + +elemsLRegSet :: IntSet -> [Int] +elemsLRegSet = IntSet.toList ===================================== compiler/GHC/Cmm/Liveness.hs ===================================== @@ -6,9 +6,12 @@ module GHC.Cmm.Liveness ( CmmLocalLive , cmmLocalLiveness + , cmmLocalLivenessL , cmmGlobalLiveness , liveLattice + , liveLatticeL , gen_kill + , gen_killL ) where @@ -22,11 +25,14 @@ import GHC.Cmm.Dataflow.Block import GHC.Cmm.Dataflow.Collections import GHC.Cmm.Dataflow import GHC.Cmm.Dataflow.Label +import GHC.Cmm.LRegSet import GHC.Data.Maybe import GHC.Utils.Outputable import GHC.Utils.Panic +import GHC.Types.Unique + ----------------------------------------------------------------------------- -- Calculating what variables are live on entry to a basic block ----------------------------------------------------------------------------- @@ -92,3 +98,66 @@ xferLive platform (BlockCC eNode middle xNode) fBase = in mapSingleton (entryLabel eNode) result {-# SPECIALIZE xferLive :: Platform -> TransferFun (CmmLive LocalReg) #-} {-# SPECIALIZE xferLive :: Platform -> TransferFun (CmmLive GlobalReg) #-} + +----------------------------------------------------------------------------- +-- | Specialization that only retains the keys for local variables. +-- +-- Local variablas are mostly glorified Ints, and some parts of the compiler +-- really don't care about anything but the Int part. So we can avoid some +-- overhead by computing a IntSet instead of a Set LocalReg which (unsurprisingly) +-- is quite a bit faster. +----------------------------------------------------------------------------- + +type BlockEntryLivenessL = LabelMap LRegSet + +-- | The dataflow lattice +liveLatticeL :: DataflowLattice LRegSet +liveLatticeL = DataflowLattice emptyLRegSet add + where + add (OldFact old) (NewFact new) = + let !join = plusLRegSet old new + in changedIf (sizeLRegSet join > sizeLRegSet old) join + + +cmmLocalLivenessL :: Platform -> CmmGraph -> BlockEntryLivenessL +cmmLocalLivenessL platform graph = + check $ analyzeCmmBwd liveLatticeL (xferLiveL platform) graph mapEmpty + where + entry = g_entry graph + check facts = + noLiveOnEntryL entry (expectJust "check" $ mapLookup entry facts) facts + +-- | On entry to the procedure, there had better not be any LocalReg's live-in. +noLiveOnEntryL :: BlockId -> LRegSet -> a -> a +noLiveOnEntryL bid in_fact x = + if nullLRegSet in_fact then x + else pprPanic "LocalReg's live-in to graph" (ppr bid <+> ppr reg_uniques) + where + -- We convert the int's to uniques so that the printing matches that + -- of registers. + reg_uniques = map mkUniqueGrimily $ elemsLRegSet in_fact + + + + +gen_killL + :: (DefinerOfRegs LocalReg n, UserOfRegs LocalReg n) + => Platform -> n -> LRegSet -> LRegSet +gen_killL platform node set = + let !afterKill = foldRegsDefd platform deleteFromLRegSet set node + in foldRegsUsed platform (flip insertLRegSet) afterKill node +{-# INLINE gen_killL #-} + +xferLiveL + :: ( UserOfRegs LocalReg (CmmNode O O) + , DefinerOfRegs LocalReg (CmmNode O O) + , UserOfRegs LocalReg (CmmNode O C) + , DefinerOfRegs LocalReg (CmmNode O C) + ) + => Platform -> TransferFun LRegSet +xferLiveL platform (BlockCC eNode middle xNode) fBase = + let joined = gen_killL platform xNode $! joinOutFacts liveLatticeL xNode fBase + !result = foldNodesBwdOO (gen_killL platform) middle joined + in mapSingleton (entryLabel eNode) result + + ===================================== compiler/GHC/Cmm/Node.hs ===================================== @@ -318,6 +318,7 @@ foreignTargetHints target -- Instances of register and slot users / definers instance UserOfRegs LocalReg (CmmNode e x) where + {-# INLINEABLE foldRegsUsed #-} foldRegsUsed platform f !z n = case n of CmmAssign _ expr -> fold f z expr CmmStore addr rval -> fold f (fold f z addr) rval @@ -332,6 +333,7 @@ instance UserOfRegs LocalReg (CmmNode e x) where fold f z n = foldRegsUsed platform f z n instance UserOfRegs GlobalReg (CmmNode e x) where + {-# INLINEABLE foldRegsUsed #-} foldRegsUsed platform f !z n = case n of CmmAssign _ expr -> fold f z expr CmmStore addr rval -> fold f (fold f z addr) rval @@ -348,10 +350,12 @@ instance UserOfRegs GlobalReg (CmmNode e x) where instance (Ord r, UserOfRegs r CmmReg) => UserOfRegs r ForeignTarget where -- The (Ord r) in the context is necessary here -- See Note [Recursive superclasses] in GHC.Tc.TyCl.Instance + {-# INLINEABLE foldRegsUsed #-} foldRegsUsed _ _ !z (PrimTarget _) = z foldRegsUsed platform f !z (ForeignTarget e _) = foldRegsUsed platform f z e instance DefinerOfRegs LocalReg (CmmNode e x) where + {-# INLINEABLE foldRegsDefd #-} foldRegsDefd platform f !z n = case n of CmmAssign lhs _ -> fold f z lhs CmmUnsafeForeignCall _ fs _ -> fold f z fs @@ -362,6 +366,7 @@ instance DefinerOfRegs LocalReg (CmmNode e x) where fold f z n = foldRegsDefd platform f z n instance DefinerOfRegs GlobalReg (CmmNode e x) where + {-# INLINEABLE foldRegsDefd #-} foldRegsDefd platform f !z n = case n of CmmAssign lhs _ -> fold f z lhs CmmUnsafeForeignCall tgt _ _ -> fold f z (foreignTargetRegs tgt) ===================================== compiler/GHC/Cmm/Opt.hs ===================================== @@ -58,7 +58,7 @@ cmmMachOpFoldM -> Maybe CmmExpr cmmMachOpFoldM _ op [CmmLit (CmmInt x rep)] - = Just $ case op of + = Just $! case op of MO_S_Neg _ -> CmmLit (CmmInt (-x) rep) MO_Not _ -> CmmLit (CmmInt (complement x) rep) @@ -90,13 +90,13 @@ cmmMachOpFoldM platform conv_outer [CmmMachOp conv_inner [x]] -- but remember to use the signedness from the widening, just in case -- the final conversion is a widen. | rep1 < rep2 && rep2 > rep3 -> - Just $ cmmMachOpFold platform (intconv signed1 rep1 rep3) [x] + Just $! cmmMachOpFold platform (intconv signed1 rep1 rep3) [x] -- Nested widenings: collapse if the signedness is the same | rep1 < rep2 && rep2 < rep3 && signed1 == signed2 -> - Just $ cmmMachOpFold platform (intconv signed1 rep1 rep3) [x] + Just $! cmmMachOpFold platform (intconv signed1 rep1 rep3) [x] -- Nested narrowings: collapse | rep1 > rep2 && rep2 > rep3 -> - Just $ cmmMachOpFold platform (MO_UU_Conv rep1 rep3) [x] + Just $! cmmMachOpFold platform (MO_UU_Conv rep1 rep3) [x] | otherwise -> Nothing where @@ -117,34 +117,34 @@ cmmMachOpFoldM platform mop [CmmLit (CmmInt x xrep), CmmLit (CmmInt y _)] = case mop of -- for comparisons: don't forget to narrow the arguments before -- comparing, since they might be out of range. - MO_Eq _ -> Just $ CmmLit (CmmInt (if x_u == y_u then 1 else 0) (wordWidth platform)) - MO_Ne _ -> Just $ CmmLit (CmmInt (if x_u /= y_u then 1 else 0) (wordWidth platform)) - - MO_U_Gt _ -> Just $ CmmLit (CmmInt (if x_u > y_u then 1 else 0) (wordWidth platform)) - MO_U_Ge _ -> Just $ CmmLit (CmmInt (if x_u >= y_u then 1 else 0) (wordWidth platform)) - MO_U_Lt _ -> Just $ CmmLit (CmmInt (if x_u < y_u then 1 else 0) (wordWidth platform)) - MO_U_Le _ -> Just $ CmmLit (CmmInt (if x_u <= y_u then 1 else 0) (wordWidth platform)) - - MO_S_Gt _ -> Just $ CmmLit (CmmInt (if x_s > y_s then 1 else 0) (wordWidth platform)) - MO_S_Ge _ -> Just $ CmmLit (CmmInt (if x_s >= y_s then 1 else 0) (wordWidth platform)) - MO_S_Lt _ -> Just $ CmmLit (CmmInt (if x_s < y_s then 1 else 0) (wordWidth platform)) - MO_S_Le _ -> Just $ CmmLit (CmmInt (if x_s <= y_s then 1 else 0) (wordWidth platform)) - - MO_Add r -> Just $ CmmLit (CmmInt (x + y) r) - MO_Sub r -> Just $ CmmLit (CmmInt (x - y) r) - MO_Mul r -> Just $ CmmLit (CmmInt (x * y) r) - MO_U_Quot r | y /= 0 -> Just $ CmmLit (CmmInt (x_u `quot` y_u) r) - MO_U_Rem r | y /= 0 -> Just $ CmmLit (CmmInt (x_u `rem` y_u) r) - MO_S_Quot r | y /= 0 -> Just $ CmmLit (CmmInt (x `quot` y) r) - MO_S_Rem r | y /= 0 -> Just $ CmmLit (CmmInt (x `rem` y) r) - - MO_And r -> Just $ CmmLit (CmmInt (x .&. y) r) - MO_Or r -> Just $ CmmLit (CmmInt (x .|. y) r) - MO_Xor r -> Just $ CmmLit (CmmInt (x `xor` y) r) - - MO_Shl r -> Just $ CmmLit (CmmInt (x `shiftL` fromIntegral y) r) - MO_U_Shr r -> Just $ CmmLit (CmmInt (x_u `shiftR` fromIntegral y) r) - MO_S_Shr r -> Just $ CmmLit (CmmInt (x `shiftR` fromIntegral y) r) + MO_Eq _ -> Just $! CmmLit (CmmInt (if x_u == y_u then 1 else 0) (wordWidth platform)) + MO_Ne _ -> Just $! CmmLit (CmmInt (if x_u /= y_u then 1 else 0) (wordWidth platform)) + + MO_U_Gt _ -> Just $! CmmLit (CmmInt (if x_u > y_u then 1 else 0) (wordWidth platform)) + MO_U_Ge _ -> Just $! CmmLit (CmmInt (if x_u >= y_u then 1 else 0) (wordWidth platform)) + MO_U_Lt _ -> Just $! CmmLit (CmmInt (if x_u < y_u then 1 else 0) (wordWidth platform)) + MO_U_Le _ -> Just $! CmmLit (CmmInt (if x_u <= y_u then 1 else 0) (wordWidth platform)) + + MO_S_Gt _ -> Just $! CmmLit (CmmInt (if x_s > y_s then 1 else 0) (wordWidth platform)) + MO_S_Ge _ -> Just $! CmmLit (CmmInt (if x_s >= y_s then 1 else 0) (wordWidth platform)) + MO_S_Lt _ -> Just $! CmmLit (CmmInt (if x_s < y_s then 1 else 0) (wordWidth platform)) + MO_S_Le _ -> Just $! CmmLit (CmmInt (if x_s <= y_s then 1 else 0) (wordWidth platform)) + + MO_Add r -> Just $! CmmLit (CmmInt (x + y) r) + MO_Sub r -> Just $! CmmLit (CmmInt (x - y) r) + MO_Mul r -> Just $! CmmLit (CmmInt (x * y) r) + MO_U_Quot r | y /= 0 -> Just $! CmmLit (CmmInt (x_u `quot` y_u) r) + MO_U_Rem r | y /= 0 -> Just $! CmmLit (CmmInt (x_u `rem` y_u) r) + MO_S_Quot r | y /= 0 -> Just $! CmmLit (CmmInt (x `quot` y) r) + MO_S_Rem r | y /= 0 -> Just $! CmmLit (CmmInt (x `rem` y) r) + + MO_And r -> Just $! CmmLit (CmmInt (x .&. y) r) + MO_Or r -> Just $! CmmLit (CmmInt (x .|. y) r) + MO_Xor r -> Just $! CmmLit (CmmInt (x `xor` y) r) + + MO_Shl r -> Just $! CmmLit (CmmInt (x `shiftL` fromIntegral y) r) + MO_U_Shr r -> Just $! CmmLit (CmmInt (x_u `shiftR` fromIntegral y) r) + MO_S_Shr r -> Just $! CmmLit (CmmInt (x `shiftR` fromIntegral y) r) _ -> Nothing @@ -162,7 +162,7 @@ cmmMachOpFoldM platform mop [CmmLit (CmmInt x xrep), CmmLit (CmmInt y _)] cmmMachOpFoldM platform op [x@(CmmLit _), y] | not (isLit y) && isCommutableMachOp op - = Just (cmmMachOpFold platform op [y, x]) + = Just $! (cmmMachOpFold platform op [y, x]) -- Turn (a+b)+c into a+(b+c) where possible. Because literals are -- moved to the right, it is more likely that we will find @@ -183,7 +183,7 @@ cmmMachOpFoldM platform op [x@(CmmLit _), y] cmmMachOpFoldM platform mop1 [CmmMachOp mop2 [arg1,arg2], arg3] | mop2 `associates_with` mop1 && not (isLit arg1) && not (isPicReg arg1) - = Just (cmmMachOpFold platform mop2 [arg1, cmmMachOpFold platform mop1 [arg2,arg3]]) + = Just $! (cmmMachOpFold platform mop2 [arg1, cmmMachOpFold platform mop1 [arg2,arg3]]) where MO_Add{} `associates_with` MO_Sub{} = True mop1 `associates_with` mop2 = @@ -192,7 +192,7 @@ cmmMachOpFoldM platform mop1 [CmmMachOp mop2 [arg1,arg2], arg3] -- special case: (a - b) + c ==> a + (c - b) cmmMachOpFoldM platform mop1@(MO_Add{}) [CmmMachOp mop2@(MO_Sub{}) [arg1,arg2], arg3] | not (isLit arg1) && not (isPicReg arg1) - = Just (cmmMachOpFold platform mop1 [arg1, cmmMachOpFold platform mop2 [arg3,arg2]]) + = Just $! (cmmMachOpFold platform mop1 [arg1, cmmMachOpFold platform mop2 [arg3,arg2]]) -- special case: (PicBaseReg + lit) + N ==> PicBaseReg + (lit+N) -- @@ -205,27 +205,27 @@ cmmMachOpFoldM platform mop1@(MO_Add{}) [CmmMachOp mop2@(MO_Sub{}) [arg1,arg2], cmmMachOpFoldM _ MO_Add{} [ CmmMachOp op at MO_Add{} [pic, CmmLit lit] , CmmLit (CmmInt n rep) ] | isPicReg pic - = Just $ CmmMachOp op [pic, CmmLit $ cmmOffsetLit lit off ] + = Just $! CmmMachOp op [pic, CmmLit $ cmmOffsetLit lit off ] where off = fromIntegral (narrowS rep n) -- Make a RegOff if we can cmmMachOpFoldM _ (MO_Add _) [CmmReg reg, CmmLit (CmmInt n rep)] - = Just $ cmmRegOff reg (fromIntegral (narrowS rep n)) + = Just $! cmmRegOff reg (fromIntegral (narrowS rep n)) cmmMachOpFoldM _ (MO_Add _) [CmmRegOff reg off, CmmLit (CmmInt n rep)] - = Just $ cmmRegOff reg (off + fromIntegral (narrowS rep n)) + = Just $! cmmRegOff reg (off + fromIntegral (narrowS rep n)) cmmMachOpFoldM _ (MO_Sub _) [CmmReg reg, CmmLit (CmmInt n rep)] - = Just $ cmmRegOff reg (- fromIntegral (narrowS rep n)) + = Just $! cmmRegOff reg (- fromIntegral (narrowS rep n)) cmmMachOpFoldM _ (MO_Sub _) [CmmRegOff reg off, CmmLit (CmmInt n rep)] - = Just $ cmmRegOff reg (off - fromIntegral (narrowS rep n)) + = Just $! cmmRegOff reg (off - fromIntegral (narrowS rep n)) -- Fold label(+/-)offset into a CmmLit where possible cmmMachOpFoldM _ (MO_Add _) [CmmLit lit, CmmLit (CmmInt i rep)] - = Just $ CmmLit (cmmOffsetLit lit (fromIntegral (narrowU rep i))) + = Just $! CmmLit (cmmOffsetLit lit (fromIntegral (narrowU rep i))) cmmMachOpFoldM _ (MO_Add _) [CmmLit (CmmInt i rep), CmmLit lit] - = Just $ CmmLit (cmmOffsetLit lit (fromIntegral (narrowU rep i))) + = Just $! CmmLit (cmmOffsetLit lit (fromIntegral (narrowU rep i))) cmmMachOpFoldM _ (MO_Sub _) [CmmLit lit, CmmLit (CmmInt i rep)] - = Just $ CmmLit (cmmOffsetLit lit (fromIntegral (negate (narrowU rep i)))) + = Just $! CmmLit (cmmOffsetLit lit (fromIntegral (negate (narrowU rep i)))) -- Comparison of literal with widened operand: perform the comparison @@ -245,7 +245,7 @@ cmmMachOpFoldM platform cmp [CmmMachOp conv [x], CmmLit (CmmInt i _)] -- and the literal fits in the smaller size: i == narrow_fn rep i -- then we can do the comparison at the smaller size - = Just (cmmMachOpFold platform narrow_cmp [x, CmmLit (CmmInt i rep)]) + = Just $! (cmmMachOpFold platform narrow_cmp [x, CmmLit (CmmInt i rep)]) where maybe_conversion (MO_UU_Conv from to) | to > from @@ -320,8 +320,8 @@ cmmMachOpFoldM platform mop [x, (CmmLit (CmmInt 1 rep))] MO_Mul _ -> Just x MO_S_Quot _ -> Just x MO_U_Quot _ -> Just x - MO_S_Rem _ -> Just $ CmmLit (CmmInt 0 rep) - MO_U_Rem _ -> Just $ CmmLit (CmmInt 0 rep) + MO_S_Rem _ -> Just $! CmmLit (CmmInt 0 rep) + MO_U_Rem _ -> Just $! CmmLit (CmmInt 0 rep) -- Comparisons; trickier -- See Note [Comparison operators] @@ -346,18 +346,18 @@ cmmMachOpFoldM platform mop [x, (CmmLit (CmmInt n _))] = case mop of MO_Mul rep | Just p <- exactLog2 n -> - Just (cmmMachOpFold platform (MO_Shl rep) [x, CmmLit (CmmInt p rep)]) + Just $! (cmmMachOpFold platform (MO_Shl rep) [x, CmmLit (CmmInt p rep)]) MO_U_Quot rep | Just p <- exactLog2 n -> - Just (cmmMachOpFold platform (MO_U_Shr rep) [x, CmmLit (CmmInt p rep)]) + Just $! (cmmMachOpFold platform (MO_U_Shr rep) [x, CmmLit (CmmInt p rep)]) MO_U_Rem rep | Just _ <- exactLog2 n -> - Just (cmmMachOpFold platform (MO_And rep) [x, CmmLit (CmmInt (n - 1) rep)]) + Just $! (cmmMachOpFold platform (MO_And rep) [x, CmmLit (CmmInt (n - 1) rep)]) MO_S_Quot rep | Just p <- exactLog2 n, CmmReg _ <- x -> -- We duplicate x in signedQuotRemHelper, hence require -- it is a reg. FIXME: remove this restriction. - Just (cmmMachOpFold platform (MO_S_Shr rep) + Just $! (cmmMachOpFold platform (MO_S_Shr rep) [signedQuotRemHelper rep p, CmmLit (CmmInt p rep)]) MO_S_Rem rep | Just p <- exactLog2 n, @@ -366,7 +366,7 @@ cmmMachOpFoldM platform mop [x, (CmmLit (CmmInt n _))] -- We replace (x `rem` 2^p) by (x - (x `quot` 2^p) * 2^p). -- Moreover, we fuse MO_S_Shr (last operation of MO_S_Quot) -- and MO_S_Shl (multiplication by 2^p) into a single MO_And operation. - Just (cmmMachOpFold platform (MO_Sub rep) + Just $! (cmmMachOpFold platform (MO_Sub rep) [x, cmmMachOpFold platform (MO_And rep) [signedQuotRemHelper rep p, CmmLit (CmmInt (- n) rep)]]) _ -> Nothing ===================================== compiler/GHC/Cmm/Sink.hs ===================================== @@ -1,4 +1,6 @@ {-# LANGUAGE GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} + module GHC.Cmm.Sink ( cmmSink ) where @@ -8,6 +10,7 @@ import GHC.Prelude import GHC.Cmm import GHC.Cmm.Opt import GHC.Cmm.Liveness +import GHC.Cmm.LRegSet import GHC.Cmm.Utils import GHC.Cmm.Dataflow.Block import GHC.Cmm.Dataflow.Label @@ -16,29 +19,13 @@ import GHC.Cmm.Dataflow.Graph import GHC.Platform.Regs import GHC.Platform -import GHC.Types.Unique import GHC.Types.Unique.FM import qualified Data.IntSet as IntSet import Data.List (partition) -import qualified Data.Set as Set import Data.Maybe --- Compact sets for membership tests of local variables. - -type LRegSet = IntSet.IntSet - -emptyLRegSet :: LRegSet -emptyLRegSet = IntSet.empty - -nullLRegSet :: LRegSet -> Bool -nullLRegSet = IntSet.null - -insertLRegSet :: LocalReg -> LRegSet -> LRegSet -insertLRegSet l = IntSet.insert (getKey (getUnique l)) - -elemLRegSet :: LocalReg -> LRegSet -> Bool -elemLRegSet l = IntSet.member (getKey (getUnique l)) +import GHC.Exts (inline) -- ----------------------------------------------------------------------------- -- Sinking and inlining @@ -167,8 +154,8 @@ type Assignments = [Assignment] cmmSink :: Platform -> CmmGraph -> CmmGraph cmmSink platform graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks where - liveness = cmmLocalLiveness platform graph - getLive l = mapFindWithDefault Set.empty l liveness + liveness = cmmLocalLivenessL platform graph + getLive l = mapFindWithDefault emptyLRegSet l liveness blocks = revPostorder graph @@ -188,8 +175,8 @@ cmmSink platform graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks -- Annotate the middle nodes with the registers live *after* -- the node. This will help us decide whether we can inline -- an assignment in the current node or not. - live = Set.unions (map getLive succs) - live_middle = gen_kill platform last live + live = IntSet.unions (map getLive succs) + live_middle = gen_killL platform last live ann_middles = annotate platform live_middle (blockToList middle) -- Now sink and inline in this block @@ -201,7 +188,7 @@ cmmSink platform graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks -- one predecessor), so identify the join points and the set -- of registers live in them. (joins, nonjoins) = partition (`mapMember` join_pts) succs - live_in_joins = Set.unions (map getLive joins) + live_in_joins = IntSet.unions (map getLive joins) -- We do not want to sink an assignment into multiple branches, -- so identify the set of registers live in multiple successors. @@ -210,26 +197,28 @@ cmmSink platform graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks -- now live in multiple branches. init_live_sets = map getLive nonjoins live_in_multi live_sets r = - case filter (Set.member r) live_sets of + case filter (elemLRegSet r) live_sets of (_one:_two:_) -> True _ -> False -- Now, drop any assignments that we will not sink any further. (dropped_last, assigs'') = dropAssignments platform drop_if init_live_sets assigs' + drop_if :: (LocalReg, CmmExpr, AbsMem) + -> [LRegSet] -> (Bool, [LRegSet]) drop_if a@(r,rhs,_) live_sets = (should_drop, live_sets') where should_drop = conflicts platform a final_last || not (isTrivial platform rhs) && live_in_multi live_sets r - || r `Set.member` live_in_joins + || r `elemLRegSet` live_in_joins live_sets' | should_drop = live_sets | otherwise = map upd live_sets - upd set | r `Set.member` set = set `Set.union` live_rhs + upd set | r `elemLRegSet` set = set `IntSet.union` live_rhs | otherwise = set - live_rhs = foldRegsUsed platform extendRegSet emptyRegSet rhs + live_rhs = foldRegsUsed platform (flip insertLRegSet) emptyLRegSet rhs final_middle = foldl' blockSnoc middle' dropped_last @@ -266,9 +255,9 @@ isTrivial _ _ = False -- -- annotate each node with the set of registers live *after* the node -- -annotate :: Platform -> LocalRegSet -> [CmmNode O O] -> [(LocalRegSet, CmmNode O O)] +annotate :: Platform -> LRegSet -> [CmmNode O O] -> [(LRegSet, CmmNode O O)] annotate platform live nodes = snd $ foldr ann (live,[]) nodes - where ann n (live,nodes) = (gen_kill platform n live, (live,n) : nodes) + where ann n (live,nodes) = (gen_killL platform n live, (live,n) : nodes) -- -- Find the blocks that have multiple successors (join points) @@ -285,13 +274,13 @@ findJoinPoints blocks = mapFilter (>1) succ_counts -- filter the list of assignments to remove any assignments that -- are not live in a continuation. -- -filterAssignments :: Platform -> LocalRegSet -> Assignments -> Assignments +filterAssignments :: Platform -> LRegSet -> Assignments -> Assignments filterAssignments platform live assigs = reverse (go assigs []) where go [] kept = kept go (a@(r,_,_):as) kept | needed = go as (a:kept) | otherwise = go as kept where - needed = r `Set.member` live + needed = r `elemLRegSet` live || any (conflicts platform a) (map toNode kept) -- Note that we must keep assignments that are -- referred to by other assignments we have @@ -312,7 +301,7 @@ filterAssignments platform live assigs = reverse (go assigs []) -- walk :: Platform - -> [(LocalRegSet, CmmNode O O)] -- nodes of the block, annotated with + -> [(LRegSet, CmmNode O O)] -- nodes of the block, annotated with -- the set of registers live *after* -- this node. @@ -366,11 +355,11 @@ shouldSink _ _other = Nothing -- out of inlining, but the inliner will see that r is live -- after the instruction and choose not to inline r in the rhs. -- -shouldDiscard :: CmmNode e x -> LocalRegSet -> Bool +shouldDiscard :: CmmNode e x -> LRegSet -> Bool shouldDiscard node live = case node of CmmAssign r (CmmReg r') | r == r' -> True - CmmAssign (CmmLocal r) _ -> not (r `Set.member` live) + CmmAssign (CmmLocal r) _ -> not (r `elemLRegSet` live) _otherwise -> False @@ -403,8 +392,9 @@ dropAssignments platform should_drop state assigs -- inlining opens up opportunities for doing so. tryToInline - :: Platform - -> LocalRegSet -- set of registers live after this + :: forall x. Platform + -> LRegSet -- set of registers live after this + -- -> LocalRegSet -- set of registers live after this -- node. We cannot inline anything -- that is live after the node, unless -- it is small enough to duplicate. @@ -415,35 +405,42 @@ tryToInline , Assignments -- Remaining assignments ) -tryToInline platform live node assigs = go usages node emptyLRegSet assigs +tryToInline platform liveAfter node assigs = + -- pprTrace "tryToInline assig length:" (ppr $ length assigs) $ + go usages liveAfter node emptyLRegSet assigs where usages :: UniqFM LocalReg Int -- Maps each LocalReg to a count of how often it is used usages = foldLocalRegsUsed platform addUsage emptyUFM node - go _usages node _skipped [] = (node, []) + go :: UniqFM LocalReg Int -> LRegSet -> CmmNode O x -> LRegSet -> Assignments + -> (CmmNode O x, Assignments) + go _usages _live node _skipped [] = (node, []) - go usages node skipped (a@(l,rhs,_) : rest) - | cannot_inline = dont_inline - | occurs_none = discard -- Note [discard during inlining] - | occurs_once = inline_and_discard - | isTrivial platform rhs = inline_and_keep - | otherwise = dont_inline + go usages live node skipped (a@(l,rhs,_) : rest) + | cannot_inline = dont_inline + | occurs_none = discard -- Note [discard during inlining] + | occurs_once = inline_and_discard + | isTrivial platform rhs = inline_and_keep + | otherwise = dont_inline where - inline_and_discard = go usages' inl_node skipped rest + inline_and_discard = go usages' live inl_node skipped rest where usages' = foldLocalRegsUsed platform addUsage usages rhs - discard = go usages node skipped rest + discard = go usages live node skipped rest dont_inline = keep node -- don't inline the assignment, keep it inline_and_keep = keep inl_node -- inline the assignment, keep it + keep :: CmmNode O x -> (CmmNode O x, Assignments) keep node' = (final_node, a : rest') - where (final_node, rest') = go usages' node' (insertLRegSet l skipped) rest - usages' = foldLocalRegsUsed platform (\m r -> addToUFM m r 2) - usages rhs - -- we must not inline anything that is mentioned in the RHS - -- of a binding that we have already skipped, so we set the - -- usages of the regs on the RHS to 2. + where (final_node, rest') = go usages live' node' (insertLRegSet l skipped) rest + + -- Avoid discarding of assignments to vars on the rhs. + -- See Note [Keeping assignemnts mentioned in skipped RHSs] + -- usages' = foldLocalRegsUsed platform (\m r -> addToUFM m r 2) + -- usages rhs + live' = inline foldLocalRegsUsed platform (\m r -> insertLRegSet r m) + live rhs cannot_inline = skipped `regsUsedIn` rhs -- Note [dependent assignments] || l `elemLRegSet` skipped @@ -451,7 +448,7 @@ tryToInline platform live node assigs = go usages node emptyLRegSet assigs -- How often is l used in the current node. l_usages = lookupUFM usages l - l_live = l `elemRegSet` live + l_live = l `elemLRegSet` live occurs_once = not l_live && l_usages == Just 1 occurs_none = not l_live && l_usages == Nothing @@ -467,6 +464,27 @@ tryToInline platform live node assigs = go usages node emptyLRegSet assigs inl_exp (CmmMachOp op args) = cmmMachOpFold platform op args inl_exp other = other +{- Note [Keeping assignemnts mentioned in skipped RHSs] + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + If we have to assignments: [z = y, y = e1] and we skip + z we *must* retain the assignment y = e1. This is because + we might inline "z = y" into another node later on so we + must ensure y is still defined at this point. + + If we dropped the assignment of "y = e1" then we would end up + referencing a variable which hasn't been mentioned after + inlining. + + We use a hack to do this. + + We pretend the regs from the rhs are live after the current + node. Since we only discard assignments to variables + which are dead after the current block this prevents discarding of the + assignment. It still allows inlining should e1 be a trivial rhs + however. + +-} {- Note [improveConditional] @@ -610,18 +628,34 @@ conflicts platform (r, rhs, addr) node -- (7) otherwise, no conflict | otherwise = False +{- Note [Inlining foldRegsDefd] + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + foldRegsDefd is, after optimization, *not* a small function so + it's only marked INLINEABLE, but not INLINE. + + However in some specific cases we call it *very* often making it + important to avoid the overhead of allocating the folding function. + + So we simply force inlining via the magic inline function. + For T3294 this improves allocation with -O by ~1%. + +-} + -- Returns True if node defines any global registers that are used in the -- Cmm expression globalRegistersConflict :: Platform -> CmmExpr -> CmmNode e x -> Bool globalRegistersConflict platform expr node = - foldRegsDefd platform (\b r -> b || regUsedIn platform (CmmGlobal r) expr) + -- See Note [Inlining foldRegsDefd] + inline foldRegsDefd platform (\b r -> b || regUsedIn platform (CmmGlobal r) expr) False node -- Returns True if node defines any local registers that are used in the -- Cmm expression localRegistersConflict :: Platform -> CmmExpr -> CmmNode e x -> Bool localRegistersConflict platform expr node = - foldRegsDefd platform (\b r -> b || regUsedIn platform (CmmLocal r) expr) + -- See Note [Inlining foldRegsDefd] + inline foldRegsDefd platform (\b r -> b || regUsedIn platform (CmmLocal r) expr) False node -- Note [Sinking and calls] ===================================== compiler/GHC/Cmm/Utils.hs ===================================== @@ -264,9 +264,11 @@ cmmOffset platform e byte_off = case e of CmmStackSlot area off -> CmmStackSlot area (off - byte_off) -- note stack area offsets increase towards lower addresses CmmMachOp (MO_Add rep) [expr, CmmLit (CmmInt byte_off1 _rep)] - -> CmmMachOp (MO_Add rep) [expr, CmmLit (CmmInt (byte_off1 + toInteger byte_off) rep)] - _ -> CmmMachOp (MO_Add width) [e, CmmLit (CmmInt (toInteger byte_off) width)] - where width = cmmExprWidth platform e + -> let !lit_off = (byte_off1 + toInteger byte_off) + in CmmMachOp (MO_Add rep) [expr, CmmLit (CmmInt lit_off rep)] + _ -> let !width = cmmExprWidth platform e + in + CmmMachOp (MO_Add width) [e, CmmLit (CmmInt (toInteger byte_off) width)] -- Smart constructor for CmmRegOff. Same caveats as cmmOffset above. cmmRegOff :: CmmReg -> Int -> CmmExpr ===================================== compiler/GHC/Utils/Outputable.hs ===================================== @@ -115,6 +115,7 @@ import Data.Int import qualified Data.IntMap as IM import Data.Set (Set) import qualified Data.Set as Set +import qualified Data.IntSet as IntSet import Data.String import Data.Word import System.IO ( Handle ) @@ -863,6 +864,9 @@ instance (Outputable a) => Outputable (NonEmpty a) where instance (Outputable a) => Outputable (Set a) where ppr s = braces (fsep (punctuate comma (map ppr (Set.toList s)))) +instance Outputable IntSet.IntSet where + ppr s = braces (fsep (punctuate comma (map ppr (IntSet.toList s)))) + instance (Outputable a, Outputable b) => Outputable (a, b) where ppr (x,y) = parens (sep [ppr x <> comma, ppr y]) ===================================== compiler/ghc.cabal.in ===================================== @@ -205,6 +205,7 @@ Library GHC.Cmm.Switch GHC.Cmm.Switch.Implement GHC.CmmToAsm + GHC.Cmm.LRegSet GHC.CmmToAsm.BlockLayout GHC.CmmToAsm.CFG GHC.CmmToAsm.CFG.Dominators ===================================== libraries/time ===================================== @@ -1 +1 @@ -Subproject commit c25d6a76702b454426e149fb590da5cb69f3bd0a +Subproject commit df292e1a74c6a87c2c1c889679074dd46ad39461 ===================================== rts/sm/Evac.c ===================================== @@ -64,14 +64,92 @@ ATTR_NOINLINE static void evacuate_large(StgPtr p); Allocate some space in which to copy an object. -------------------------------------------------------------------------- */ +static StgPtr +alloc_in_nonmoving_heap (uint32_t size) +{ + gct->copied += size; + StgPtr to = nonmovingAllocate(gct->cap, size); + + // Add segment to the todo list unless it's already there + // current->todo_link == NULL means not in todo list + struct NonmovingSegment *seg = nonmovingGetSegment(to); + if (!seg->todo_link) { + gen_workspace *ws = &gct->gens[oldest_gen->no]; + seg->todo_link = ws->todo_seg; + ws->todo_seg = seg; + } + + // The object which refers to this closure may have been aged (i.e. + // retained in a younger generation). Consequently, we must add the + // closure to the mark queue to ensure that it will be marked. + // + // However, if we are in a deadlock detection GC then we disable aging + // so there is no need. + // + // See Note [Non-moving GC: Marking evacuated objects]. + if (major_gc && !deadlock_detect_gc) { + markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, (StgClosure *) to); + } + return to; +} + +/* Inlined helper shared between alloc_for_copy_nonmoving and alloc_for_copy. */ +STATIC_INLINE StgPtr +alloc_in_moving_heap (uint32_t size, uint32_t gen_no) +{ + gen_workspace *ws = &gct->gens[gen_no]; // zero memory references here + + /* chain a new block onto the to-space for the destination gen if + * necessary. + */ + StgPtr to = ws->todo_free; + ws->todo_free += size; + if (ws->todo_free > ws->todo_lim) { + to = todo_block_full(size, ws); + } + ASSERT(ws->todo_free >= ws->todo_bd->free && ws->todo_free <= ws->todo_lim); + + return to; +} + +/* + * N.B. We duplicate much of alloc_for_copy here to minimize the number of + * branches introduced in the moving GC path of alloc_for_copy while minimizing + * repeated work. + */ +static StgPtr +alloc_for_copy_nonmoving (uint32_t size, uint32_t gen_no) +{ + /* See Note [Deadlock detection under nonmoving collector]. */ + if (deadlock_detect_gc) { + return alloc_in_nonmoving_heap(size); + } + + /* Should match logic from alloc_for_copy */ + if (gen_no < gct->evac_gen_no) { + if (gct->eager_promotion) { + gen_no = gct->evac_gen_no; + } else { + gct->failed_to_evac = true; + } + } + + if (gen_no == oldest_gen->no) { + return alloc_in_nonmoving_heap(size); + } else { + return alloc_in_moving_heap(size, gen_no); + } +} + /* size is in words */ STATIC_INLINE StgPtr alloc_for_copy (uint32_t size, uint32_t gen_no) { ASSERT(gen_no < RtsFlags.GcFlags.generations); - StgPtr to; - gen_workspace *ws; + if (RTS_UNLIKELY(RtsFlags.GcFlags.useNonmoving)) { + return alloc_for_copy_nonmoving(size, gen_no); + } /* Find out where we're going, using the handy "to" pointer in * the gen of the source object. If it turns out we need to @@ -81,55 +159,12 @@ alloc_for_copy (uint32_t size, uint32_t gen_no) if (gen_no < gct->evac_gen_no) { if (gct->eager_promotion) { gen_no = gct->evac_gen_no; - } else if (RTS_UNLIKELY(RtsFlags.GcFlags.useNonmoving) && deadlock_detect_gc) { - /* See Note [Deadlock detection under nonmoving collector]. */ - gen_no = oldest_gen->no; } else { gct->failed_to_evac = true; } } - if (RTS_UNLIKELY(RtsFlags.GcFlags.useNonmoving)) { - if (gen_no == oldest_gen->no) { - gct->copied += size; - to = nonmovingAllocate(gct->cap, size); - - // Add segment to the todo list unless it's already there - // current->todo_link == NULL means not in todo list - struct NonmovingSegment *seg = nonmovingGetSegment(to); - if (!seg->todo_link) { - gen_workspace *ws = &gct->gens[oldest_gen->no]; - seg->todo_link = ws->todo_seg; - ws->todo_seg = seg; - } - - // The object which refers to this closure may have been aged (i.e. - // retained in a younger generation). Consequently, we must add the - // closure to the mark queue to ensure that it will be marked. - // - // However, if we are in a deadlock detection GC then we disable aging - // so there is no need. - // - // See Note [Non-moving GC: Marking evacuated objects]. - if (major_gc && !deadlock_detect_gc) - markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, (StgClosure *) to); - return to; - } - } - - ws = &gct->gens[gen_no]; // zero memory references here - - /* chain a new block onto the to-space for the destination gen if - * necessary. - */ - to = ws->todo_free; - ws->todo_free += size; - if (ws->todo_free > ws->todo_lim) { - to = todo_block_full(size, ws); - } - ASSERT(ws->todo_free >= ws->todo_bd->free && ws->todo_free <= ws->todo_lim); - - return to; + return alloc_in_moving_heap(size, gen_no); } /* ----------------------------------------------------------------------------- @@ -406,7 +441,9 @@ evacuate_large(StgPtr p) __atomic_fetch_or(&bd->flags, BF_NONMOVING, __ATOMIC_ACQ_REL); // See Note [Non-moving GC: Marking evacuated objects]. - markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, (StgClosure *) p); + if (major_gc && !deadlock_detect_gc) { + markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, (StgClosure *) p); + } } initBdescr(bd, new_gen, new_gen->to); @@ -563,7 +600,9 @@ evacuate_compact (StgPtr p) __atomic_fetch_or(&bd->flags, BF_NONMOVING, __ATOMIC_RELAXED); // See Note [Non-moving GC: Marking evacuated objects]. - markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, (StgClosure *) str); + if (major_gc && !deadlock_detect_gc) { + markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, (StgClosure *) str); + } } initBdescr(bd, new_gen, new_gen->to); ===================================== rts/sm/NonMovingMark.c ===================================== @@ -737,9 +737,11 @@ void updateRemembSetPushStack(Capability *cap, StgStack *stack) // The concurrent GC has claimed the right to mark the stack. // Wait until it finishes marking before proceeding with // mutation. - while (needs_upd_rem_set_mark((StgClosure *) stack)); + while (needs_upd_rem_set_mark((StgClosure *) stack)) #if defined(PARALLEL_GC) busy_wait_nop(); // TODO: Spinning here is unfortunate +#else + ; #endif return; } @@ -1927,6 +1929,8 @@ void nonmovingTidyThreads () } } +// Mark threads which appear to be dead but still need to be properly torn down +// by resurrectThreads. void nonmovingResurrectThreads (struct MarkQueue_ *queue, StgTSO **resurrected_threads) { StgTSO *next; @@ -1938,6 +1942,9 @@ void nonmovingResurrectThreads (struct MarkQueue_ *queue, StgTSO **resurrected_t case ThreadComplete: continue; default: + // The thread may be, e.g., deadlocked in which case we must ensure + // it isn't swept since resurrectThreads will need to throw it an + // exception. markQueuePushClosure_(queue, (StgClosure*)t); t->global_link = *resurrected_threads; *resurrected_threads = t; ===================================== rts/sm/Scav.c ===================================== @@ -441,6 +441,14 @@ scavenge_block (bdescr *bd) p = bd->u.scan; + // Sanity check: See Note [Deadlock detection under nonmoving collector]. +#if defined(DEBUG) + if (RtsFlags.GcFlags.useNonmoving && deadlock_detect_gc) { + ASSERT(bd->gen == oldest_gen); + } +#endif + + // we might be evacuating into the very object that we're // scavenging, so we have to check the real bd->free pointer each // time around the loop. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/62265eb38a56eebc24401b43895a9fe65f545d0f...5cc213666d20437cdbbead665a0fd725d8dfb533 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/62265eb38a56eebc24401b43895a9fe65f545d0f...5cc213666d20437cdbbead665a0fd725d8dfb533 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 10 04:53:44 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 09 Dec 2020 23:53:44 -0500 Subject: [Git][ghc/ghc][wip/ci-fixes] 5 commits: Fix bad span calculations of post qualified imports Message-ID: <5fd1a9d832777_6b2174471c8692c3@gitlab.mail> Ben Gamari pushed to branch wip/ci-fixes at Glasgow Haskell Compiler / GHC Commits: 4a437bc1 by Shayne Fletcher at 2020-12-05T09:06:38-05:00 Fix bad span calculations of post qualified imports - - - - - 8fac4b93 by Ben Gamari at 2020-12-05T09:07:13-05:00 testsuite: Add a test for #18923 - - - - - 62ed6957 by Simon Peyton Jones at 2020-12-08T15:31:41-05:00 Fix kind inference for data types. Again. This patch fixes several aspects of kind inference for data type declarations, especially data /instance/ declarations Specifically 1. In kcConDecls/kcConDecl make it clear that the tc_res_kind argument is only used in the H98 case; and in that case there is no result kind signature; and hence no need for the disgusting splitPiTys in kcConDecls (now thankfully gone). The GADT case is a bit different to before, and much nicer. This is what fixes #18891. See Note [kcConDecls: kind-checking data type decls] 2. Do not look at the constructor decls of a data/newtype instance in tcDataFamInstanceHeader. See GHC.Tc.TyCl.Instance Note [Kind inference for data family instances]. This was a new realisation that arose when doing (1) This causes a few knock-on effects in the tests suite, because we require more information than before in the instance /header/. New user-manual material about this in "Kind inference in data type declarations" and "Kind inference for data/newtype instance declarations". 3. Minor improvement in kcTyClDecl, combining GADT and H98 cases 4. Fix #14111 and #8707 by allowing the header of a data instance to affect kind inferece for the the data constructor signatures; as described at length in Note [GADT return types] in GHC.Tc.TyCl This led to a modest refactoring of the arguments (and argument order) of tcConDecl/tcConDecls. 5. Fix #19000 by inverting the sense of the test in new_locs in GHC.Tc.Solver.Canonical.canDecomposableTyConAppOK. - - - - - 0abe3ddf by Adam Sandberg Ericsson at 2020-12-08T15:32:19-05:00 hadrian: build the _l and _thr_l rts flavours in the develN flavours The ghc binary requires the eventlog rts since fc644b1a643128041cfec25db84e417851e28bab - - - - - dc2da968 by Ben Gamari at 2020-12-09T23:52:56-05:00 gitlab-ci: Fix incorrect Docker image for nightly cross job Also refactor the job definition to eliminate the bug by construction. - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC/Hs/Extension.hs - compiler/GHC/Parser.y - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Instance.hs - docs/users_guide/9.2.1-notes.rst - docs/users_guide/exts/poly_kinds.rst - hadrian/src/Settings/Flavours/Development.hs - testsuite/tests/dependent/should_fail/T13780a.stderr - testsuite/tests/deriving/should_compile/T11416.hs - testsuite/tests/deriving/should_compile/T9359.hs - + testsuite/tests/gadt/SynDataRec.hs - testsuite/tests/gadt/all.T - + testsuite/tests/indexed-types/should_compile/T14111.hs - + testsuite/tests/indexed-types/should_compile/T8707.hs - testsuite/tests/indexed-types/should_compile/all.T - testsuite/tests/indexed-types/should_fail/T8368.stderr - testsuite/tests/indexed-types/should_fail/T8368a.stderr - testsuite/tests/module/all.T - + testsuite/tests/module/mod185.hs - + testsuite/tests/module/mod185.stderr - testsuite/tests/patsyn/should_fail/T15685.stderr - + testsuite/tests/perf/compiler/T18923.hs - testsuite/tests/perf/compiler/all.T - testsuite/tests/polykinds/T13659.stderr - testsuite/tests/polykinds/T16221a.stderr - testsuite/tests/th/T11145.stderr - testsuite/tests/th/T9692.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/33ec3a0600fe8c009ab8ed6d86941a8fd88fb033...dc2da968f2df3fd6b9f21d68882d802dfeaa4ace -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/33ec3a0600fe8c009ab8ed6d86941a8fd88fb033...dc2da968f2df3fd6b9f21d68882d802dfeaa4ace You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 10 04:54:48 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 09 Dec 2020 23:54:48 -0500 Subject: [Git][ghc/ghc][wip/ci-fixes] gitlab-ci: Fix incorrect Docker image for nightly cross job Message-ID: <5fd1aa1845bbf_6b213272ccc8711d8@gitlab.mail> Ben Gamari pushed to branch wip/ci-fixes at Glasgow Haskell Compiler / GHC Commits: 354fb946 by Ben Gamari at 2020-12-09T23:54:40-05:00 gitlab-ci: Fix incorrect Docker image for nightly cross job Also refactor the job definition to eliminate the bug by construction. - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -257,27 +257,24 @@ validate-x86_64-linux-deb9-unreg-hadrian: CONFIGURE_ARGS: --enable-unregisterised TEST_ENV: "x86_64-linux-deb9-unreg-hadrian" -validate-x86_64-linux-deb10-hadrian-cross-aarch64: - <<: *nightly +.build-x86_64-linux-deb10-hadrian-cross-aarch64: extends: .validate-linux-hadrian - stage: full-build image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV" variables: BIN_DIST_NAME: "ghc-x86_64-deb9-linux" - rules: - - if: '$CI_MERGE_REQUEST_LABELS =~ /.*cross-compilation.*/' - variables: CONFIGURE_ARGS: --with-intree-gmp CROSS_TARGET: "aarch64-linux-gnu" +validate-x86_64-linux-deb10-hadrian-cross-aarch64: + extends: .build-x86_64-linux-deb10-hadrian-cross-aarch64 + stage: full-build + rules: + - if: '$CI_MERGE_REQUEST_LABELS =~ /.*cross-compilation.*/' + nightly-x86_64-linux-deb10-hadrian-cross-aarch64: <<: *nightly - extends: .validate-linux-hadrian + extends: .build-x86_64-linux-deb10-hadrian-cross-aarch64 stage: full-build - variables: - CONFIGURE_ARGS: --with-intree-gmp - CROSS_TARGET: "aarch64-linux-gnu" - ############################################################ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/354fb9462bd8f12143a48ce477338136c55b3133 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/354fb9462bd8f12143a48ce477338136c55b3133 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 10 04:56:29 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 09 Dec 2020 23:56:29 -0500 Subject: [Git][ghc/ghc][wip/ci-fixes] gitlab-ci: Fix name of flavour in ThreadSanitizer job Message-ID: <5fd1aa7d3277_6b2131d5c388717e3@gitlab.mail> Ben Gamari pushed to branch wip/ci-fixes at Glasgow Haskell Compiler / GHC Commits: 097b9f44 by Ben Gamari at 2020-12-09T23:55:48-05:00 gitlab-ci: Fix name of flavour in ThreadSanitizer job It looks like I neglected to update this after introduce flavour transformers. - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -709,7 +709,7 @@ nightly-x86_64-linux-deb9-integer-simple: stage: full-build variables: TEST_ENV: "x86_64-linux-deb9-tsan" - BUILD_FLAVOUR: "thread-sanitizer" + BUILD_FLAVOUR: "default+thread_sanitizer" TSAN_OPTIONS: "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions" # Haddock is large enough to make TSAN choke without massive quantities of # memory. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/097b9f449fc1a218b70a304be9135eb63bce639a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/097b9f449fc1a218b70a304be9135eb63bce639a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 10 06:19:11 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 10 Dec 2020 01:19:11 -0500 Subject: [Git][ghc/ghc][wip/T7275] rts: Implement heap census support for pinned objects Message-ID: <5fd1bddfd861a_6b213272c548790f3@gitlab.mail> Ben Gamari pushed to branch wip/T7275 at Glasgow Haskell Compiler / GHC Commits: cf056865 by Ben Gamari at 2020-12-10T01:18:58-05:00 rts: Implement heap census support for pinned objects It turns out that this was fairly straightforward to implement since we are now pretty careful about zeroing slop. - - - - - 1 changed file: - rts/ProfHeap.c Changes: ===================================== rts/ProfHeap.c ===================================== @@ -1103,26 +1103,21 @@ heapCensusCompactList(Census *census, bdescr *bd) } } -static void -heapCensusPinnedBlock( Census *census, bdescr *bd ) -{ - // HACK: pretend a pinned block is just one big ARR_WORDS - // owned by CCS_PINNED. These blocks can be full of holes due - // to alignment constraints so we can't traverse the memory - // and do a proper census. - StgClosure arr; - SET_HDR(&arr, &stg_ARR_WORDS_info, CCS_PINNED); - heapProfObject(census, &arr, bd->blocks * BLOCK_SIZE_W, true); -} - /* - * Take a census of the contents of a "normal" (e.g. not large, not pinned, not - * compact) heap block. + * Take a census of the contents of a "normal" (e.g. not large, not compact) + * heap block. This can, however, handle PINNED blocks. */ static void -heapCensusNormalBlock(Census *census, bdescr *bd) +heapCensusBlock(Census *census, bdescr *bd) { StgPtr p = bd->start; + + // In the case of PINNED blocks there can be (zeroed) slop at the beginning + // due to object alignment. + if (bd->flags & BF_PINNED) { + while (p < bd->free && !*p) p++; + } + while (p < bd->free) { const StgInfoTable *info = get_itbl((const StgClosure *)p); bool prim = false; @@ -1299,13 +1294,6 @@ static void heapCensusChain( Census *census, bdescr *bd ) { for (; bd != NULL; bd = bd->link) { - StgPtr p = bd->start; - - if (bd->flags & BF_PINNED) { - heapCensusPinnedBlock(census, bd); - continue; - } - // When we shrink a large ARR_WORDS, we do not adjust the free pointer // of the associated block descriptor, thus introducing slop at the end // of the object. This slop remains after GC, violating the assumption @@ -1313,15 +1301,19 @@ heapCensusChain( Census *census, bdescr *bd ) // The slop isn't always zeroed (e.g. in non-profiling mode, cf // OVERWRITING_CLOSURE_OFS). // Consequently, we handle large ARR_WORDS objects as a special case. - if (bd->flags & BF_LARGE - && get_itbl((StgClosure *)p)->type == ARR_WORDS) { - size_t size = arr_words_sizeW((StgArrBytes *)p); - bool prim = true; - heapProfObject(census, (StgClosure *)p, size, prim); - continue; + if (bd->flags & BF_LARGE) { + StgPtr p = bd->start; + // There may be some initial zeros due to object alignment. + while (p < bd->free && !*p) p++; + if (get_itbl((StgClosure *)p)->type == ARR_WORDS) { + size_t size = arr_words_sizeW((StgArrBytes *)p); + bool prim = true; + heapProfObject(census, (StgClosure *)p, size, prim); + continue; + } } - heapCensusNormalBlock(census, bd); + heapCensusBlock(census, bd); } } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cf0568657b1cf256876ae58a6306d5d5b31905d3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cf0568657b1cf256876ae58a6306d5d5b31905d3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 10 06:46:01 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 10 Dec 2020 01:46:01 -0500 Subject: [Git][ghc/ghc][master] 2 commits: doc: Clarify the default for -fomit-yields Message-ID: <5fd1c4291b748_6b213272c68882678@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 35e7b0c6 by Kirill Elagin at 2020-12-10T01:45:54-05:00 doc: Clarify the default for -fomit-yields “Yield points enabled” is confusing (and probably wrong? I am not 100% sure what it means). Change it to a simple “on”. Undo this change from 2c23fff2e03e77187dc4d01f325f5f43a0e7cad2. - - - - - 3551c554 by Kirill Elagin at 2020-12-10T01:45:54-05:00 doc: Extra-clarify -fomit-yields Be more clear on what this optimisation being on by default means in terms of yields. - - - - - 1 changed file: - docs/users_guide/using-optimisation.rst Changes: ===================================== docs/users_guide/using-optimisation.rst ===================================== @@ -720,7 +720,7 @@ by saying ``-fno-wombat``. :reverse: -fno-omit-yields :category: - :default: yield points enabled + :default: on (yields are *not* inserted) Tells GHC to omit heap checks when no allocation is being performed. While this improves binary sizes by about 5%, it View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/54b88eacbf9d13f2b1d070932a742ec74419c3f5...3551c554acd8d692de7948c47a27327988b3a308 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/54b88eacbf9d13f2b1d070932a742ec74419c3f5...3551c554acd8d692de7948c47a27327988b3a308 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 10 06:46:40 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 10 Dec 2020 01:46:40 -0500 Subject: [Git][ghc/ghc][master] rts/linker/Elf.c: add missing include (musl support) Message-ID: <5fd1c450b68cd_6b213272c68885771@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 6484f0d7 by Sergei Trofimovich at 2020-12-10T01:46:33-05:00 rts/linker/Elf.c: add missing <dlfcn.h> include (musl support) The change fixes build failure on musl: ``` rts/linker/Elf.c:2031:3: error: warning: implicit declaration of function 'dlclose'; did you mean 'close'? [-Wimplicit-function-declaration] 2031 | dlclose(nc->dlopen_handle); | ^~~~~~~ | close ``` Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - 1 changed file: - rts/linker/Elf.c Changes: ===================================== rts/linker/Elf.c ===================================== @@ -32,6 +32,9 @@ #include #include #include +#if defined(HAVE_DLFCN_H) +#include +#endif #if defined(HAVE_SYS_STAT_H) #include #endif View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6484f0d72a9110c5960b9185f239e6ce049b0c74 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6484f0d72a9110c5960b9185f239e6ce049b0c74 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 10 08:40:46 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Thu, 10 Dec 2020 03:40:46 -0500 Subject: [Git][ghc/ghc][wip/T17656] Fix unused binding Message-ID: <5fd1df0e4cdd7_6b2133294b88993b0@gitlab.mail> Simon Peyton Jones pushed to branch wip/T17656 at Glasgow Haskell Compiler / GHC Commits: da9cab26 by Simon Peyton Jones at 2020-12-10T08:40:08+00:00 Fix unused binding - - - - - 1 changed file: - compiler/GHC/Tc/Solver.hs Changes: ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -1773,7 +1773,6 @@ solveImplication :: Implication -- Wanted -- which after trying to solve this implication we must restore to their original value solveImplication imp@(Implic { ic_tclvl = tclvl , ic_binds = ev_binds_var - , ic_skols = skols , ic_given = given_ids , ic_wanted = wanteds , ic_info = info View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/da9cab26faedb886de0b563f293a15b8bd9b6c21 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/da9cab26faedb886de0b563f293a15b8bd9b6c21 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 10 14:35:02 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 10 Dec 2020 09:35:02 -0500 Subject: [Git][ghc/ghc][wip/T7275] 2 commits: Storage: Unconditionally enable zeroing of alignment slop Message-ID: <5fd232169c4a4_6b21410d5e8937873@gitlab.mail> Ben Gamari pushed to branch wip/T7275 at Glasgow Haskell Compiler / GHC Commits: 396c6e8a by Ben Gamari at 2020-12-10T09:16:19-05:00 Storage: Unconditionally enable zeroing of alignment slop This is necessary since the user may enable `+RTS -hT` at any time. - - - - - cf80bf51 by Ben Gamari at 2020-12-10T09:34:31-05:00 rts: Zero shrunk array slop in vanilla RTS But only when profiling or DEBUG are enabled. Fixes #17572 and #9666. - - - - - 3 changed files: - includes/Cmm.h - rts/sm/Storage.c - utils/deriveConstants/Main.hs Changes: ===================================== includes/Cmm.h ===================================== @@ -630,7 +630,11 @@ #else #define OVERWRITING_CLOSURE_SIZE(c, size) /* nothing */ #define OVERWRITING_CLOSURE(c) /* nothing */ -#define OVERWRITING_CLOSURE_MUTABLE(c, off) /* nothing */ +/* This is used to zero slop after shrunk arrays. It is important that we do + * this whenever profiling is enabled as described in Note [slop on the heap] + * in Storage.c. */ +#define OVERWRITING_CLOSURE_MUTABLE(c, off) \ + if (RtsFlags_ProfFlags_doHeapProfile != 0) { foreign "C" overwritingMutableClosureOfs(c "ptr", off) } #endif // Memory barriers. ===================================== rts/sm/Storage.c ===================================== @@ -952,10 +952,20 @@ accountAllocation(Capability *cap, W_ n) * of closures. This trick is used by the sanity checking code and the heap * profiler, see Note [skipping slop in the heap profiler]. * - * When profiling we zero: - * - Pinned object alignment slop, see MEMSET_IF_PROFILING_W in allocatePinned. + * In general we zero: + * + * - Pinned object alignment slop, see MEMSET_SLOP_W in allocatePinned. + * - Large object alignment slop, see MEMSET_SLOP_W in allocatePinned. * - Shrunk array slop, see OVERWRITING_CLOSURE_MUTABLE. * + * Note that this is necessary even in the vanilla (e.g. non-profiling) RTS + * since the user may trigger a heap census via +RTS -hT, which can be used + * even when not linking against the profiled RTS. Failing to zero slop + * due to array shrinking has resulted in a few nasty bugs (#17572, #9666). + * However, since array shrink may result in large amounts of slop (unlike + * alignment), we take care to only zero such slop when heap profiling or DEBUG + * are enabled. + * * When performing LDV profiling or using a (single threaded) debug RTS we zero * slop even when overwriting immutable closures, see Note [zeroing slop when * overwriting closures]. @@ -1126,12 +1136,7 @@ allocateMightFail (Capability *cap, W_ n) * * See Note [skipping slop in the heap profiler] */ -#if defined(PROFILING) -#define MEMSET_IF_PROFILING_W(p, val, len_w) memset(p, val, (len_w) * sizeof(W_)) -#else -#define MEMSET_IF_PROFILING_W(p, val, len_w) \ - do { (void)(p); (void)(val); (void)(len_w); } while(0) -#endif +#define MEMSET_SLOP_W(p, val, len_w) memset(p, val, (len_w) * sizeof(W_)) /* --------------------------------------------------------------------------- Allocate a fixed/pinned object. @@ -1184,9 +1189,9 @@ allocatePinned (Capability *cap, W_ n /*words*/, W_ alignment /*bytes*/, W_ alig } else { Bdescr(p)->flags |= BF_PINNED; W_ off_w = ALIGN_WITH_OFF_W(p, alignment, align_off); - MEMSET_IF_PROFILING_W(p, 0, off_w); + MEMSET_SLOP(p, 0, off_w); p += off_w; - MEMSET_IF_PROFILING_W(p + n, 0, alignment_w - off_w - 1); + MEMSET_SLOP(p + n, 0, (alignment_w - off_w - 1)); return p; } } @@ -1258,7 +1263,7 @@ allocatePinned (Capability *cap, W_ n /*words*/, W_ alignment /*bytes*/, W_ alig p = bd->free; - MEMSET_IF_PROFILING_W(p, 0, off_w); + MEMSET_SLOP(p, 0, off_w); n += off_w; p += off_w; ===================================== utils/deriveConstants/Main.hs ===================================== @@ -561,6 +561,8 @@ wanteds os = concat ,structField C "StgCompactNFDataBlock" "owner" ,structField C "StgCompactNFDataBlock" "next" + ,structField_ C "RtsFlags_ProfFlags_doHeapProfile" + "RTS_FLAGS" "ProfFlags.doHeapProfile" ,structField_ C "RtsFlags_ProfFlags_showCCSOnException" "RTS_FLAGS" "ProfFlags.showCCSOnException" ,structField_ C "RtsFlags_DebugFlags_apply" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cf0568657b1cf256876ae58a6306d5d5b31905d3...cf80bf51fab0be63afa189b09592b7ae2f0c94ad -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cf0568657b1cf256876ae58a6306d5d5b31905d3...cf80bf51fab0be63afa189b09592b7ae2f0c94ad You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 10 14:36:39 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 10 Dec 2020 09:36:39 -0500 Subject: [Git][ghc/ghc][wip/T7275] rts: Zero shrunk array slop in vanilla RTS Message-ID: <5fd232773b229_6b2174471c940099@gitlab.mail> Ben Gamari pushed to branch wip/T7275 at Glasgow Haskell Compiler / GHC Commits: aed29739 by Ben Gamari at 2020-12-10T09:36:33-05:00 rts: Zero shrunk array slop in vanilla RTS But only when profiling or DEBUG are enabled. Fixes #17572 and #9666. - - - - - 3 changed files: - includes/Cmm.h - rts/sm/Storage.c - utils/deriveConstants/Main.hs Changes: ===================================== includes/Cmm.h ===================================== @@ -630,7 +630,11 @@ #else #define OVERWRITING_CLOSURE_SIZE(c, size) /* nothing */ #define OVERWRITING_CLOSURE(c) /* nothing */ -#define OVERWRITING_CLOSURE_MUTABLE(c, off) /* nothing */ +/* This is used to zero slop after shrunk arrays. It is important that we do + * this whenever profiling is enabled as described in Note [slop on the heap] + * in Storage.c. */ +#define OVERWRITING_CLOSURE_MUTABLE(c, off) \ + if (RtsFlags_ProfFlags_doHeapProfile != 0) { foreign "C" overwritingMutableClosureOfs(c "ptr", off); } #endif // Memory barriers. ===================================== rts/sm/Storage.c ===================================== @@ -953,14 +953,19 @@ accountAllocation(Capability *cap, W_ n) * profiler, see Note [skipping slop in the heap profiler]. * * In general we zero: + * * - Pinned object alignment slop, see MEMSET_SLOP_W in allocatePinned. * - Large object alignment slop, see MEMSET_SLOP_W in allocatePinned. - * This is necessary even in the vanilla RTS since the user may trigger a heap - * census via +RTS -hT even when not linking against the profiled RTS. - * - * Only when profiling we zero: * - Shrunk array slop, see OVERWRITING_CLOSURE_MUTABLE. * + * Note that this is necessary even in the vanilla (e.g. non-profiling) RTS + * since the user may trigger a heap census via +RTS -hT, which can be used + * even when not linking against the profiled RTS. Failing to zero slop + * due to array shrinking has resulted in a few nasty bugs (#17572, #9666). + * However, since array shrink may result in large amounts of slop (unlike + * alignment), we take care to only zero such slop when heap profiling or DEBUG + * are enabled. + * * When performing LDV profiling or using a (single threaded) debug RTS we zero * slop even when overwriting immutable closures, see Note [zeroing slop when * overwriting closures]. ===================================== utils/deriveConstants/Main.hs ===================================== @@ -561,6 +561,8 @@ wanteds os = concat ,structField C "StgCompactNFDataBlock" "owner" ,structField C "StgCompactNFDataBlock" "next" + ,structField_ C "RtsFlags_ProfFlags_doHeapProfile" + "RTS_FLAGS" "ProfFlags.doHeapProfile" ,structField_ C "RtsFlags_ProfFlags_showCCSOnException" "RTS_FLAGS" "ProfFlags.showCCSOnException" ,structField_ C "RtsFlags_DebugFlags_apply" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/aed297394b7d57aaced800e5341bc9a0a5312d26 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/aed297394b7d57aaced800e5341bc9a0a5312d26 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 10 14:38:19 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 10 Dec 2020 09:38:19 -0500 Subject: [Git][ghc/ghc][wip/T7275] 2 commits: Storage: Unconditionally enable zeroing of alignment slop Message-ID: <5fd232dbcf6b4_6b213272ce09407bd@gitlab.mail> Ben Gamari pushed to branch wip/T7275 at Glasgow Haskell Compiler / GHC Commits: 3d354644 by Ben Gamari at 2020-12-10T09:38:14-05:00 Storage: Unconditionally enable zeroing of alignment slop This is necessary since the user may enable `+RTS -hT` at any time. - - - - - 59cbb122 by Ben Gamari at 2020-12-10T09:38:14-05:00 rts: Zero shrunk array slop in vanilla RTS But only when profiling or DEBUG are enabled. Fixes #17572 and #9666. - - - - - 3 changed files: - includes/Cmm.h - rts/sm/Storage.c - utils/deriveConstants/Main.hs Changes: ===================================== includes/Cmm.h ===================================== @@ -630,7 +630,11 @@ #else #define OVERWRITING_CLOSURE_SIZE(c, size) /* nothing */ #define OVERWRITING_CLOSURE(c) /* nothing */ -#define OVERWRITING_CLOSURE_MUTABLE(c, off) /* nothing */ +/* This is used to zero slop after shrunk arrays. It is important that we do + * this whenever profiling is enabled as described in Note [slop on the heap] + * in Storage.c. */ +#define OVERWRITING_CLOSURE_MUTABLE(c, off) \ + if (RtsFlags_ProfFlags_doHeapProfile != 0) { foreign "C" overwritingMutableClosureOfs(c "ptr", off); } #endif // Memory barriers. ===================================== rts/sm/Storage.c ===================================== @@ -952,10 +952,20 @@ accountAllocation(Capability *cap, W_ n) * of closures. This trick is used by the sanity checking code and the heap * profiler, see Note [skipping slop in the heap profiler]. * - * When profiling we zero: - * - Pinned object alignment slop, see MEMSET_IF_PROFILING_W in allocatePinned. + * In general we zero: + * + * - Pinned object alignment slop, see MEMSET_SLOP_W in allocatePinned. + * - Large object alignment slop, see MEMSET_SLOP_W in allocatePinned. * - Shrunk array slop, see OVERWRITING_CLOSURE_MUTABLE. * + * Note that this is necessary even in the vanilla (e.g. non-profiling) RTS + * since the user may trigger a heap census via +RTS -hT, which can be used + * even when not linking against the profiled RTS. Failing to zero slop + * due to array shrinking has resulted in a few nasty bugs (#17572, #9666). + * However, since array shrink may result in large amounts of slop (unlike + * alignment), we take care to only zero such slop when heap profiling or DEBUG + * are enabled. + * * When performing LDV profiling or using a (single threaded) debug RTS we zero * slop even when overwriting immutable closures, see Note [zeroing slop when * overwriting closures]. @@ -1126,12 +1136,7 @@ allocateMightFail (Capability *cap, W_ n) * * See Note [skipping slop in the heap profiler] */ -#if defined(PROFILING) -#define MEMSET_IF_PROFILING_W(p, val, len_w) memset(p, val, (len_w) * sizeof(W_)) -#else -#define MEMSET_IF_PROFILING_W(p, val, len_w) \ - do { (void)(p); (void)(val); (void)(len_w); } while(0) -#endif +#define MEMSET_SLOP_W(p, val, len_w) memset(p, val, (len_w) * sizeof(W_)) /* --------------------------------------------------------------------------- Allocate a fixed/pinned object. @@ -1184,9 +1189,9 @@ allocatePinned (Capability *cap, W_ n /*words*/, W_ alignment /*bytes*/, W_ alig } else { Bdescr(p)->flags |= BF_PINNED; W_ off_w = ALIGN_WITH_OFF_W(p, alignment, align_off); - MEMSET_IF_PROFILING_W(p, 0, off_w); + MEMSET_SLOP_W(p, 0, off_w); p += off_w; - MEMSET_IF_PROFILING_W(p + n, 0, alignment_w - off_w - 1); + MEMSET_SLOP_W(p + n, 0, alignment_w - off_w - 1); return p; } } @@ -1258,7 +1263,7 @@ allocatePinned (Capability *cap, W_ n /*words*/, W_ alignment /*bytes*/, W_ alig p = bd->free; - MEMSET_IF_PROFILING_W(p, 0, off_w); + MEMSET_SLOP_W(p, 0, off_w); n += off_w; p += off_w; ===================================== utils/deriveConstants/Main.hs ===================================== @@ -561,6 +561,8 @@ wanteds os = concat ,structField C "StgCompactNFDataBlock" "owner" ,structField C "StgCompactNFDataBlock" "next" + ,structField_ C "RtsFlags_ProfFlags_doHeapProfile" + "RTS_FLAGS" "ProfFlags.doHeapProfile" ,structField_ C "RtsFlags_ProfFlags_showCCSOnException" "RTS_FLAGS" "ProfFlags.showCCSOnException" ,structField_ C "RtsFlags_DebugFlags_apply" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/aed297394b7d57aaced800e5341bc9a0a5312d26...59cbb1227761934dc97770f6cf84418513077c1e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/aed297394b7d57aaced800e5341bc9a0a5312d26...59cbb1227761934dc97770f6cf84418513077c1e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 10 14:40:20 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 10 Dec 2020 09:40:20 -0500 Subject: [Git][ghc/ghc][wip/T7275] rts: Zero shrunk array slop in vanilla RTS Message-ID: <5fd23354ec331_6b213272ce09414ed@gitlab.mail> Ben Gamari pushed to branch wip/T7275 at Glasgow Haskell Compiler / GHC Commits: 4c46003b by Ben Gamari at 2020-12-10T09:40:14-05:00 rts: Zero shrunk array slop in vanilla RTS But only when profiling or DEBUG are enabled. Fixes #17572 and #9666. - - - - - 3 changed files: - includes/Cmm.h - rts/sm/Storage.c - utils/deriveConstants/Main.hs Changes: ===================================== includes/Cmm.h ===================================== @@ -630,7 +630,11 @@ #else #define OVERWRITING_CLOSURE_SIZE(c, size) /* nothing */ #define OVERWRITING_CLOSURE(c) /* nothing */ -#define OVERWRITING_CLOSURE_MUTABLE(c, off) /* nothing */ +/* This is used to zero slop after shrunk arrays. It is important that we do + * this whenever profiling is enabled as described in Note [slop on the heap] + * in Storage.c. */ +#define OVERWRITING_CLOSURE_MUTABLE(c, off) \ + if (RtsFlags_ProfFlags_doHeapProfile(RtsFlags) != 0) { foreign "C" overwritingMutableClosureOfs(c "ptr", off); } #endif // Memory barriers. ===================================== rts/sm/Storage.c ===================================== @@ -953,14 +953,19 @@ accountAllocation(Capability *cap, W_ n) * profiler, see Note [skipping slop in the heap profiler]. * * In general we zero: + * * - Pinned object alignment slop, see MEMSET_SLOP_W in allocatePinned. * - Large object alignment slop, see MEMSET_SLOP_W in allocatePinned. - * This is necessary even in the vanilla RTS since the user may trigger a heap - * census via +RTS -hT even when not linking against the profiled RTS. - * - * Only when profiling we zero: * - Shrunk array slop, see OVERWRITING_CLOSURE_MUTABLE. * + * Note that this is necessary even in the vanilla (e.g. non-profiling) RTS + * since the user may trigger a heap census via +RTS -hT, which can be used + * even when not linking against the profiled RTS. Failing to zero slop + * due to array shrinking has resulted in a few nasty bugs (#17572, #9666). + * However, since array shrink may result in large amounts of slop (unlike + * alignment), we take care to only zero such slop when heap profiling or DEBUG + * are enabled. + * * When performing LDV profiling or using a (single threaded) debug RTS we zero * slop even when overwriting immutable closures, see Note [zeroing slop when * overwriting closures]. ===================================== utils/deriveConstants/Main.hs ===================================== @@ -561,6 +561,8 @@ wanteds os = concat ,structField C "StgCompactNFDataBlock" "owner" ,structField C "StgCompactNFDataBlock" "next" + ,structField_ C "RtsFlags_ProfFlags_doHeapProfile" + "RTS_FLAGS" "ProfFlags.doHeapProfile" ,structField_ C "RtsFlags_ProfFlags_showCCSOnException" "RTS_FLAGS" "ProfFlags.showCCSOnException" ,structField_ C "RtsFlags_DebugFlags_apply" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4c46003b51c7c11d084cc6fb94ebc6b4d7d6f4b7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4c46003b51c7c11d084cc6fb94ebc6b4d7d6f4b7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 10 14:57:37 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Thu, 10 Dec 2020 09:57:37 -0500 Subject: [Git][ghc/ghc][wip/T18962-simpl] tmp Message-ID: <5fd237615a835_6b213272ce0943570@gitlab.mail> Sebastian Graf pushed to branch wip/T18962-simpl at Glasgow Haskell Compiler / GHC Commits: b9867ba0 by Sebastian Graf at 2020-12-10T15:57:31+01:00 tmp - - - - - 2 changed files: - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/StaticArgs.hs Changes: ===================================== compiler/GHC/Core/Opt/Simplify.hs ===================================== @@ -542,6 +542,7 @@ prepareBinding env top_lvl old_bndr bndr rhs `setDemandInfo` demandInfo info `setInlinePragInfo` inlinePragInfo info `setArityInfo` arityInfo info + `setStaticArgsInfo` staticArgsInfo info -- We do /not/ want to transfer OccInfo, Rules, Unfolding -- Note [Preserve strictness in cast w/w] @@ -3787,18 +3788,18 @@ simplLetUnfolding env top_lvl cont_mb id new_rhs rhs_ty arity unf = simplStableUnfolding env top_lvl cont_mb id rhs_ty arity unf | isExitJoinId id = return noUnfolding -- See Note [Do not inline exit join points] in GHC.Core.Opt.Exitify - | Just static_args <- isStrongLoopBreakerWithStaticArgs id - , (lam_bndrs, lam_body) <- collectBinders new_rhs + | (lam_bndrs, lam_body) <- collectBinders new_rhs + , Just static_args <- isStrongLoopBreakerWithNStaticArgs id (length lam_bndrs) = do { unf_rhs <- saTransform id static_args lam_bndrs lam_body ; pprTraceM "simplLetUnfolding" (ppr id $$ ppr static_args $$ ppr unf_rhs) ; mkLetUnfolding (seUnfoldingOpts env) top_lvl InlineRhs id unf_rhs } | otherwise = mkLetUnfolding (seUnfoldingOpts env) top_lvl InlineRhs id new_rhs -isStrongLoopBreakerWithStaticArgs :: Id -> Maybe [Staticness ()] -isStrongLoopBreakerWithStaticArgs id +isStrongLoopBreakerWithNStaticArgs :: Id -> Int -> Maybe [Staticness ()] +isStrongLoopBreakerWithNStaticArgs id n_args | isStrongLoopBreaker $ idOccInfo id - , static_args <- getStaticArgs $ idStaticArgs id + , static_args <- take n_args $ getStaticArgs $ idStaticArgs id , notNull static_args = Just static_args | otherwise ===================================== compiler/GHC/Core/Opt/StaticArgs.hs ===================================== @@ -185,7 +185,7 @@ satAnalExpr env e at Lam{} = (occs, mkLams bndrs body') (occs, body') = satAnalExpr (env `addInScopeVars` bndrs) body satAnalExpr env (Let bnd body) = (occs, Let bnd' body') where - (occs_bind, bnd') = satAnalBind env bnd' + (occs_bind, bnd') = satAnalBind env bnd (occs_body, body') = satAnalExpr (env `addInScopeVars` bindersOf bnd) body !occs = combineSatOccs occs_body occs_bind satAnalExpr env (Case scrut bndr ty alts) = (occs, Case scrut' bndr ty alts') @@ -201,12 +201,11 @@ satAnalAlt env (dc, bndrs, rhs) = (occs, (dc, bndrs, rhs')) (occs, rhs') = satAnalExpr (env `addInScopeVars` bndrs) rhs satAnalApp :: SatEnv -> CoreExpr -> [CoreArg] -> (SatOccs, CoreExpr) -satAnalApp env head args = (add_static_args_info occs, expr') +satAnalApp env head args = (add_static_args_info occs, mkApps head' args') where (occs_head, head') = satAnalExpr env head (occs_args, args') = mapAndUnzip (satAnalExpr env) args occs = combineSatOccsList (occs_head:occs_args) - expr' = mkApps head' args' add_static_args_info occs | Var fn <- head, Just params <- lookupInterestingId env fn = addSatOccs occs fn (mkStaticArgs $ zipWith asStaticArg params args) @@ -521,8 +520,11 @@ saTransformMaybe binder maybe_arg_staticness rhs_binders rhs_body n_static_args = count isStaticValue staticness saTransform :: MonadUnique m => Id -> [Staticness a] -> [Id] -> CoreExpr -> m CoreExpr +-- Precondition: At least as many arg_staticness as rhs_binders +-- Precondition: At least one NotStatic saTransform binder arg_staticness rhs_binders rhs_body - = do { MASSERT( arg_staticness `leLength` rhs_binders ) + = do { MASSERT2( arg_staticness `leLength` rhs_binders, ppr binder $$ ppr (mkStaticArgs arg_staticness) $$ ppr rhs_binders ) + ; MASSERT2( mkStaticArgs arg_staticness /= noStaticArgs, ppr binder $$ ppr rhs_binders ) ; shadow_lam_bndrs <- mapM clone binders_w_staticness ; uniq <- getUniqueM ; return (mk_new_rhs uniq shadow_lam_bndrs) } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b9867ba0386438dff378bb3b3b130e4d0be0c0d4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b9867ba0386438dff378bb3b3b130e4d0be0c0d4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 10 16:38:04 2020 From: gitlab at gitlab.haskell.org (John Ericson) Date: Thu, 10 Dec 2020 11:38:04 -0500 Subject: [Git][ghc/ghc][wip/primop-naming-consistency] 17 commits: gitlab-ci: Fix copy-paste error Message-ID: <5fd24eec8316c_6b2174471c97524b@gitlab.mail> John Ericson pushed to branch wip/primop-naming-consistency at Glasgow Haskell Compiler / GHC Commits: e0b08c5f by Ben Gamari at 2020-12-03T13:01:47-05:00 gitlab-ci: Fix copy-paste error Also be more consistent in quoting. - - - - - 33ec3a06 by Ben Gamari at 2020-12-03T23:11:31-05:00 gitlab-ci: Run linters through ci.sh Ensuring that the right toolchain is used. - - - - - 4a437bc1 by Shayne Fletcher at 2020-12-05T09:06:38-05:00 Fix bad span calculations of post qualified imports - - - - - 8fac4b93 by Ben Gamari at 2020-12-05T09:07:13-05:00 testsuite: Add a test for #18923 - - - - - 62ed6957 by Simon Peyton Jones at 2020-12-08T15:31:41-05:00 Fix kind inference for data types. Again. This patch fixes several aspects of kind inference for data type declarations, especially data /instance/ declarations Specifically 1. In kcConDecls/kcConDecl make it clear that the tc_res_kind argument is only used in the H98 case; and in that case there is no result kind signature; and hence no need for the disgusting splitPiTys in kcConDecls (now thankfully gone). The GADT case is a bit different to before, and much nicer. This is what fixes #18891. See Note [kcConDecls: kind-checking data type decls] 2. Do not look at the constructor decls of a data/newtype instance in tcDataFamInstanceHeader. See GHC.Tc.TyCl.Instance Note [Kind inference for data family instances]. This was a new realisation that arose when doing (1) This causes a few knock-on effects in the tests suite, because we require more information than before in the instance /header/. New user-manual material about this in "Kind inference in data type declarations" and "Kind inference for data/newtype instance declarations". 3. Minor improvement in kcTyClDecl, combining GADT and H98 cases 4. Fix #14111 and #8707 by allowing the header of a data instance to affect kind inferece for the the data constructor signatures; as described at length in Note [GADT return types] in GHC.Tc.TyCl This led to a modest refactoring of the arguments (and argument order) of tcConDecl/tcConDecls. 5. Fix #19000 by inverting the sense of the test in new_locs in GHC.Tc.Solver.Canonical.canDecomposableTyConAppOK. - - - - - 0abe3ddf by Adam Sandberg Ericsson at 2020-12-08T15:32:19-05:00 hadrian: build the _l and _thr_l rts flavours in the develN flavours The ghc binary requires the eventlog rts since fc644b1a643128041cfec25db84e417851e28bab - - - - - 51e3bb6d by Andreas Klebinger at 2020-12-08T22:43:21-05:00 CodeGen: Make folds User/DefinerOfRegs INLINEABLE. Reduces allocation for the test case I was looking at by about 1.2%. Mostly from avoiding allocation of some folding functions which turn into let-no-escape bindings which just reuse their environment instead. We also force inlining in a few key places in CmmSink which helps a bit more. - - - - - 69ae10c3 by Andreas Klebinger at 2020-12-08T22:43:21-05:00 CmmSink: Force inlining of foldRegsDefd Helps avoid allocating the folding function. Improves perf for T3294 by about 1%. - - - - - 6e3da800 by Andreas Klebinger at 2020-12-08T22:43:21-05:00 Cmm: Make a few types and utility function slightly stricter. About 0.6% reduction in allocations for the code I was looking at. Not a huge difference but no need to throw away performance. - - - - - aef44d7f by Andreas Klebinger at 2020-12-08T22:43:21-05:00 Cmm.Sink: Optimize retaining of assignments, live sets. Sinking requires us to track live local regs after each cmm statement. We used to do this via "Set LocalReg". However we can replace this with a solution based on IntSet which is overall more efficient without losing much. The thing we lose is width of the variables, which isn't used by the sinking pass anyway. I also reworked how we keep assignments to regs mentioned in skipped assignments. I put the details into Note [Keeping assignemnts mentioned in skipped RHSs]. The gist of it is instead of keeping track of it via the use count which is a `IntMap Int` we now use the live regs set (IntSet) which is quite a bit faster. I think it also matches the semantics a lot better. The skipped (not discarded) assignment does in fact keep the regs on it's rhs alive so keeping track of this in the live set seems like the clearer solution as well. Improves allocations for T3294 by yet another 1%. - - - - - 59f2249b by Andreas Klebinger at 2020-12-08T22:43:21-05:00 GHC.Cmm.Opt: Be stricter in results. Optimization either returns Nothing if nothing is to be done or `Just <cmmExpr>` otherwise. There is no point in being lazy in `cmmExpr`. We usually inspect this element so the thunk gets forced not long after. We might eliminate it as dead code once in a blue moon but that's not a case worth optimizing for. Overall the impact of this is rather low. As Cmm.Opt doesn't allocate much (compared to the rest of GHC) to begin with. - - - - - 54b88eac by Andreas Klebinger at 2020-12-08T22:43:57-05:00 Bump time submodule. This should fix #19002. - - - - - 35e7b0c6 by Kirill Elagin at 2020-12-10T01:45:54-05:00 doc: Clarify the default for -fomit-yields “Yield points enabled” is confusing (and probably wrong? I am not 100% sure what it means). Change it to a simple “on”. Undo this change from 2c23fff2e03e77187dc4d01f325f5f43a0e7cad2. - - - - - 3551c554 by Kirill Elagin at 2020-12-10T01:45:54-05:00 doc: Extra-clarify -fomit-yields Be more clear on what this optimisation being on by default means in terms of yields. - - - - - 6484f0d7 by Sergei Trofimovich at 2020-12-10T01:46:33-05:00 rts/linker/Elf.c: add missing <dlfcn.h> include (musl support) The change fixes build failure on musl: ``` rts/linker/Elf.c:2031:3: error: warning: implicit declaration of function 'dlclose'; did you mean 'close'? [-Wimplicit-function-declaration] 2031 | dlclose(nc->dlopen_handle); | ^~~~~~~ | close ``` Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - e11bbedb by Sylvain Henry at 2020-12-10T16:37:58+00:00 Fix sized primitives (#19026) Bump Cabal, array, bytestring, text submodules - - - - - 07cd9f3f by John Ericson at 2020-12-10T16:37:58+00:00 Cleanup number primop conversion names Don't use "extend" or "narrow" in some of the user-facing primops names for conversions. - Names like `narrowInt32#` are misleading when `Int` is 32-bits. - Names like `extendInt64#` are flat-out wrong when `Int is 32-bits. - `narrow{Int,Word}<N>#` however map a type to itself, and so don't suffer from this problem. They are left as-is. Bumps the array, bytestring, text, and binary submodules - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - compiler/GHC/Builtin/bytearray-ops.txt.pp - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/Expr.hs - + compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Liveness.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Data/FastString.hs - compiler/GHC/Hs/Extension.hs - compiler/GHC/Parser.y - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Utils/Outputable.hs - compiler/ghc.cabal.in - docs/users_guide/9.2.1-notes.rst - docs/users_guide/exts/poly_kinds.rst - docs/users_guide/using-optimisation.rst - hadrian/src/Settings/Flavours/Development.hs - libraries/Cabal - libraries/array The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e2e89133e23445e78775594f244f55732dfb60ea...07cd9f3fce0bac23aa6e35836efeacbf5767dae4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e2e89133e23445e78775594f244f55732dfb60ea...07cd9f3fce0bac23aa6e35836efeacbf5767dae4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 10 17:05:51 2020 From: gitlab at gitlab.haskell.org (John Ericson) Date: Thu, 10 Dec 2020 12:05:51 -0500 Subject: [Git][ghc/ghc][wip/primop-naming-consistency] 3 commits: Use static array in zeroCount Message-ID: <5fd2556f7c114_6b2174471c985286@gitlab.mail> John Ericson pushed to branch wip/primop-naming-consistency at Glasgow Haskell Compiler / GHC Commits: a631bc3c by Sylvain Henry at 2020-12-10T17:52:47+01:00 Use static array in zeroCount - - - - - 83738aa9 by Sylvain Henry at 2020-12-10T17:52:47+01:00 Fix sized primitives (#19026) Bump Cabal, array, bytestring, text submodules - - - - - a513969d by Sylvain Henry at 2020-12-10T17:02:42+00:00 Fix array and cleanup conversion primops (#19026) The first change makes the array ones use the proper fixed-size types, which also means that just like before, they can be used without explicit conversions with the boxed sized types. (Before, it was Int# / Word# on both sides, now it is fixed sized on both sides). For the second change, don't use "extend" or "narrow" in some of the user-facing primops names for conversions. - Names like `narrowInt32#` are misleading when `Int` is 32-bits. - Names like `extendInt64#` are flat-out wrong when `Int is 32-bits. - `narrow{Int,Word}<N>#` however map a type to itself, and so don't suffer from this problem. They are left as-is. These changes are batched together because Alex happend to use the array ops. We can only use released versions of Alex at this time, sadly, and I don't want to have to have a release thatwon't work for the final GHC 9.2. So by combining these we get all the changes for Alex done at once. Bump Cabal, array, bytestring, text, and binary submodules TODO bump alex version - - - - - 30 changed files: - compiler/GHC/Builtin/bytearray-ops.txt.pp - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Data/FastString.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/Tc/Deriv/Generate.hs - libraries/Cabal - libraries/array - libraries/base/GHC/Float/ConversionUtils.hs - libraries/base/GHC/IO/Encoding/CodePage.hs - libraries/base/GHC/IO/Encoding/UTF16.hs - libraries/base/GHC/IO/Encoding/UTF32.hs - libraries/base/GHC/IO/Encoding/UTF8.hs - libraries/base/GHC/Int.hs - libraries/base/GHC/Storable.hs - libraries/base/GHC/Word.hs - libraries/binary - libraries/bytestring - libraries/ghc-bignum/src/GHC/Num/Backend/GMP.hs - libraries/ghc-bignum/src/GHC/Num/Primitives.hs - libraries/ghc-boot/GHC/Utils/Encoding.hs - libraries/ghc-heap/tests/tso_and_stack_closures.hs - libraries/ghci/GHCi/BreakArray.hs - libraries/text - testsuite/tests/array/should_run/arr020.hs - testsuite/tests/cmm/opt/T18141.hs - testsuite/tests/codeGen/should_compile/T18614.hs - testsuite/tests/codeGen/should_run/cgrun070.hs - testsuite/tests/codeGen/should_run/cgrun072.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/07cd9f3fce0bac23aa6e35836efeacbf5767dae4...a513969dacabf4afa2b0aefecb607bf345cae67e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/07cd9f3fce0bac23aa6e35836efeacbf5767dae4...a513969dacabf4afa2b0aefecb607bf345cae67e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 10 17:10:48 2020 From: gitlab at gitlab.haskell.org (John Ericson) Date: Thu, 10 Dec 2020 12:10:48 -0500 Subject: [Git][ghc/ghc][wip/primop-naming-consistency] Fix array and cleanup conversion primops (#19026) Message-ID: <5fd25698eda5b_6b21410d5e8987763@gitlab.mail> John Ericson pushed to branch wip/primop-naming-consistency at Glasgow Haskell Compiler / GHC Commits: c29a34c5 by Sylvain Henry at 2020-12-10T17:09:41+00:00 Fix array and cleanup conversion primops (#19026) The first change makes the array ones use the proper fixed-size types, which also means that just like before, they can be used without explicit conversions with the boxed sized types. (Before, it was Int# / Word# on both sides, now it is fixed sized on both sides). For the second change, don't use "extend" or "narrow" in some of the user-facing primops names for conversions. - Names like `narrowInt32#` are misleading when `Int` is 32-bits. - Names like `extendInt64#` are flat-out wrong when `Int is 32-bits. - `narrow{Int,Word}<N>#` however map a type to itself, and so don't suffer from this problem. They are left as-is. These changes are batched together because Alex happend to use the array ops. We can only use released versions of Alex at this time, sadly, and I don't want to have to have a release thatwon't work for the final GHC 9.2. So by combining these we get all the changes for Alex done at once. Bump Cabal, array, bytestring, text, and binary submodules TODO bump alex version - - - - - 30 changed files: - compiler/GHC/Builtin/bytearray-ops.txt.pp - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Data/FastString.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/Tc/Deriv/Generate.hs - libraries/Cabal - libraries/array - libraries/base/GHC/IO/Encoding/CodePage.hs - libraries/base/GHC/IO/Encoding/UTF16.hs - libraries/base/GHC/IO/Encoding/UTF32.hs - libraries/base/GHC/IO/Encoding/UTF8.hs - libraries/base/GHC/Int.hs - libraries/base/GHC/Storable.hs - libraries/base/GHC/Word.hs - libraries/binary - libraries/bytestring - libraries/ghc-bignum/src/GHC/Num/Backend/GMP.hs - libraries/ghc-bignum/src/GHC/Num/Primitives.hs - libraries/ghc-boot/GHC/Utils/Encoding.hs - libraries/ghc-heap/tests/tso_and_stack_closures.hs - libraries/ghci/GHCi/BreakArray.hs - libraries/text - testsuite/tests/array/should_run/arr020.hs - testsuite/tests/cmm/opt/T18141.hs - testsuite/tests/codeGen/should_compile/T18614.hs - testsuite/tests/codeGen/should_run/cgrun070.hs - testsuite/tests/codeGen/should_run/cgrun072.hs - testsuite/tests/codeGen/should_run/cgrun075.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c29a34c5a242528afc48df6bbf79840756bf6b01 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c29a34c5a242528afc48df6bbf79840756bf6b01 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 10 18:00:48 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 10 Dec 2020 13:00:48 -0500 Subject: [Git][ghc/ghc][wip/T7275] rts: Enforce that mark-region isn't used with -h Message-ID: <5fd262505a531_6b2131d5c389973de@gitlab.mail> Ben Gamari pushed to branch wip/T7275 at Glasgow Haskell Compiler / GHC Commits: decf9ef5 by Ben Gamari at 2020-12-10T12:59:58-05:00 rts: Enforce that mark-region isn't used with -h As noted in #9666, the mark-region GC is not compatible with heap profiling. Also add documentation for this flag. Closes #9666. - - - - - 2 changed files: - docs/users_guide/runtime_control.rst - rts/RtsFlags.c Changes: ===================================== docs/users_guide/runtime_control.rst ===================================== @@ -411,6 +411,17 @@ performance. Note that :rts-flag:`--nonmoving-gc` cannot be used with ``-G1``, :rts-flag:`profiling <-hc>` nor :rts-flag:`-c`. +.. rts-flag:: -w + + :default: off + :since: a long time ago + :reverse: none + + Uses a mark-region garbage collection strategy for the oldest-generation heap. + Note that this cannot be used in conjunction with heap profiling + (:rts-flag:`-hT`) unless linked against the profiling runtime system with + :ghc-flag:`-prof`. + .. rts-flag:: -xn :default: off ===================================== rts/RtsFlags.c ===================================== @@ -1849,6 +1849,16 @@ static void normaliseRtsOpts (void) barf("The non-moving collector doesn't support -G1"); } +#if !defined(PROFILING) && !defined(DEBUG) + // The mark-region collector is incompatible with heap census unless + // we zero slop of blackhole'd thunks, which doesn't happen in the + // vanilla way. See #9666. + if (RtsFlags.ProfFlags.doHeapProfile && RtsFlags.GcFlags.sweep) { + barf("The mark-region collector can only be used with profiling\n" + "when linked against the profiled RTS."); + } +#endif + if (RtsFlags.ProfFlags.doHeapProfile != NO_HEAP_PROFILING && RtsFlags.GcFlags.useNonmoving) { barf("The non-moving collector doesn't support profiling"); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/decf9ef5f770d0fa95cf35608cfdea25c0520091 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/decf9ef5f770d0fa95cf35608cfdea25c0520091 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 10 18:02:32 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 10 Dec 2020 13:02:32 -0500 Subject: [Git][ghc/ghc][wip/T7275] 2 commits: rts: Zero shrunk array slop in vanilla RTS Message-ID: <5fd262b81e0eb_6b214011b809980aa@gitlab.mail> Ben Gamari pushed to branch wip/T7275 at Glasgow Haskell Compiler / GHC Commits: adb87d30 by Ben Gamari at 2020-12-10T13:02:23-05:00 rts: Zero shrunk array slop in vanilla RTS But only when profiling or DEBUG are enabled. Fixes #17572. - - - - - 73f23069 by Ben Gamari at 2020-12-10T13:02:26-05:00 rts: Enforce that mark-region isn't used with -h As noted in #9666, the mark-region GC is not compatible with heap profiling. Also add documentation for this flag. Closes #9666. - - - - - 5 changed files: - docs/users_guide/runtime_control.rst - includes/Cmm.h - rts/RtsFlags.c - rts/sm/Storage.c - utils/deriveConstants/Main.hs Changes: ===================================== docs/users_guide/runtime_control.rst ===================================== @@ -411,6 +411,17 @@ performance. Note that :rts-flag:`--nonmoving-gc` cannot be used with ``-G1``, :rts-flag:`profiling <-hc>` nor :rts-flag:`-c`. +.. rts-flag:: -w + + :default: off + :since: a long time ago + :reverse: none + + Uses a mark-region garbage collection strategy for the oldest-generation heap. + Note that this cannot be used in conjunction with heap profiling + (:rts-flag:`-hT`) unless linked against the profiling runtime system with + :ghc-flag:`-prof`. + .. rts-flag:: -xn :default: off ===================================== includes/Cmm.h ===================================== @@ -630,7 +630,11 @@ #else #define OVERWRITING_CLOSURE_SIZE(c, size) /* nothing */ #define OVERWRITING_CLOSURE(c) /* nothing */ -#define OVERWRITING_CLOSURE_MUTABLE(c, off) /* nothing */ +/* This is used to zero slop after shrunk arrays. It is important that we do + * this whenever profiling is enabled as described in Note [slop on the heap] + * in Storage.c. */ +#define OVERWRITING_CLOSURE_MUTABLE(c, off) \ + if (RtsFlags_ProfFlags_doHeapProfile(RtsFlags) != 0) { foreign "C" overwritingMutableClosureOfs(c "ptr", off); } #endif // Memory barriers. ===================================== rts/RtsFlags.c ===================================== @@ -1849,6 +1849,16 @@ static void normaliseRtsOpts (void) barf("The non-moving collector doesn't support -G1"); } +#if !defined(PROFILING) && !defined(DEBUG) + // The mark-region collector is incompatible with heap census unless + // we zero slop of blackhole'd thunks, which doesn't happen in the + // vanilla way. See #9666. + if (RtsFlags.ProfFlags.doHeapProfile && RtsFlags.GcFlags.sweep) { + barf("The mark-region collector can only be used with profiling\n" + "when linked against the profiled RTS."); + } +#endif + if (RtsFlags.ProfFlags.doHeapProfile != NO_HEAP_PROFILING && RtsFlags.GcFlags.useNonmoving) { barf("The non-moving collector doesn't support profiling"); ===================================== rts/sm/Storage.c ===================================== @@ -953,14 +953,19 @@ accountAllocation(Capability *cap, W_ n) * profiler, see Note [skipping slop in the heap profiler]. * * In general we zero: + * * - Pinned object alignment slop, see MEMSET_SLOP_W in allocatePinned. * - Large object alignment slop, see MEMSET_SLOP_W in allocatePinned. - * This is necessary even in the vanilla RTS since the user may trigger a heap - * census via +RTS -hT even when not linking against the profiled RTS. - * - * Only when profiling we zero: * - Shrunk array slop, see OVERWRITING_CLOSURE_MUTABLE. * + * Note that this is necessary even in the vanilla (e.g. non-profiling) RTS + * since the user may trigger a heap census via +RTS -hT, which can be used + * even when not linking against the profiled RTS. Failing to zero slop + * due to array shrinking has resulted in a few nasty bugs (#17572, #9666). + * However, since array shrink may result in large amounts of slop (unlike + * alignment), we take care to only zero such slop when heap profiling or DEBUG + * are enabled. + * * When performing LDV profiling or using a (single threaded) debug RTS we zero * slop even when overwriting immutable closures, see Note [zeroing slop when * overwriting closures]. ===================================== utils/deriveConstants/Main.hs ===================================== @@ -561,6 +561,8 @@ wanteds os = concat ,structField C "StgCompactNFDataBlock" "owner" ,structField C "StgCompactNFDataBlock" "next" + ,structField_ C "RtsFlags_ProfFlags_doHeapProfile" + "RTS_FLAGS" "ProfFlags.doHeapProfile" ,structField_ C "RtsFlags_ProfFlags_showCCSOnException" "RTS_FLAGS" "ProfFlags.showCCSOnException" ,structField_ C "RtsFlags_DebugFlags_apply" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/decf9ef5f770d0fa95cf35608cfdea25c0520091...73f23069b34cea50d237c10125b5814df6b19bff -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/decf9ef5f770d0fa95cf35608cfdea25c0520091...73f23069b34cea50d237c10125b5814df6b19bff You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 10 20:51:04 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Thu, 10 Dec 2020 15:51:04 -0500 Subject: [Git][ghc/ghc][wip/T18962-simpl] Zap some idStaticArgs Message-ID: <5fd28a38bab3f_6b2174471c1023230@gitlab.mail> Sebastian Graf pushed to branch wip/T18962-simpl at Glasgow Haskell Compiler / GHC Commits: 0aae1d23 by Sebastian Graf at 2020-12-10T21:50:59+01:00 Zap some idStaticArgs - - - - - 1 changed file: - compiler/GHC/Core/Opt/Simplify.hs Changes: ===================================== compiler/GHC/Core/Opt/Simplify.hs ===================================== @@ -796,7 +796,7 @@ completeBind env top_lvl mb_cont old_bndr new_bndr new_rhs addLetBndrInfo :: OutId -> ArityType -> Unfolding -> OutId addLetBndrInfo new_bndr new_arity_type new_unf - = new_bndr `setIdInfo` info5 + = new_bndr `setIdInfo` info6 where AT oss div = new_arity_type new_arity = length oss @@ -804,7 +804,7 @@ addLetBndrInfo new_bndr new_arity_type new_unf info1 = idInfo new_bndr `setArityInfo` new_arity -- Unfolding info: Note [Setting the new unfolding] - info2 = info1 `setUnfoldingInfo` new_unf + info2 = info1 `setUnfoldingInfo` new_unf -- Demand info: Note [Setting the demand info] -- We also have to nuke demand info if for some reason @@ -830,6 +830,25 @@ addLetBndrInfo new_bndr new_arity_type new_unf -- information, leading to broken code later (e.g. #13479) info5 = zapCallArityInfo info4 + -- Eta reduction might have contracted all the static arguments, in which case + -- we have not SAT'd the unfolding. That's easy to find out by counting the + -- manifest lambdas of the unfolding and trimming the static args info to as + -- many arguments. If there are none left, we get @noStaticArgs@, which + -- amounts to zapping. + -- Failing to zap in that case means we inline the recursive vanilla + -- unfolding, resulting in a loop. + info6 + | let sas = idStaticArgs new_bndr + , sas /= noStaticArgs + , Just tmpl <- maybeUnfoldingTemplate new_unf + , (lams, _) <- collectBinders tmpl + , let !new_sas = mkStaticArgs $ take (length lams) $ getStaticArgs sas + , new_sas /= sas + = info5 `setStaticArgsInfo` new_sas + | isStableUnfolding new_unf + = info5 `setStaticArgsInfo` noStaticArgs -- zap SA info, otherwise we inline a recursive stable unfolding! Cf. mapUnionFV + | otherwise + = info5 {- Note [Arity decrease] ~~~~~~~~~~~~~~~~~~~~~~~~ @@ -3791,7 +3810,7 @@ simplLetUnfolding env top_lvl cont_mb id new_rhs rhs_ty arity unf | (lam_bndrs, lam_body) <- collectBinders new_rhs , Just static_args <- isStrongLoopBreakerWithNStaticArgs id (length lam_bndrs) = do { unf_rhs <- saTransform id static_args lam_bndrs lam_body - ; pprTraceM "simplLetUnfolding" (ppr id $$ ppr static_args $$ ppr unf_rhs) + -- ; pprTraceM "simplLetUnfolding" (ppr id $$ ppr static_args $$ ppr unf_rhs) ; mkLetUnfolding (seUnfoldingOpts env) top_lvl InlineRhs id unf_rhs } | otherwise = mkLetUnfolding (seUnfoldingOpts env) top_lvl InlineRhs id new_rhs View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0aae1d235bc8d7fd0702d5d8bcc0bd286b841030 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0aae1d235bc8d7fd0702d5d8bcc0bd286b841030 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 10 21:10:41 2020 From: gitlab at gitlab.haskell.org (John Ericson) Date: Thu, 10 Dec 2020 16:10:41 -0500 Subject: [Git][ghc/ghc][wip/primop-naming-consistency] Fix array and cleanup conversion primops (#19026) Message-ID: <5fd28ed16a725_6b21410d5e8103488e@gitlab.mail> John Ericson pushed to branch wip/primop-naming-consistency at Glasgow Haskell Compiler / GHC Commits: 580c5469 by Sylvain Henry at 2020-12-10T21:09:57+00:00 Fix array and cleanup conversion primops (#19026) The first change makes the array ones use the proper fixed-size types, which also means that just like before, they can be used without explicit conversions with the boxed sized types. (Before, it was Int# / Word# on both sides, now it is fixed sized on both sides). For the second change, don't use "extend" or "narrow" in some of the user-facing primops names for conversions. - Names like `narrowInt32#` are misleading when `Int` is 32-bits. - Names like `extendInt64#` are flat-out wrong when `Int is 32-bits. - `narrow{Int,Word}<N>#` however map a type to itself, and so don't suffer from this problem. They are left as-is. These changes are batched together because Alex happend to use the array ops. We can only use released versions of Alex at this time, sadly, and I don't want to have to have a release thatwon't work for the final GHC 9.2. So by combining these we get all the changes for Alex done at once. Bump Cabal, array, bytestring, text, and binary submodules TODO bump alex version - - - - - 30 changed files: - compiler/GHC/Builtin/bytearray-ops.txt.pp - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Data/FastString.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/Tc/Deriv/Generate.hs - libraries/Cabal - libraries/array - libraries/base/GHC/IO/Encoding/CodePage.hs - libraries/base/GHC/IO/Encoding/UTF16.hs - libraries/base/GHC/IO/Encoding/UTF32.hs - libraries/base/GHC/IO/Encoding/UTF8.hs - libraries/base/GHC/Int.hs - libraries/base/GHC/Storable.hs - libraries/base/GHC/Word.hs - libraries/binary - libraries/bytestring - libraries/ghc-bignum/src/GHC/Num/Backend/GMP.hs - libraries/ghc-bignum/src/GHC/Num/Primitives.hs - libraries/ghc-boot/GHC/Utils/Encoding.hs - libraries/ghc-heap/tests/tso_and_stack_closures.hs - libraries/ghci/GHCi/BreakArray.hs - libraries/text - testsuite/tests/array/should_run/arr020.hs - testsuite/tests/cmm/opt/T18141.hs - testsuite/tests/codeGen/should_compile/T18614.hs - testsuite/tests/codeGen/should_run/cgrun070.hs - testsuite/tests/codeGen/should_run/cgrun072.hs - testsuite/tests/codeGen/should_run/cgrun075.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/580c5469026e36c11cfebc9531758871f936ae2e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/580c5469026e36c11cfebc9531758871f936ae2e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 10 21:31:51 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 10 Dec 2020 16:31:51 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/backports-8.10 Message-ID: <5fd293c7d7db0_6b2174471c1035569@gitlab.mail> Ben Gamari pushed new branch wip/backports-8.10 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/backports-8.10 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 10 21:55:16 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 10 Dec 2020 16:55:16 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: doc: Clarify the default for -fomit-yields Message-ID: <5fd299443bf1e_6b213f800b810551a1@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 35e7b0c6 by Kirill Elagin at 2020-12-10T01:45:54-05:00 doc: Clarify the default for -fomit-yields “Yield points enabled” is confusing (and probably wrong? I am not 100% sure what it means). Change it to a simple “on”. Undo this change from 2c23fff2e03e77187dc4d01f325f5f43a0e7cad2. - - - - - 3551c554 by Kirill Elagin at 2020-12-10T01:45:54-05:00 doc: Extra-clarify -fomit-yields Be more clear on what this optimisation being on by default means in terms of yields. - - - - - 6484f0d7 by Sergei Trofimovich at 2020-12-10T01:46:33-05:00 rts/linker/Elf.c: add missing <dlfcn.h> include (musl support) The change fixes build failure on musl: ``` rts/linker/Elf.c:2031:3: error: warning: implicit declaration of function 'dlclose'; did you mean 'close'? [-Wimplicit-function-declaration] 2031 | dlclose(nc->dlopen_handle); | ^~~~~~~ | close ``` Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - 215ea679 by Ben Gamari at 2020-12-10T16:55:07-05:00 users guide: Fix syntax errors Fixes errors introduced by 3a55b3a2574f913d046f3a6f82db48d7f6df32e3. - - - - - 00a9f10b by Ben Gamari at 2020-12-10T16:55:07-05:00 users guide: Describe GC lifecycle events Every time I am asked about how to interpret these events I need to figure it out from scratch. It's well past time that the users guide properly documents these. - - - - - 62d10d31 by Ben Gamari at 2020-12-10T16:55:07-05:00 gitlab-ci: Fix incorrect Docker image for nightly cross job Also refactor the job definition to eliminate the bug by construction. - - - - - 6acfc525 by Ben Gamari at 2020-12-10T16:55:07-05:00 gitlab-ci: Fix name of flavour in ThreadSanitizer job It looks like I neglected to update this after introduce flavour transformers. - - - - - 6 changed files: - .gitlab-ci.yml - docs/users_guide/eventlog-formats.rst - docs/users_guide/runtime_control.rst - docs/users_guide/using-optimisation.rst - rts/Stats.c - rts/linker/Elf.c Changes: ===================================== .gitlab-ci.yml ===================================== @@ -257,27 +257,24 @@ validate-x86_64-linux-deb9-unreg-hadrian: CONFIGURE_ARGS: --enable-unregisterised TEST_ENV: "x86_64-linux-deb9-unreg-hadrian" -validate-x86_64-linux-deb10-hadrian-cross-aarch64: - <<: *nightly +.build-x86_64-linux-deb10-hadrian-cross-aarch64: extends: .validate-linux-hadrian - stage: full-build image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV" variables: BIN_DIST_NAME: "ghc-x86_64-deb9-linux" - rules: - - if: '$CI_MERGE_REQUEST_LABELS =~ /.*cross-compilation.*/' - variables: CONFIGURE_ARGS: --with-intree-gmp CROSS_TARGET: "aarch64-linux-gnu" +validate-x86_64-linux-deb10-hadrian-cross-aarch64: + extends: .build-x86_64-linux-deb10-hadrian-cross-aarch64 + stage: full-build + rules: + - if: '$CI_MERGE_REQUEST_LABELS =~ /.*cross-compilation.*/' + nightly-x86_64-linux-deb10-hadrian-cross-aarch64: <<: *nightly - extends: .validate-linux-hadrian + extends: .build-x86_64-linux-deb10-hadrian-cross-aarch64 stage: full-build - variables: - CONFIGURE_ARGS: --with-intree-gmp - CROSS_TARGET: "aarch64-linux-gnu" - ############################################################ @@ -712,7 +709,7 @@ nightly-x86_64-linux-deb9-integer-simple: stage: full-build variables: TEST_ENV: "x86_64-linux-deb9-tsan" - BUILD_FLAVOUR: "thread-sanitizer" + BUILD_FLAVOUR: "default+thread_sanitizer" TSAN_OPTIONS: "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions" # Haddock is large enough to make TSAN choke without massive quantities of # memory. ===================================== docs/users_guide/eventlog-formats.rst ===================================== @@ -207,9 +207,61 @@ Thread and scheduling events :base-ref:`Control.Concurrent.setThreadLabel`). +.. _gc-events: + Garbage collector events ~~~~~~~~~~~~~~~~~~~~~~~~ +The following events mark various points of the lifecycle of a moving garbage +collection. + +A typical garbage collection will look something like the following: + +1. A capability realizes that it needs a garbage collection (e.g. as a result + of running out of nursery) and requests a garbage collection. This is + marked by :event-type:`REQUEST_SEQ_GC` or :event-type:`REQUEST_PAR_GC`. + +2. As other capabilities reach yield points and suspend execution they emit + :event-type:`STOP_THREAD` events. + +3. When all capabilities have suspended execution, collection will begin, + marked by a :event-type:`GC_START` event. + +4. As individual parallel GC threads commence with scavenging they will emit + :event-type:`GC_WORK` events. + +5. If a parallel GC thread runs out of work it will emit a + :event-type:`GC_IDLE` event. If it is later handed more work it will emit + another :event-type:`GC_WORK` event. + +6. Eventually when scavenging has finished a :event-type:`GC_DONE` event + will be emitted by each GC thread. + +7. A bit of book-keeping is performed. + +8. A :event-type:`GC_END` event will be emitted marking the end of the GC cycle. + +9. A :event-type:`HEAP_SIZE` event will be emitted giving the + cumulative heap allocations of the program until now. + +10. A :event-type:`GC_STATS_GHC` event will be emitted + containing various details of the collection and heap state. + +11. In the case of a major collection, a + :event-type:`HEAP_LIVE` event will be emitted describing + the current size of the live on-heap data. + +12. In the case of the :ghc-flag:`-threaded` RTS, a + :event-type:`SPARK_COUNTERS` event will be emitted giving + details on how many sparks have been created, evaluated, and GC'd. + +13. As mutator threads resume execution they will emit :event-type:`RUN_THREAD` + events. + +Note that in the case of the concurrent non-moving collector additional events +will be emitted during the concurrent phase of collection. These are described +in :ref:`nonmoving-gc-events`. + .. event-type:: GC_START :tag: 9 @@ -685,6 +737,46 @@ These events mark various stages of the :rts-flag:`non-moving collection <--nonmoving-gc>` lifecycle. These are enabled with the ``+RTS -lg`` event-set. +A typical non-moving collection cycle will look something like the following: + +1. The preparatory phase of collection will emit the usual events associated + with a moving collection. See :ref:`gc-events` for details. + +2. The concurrent write barrier is enabled and the concurrent mark thread is + started. From this point forward mutator threads may emit + :event-type:`CONC_UPD_REM_SET_FLUSH` events, indicating that they have + flushed their capability-local update remembered sets. + +3. Concurrent marking begins, denoted by a :event-type:`CONC_MARK_BEGIN` event. + +4. When the mark queue is depleted a :event-type:`CONC_MARK_END` is emitted. + +5. If necessary (e.g. due to weak pointer marking), the marking process will + continue, returning to step (3) above. + +6. When the collector has done as much concurrent marking as it can it will + enter the post-mark synchronization phase of collection, denoted by a + :event-type:`CONC_SYNC_BEGIN` event. + +7. Mutator threads will suspend execution and, if necessary, flush their update + remembered sets (indicated by :event-type:`CONC_UPD_REM_SET_FLUSH` events). + +8. The collector will do any final marking necessary (indicated by + :event-type:`CONC_MARK_BEGIN` and :event-type:`CONC_MARK_END` events). + +9. The collector will do a small amount of sweeping, disable the write barrier, + emit a :event-type:`CONC_SYNC_END` event, and allow mutators to resume + +10. The collector will begin the concurrent sweep phase, indicated by a + :event-type:`CONC_SWEEP_BEGIN` event. + +11. Once sweeping has concluded a :event-type:`CONC_SWEEP_END` event will be + emitted and the concurrent collector thread will terminate. + +12. A :event-type:`NONMOVING_HEAP_CENSUS` event will be emitted describing the + fragmentation state of the non-moving heap. + + .. event-type:: CONC_MARK_BEGIN :tag: 200 @@ -742,8 +834,9 @@ with the ``+RTS -lg`` event-set. Non-moving heap census ~~~~~~~~~~~~~~~~~~~~~~ -The non-moving heap census events (enabled with the ``+RTS -ln`` event-set) are -intended to provide insight into fragmentation of the non-moving heap. +The non-moving heap census events (enabled with the :rts-flag:`+RTS -ln <-l ⟨flags⟩>` +event-set) are intended to provide insight into fragmentation of the non-moving +heap. .. event-type:: NONMOVING_HEAP_CENSUS @@ -760,8 +853,8 @@ Ticky counters ~~~~~~~~~~~~~~ Programs compiled with :ghc-flag:`-ticky` and :ghc-flag:`-eventlog` and invoked -with ``+RTS -lT`` will emit periodic samples of the ticky entry counters to the -eventlog. +with :rts-flag:`+RTS -lT <-l ⟨flags⟩>` will emit periodic samples of the ticky +entry counters to the eventlog. .. event-type:: TICKY_COUNTER_DEF ===================================== docs/users_guide/runtime_control.rst ===================================== @@ -1194,6 +1194,9 @@ When the program is linked with the :ghc-flag:`-eventlog` option - ``f`` — parallel sparks (fully accurate). Disabled by default. + - ``T`` — :ghc-flag:`ticky-ticky profiler <-ticky>` events. Disabled by + default. + - ``u`` — user events. These are events emitted from Haskell code using functions such as ``Debug.Trace.traceEvent``. Enabled by default. ===================================== docs/users_guide/using-optimisation.rst ===================================== @@ -720,7 +720,7 @@ by saying ``-fno-wombat``. :reverse: -fno-omit-yields :category: - :default: yield points enabled + :default: on (yields are *not* inserted) Tells GHC to omit heap checks when no allocation is being performed. While this improves binary sizes by about 5%, it @@ -1197,16 +1197,16 @@ by saying ``-fno-wombat``. This is the full syntax for cardinalities, demands and sub-demands in BNF: - .. code-block:: + .. code-block:: none - card ::= B | A | 1 | U | S | M semantics as in the table above + card ::= B | A | 1 | U | S | M semantics as in the table above - d ::= card sd card = how often, sd = how deep - | card abbreviation: Same as "card card" + d ::= card sd card = how often, sd = how deep + | card abbreviation: Same as "card card" - sd ::= card polymorphic sub-demand, card at every level - | P(d,d,..) product sub-demand - | Ccard(sd) call sub-demand + sd ::= card polymorphic sub-demand, card at every level + | P(d,d,..) product sub-demand + | Ccard(sd) call sub-demand For example, ``fst`` is strict in its argument, and also in the first component of the argument. It will not evaluate the argument's second @@ -1234,17 +1234,17 @@ by saying ``-fno-wombat``. We summarise a function's demand properties in its *demand signature*. This is the general syntax: - .. code-block:: + .. code-block:: none - {x->dx,y->dy,z->dz...}...div - ^ ^ ^ ^ ^ ^ - | | | | | | - | \---+---+------/ | - | | | - demand on free demand on divergence - variables arguments information - (omitted if empty) (omitted if - no information) + {x->dx,y->dy,z->dz...}...div + ^ ^ ^ ^ ^ ^ + | | | | | | + | \---+---+------/ | + | | | + demand on free demand on divergence + variables arguments information + (omitted if empty) (omitted if + no information) We summarise ``fst``'s demand properties in its *demand signature* ````, which just says "If ``fst`` is applied to one argument, @@ -1260,13 +1260,11 @@ by saying ``-fno-wombat``. **Call sub-demands** - Consider ``maybe``: + Consider ``maybe``: :: - .. code-block:: - - maybe :: b -> (a -> b) -> Maybe a -> b - maybe n _ Nothing = n - maybe _ s (Just a) = s a + maybe :: b -> (a -> b) -> Maybe a -> b + maybe n _ Nothing = n + maybe _ s (Just a) = s a We give it demand signature ``<1C1(U)>``. The ``C1(U)`` is a *call sub-demand* that says "Called at most once, where the result is used ===================================== rts/Stats.c ===================================== @@ -570,7 +570,7 @@ stat_endGC (Capability *cap, gc_thread *initiating_gct, W_ live, W_ copied, W_ s // Emit events to the event log // Has to be emitted while all caps stopped for GC, but before GC_END. - // See trac.haskell.org/ThreadScope/wiki/RTSsummaryEvents + // See https://gitlab.haskell.org/ghc/ghc/-/wikis/RTSsummaryEvents // for a detailed design rationale of the current setup // of GC eventlog events. traceEventGcGlobalSync(cap); ===================================== rts/linker/Elf.c ===================================== @@ -32,6 +32,9 @@ #include #include #include +#if defined(HAVE_DLFCN_H) +#include +#endif #if defined(HAVE_SYS_STAT_H) #include #endif View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e4f41000077c2da09b2ca7ffc623aefff21da6ee...6acfc525611463525587a0af5cf591c6fdbe8cf1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e4f41000077c2da09b2ca7ffc623aefff21da6ee...6acfc525611463525587a0af5cf591c6fdbe8cf1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 10 23:24:34 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Thu, 10 Dec 2020 18:24:34 -0500 Subject: [Git][ghc/ghc][wip/T18962] 18 commits: Move core flattening algorithm to Core.Unify Message-ID: <5fd2ae32122eb_6b2131d5c381069346@gitlab.mail> Sebastian Graf pushed to branch wip/T18962 at Glasgow Haskell Compiler / GHC Commits: 72a87fbc by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Move core flattening algorithm to Core.Unify This sets the stage for a later change, where this algorithm will be needed from GHC.Core.InstEnv. This commit also splits GHC.Core.Map into GHC.Core.Map.Type and GHC.Core.Map.Expr, in order to avoid module import cycles with GHC.Core. - - - - - 0dd45d0a by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Bump the # of commits searched for perf baseline The previous value of 75 meant that a feature branch with more than 75 commits would get spurious CI passes. This affects #18692, but does not fix that ticket, because if a baseline cannot be found, we should fail, not succeed. - - - - - 8bb52d91 by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Remove flattening variables This patch redesigns the flattener to simplify type family applications directly instead of using flattening meta-variables and skolems. The key new innovation is the CanEqLHS type and the new CEqCan constraint (Ct). A CanEqLHS is either a type variable or exactly-saturated type family application; either can now be rewritten using a CEqCan constraint in the inert set. Because the flattener no longer reduces all type family applications to variables, there was some performance degradation if a lengthy type family application is now flattened over and over (not making progress). To compensate, this patch contains some extra optimizations in the flattener, leading to a number of performance improvements. Close #18875. Close #18910. There are many extra parts of the compiler that had to be affected in writing this patch: * The family-application cache (formerly the flat-cache) sometimes stores coercions built from Given inerts. When these inerts get kicked out, we must kick out from the cache as well. (This was, I believe, true previously, but somehow never caused trouble.) Kicking out from the cache requires adding a filterTM function to TrieMap. * This patch obviates the need to distinguish "blocking" coercion holes from non-blocking ones (which, previously, arose from CFunEqCans). There is thus some simplification around coercion holes. * Extra commentary throughout parts of the code I read through, to preserve the knowledge I gained while working. * A change in the pure unifier around unifying skolems with other types. Unifying a skolem now leads to SurelyApart, not MaybeApart, as documented in Note [Binding when looking up instances] in GHC.Core.InstEnv. * Some more use of MCoercion where appropriate. * Previously, class-instance lookup automatically noticed that e.g. C Int was a "unifier" to a target [W] C (F Bool), because the F Bool was flattened to a variable. Now, a little more care must be taken around checking for unifying instances. * Previously, tcSplitTyConApp_maybe would split (Eq a => a). This is silly, because (=>) is not a tycon in Haskell. Fixed now, but there are some knock-on changes in e.g. TrieMap code and in the canonicaliser. * New function anyFreeVarsOf{Type,Co} to check whether a free variable satisfies a certain predicate. * Type synonyms now remember whether or not they are "forgetful"; a forgetful synonym drops at least one argument. This is useful when flattening; see flattenView. * The pattern-match completeness checker invokes the solver. This invocation might need to look through newtypes when checking representational equality. Thus, the desugarer needs to keep track of the in-scope variables to know what newtype constructors are in scope. I bet this bug was around before but never noticed. * Extra-constraints wildcards are no longer simplified before printing. See Note [Do not simplify ConstraintHoles] in GHC.Tc.Solver. * Whether or not there are Given equalities has become slightly subtler. See the new HasGivenEqs datatype. * Note [Type variable cycles in Givens] in GHC.Tc.Solver.Canonical explains a significant new wrinkle in the new approach. * See Note [What might match later?] in GHC.Tc.Solver.Interact, which explains the fix to #18910. * The inert_count field of InertCans wasn't actually used, so I removed it. Though I (Richard) did the implementation, Simon PJ was very involved in design and review. This updates the Haddock submodule to avoid #18932 by adding a type signature. ------------------------- Metric Decrease: T12227 T5030 T9872a T9872b T9872c Metric Increase: T9872d ------------------------- - - - - - d66660ba by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Rename the flattener to become the rewriter. Now that flattening doesn't produce flattening variables, it's not really flattening anything: it's rewriting. This change also means that the rewriter can no longer be confused the core flattener (in GHC.Core.Unify), which is sometimes used during type-checking. - - - - - add0aeae by Ben Gamari at 2020-12-01T19:58:17-05:00 rts: Introduce mmapAnonForLinker Previously most of the uses of mmapForLinker were mapping anonymous memory, resulting in a great deal of unnecessary repetition. Factor this out into a new helper. Also fixes a few places where error checking was missing or suboptimal. - - - - - 97d71646 by Ben Gamari at 2020-12-01T19:58:17-05:00 rts/linker: Introduce munmapForLinker Consolidates munmap calls to ensure consistent error handling. - - - - - d8872af0 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/Linker: Introduce Windows implementations for mmapForLinker, et al. - - - - - c35d0e03 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/m32: Introduce NEEDS_M32 macro Instead of relying on RTS_LINKER_USE_MMAP - - - - - 41c64eb5 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/linker: Use m32 to allocate symbol extras in PEi386 - - - - - e0b08c5f by Ben Gamari at 2020-12-03T13:01:47-05:00 gitlab-ci: Fix copy-paste error Also be more consistent in quoting. - - - - - 33ec3a06 by Ben Gamari at 2020-12-03T23:11:31-05:00 gitlab-ci: Run linters through ci.sh Ensuring that the right toolchain is used. - - - - - 4a437bc1 by Shayne Fletcher at 2020-12-05T09:06:38-05:00 Fix bad span calculations of post qualified imports - - - - - 8fac4b93 by Ben Gamari at 2020-12-05T09:07:13-05:00 testsuite: Add a test for #18923 - - - - - 95dd3cde by Sebastian Graf at 2020-12-08T12:40:10+01:00 Implement Static Argument analysis in the Occurrence Analyser .. so that we can exploit it in the Simplifier. - - - - - 584ce104 by Sebastian Graf at 2020-12-08T12:40:46+01:00 A few changes to callSiteInline, acting as a bookmark - - - - - e8be408f by Sebastian Graf at 2020-12-09T18:01:51+01:00 Implement as separate analysis instead; feed on that in Simplifier - - - - - b9867ba0 by Sebastian Graf at 2020-12-10T15:57:31+01:00 tmp - - - - - 0aae1d23 by Sebastian Graf at 2020-12-10T21:50:59+01:00 Zap some idStaticArgs - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Axiom.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FamInstEnv.hs - compiler/GHC/Core/InstEnv.hs - + compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Map.hs → compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/Opt/CSE.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/StaticArgs.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/TyCon/Env.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/Maybe.hs - compiler/GHC/Data/TrieMap.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Monad.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1822f12a313da30fed1cca513a7c26c8620aaeb5...0aae1d235bc8d7fd0702d5d8bcc0bd286b841030 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1822f12a313da30fed1cca513a7c26c8620aaeb5...0aae1d235bc8d7fd0702d5d8bcc0bd286b841030 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 11 04:06:24 2020 From: gitlab at gitlab.haskell.org (Richard Eisenberg) Date: Thu, 10 Dec 2020 23:06:24 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/T18998 Message-ID: <5fd2f040cf676_6b214011b8010768e9@gitlab.mail> Richard Eisenberg pushed new branch wip/T18998 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T18998 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 11 04:07:05 2020 From: gitlab at gitlab.haskell.org (Richard Eisenberg) Date: Thu, 10 Dec 2020 23:07:05 -0500 Subject: [Git][ghc/ghc][wip/T18998] Unfortunate dirty hack to overcome #18998. Message-ID: <5fd2f06954c61_6b213272ce0107706d@gitlab.mail> Richard Eisenberg pushed to branch wip/T18998 at Glasgow Haskell Compiler / GHC Commits: d1998b7f by Richard Eisenberg at 2020-12-10T23:06:51-05:00 Unfortunate dirty hack to overcome #18998. See commentary in tcCollectingUsage, which had to move modules to avoid import loops. Close #18998. Test case: typecheck/should_compile/T18998 - - - - - 7 changed files: - compiler/GHC/Core/UsageEnv.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Utils/Env.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Types/Name/Env.hs - + testsuite/tests/typecheck/should_compile/T18998.hs - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== compiler/GHC/Core/UsageEnv.hs ===================================== @@ -12,6 +12,7 @@ module GHC.Core.UsageEnv , supUEs , unitUE , zeroUE + , nonDetMapUEM ) where import Data.Foldable @@ -52,7 +53,9 @@ scaleUsage x Bottom = MUsage x scaleUsage x (MUsage y) = MUsage $ mkMultMul x y -- For now, we use extra multiplicity Bottom for empty case. -data UsageEnv = UsageEnv (NameEnv Mult) Bool +data UsageEnv + = UsageEnv (NameEnv Mult) -- ^ mapping from names to their multiplicities + Bool -- ^ True <=> this is a bottom 'UsageEnv'; used for empty case unitUE :: NamedThing n => n -> Mult -> UsageEnv unitUE x w = UsageEnv (unitNameEnv (getName x) w) False @@ -100,3 +103,10 @@ lookupUE (UsageEnv e has_bottom) x = instance Outputable UsageEnv where ppr (UsageEnv ne b) = text "UsageEnv:" <+> ppr ne <+> ppr b + +-- | Perform a applicative operation on all the 'Mult's in a 'UsageEnv'. +-- The operation should *not* care about the order in which the +-- environment is traversed. +nonDetMapUEM :: Applicative m => (Mult -> m Mult) -> UsageEnv -> m UsageEnv +nonDetMapUEM f (UsageEnv env is_bottom) + = UsageEnv <$> nonDetTraverseNameEnv f env <*> pure is_bottom ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -25,6 +25,7 @@ import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcCheckPolyExprNC ) import GHC.Builtin.Types (multiplicityTy) import GHC.Tc.Gen.Head import GHC.Hs +import GHC.Tc.Utils.Env ( tcScalingUsage ) import GHC.Tc.Utils.Monad import GHC.Tc.Utils.Unify import GHC.Tc.Utils.Instantiate @@ -1087,5 +1088,3 @@ tcTagToEnum expr fun args app_res_ty res_ty tcExprPrag :: HsPragE GhcRn -> HsPragE GhcTc tcExprPrag (HsPragSCC x1 src ann) = HsPragSCC x1 src ann - - ===================================== compiler/GHC/Tc/Utils/Env.hs ===================================== @@ -47,6 +47,9 @@ module GHC.Tc.Utils.Env( getTypeSigNames, tcExtendRecEnv, -- For knot-tying + -- * Usage environment + tcCollectingUsage, tcScalingUsage, tcEmitBindingUsage, + -- Tidying tcInitTidyEnv, tcInitOpenTidyEnv, @@ -102,6 +105,7 @@ import GHC.Core.ConLike import GHC.Core.TyCon import GHC.Core.Type import GHC.Core.Coercion.Axiom +import GHC.Core.Coercion import GHC.Core.Class import GHC.Unit.Module @@ -137,6 +141,8 @@ import Data.IORef import Data.List (intercalate) import Control.Monad +import GHC.Driver.Ppr + {- ********************************************************************* * * An IO interface to looking up globals @@ -667,6 +673,67 @@ tcCheckUsage name id_mult thing_inside ; tcEmitBindingUsage (deleteUE uenv name) ; return wrapper } +----------------------- +-- | @tcCollectingUsage thing_inside@ runs @thing_inside@ and returns the usage +-- information which was collected as part of the execution of +-- @thing_inside at . Careful: @tcCollectingUsage thing_inside@ itself does not +-- report any usage information, it's up to the caller to incorporate the +-- returned usage information into the larger context appropriately. +tcCollectingUsage :: TcM a -> TcM (UsageEnv,a) +tcCollectingUsage thing_inside + = do { env0 <- getLclEnv + ; local_usage_ref <- newTcRef zeroUE + ; let env1 = env0 { tcl_usage = local_usage_ref } + ; result <- setLclEnv env1 thing_inside + ; local_usage <- readTcRef local_usage_ref + ; promoted_usage <- nonDetMapUEM promote_mult local_usage + ; return (promoted_usage,result) } + where + -- This is gross. The problem is in test case typecheck/should_compile/T18998: + -- f :: a %1-> Id n a -> Id n a + -- f x (MkId _) = MkId x + -- where MkId is a GADT constructor. Multiplicity polymorphism of constructors + -- invents a new multiplicity variable p[2] for the application MkId x. This + -- variable is at level 2, bumped because of the GADT pattern-match (MkId _). + -- We eventually unify the variable with One, due to the call to tcSubMult in + -- tcCheckUsage. But by then, we're at TcLevel 1, and so the level-check + -- fails. + -- + -- What to do? If we did inference "for real", the sub-multiplicity constraint + -- would end up in the implication of the GADT pattern-match, and all would + -- be well. But we don't have a real sub-multiplicity constraint to put in + -- the implication. (Multiplicity inference works outside the usual generate- + -- constraints-and-solve scheme.) Here, where the multiplicity arrives, we + -- must promote all multiplicity variables to reflect this outer TcLevel. + -- It's reminiscent of floating a constraint, really, so promotion is + -- appropriate. The promoteTcType function works only on types of kind TYPE rr, + -- so we can't use it here. Thus, this dirtiness. + -- + -- It works nicely in practice. + (promote_mult, _, _, _) = mapTyCo mapper + mapper = TyCoMapper { tcm_tyvar = \ () tv -> do { _ <- promoteTyVar tv + ; zonkTcTyVar tv } + , tcm_covar = \ () cv -> return (mkCoVarCo cv) + , tcm_hole = \ () h -> return (mkHoleCo h) + , tcm_tycobinder = \ () tcv _flag -> return ((), tcv) + , tcm_tycon = return } + +-- | @tcScalingUsage mult thing_inside@ runs @thing_inside@ and scales all the +-- usage information by @mult at . +tcScalingUsage :: Mult -> TcM a -> TcM a +tcScalingUsage mult thing_inside + = do { (usage, result) <- tcCollectingUsage thing_inside + ; traceTc "tcScalingUsage" (ppr mult) + ; tcEmitBindingUsage $ scaleUE mult usage + ; return result } + +tcEmitBindingUsage :: UsageEnv -> TcM () +tcEmitBindingUsage ue + = do { lcl_env <- getLclEnv + ; let usage = tcl_usage lcl_env + ; updTcRef usage (addUE ue) } + + {- ********************************************************************* * * The TcBinderStack ===================================== compiler/GHC/Tc/Utils/Monad.hs ===================================== @@ -71,9 +71,6 @@ module GHC.Tc.Utils.Monad( addMessages, discardWarnings, - -- * Usage environment - tcCollectingUsage, tcScalingUsage, tcEmitBindingUsage, - -- * Shared error message stuff: renamer and typechecker mkLongErrAt, mkErrDocAt, addLongErrAt, reportErrors, reportError, reportWarning, recoverM, mapAndRecoverM, mapAndReportM, foldAndRecoverM, @@ -1273,36 +1270,6 @@ captureConstraints thing_inside Nothing -> do { emitConstraints lie; failM } Just res -> return (res, lie) } ------------------------ --- | @tcCollectingUsage thing_inside@ runs @thing_inside@ and returns the usage --- information which was collected as part of the execution of --- @thing_inside at . Careful: @tcCollectingUsage thing_inside@ itself does not --- report any usage information, it's up to the caller to incorporate the --- returned usage information into the larger context appropriately. -tcCollectingUsage :: TcM a -> TcM (UsageEnv,a) -tcCollectingUsage thing_inside - = do { env0 <- getLclEnv - ; local_usage_ref <- newTcRef zeroUE - ; let env1 = env0 { tcl_usage = local_usage_ref } - ; result <- setLclEnv env1 thing_inside - ; local_usage <- readTcRef local_usage_ref - ; return (local_usage,result) } - --- | @tcScalingUsage mult thing_inside@ runs @thing_inside@ and scales all the --- usage information by @mult at . -tcScalingUsage :: Mult -> TcM a -> TcM a -tcScalingUsage mult thing_inside - = do { (usage, result) <- tcCollectingUsage thing_inside - ; traceTc "tcScalingUsage" (ppr mult) - ; tcEmitBindingUsage $ scaleUE mult usage - ; return result } - -tcEmitBindingUsage :: UsageEnv -> TcM () -tcEmitBindingUsage ue - = do { lcl_env <- getLclEnv - ; let usage = tcl_usage lcl_env - ; updTcRef usage (addUE ue) } - ----------------------- attemptM :: TcRn r -> TcRn (Maybe r) -- (attemptM thing_inside) runs thing_inside ===================================== compiler/GHC/Types/Name/Env.hs ===================================== @@ -8,6 +8,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} module GHC.Types.Name.Env ( -- * Var, Id and TyVar environments (maps) @@ -22,7 +23,7 @@ module GHC.Types.Name.Env ( filterNameEnv, anyNameEnv, plusNameEnv, plusNameEnv_C, plusNameEnv_CD, plusNameEnv_CD2, alterNameEnv, lookupNameEnv, lookupNameEnv_NF, delFromNameEnv, delListFromNameEnv, - elemNameEnv, mapNameEnv, disjointNameEnv, + elemNameEnv, mapNameEnv, disjointNameEnv, nonDetTraverseNameEnv, DNameEnv, @@ -44,6 +45,7 @@ import GHC.Types.Name import GHC.Types.Unique.FM import GHC.Types.Unique.DFM import GHC.Data.Maybe +import Data.Coerce {- ************************************************************************ @@ -120,6 +122,8 @@ filterNameEnv :: (elt -> Bool) -> NameEnv elt -> NameEnv elt anyNameEnv :: (elt -> Bool) -> NameEnv elt -> Bool mapNameEnv :: (elt1 -> elt2) -> NameEnv elt1 -> NameEnv elt2 disjointNameEnv :: NameEnv a -> NameEnv a -> Bool +nonDetTraverseNameEnv :: forall f a b. Applicative f + => (a -> f b) -> NameEnv a -> f (NameEnv b) nameEnvElts x = eltsUFM x emptyNameEnv = emptyUFM @@ -145,6 +149,7 @@ delListFromNameEnv x y = delListFromUFM x y filterNameEnv x y = filterUFM x y anyNameEnv f x = foldUFM ((||) . f) False x disjointNameEnv x y = disjointUFM x y +nonDetTraverseNameEnv f n = fmap coerce $ traverse @(NonDetUniqFM Name) f $ coerce n lookupNameEnv_NF env n = expectJust "lookupNameEnv_NF" (lookupNameEnv env n) ===================================== testsuite/tests/typecheck/should_compile/T18998.hs ===================================== @@ -0,0 +1,14 @@ +{-# LANGUAGE LinearTypes, GADTs, DataKinds, KindSignatures #-} + +-- this caused a TcLevel assertion failure + +module T18998 where + +import GHC.Types +import GHC.TypeLits + +data Id :: Nat -> Type -> Type where + MkId :: a %1-> Id 0 a + +f :: a %1-> Id n a -> Id n a +f a (MkId _) = MkId a ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -737,3 +737,4 @@ test('InstanceGivenOverlap2', normal, compile, ['']) test('LocalGivenEqs', normal, compile, ['']) test('LocalGivenEqs2', normal, compile, ['']) test('T18891', normal, compile, ['']) +test('T18998', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d1998b7ff0c590cee7ca80f0fe296aec3bece3bc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d1998b7ff0c590cee7ca80f0fe296aec3bece3bc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 11 04:39:31 2020 From: gitlab at gitlab.haskell.org (Richard Eisenberg) Date: Thu, 10 Dec 2020 23:39:31 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/T19044 Message-ID: <5fd2f8031006e_6b213272cb81079120@gitlab.mail> Richard Eisenberg pushed new branch wip/T19044 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T19044 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 11 07:08:58 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 11 Dec 2020 02:08:58 -0500 Subject: [Git][ghc/ghc] Deleted branch wip/backports-8.10 Message-ID: <5fd31b0a7c5_6b214a47f7810830e2@gitlab.mail> Ben Gamari deleted branch wip/backports-8.10 at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 11 07:08:59 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 11 Dec 2020 02:08:59 -0500 Subject: [Git][ghc/ghc][ghc-8.10] 6 commits: nonmoving: Fix small CPP bug Message-ID: <5fd31b0bc5b4c_6b213272ce01083280@gitlab.mail> Ben Gamari pushed to branch ghc-8.10 at Glasgow Haskell Compiler / GHC Commits: 1abaf38a by Ben Gamari at 2020-12-10T04:29:23+00:00 nonmoving: Fix small CPP bug Previously an incorrect semicolon meant that we would fail to call busy_wait_nop when spinning. - - - - - 4123b929 by GHC GitLab CI at 2020-12-10T04:29:25+00:00 nonmoving: Assert deadlock-gc promotion invariant When performing a deadlock-detection GC we must ensure that all objects end up in the non-moving generation. Assert this in scavenge. - - - - - 13b6696b by GHC GitLab CI at 2020-12-10T04:29:25+00:00 nonmoving: Ensure deadlock detection promotion works Previously the deadlock-detection promotion logic in alloc_for_copy was just plain wrong: it failed to fire when gct->evac_gen_no != oldest_gen->gen_no. The fix is simple: move the - - - - - 0c7f20e2 by GHC GitLab CI at 2020-12-10T04:30:10+00:00 nonmoving: Refactor alloc_for_copy Pull the cold non-moving allocation path out of alloc_for_copy. - - - - - b1b55be1 by Ben Gamari at 2020-12-10T04:30:34+00:00 nonmoving: Don't push objects during deadlock detect GC Previously we would push large objects and compact regions to the mark queue during the deadlock detect GC, resulting in failure to detect deadlocks. - - - - - b0ad86fb by GHC GitLab CI at 2020-12-10T04:31:18+00:00 nonmoving: Add comments to nonmovingResurrectThreads - - - - - 3 changed files: - rts/sm/Evac.c - rts/sm/NonMovingMark.c - rts/sm/Scav.c Changes: ===================================== rts/sm/Evac.c ===================================== @@ -64,14 +64,92 @@ STATIC_INLINE void evacuate_large(StgPtr p); Allocate some space in which to copy an object. -------------------------------------------------------------------------- */ +static StgPtr +alloc_in_nonmoving_heap (uint32_t size) +{ + gct->copied += size; + StgPtr to = nonmovingAllocate(gct->cap, size); + + // Add segment to the todo list unless it's already there + // current->todo_link == NULL means not in todo list + struct NonmovingSegment *seg = nonmovingGetSegment(to); + if (!seg->todo_link) { + gen_workspace *ws = &gct->gens[oldest_gen->no]; + seg->todo_link = ws->todo_seg; + ws->todo_seg = seg; + } + + // The object which refers to this closure may have been aged (i.e. + // retained in a younger generation). Consequently, we must add the + // closure to the mark queue to ensure that it will be marked. + // + // However, if we are in a deadlock detection GC then we disable aging + // so there is no need. + // + // See Note [Non-moving GC: Marking evacuated objects]. + if (major_gc && !deadlock_detect_gc) { + markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, (StgClosure *) to); + } + return to; +} + +/* Inlined helper shared between alloc_for_copy_nonmoving and alloc_for_copy. */ +STATIC_INLINE StgPtr +alloc_in_moving_heap (uint32_t size, uint32_t gen_no) +{ + gen_workspace *ws = &gct->gens[gen_no]; // zero memory references here + + /* chain a new block onto the to-space for the destination gen if + * necessary. + */ + StgPtr to = ws->todo_free; + ws->todo_free += size; + if (ws->todo_free > ws->todo_lim) { + to = todo_block_full(size, ws); + } + ASSERT(ws->todo_free >= ws->todo_bd->free && ws->todo_free <= ws->todo_lim); + + return to; +} + +/* + * N.B. We duplicate much of alloc_for_copy here to minimize the number of + * branches introduced in the moving GC path of alloc_for_copy while minimizing + * repeated work. + */ +static StgPtr +alloc_for_copy_nonmoving (uint32_t size, uint32_t gen_no) +{ + /* See Note [Deadlock detection under nonmoving collector]. */ + if (deadlock_detect_gc) { + return alloc_in_nonmoving_heap(size); + } + + /* Should match logic from alloc_for_copy */ + if (gen_no < gct->evac_gen_no) { + if (gct->eager_promotion) { + gen_no = gct->evac_gen_no; + } else { + gct->failed_to_evac = true; + } + } + + if (gen_no == oldest_gen->no) { + return alloc_in_nonmoving_heap(size); + } else { + return alloc_in_moving_heap(size, gen_no); + } +} + /* size is in words */ STATIC_INLINE StgPtr alloc_for_copy (uint32_t size, uint32_t gen_no) { ASSERT(gen_no < RtsFlags.GcFlags.generations); - StgPtr to; - gen_workspace *ws; + if (RTS_UNLIKELY(RtsFlags.GcFlags.useNonmoving)) { + return alloc_for_copy_nonmoving(size, gen_no); + } /* Find out where we're going, using the handy "to" pointer in * the gen of the source object. If it turns out we need to @@ -81,55 +159,12 @@ alloc_for_copy (uint32_t size, uint32_t gen_no) if (gen_no < gct->evac_gen_no) { if (gct->eager_promotion) { gen_no = gct->evac_gen_no; - } else if (RTS_UNLIKELY(RtsFlags.GcFlags.useNonmoving) && deadlock_detect_gc) { - /* See Note [Deadlock detection under nonmoving collector]. */ - gen_no = oldest_gen->no; } else { gct->failed_to_evac = true; } } - if (RTS_UNLIKELY(RtsFlags.GcFlags.useNonmoving)) { - if (gen_no == oldest_gen->no) { - gct->copied += size; - to = nonmovingAllocate(gct->cap, size); - - // Add segment to the todo list unless it's already there - // current->todo_link == NULL means not in todo list - struct NonmovingSegment *seg = nonmovingGetSegment(to); - if (!seg->todo_link) { - gen_workspace *ws = &gct->gens[oldest_gen->no]; - seg->todo_link = ws->todo_seg; - ws->todo_seg = seg; - } - - // The object which refers to this closure may have been aged (i.e. - // retained in a younger generation). Consequently, we must add the - // closure to the mark queue to ensure that it will be marked. - // - // However, if we are in a deadlock detection GC then we disable aging - // so there is no need. - // - // See Note [Non-moving GC: Marking evacuated objects]. - if (major_gc && !deadlock_detect_gc) - markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, (StgClosure *) to); - return to; - } - } - - ws = &gct->gens[gen_no]; // zero memory references here - - /* chain a new block onto the to-space for the destination gen if - * necessary. - */ - to = ws->todo_free; - ws->todo_free += size; - if (ws->todo_free > ws->todo_lim) { - to = todo_block_full(size, ws); - } - ASSERT(ws->todo_free >= ws->todo_bd->free && ws->todo_free <= ws->todo_lim); - - return to; + return alloc_in_moving_heap(size, gen_no); } /* ----------------------------------------------------------------------------- @@ -406,7 +441,9 @@ evacuate_large(StgPtr p) __atomic_fetch_or(&bd->flags, BF_NONMOVING, __ATOMIC_ACQ_REL); // See Note [Non-moving GC: Marking evacuated objects]. - markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, (StgClosure *) p); + if (major_gc && !deadlock_detect_gc) { + markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, (StgClosure *) p); + } } initBdescr(bd, new_gen, new_gen->to); @@ -563,7 +600,9 @@ evacuate_compact (StgPtr p) __atomic_fetch_or(&bd->flags, BF_NONMOVING, __ATOMIC_RELAXED); // See Note [Non-moving GC: Marking evacuated objects]. - markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, (StgClosure *) str); + if (major_gc && !deadlock_detect_gc) { + markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, (StgClosure *) str); + } } initBdescr(bd, new_gen, new_gen->to); ===================================== rts/sm/NonMovingMark.c ===================================== @@ -737,9 +737,11 @@ void updateRemembSetPushStack(Capability *cap, StgStack *stack) // The concurrent GC has claimed the right to mark the stack. // Wait until it finishes marking before proceeding with // mutation. - while (needs_upd_rem_set_mark((StgClosure *) stack)); + while (needs_upd_rem_set_mark((StgClosure *) stack)) #if defined(PARALLEL_GC) busy_wait_nop(); // TODO: Spinning here is unfortunate +#else + ; #endif return; } @@ -1927,6 +1929,8 @@ void nonmovingTidyThreads () } } +// Mark threads which appear to be dead but still need to be properly torn down +// by resurrectThreads. void nonmovingResurrectThreads (struct MarkQueue_ *queue, StgTSO **resurrected_threads) { StgTSO *next; @@ -1938,6 +1942,9 @@ void nonmovingResurrectThreads (struct MarkQueue_ *queue, StgTSO **resurrected_t case ThreadComplete: continue; default: + // The thread may be, e.g., deadlocked in which case we must ensure + // it isn't swept since resurrectThreads will need to throw it an + // exception. markQueuePushClosure_(queue, (StgClosure*)t); t->global_link = *resurrected_threads; *resurrected_threads = t; ===================================== rts/sm/Scav.c ===================================== @@ -440,6 +440,14 @@ scavenge_block (bdescr *bd) p = bd->u.scan; + // Sanity check: See Note [Deadlock detection under nonmoving collector]. +#if defined(DEBUG) + if (RtsFlags.GcFlags.useNonmoving && deadlock_detect_gc) { + ASSERT(bd->gen == oldest_gen); + } +#endif + + // we might be evacuating into the very object that we're // scavenging, so we have to check the real bd->free pointer each // time around the loop. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e7dbdbfadf897b246a0b7d669bb559d18030c3c6...b0ad86fb84fbd2ac78208e6545c48c7a09e7f4aa -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e7dbdbfadf897b246a0b7d669bb559d18030c3c6...b0ad86fb84fbd2ac78208e6545c48c7a09e7f4aa You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 11 08:55:58 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 11 Dec 2020 03:55:58 -0500 Subject: [Git][ghc/ghc][master] 2 commits: users guide: Fix syntax errors Message-ID: <5fd3341e89a2_6b2131d5c381088658@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: ab24ed9b by Ben Gamari at 2020-12-11T03:55:51-05:00 users guide: Fix syntax errors Fixes errors introduced by 3a55b3a2574f913d046f3a6f82db48d7f6df32e3. - - - - - d3a24d31 by Ben Gamari at 2020-12-11T03:55:51-05:00 users guide: Describe GC lifecycle events Every time I am asked about how to interpret these events I need to figure it out from scratch. It's well past time that the users guide properly documents these. - - - - - 4 changed files: - docs/users_guide/eventlog-formats.rst - docs/users_guide/runtime_control.rst - docs/users_guide/using-optimisation.rst - rts/Stats.c Changes: ===================================== docs/users_guide/eventlog-formats.rst ===================================== @@ -207,9 +207,61 @@ Thread and scheduling events :base-ref:`Control.Concurrent.setThreadLabel`). +.. _gc-events: + Garbage collector events ~~~~~~~~~~~~~~~~~~~~~~~~ +The following events mark various points of the lifecycle of a moving garbage +collection. + +A typical garbage collection will look something like the following: + +1. A capability realizes that it needs a garbage collection (e.g. as a result + of running out of nursery) and requests a garbage collection. This is + marked by :event-type:`REQUEST_SEQ_GC` or :event-type:`REQUEST_PAR_GC`. + +2. As other capabilities reach yield points and suspend execution they emit + :event-type:`STOP_THREAD` events. + +3. When all capabilities have suspended execution, collection will begin, + marked by a :event-type:`GC_START` event. + +4. As individual parallel GC threads commence with scavenging they will emit + :event-type:`GC_WORK` events. + +5. If a parallel GC thread runs out of work it will emit a + :event-type:`GC_IDLE` event. If it is later handed more work it will emit + another :event-type:`GC_WORK` event. + +6. Eventually when scavenging has finished a :event-type:`GC_DONE` event + will be emitted by each GC thread. + +7. A bit of book-keeping is performed. + +8. A :event-type:`GC_END` event will be emitted marking the end of the GC cycle. + +9. A :event-type:`HEAP_SIZE` event will be emitted giving the + cumulative heap allocations of the program until now. + +10. A :event-type:`GC_STATS_GHC` event will be emitted + containing various details of the collection and heap state. + +11. In the case of a major collection, a + :event-type:`HEAP_LIVE` event will be emitted describing + the current size of the live on-heap data. + +12. In the case of the :ghc-flag:`-threaded` RTS, a + :event-type:`SPARK_COUNTERS` event will be emitted giving + details on how many sparks have been created, evaluated, and GC'd. + +13. As mutator threads resume execution they will emit :event-type:`RUN_THREAD` + events. + +Note that in the case of the concurrent non-moving collector additional events +will be emitted during the concurrent phase of collection. These are described +in :ref:`nonmoving-gc-events`. + .. event-type:: GC_START :tag: 9 @@ -685,6 +737,46 @@ These events mark various stages of the :rts-flag:`non-moving collection <--nonmoving-gc>` lifecycle. These are enabled with the ``+RTS -lg`` event-set. +A typical non-moving collection cycle will look something like the following: + +1. The preparatory phase of collection will emit the usual events associated + with a moving collection. See :ref:`gc-events` for details. + +2. The concurrent write barrier is enabled and the concurrent mark thread is + started. From this point forward mutator threads may emit + :event-type:`CONC_UPD_REM_SET_FLUSH` events, indicating that they have + flushed their capability-local update remembered sets. + +3. Concurrent marking begins, denoted by a :event-type:`CONC_MARK_BEGIN` event. + +4. When the mark queue is depleted a :event-type:`CONC_MARK_END` is emitted. + +5. If necessary (e.g. due to weak pointer marking), the marking process will + continue, returning to step (3) above. + +6. When the collector has done as much concurrent marking as it can it will + enter the post-mark synchronization phase of collection, denoted by a + :event-type:`CONC_SYNC_BEGIN` event. + +7. Mutator threads will suspend execution and, if necessary, flush their update + remembered sets (indicated by :event-type:`CONC_UPD_REM_SET_FLUSH` events). + +8. The collector will do any final marking necessary (indicated by + :event-type:`CONC_MARK_BEGIN` and :event-type:`CONC_MARK_END` events). + +9. The collector will do a small amount of sweeping, disable the write barrier, + emit a :event-type:`CONC_SYNC_END` event, and allow mutators to resume + +10. The collector will begin the concurrent sweep phase, indicated by a + :event-type:`CONC_SWEEP_BEGIN` event. + +11. Once sweeping has concluded a :event-type:`CONC_SWEEP_END` event will be + emitted and the concurrent collector thread will terminate. + +12. A :event-type:`NONMOVING_HEAP_CENSUS` event will be emitted describing the + fragmentation state of the non-moving heap. + + .. event-type:: CONC_MARK_BEGIN :tag: 200 @@ -742,8 +834,9 @@ with the ``+RTS -lg`` event-set. Non-moving heap census ~~~~~~~~~~~~~~~~~~~~~~ -The non-moving heap census events (enabled with the ``+RTS -ln`` event-set) are -intended to provide insight into fragmentation of the non-moving heap. +The non-moving heap census events (enabled with the :rts-flag:`+RTS -ln <-l ⟨flags⟩>` +event-set) are intended to provide insight into fragmentation of the non-moving +heap. .. event-type:: NONMOVING_HEAP_CENSUS @@ -760,8 +853,8 @@ Ticky counters ~~~~~~~~~~~~~~ Programs compiled with :ghc-flag:`-ticky` and :ghc-flag:`-eventlog` and invoked -with ``+RTS -lT`` will emit periodic samples of the ticky entry counters to the -eventlog. +with :rts-flag:`+RTS -lT <-l ⟨flags⟩>` will emit periodic samples of the ticky +entry counters to the eventlog. .. event-type:: TICKY_COUNTER_DEF ===================================== docs/users_guide/runtime_control.rst ===================================== @@ -1194,6 +1194,9 @@ When the program is linked with the :ghc-flag:`-eventlog` option - ``f`` — parallel sparks (fully accurate). Disabled by default. + - ``T`` — :ghc-flag:`ticky-ticky profiler <-ticky>` events. Disabled by + default. + - ``u`` — user events. These are events emitted from Haskell code using functions such as ``Debug.Trace.traceEvent``. Enabled by default. ===================================== docs/users_guide/using-optimisation.rst ===================================== @@ -1197,16 +1197,16 @@ by saying ``-fno-wombat``. This is the full syntax for cardinalities, demands and sub-demands in BNF: - .. code-block:: + .. code-block:: none - card ::= B | A | 1 | U | S | M semantics as in the table above + card ::= B | A | 1 | U | S | M semantics as in the table above - d ::= card sd card = how often, sd = how deep - | card abbreviation: Same as "card card" + d ::= card sd card = how often, sd = how deep + | card abbreviation: Same as "card card" - sd ::= card polymorphic sub-demand, card at every level - | P(d,d,..) product sub-demand - | Ccard(sd) call sub-demand + sd ::= card polymorphic sub-demand, card at every level + | P(d,d,..) product sub-demand + | Ccard(sd) call sub-demand For example, ``fst`` is strict in its argument, and also in the first component of the argument. It will not evaluate the argument's second @@ -1234,17 +1234,17 @@ by saying ``-fno-wombat``. We summarise a function's demand properties in its *demand signature*. This is the general syntax: - .. code-block:: + .. code-block:: none - {x->dx,y->dy,z->dz...}...div - ^ ^ ^ ^ ^ ^ - | | | | | | - | \---+---+------/ | - | | | - demand on free demand on divergence - variables arguments information - (omitted if empty) (omitted if - no information) + {x->dx,y->dy,z->dz...}...div + ^ ^ ^ ^ ^ ^ + | | | | | | + | \---+---+------/ | + | | | + demand on free demand on divergence + variables arguments information + (omitted if empty) (omitted if + no information) We summarise ``fst``'s demand properties in its *demand signature* ````, which just says "If ``fst`` is applied to one argument, @@ -1260,13 +1260,11 @@ by saying ``-fno-wombat``. **Call sub-demands** - Consider ``maybe``: + Consider ``maybe``: :: - .. code-block:: - - maybe :: b -> (a -> b) -> Maybe a -> b - maybe n _ Nothing = n - maybe _ s (Just a) = s a + maybe :: b -> (a -> b) -> Maybe a -> b + maybe n _ Nothing = n + maybe _ s (Just a) = s a We give it demand signature ``<1C1(U)>``. The ``C1(U)`` is a *call sub-demand* that says "Called at most once, where the result is used ===================================== rts/Stats.c ===================================== @@ -570,7 +570,7 @@ stat_endGC (Capability *cap, gc_thread *initiating_gct, W_ live, W_ copied, W_ s // Emit events to the event log // Has to be emitted while all caps stopped for GC, but before GC_END. - // See trac.haskell.org/ThreadScope/wiki/RTSsummaryEvents + // See https://gitlab.haskell.org/ghc/ghc/-/wikis/RTSsummaryEvents // for a detailed design rationale of the current setup // of GC eventlog events. traceEventGcGlobalSync(cap); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6484f0d72a9110c5960b9185f239e6ce049b0c74...d3a24d3190de47044981363329337c16b5052028 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6484f0d72a9110c5960b9185f239e6ce049b0c74...d3a24d3190de47044981363329337c16b5052028 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 11 08:56:33 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 11 Dec 2020 03:56:33 -0500 Subject: [Git][ghc/ghc][master] 2 commits: gitlab-ci: Fix incorrect Docker image for nightly cross job Message-ID: <5fd33441c3a68_6b2174471c1091533@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 741309b9 by Ben Gamari at 2020-12-11T03:56:27-05:00 gitlab-ci: Fix incorrect Docker image for nightly cross job Also refactor the job definition to eliminate the bug by construction. - - - - - 19703bc8 by Ben Gamari at 2020-12-11T03:56:27-05:00 gitlab-ci: Fix name of flavour in ThreadSanitizer job It looks like I neglected to update this after introduce flavour transformers. - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -257,27 +257,24 @@ validate-x86_64-linux-deb9-unreg-hadrian: CONFIGURE_ARGS: --enable-unregisterised TEST_ENV: "x86_64-linux-deb9-unreg-hadrian" -validate-x86_64-linux-deb10-hadrian-cross-aarch64: - <<: *nightly +.build-x86_64-linux-deb10-hadrian-cross-aarch64: extends: .validate-linux-hadrian - stage: full-build image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV" variables: BIN_DIST_NAME: "ghc-x86_64-deb9-linux" - rules: - - if: '$CI_MERGE_REQUEST_LABELS =~ /.*cross-compilation.*/' - variables: CONFIGURE_ARGS: --with-intree-gmp CROSS_TARGET: "aarch64-linux-gnu" +validate-x86_64-linux-deb10-hadrian-cross-aarch64: + extends: .build-x86_64-linux-deb10-hadrian-cross-aarch64 + stage: full-build + rules: + - if: '$CI_MERGE_REQUEST_LABELS =~ /.*cross-compilation.*/' + nightly-x86_64-linux-deb10-hadrian-cross-aarch64: <<: *nightly - extends: .validate-linux-hadrian + extends: .build-x86_64-linux-deb10-hadrian-cross-aarch64 stage: full-build - variables: - CONFIGURE_ARGS: --with-intree-gmp - CROSS_TARGET: "aarch64-linux-gnu" - ############################################################ @@ -712,7 +709,7 @@ nightly-x86_64-linux-deb9-integer-simple: stage: full-build variables: TEST_ENV: "x86_64-linux-deb9-tsan" - BUILD_FLAVOUR: "thread-sanitizer" + BUILD_FLAVOUR: "default+thread_sanitizer" TSAN_OPTIONS: "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions" # Haddock is large enough to make TSAN choke without massive quantities of # memory. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d3a24d3190de47044981363329337c16b5052028...19703bc83732525cd8309b1e07815840fcc622fb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d3a24d3190de47044981363329337c16b5052028...19703bc83732525cd8309b1e07815840fcc622fb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 11 09:27:33 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 11 Dec 2020 04:27:33 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: users guide: Fix syntax errors Message-ID: <5fd33b854a11c_6b213272ce01096452@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: ab24ed9b by Ben Gamari at 2020-12-11T03:55:51-05:00 users guide: Fix syntax errors Fixes errors introduced by 3a55b3a2574f913d046f3a6f82db48d7f6df32e3. - - - - - d3a24d31 by Ben Gamari at 2020-12-11T03:55:51-05:00 users guide: Describe GC lifecycle events Every time I am asked about how to interpret these events I need to figure it out from scratch. It's well past time that the users guide properly documents these. - - - - - 741309b9 by Ben Gamari at 2020-12-11T03:56:27-05:00 gitlab-ci: Fix incorrect Docker image for nightly cross job Also refactor the job definition to eliminate the bug by construction. - - - - - 19703bc8 by Ben Gamari at 2020-12-11T03:56:27-05:00 gitlab-ci: Fix name of flavour in ThreadSanitizer job It looks like I neglected to update this after introduce flavour transformers. - - - - - 4336faf4 by Sylvain Henry at 2020-12-11T04:27:22-05:00 Display FFI labels (fix #18539) - - - - - cf071848 by Aaron Allen at 2020-12-11T04:27:24-05:00 Elide extraneous messages for :doc command (#15784) Do not print `<has no documentation>` alongside a valid doc. Additionally, if two matching symbols lack documentation then the message will only be printed once. Hence, `<has no documentation>` will be printed at most once and only if all matching symbols are lacking docs. - - - - - d112fb3d by Aaron Allen at 2020-12-11T04:27:24-05:00 Add :doc test case for duplicate record fields Tests that the output of the `:doc` command is correct for duplicate record fields defined using -XDuplicateRecordFields. - - - - - 11 changed files: - .gitlab-ci.yml - compiler/GHC/Types/ForeignCall.hs - docs/users_guide/eventlog-formats.rst - docs/users_guide/runtime_control.rst - docs/users_guide/using-optimisation.rst - ghc/GHCi/UI.hs - rts/Stats.c - testsuite/tests/ghci/scripts/ghci065.hs - testsuite/tests/ghci/scripts/ghci065.script - testsuite/tests/ghci/scripts/ghci065.stdout - testsuite/tests/numeric/should_compile/all.T Changes: ===================================== .gitlab-ci.yml ===================================== @@ -257,27 +257,24 @@ validate-x86_64-linux-deb9-unreg-hadrian: CONFIGURE_ARGS: --enable-unregisterised TEST_ENV: "x86_64-linux-deb9-unreg-hadrian" -validate-x86_64-linux-deb10-hadrian-cross-aarch64: - <<: *nightly +.build-x86_64-linux-deb10-hadrian-cross-aarch64: extends: .validate-linux-hadrian - stage: full-build image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV" variables: BIN_DIST_NAME: "ghc-x86_64-deb9-linux" - rules: - - if: '$CI_MERGE_REQUEST_LABELS =~ /.*cross-compilation.*/' - variables: CONFIGURE_ARGS: --with-intree-gmp CROSS_TARGET: "aarch64-linux-gnu" +validate-x86_64-linux-deb10-hadrian-cross-aarch64: + extends: .build-x86_64-linux-deb10-hadrian-cross-aarch64 + stage: full-build + rules: + - if: '$CI_MERGE_REQUEST_LABELS =~ /.*cross-compilation.*/' + nightly-x86_64-linux-deb10-hadrian-cross-aarch64: <<: *nightly - extends: .validate-linux-hadrian + extends: .build-x86_64-linux-deb10-hadrian-cross-aarch64 stage: full-build - variables: - CONFIGURE_ARGS: --with-intree-gmp - CROSS_TARGET: "aarch64-linux-gnu" - ############################################################ @@ -712,7 +709,7 @@ nightly-x86_64-linux-deb9-integer-simple: stage: full-build variables: TEST_ENV: "x86_64-linux-deb9-tsan" - BUILD_FLAVOUR: "thread-sanitizer" + BUILD_FLAVOUR: "default+thread_sanitizer" TSAN_OPTIONS: "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions" # Haddock is large enough to make TSAN choke without massive quantities of # memory. ===================================== compiler/GHC/Types/ForeignCall.hs ===================================== @@ -206,24 +206,26 @@ instance Outputable CExportSpec where instance Outputable CCallSpec where ppr (CCallSpec fun cconv safety) - = hcat [ whenPprDebug callconv, ppr_fun fun ] + = hcat [ whenPprDebug callconv, ppr_fun fun, text " ::" ] where callconv = text "{-" <> ppr cconv <> text "-}" - gc_suf | playSafe safety = text "_GC" - | otherwise = empty + gc_suf | playSafe safety = text "_safe" + | otherwise = text "_unsafe" - ppr_fun (StaticTarget st _fn mPkgId isFun) - = text (if isFun then "__pkg_ccall" - else "__pkg_ccall_value") + ppr_fun (StaticTarget st lbl mPkgId isFun) + = text (if isFun then "__ffi_static_ccall" + else "__ffi_static_ccall_value") <> gc_suf <+> (case mPkgId of Nothing -> empty Just pkgId -> ppr pkgId) + <> text ":" + <> ppr lbl <+> (pprWithSourceText st empty) ppr_fun DynamicTarget - = text "__dyn_ccall" <> gc_suf <+> text "\"\"" + = text "__ffi_dyn_ccall" <> gc_suf <+> text "\"\"" -- The filename for a C header file -- Note [Pragma source text] in GHC.Types.SourceText ===================================== docs/users_guide/eventlog-formats.rst ===================================== @@ -207,9 +207,61 @@ Thread and scheduling events :base-ref:`Control.Concurrent.setThreadLabel`). +.. _gc-events: + Garbage collector events ~~~~~~~~~~~~~~~~~~~~~~~~ +The following events mark various points of the lifecycle of a moving garbage +collection. + +A typical garbage collection will look something like the following: + +1. A capability realizes that it needs a garbage collection (e.g. as a result + of running out of nursery) and requests a garbage collection. This is + marked by :event-type:`REQUEST_SEQ_GC` or :event-type:`REQUEST_PAR_GC`. + +2. As other capabilities reach yield points and suspend execution they emit + :event-type:`STOP_THREAD` events. + +3. When all capabilities have suspended execution, collection will begin, + marked by a :event-type:`GC_START` event. + +4. As individual parallel GC threads commence with scavenging they will emit + :event-type:`GC_WORK` events. + +5. If a parallel GC thread runs out of work it will emit a + :event-type:`GC_IDLE` event. If it is later handed more work it will emit + another :event-type:`GC_WORK` event. + +6. Eventually when scavenging has finished a :event-type:`GC_DONE` event + will be emitted by each GC thread. + +7. A bit of book-keeping is performed. + +8. A :event-type:`GC_END` event will be emitted marking the end of the GC cycle. + +9. A :event-type:`HEAP_SIZE` event will be emitted giving the + cumulative heap allocations of the program until now. + +10. A :event-type:`GC_STATS_GHC` event will be emitted + containing various details of the collection and heap state. + +11. In the case of a major collection, a + :event-type:`HEAP_LIVE` event will be emitted describing + the current size of the live on-heap data. + +12. In the case of the :ghc-flag:`-threaded` RTS, a + :event-type:`SPARK_COUNTERS` event will be emitted giving + details on how many sparks have been created, evaluated, and GC'd. + +13. As mutator threads resume execution they will emit :event-type:`RUN_THREAD` + events. + +Note that in the case of the concurrent non-moving collector additional events +will be emitted during the concurrent phase of collection. These are described +in :ref:`nonmoving-gc-events`. + .. event-type:: GC_START :tag: 9 @@ -685,6 +737,46 @@ These events mark various stages of the :rts-flag:`non-moving collection <--nonmoving-gc>` lifecycle. These are enabled with the ``+RTS -lg`` event-set. +A typical non-moving collection cycle will look something like the following: + +1. The preparatory phase of collection will emit the usual events associated + with a moving collection. See :ref:`gc-events` for details. + +2. The concurrent write barrier is enabled and the concurrent mark thread is + started. From this point forward mutator threads may emit + :event-type:`CONC_UPD_REM_SET_FLUSH` events, indicating that they have + flushed their capability-local update remembered sets. + +3. Concurrent marking begins, denoted by a :event-type:`CONC_MARK_BEGIN` event. + +4. When the mark queue is depleted a :event-type:`CONC_MARK_END` is emitted. + +5. If necessary (e.g. due to weak pointer marking), the marking process will + continue, returning to step (3) above. + +6. When the collector has done as much concurrent marking as it can it will + enter the post-mark synchronization phase of collection, denoted by a + :event-type:`CONC_SYNC_BEGIN` event. + +7. Mutator threads will suspend execution and, if necessary, flush their update + remembered sets (indicated by :event-type:`CONC_UPD_REM_SET_FLUSH` events). + +8. The collector will do any final marking necessary (indicated by + :event-type:`CONC_MARK_BEGIN` and :event-type:`CONC_MARK_END` events). + +9. The collector will do a small amount of sweeping, disable the write barrier, + emit a :event-type:`CONC_SYNC_END` event, and allow mutators to resume + +10. The collector will begin the concurrent sweep phase, indicated by a + :event-type:`CONC_SWEEP_BEGIN` event. + +11. Once sweeping has concluded a :event-type:`CONC_SWEEP_END` event will be + emitted and the concurrent collector thread will terminate. + +12. A :event-type:`NONMOVING_HEAP_CENSUS` event will be emitted describing the + fragmentation state of the non-moving heap. + + .. event-type:: CONC_MARK_BEGIN :tag: 200 @@ -742,8 +834,9 @@ with the ``+RTS -lg`` event-set. Non-moving heap census ~~~~~~~~~~~~~~~~~~~~~~ -The non-moving heap census events (enabled with the ``+RTS -ln`` event-set) are -intended to provide insight into fragmentation of the non-moving heap. +The non-moving heap census events (enabled with the :rts-flag:`+RTS -ln <-l ⟨flags⟩>` +event-set) are intended to provide insight into fragmentation of the non-moving +heap. .. event-type:: NONMOVING_HEAP_CENSUS @@ -760,8 +853,8 @@ Ticky counters ~~~~~~~~~~~~~~ Programs compiled with :ghc-flag:`-ticky` and :ghc-flag:`-eventlog` and invoked -with ``+RTS -lT`` will emit periodic samples of the ticky entry counters to the -eventlog. +with :rts-flag:`+RTS -lT <-l ⟨flags⟩>` will emit periodic samples of the ticky +entry counters to the eventlog. .. event-type:: TICKY_COUNTER_DEF ===================================== docs/users_guide/runtime_control.rst ===================================== @@ -1194,6 +1194,9 @@ When the program is linked with the :ghc-flag:`-eventlog` option - ``f`` — parallel sparks (fully accurate). Disabled by default. + - ``T`` — :ghc-flag:`ticky-ticky profiler <-ticky>` events. Disabled by + default. + - ``u`` — user events. These are events emitted from Haskell code using functions such as ``Debug.Trace.traceEvent``. Enabled by default. ===================================== docs/users_guide/using-optimisation.rst ===================================== @@ -1197,16 +1197,16 @@ by saying ``-fno-wombat``. This is the full syntax for cardinalities, demands and sub-demands in BNF: - .. code-block:: + .. code-block:: none - card ::= B | A | 1 | U | S | M semantics as in the table above + card ::= B | A | 1 | U | S | M semantics as in the table above - d ::= card sd card = how often, sd = how deep - | card abbreviation: Same as "card card" + d ::= card sd card = how often, sd = how deep + | card abbreviation: Same as "card card" - sd ::= card polymorphic sub-demand, card at every level - | P(d,d,..) product sub-demand - | Ccard(sd) call sub-demand + sd ::= card polymorphic sub-demand, card at every level + | P(d,d,..) product sub-demand + | Ccard(sd) call sub-demand For example, ``fst`` is strict in its argument, and also in the first component of the argument. It will not evaluate the argument's second @@ -1234,17 +1234,17 @@ by saying ``-fno-wombat``. We summarise a function's demand properties in its *demand signature*. This is the general syntax: - .. code-block:: + .. code-block:: none - {x->dx,y->dy,z->dz...}...div - ^ ^ ^ ^ ^ ^ - | | | | | | - | \---+---+------/ | - | | | - demand on free demand on divergence - variables arguments information - (omitted if empty) (omitted if - no information) + {x->dx,y->dy,z->dz...}...div + ^ ^ ^ ^ ^ ^ + | | | | | | + | \---+---+------/ | + | | | + demand on free demand on divergence + variables arguments information + (omitted if empty) (omitted if + no information) We summarise ``fst``'s demand properties in its *demand signature* ````, which just says "If ``fst`` is applied to one argument, @@ -1260,13 +1260,11 @@ by saying ``-fno-wombat``. **Call sub-demands** - Consider ``maybe``: + Consider ``maybe``: :: - .. code-block:: - - maybe :: b -> (a -> b) -> Maybe a -> b - maybe n _ Nothing = n - maybe _ s (Just a) = s a + maybe :: b -> (a -> b) -> Maybe a -> b + maybe n _ Nothing = n + maybe _ s (Just a) = s a We give it demand signature ``<1C1(U)>``. The ``C1(U)`` is a *call sub-demand* that says "Called at most once, where the result is used ===================================== ghc/GHCi/UI.hs ===================================== @@ -1791,22 +1791,32 @@ docCmd "" = docCmd s = do -- TODO: Maybe also get module headers for module names names <- GHC.parseName s - e_docss <- mapM GHC.getDocs names - sdocs <- mapM (either handleGetDocsFailure (pure . pprDocs)) e_docss + e_docss <- sequence <$> mapM GHC.getDocs names + sdocs <- either handleGetDocsFailure (pure . pprDocs) e_docss let sdocs' = vcat (intersperse (text "") sdocs) unqual <- GHC.getPrintUnqual dflags <- getDynFlags (liftIO . putStrLn . showSDocForUser dflags unqual) sdocs' +pprDocs :: [(Maybe HsDocString, Map Int HsDocString)] -> [SDoc] +pprDocs docs + | null nonEmptyDocs = pprDoc <$> take 1 docs + -- elide if there's at least one non-empty doc (#15784) + | otherwise = pprDoc <$> nonEmptyDocs + where + empty (mb_decl_docs, arg_docs) + = isNothing mb_decl_docs && null arg_docs + nonEmptyDocs = filter (not . empty) docs + -- TODO: also print arg docs. -pprDocs :: (Maybe HsDocString, Map Int HsDocString) -> SDoc -pprDocs (mb_decl_docs, _arg_docs) = +pprDoc :: (Maybe HsDocString, Map Int HsDocString) -> SDoc +pprDoc (mb_decl_docs, _arg_docs) = maybe (text "") (text . unpackHDS) mb_decl_docs -handleGetDocsFailure :: GHC.GhcMonad m => GetDocsFailure -> m SDoc +handleGetDocsFailure :: GHC.GhcMonad m => GetDocsFailure -> m [SDoc] handleGetDocsFailure no_docs = do dflags <- getDynFlags let msg = showPpr dflags no_docs ===================================== rts/Stats.c ===================================== @@ -570,7 +570,7 @@ stat_endGC (Capability *cap, gc_thread *initiating_gct, W_ live, W_ copied, W_ s // Emit events to the event log // Has to be emitted while all caps stopped for GC, but before GC_END. - // See trac.haskell.org/ThreadScope/wiki/RTSsummaryEvents + // See https://gitlab.haskell.org/ghc/ghc/-/wikis/RTSsummaryEvents // for a detailed design rationale of the current setup // of GC eventlog events. traceEventGcGlobalSync(cap); ===================================== testsuite/tests/ghci/scripts/ghci065.hs ===================================== @@ -5,6 +5,7 @@ -- this test is constructed with simple text (without markup) only. -- +{-# LANGUAGE DuplicateRecordFields #-} module Test where -- | This is the haddock comment of a data declaration for Data1. @@ -13,6 +14,25 @@ data Data1 = Val1a | Val1b data Data2 = Val2a -- ^ This is the haddock comment of a data value for Val2a | Val2b -- ^ This is the haddock comment of a data value for Val2b +-- | This is the haddock comment of a data declaration for Data3. +newtype Data3 = + Data3 { getData3 :: Int } + +newtype Data4 = + -- | This is the haddock comment of a data constructor for Data4. + Data4 { getData4 :: Int } + +data DupeFields1 = + DF1 { dupeField :: Int -- ^ This is the first haddock comment of a duplicate record field. + } + +data DupeFields2 = + DF2 { dupeField :: Int -- ^ This is the second haddock comment of a duplicate record field. + } + +data DupeFields3 = + DF3 { dupeField :: Int -- No haddock + } -- | This is the haddock comment of a function declaration for func1. func1 :: Int -> Int -> Int ===================================== testsuite/tests/ghci/scripts/ghci065.script ===================================== @@ -5,6 +5,9 @@ :doc Data1 :doc Val2a :doc Val2b +:doc Data3 +:doc Data4 +:doc dupeField :doc func1 :doc func2 ===================================== testsuite/tests/ghci/scripts/ghci065.stdout ===================================== @@ -1,6 +1,11 @@ This is the haddock comment of a data declaration for Data1. This is the haddock comment of a data value for Val2a This is the haddock comment of a data value for Val2b + This is the haddock comment of a data declaration for Data3. + This is the haddock comment of a data constructor for Data4. + This is the second haddock comment of a duplicate record field. + + This is the first haddock comment of a duplicate record field. This is the haddock comment of a function declaration for func1. This is the haddock comment of a function declaration for func3. ===================================== testsuite/tests/numeric/should_compile/all.T ===================================== @@ -8,4 +8,4 @@ test('T7881', normal, compile, ['']) # desugaring, so we don't get the warning we expect. test('T8542', omit_ways(['hpc']), compile, ['']) test('T10929', normal, compile, ['']) -test('T16402', [ grep_errmsg(r'and') ], compile, ['']) +test('T16402', [ grep_errmsg(r'and'), when(wordsize(32), expect_broken(19024)) ], compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6acfc525611463525587a0af5cf591c6fdbe8cf1...d112fb3dbd8519b33bfb3cea22000022f68169d4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6acfc525611463525587a0af5cf591c6fdbe8cf1...d112fb3dbd8519b33bfb3cea22000022f68169d4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 11 10:41:06 2020 From: gitlab at gitlab.haskell.org (Ryan Scott) Date: Fri, 11 Dec 2020 05:41:06 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/T19008 Message-ID: <5fd34cc2e57db_6b21491119011012b8@gitlab.mail> Ryan Scott pushed new branch wip/T19008 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T19008 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 11 14:40:32 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Fri, 11 Dec 2020 09:40:32 -0500 Subject: [Git][ghc/ghc][wip/T18894] 2 commits: DmdAnal: Annotate top-level function bindings with demands (#18894) Message-ID: <5fd384e071b4a_6b2131d5c3811201f1@gitlab.mail> Sebastian Graf pushed to branch wip/T18894 at Glasgow Haskell Compiler / GHC Commits: 45752a9e by Sebastian Graf at 2020-12-11T14:55:38+01:00 DmdAnal: Annotate top-level function bindings with demands (#18894) It's useful to annotate a non-exported top-level function like `g` in ```hs module Lib (h) where g :: Int -> Int -> (Int,Int) g m 1 = (m, 0) g m n = (2 * m, 2 `div` n) {-# NOINLINE g #-} h :: Int -> Int h 1 = 0 h m | odd m = snd (g m 2) | otherwise = uncurry (+) (g 2 m) ``` with its demand `UCU(CS(P(1P(U),SP(U))`, which tells us that whenever `g` was called, the second component of the returned pair was evaluated strictly. Since #18903 we do so for local functions, where we can see all calls. For top-level functions, we can assume that all *exported* functions are demanded according to `topDmd` and thus get sound demands for non-exported top-level functions. The demand on `g` is crucial information for Nested CPR, which may the go on and unbox `g` for the second pair component. That is true even if that pair component may diverge, as is the case for the call site `g 13 0`, which throws a div-by-zero exception. In `T18894b`, you can even see the new demand annotation enabling us to eta-expand a function that we wouldn't be able to eta-expand without Call Arity. We only track bindings of function type in order not to risk huge compile-time regressions, see `isInterestingTopLevelFn`. There was a CoreLint check that rejected strict demand annotations on recursive or top-level bindings, which seems completely unjustified. All the cases I investigated were fine, so I removed it. Fixes #18894. - - - - - 2d9e01d6 by Sebastian Graf at 2020-12-11T15:40:15+01:00 Demand: Simplify `CU(U)` to `U` (#19005) Both sub-demands encode the same information. This is a trivial change and already affects a few regression tests (e.g. `T5075`), so no separate regression test is necessary. - - - - - 18 changed files: - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Types/Demand.hs - compiler/GHC/Types/Id/Info.hs - testsuite/tests/arityanal/should_compile/Arity11.stderr - testsuite/tests/arityanal/should_compile/Arity16.stderr - + testsuite/tests/stranal/should_compile/T18894.hs - + testsuite/tests/stranal/should_compile/T18894.stderr - + testsuite/tests/stranal/should_compile/T18894b.hs - + testsuite/tests/stranal/should_compile/T18894b.stderr - testsuite/tests/stranal/should_compile/all.T - testsuite/tests/stranal/sigs/T5075.stderr Changes: ===================================== compiler/GHC/Core/FVs.hs ===================================== @@ -525,12 +525,11 @@ ruleLhsFVIds (Rule { ru_bndrs = bndrs, ru_args = args }) = filterFV isLocalId $ addBndrs bndrs (exprs_fvs args) ruleRhsFreeIds :: CoreRule -> VarSet --- ^ This finds all locally-defined free Ids on the left hand side of a rule +-- ^ This finds all locally-defined free Ids on the right hand side of a rule -- and returns them as a non-deterministic set ruleRhsFreeIds (BuiltinRule {}) = emptyVarSet -ruleRhsFreeIds (Rule { ru_bndrs = bndrs, ru_args = args }) - = fvVarSet $ filterFV isLocalId $ - addBndrs bndrs $ exprs_fvs args +ruleRhsFreeIds (Rule { ru_bndrs = bndrs, ru_rhs = rhs }) + = fvVarSet $ filterFV isLocalId $ addBndrs bndrs $ expr_fvs rhs {- Note [Rule free var hack] (Not a hack any more) ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -623,14 +623,6 @@ lintLetBind top_lvl rec_flag binder rhs rhs_ty || exprIsTickedString rhs) (badBndrTyMsg binder (text "unlifted")) - -- Check that if the binder is top-level or recursive, it's not - -- demanded. Primitive string literals are exempt as there is no - -- computation to perform, see Note [Core top-level string literals]. - ; checkL (not (isStrictId binder) - || (isNonRec rec_flag && not (isTopLevel top_lvl)) - || exprIsTickedString rhs) - (mkStrictMsg binder) - -- Check that if the binder is at the top level and has type Addr#, -- that it is a string literal, see -- Note [Core top-level string literals]. @@ -3119,13 +3111,6 @@ badBndrTyMsg binder what = vcat [ text "The type of this binder is" <+> what <> colon <+> ppr binder , text "Binder's type:" <+> ppr (idType binder) ] -mkStrictMsg :: Id -> MsgDoc -mkStrictMsg binder - = vcat [hsep [text "Recursive or top-level binder has strict demand info:", - ppr binder], - hsep [text "Binder's demand info:", ppr (idDemandInfo binder)] - ] - mkNonTopExportedMsg :: Id -> MsgDoc mkNonTopExportedMsg binder = hsep [text "Non-top-level binder is marked as exported:", ppr binder] ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -37,6 +37,7 @@ import GHC.Core.Type import GHC.Core.FVs ( exprFreeIds, ruleRhsFreeIds ) import GHC.Core.Coercion ( Coercion, coVarsOfCo ) import GHC.Core.FamInstEnv +import GHC.Core.Opt.Arity ( typeArity ) import GHC.Utils.Misc import GHC.Utils.Panic import GHC.Data.Maybe ( isJust ) @@ -64,28 +65,55 @@ data DmdAnalOpts = DmdAnalOpts -- -- Note: use `seqBinds` on the result to avoid leaks due to lazyness (cf Note -- [Stamp out space leaks in demand analysis]) -dmdAnalProgram :: DmdAnalOpts -> FamInstEnvs -> CoreProgram -> CoreProgram -dmdAnalProgram opts fam_envs binds = binds_plus_dmds - where - env = emptyAnalEnv opts fam_envs - binds_plus_dmds = snd $ mapAccumL dmdAnalTopBind env binds - --- Analyse a (group of) top-level binding(s) -dmdAnalTopBind :: AnalEnv - -> CoreBind - -> (AnalEnv, CoreBind) -dmdAnalTopBind env (NonRec id rhs) - = ( extendAnalEnv TopLevel env id sig - , NonRec (setIdStrictness id sig) rhs') +dmdAnalProgram :: DmdAnalOpts -> FamInstEnvs -> [CoreRule] -> CoreProgram -> CoreProgram +dmdAnalProgram opts fam_envs rules binds + = snd $ go (emptyAnalEnv opts fam_envs) binds where - ( _, sig, rhs') = dmdAnalRhsLetDown Nothing env topSubDmd id rhs + -- See Note [Analysing top-level bindings] + -- and Note [Why care for top-level demand annotations?] + go _ [] = (nopDmdType, []) + go env (b:bs) = cons_up $ dmdAnalBind TopLevel env topSubDmd b anal_body + where + anal_body env' + | (body_ty, bs') <- go env' bs + = (add_exported_uses env' body_ty (bindersOf b), bs') + + cons_up :: (a, b, [b]) -> (a, [b]) + cons_up (dmd_ty, b', bs') = (dmd_ty, b':bs') + + add_exported_uses :: AnalEnv -> DmdType -> [Id] -> DmdType + add_exported_uses env = foldl' (add_exported_use env) + + -- | If @e@ is denoted by @dmd_ty@, then @add_exported_use _ dmd_ty id@ + -- corresponds to the demand type of @(id, e)@, but is a lot more direct. + -- See Note [Analysing top-level bindings]. + add_exported_use :: AnalEnv -> DmdType -> Id -> DmdType + add_exported_use env dmd_ty id + | isExportedId id || elemVarSet id rule_fvs + -- See Note [Absence analysis for stable unfoldings and RULES] + = dmd_ty `plusDmdType` fst (dmdAnalStar env topDmd (Var id)) + | otherwise + = dmd_ty -dmdAnalTopBind env (Rec pairs) - = (env', Rec pairs') - where - (env', _, pairs') = dmdFix TopLevel env topSubDmd pairs - -- We get two iterations automatically - -- c.f. the NonRec case above + rule_fvs :: IdSet + rule_fvs = foldr (unionVarSet . ruleRhsFreeIds) emptyVarSet rules + +-- | We attach useful (e.g. not 'topDmd') 'idDemandInfo' to top-level bindings +-- that satisfy this function. +-- +-- Basically, we want to know how top-level *functions* are *used* +-- (e.g. called). The information will always be lazy. +-- Any other top-level bindings are boring. +-- +-- See also Note [Why care for top-level demand annotations?]. +isInterestingTopLevelFn :: Id -> Bool +-- SG tried to set this to True and got a +2% ghc/alloc regression in T5642 +-- (which is dominated by the Simplifier) at no gain in analysis precision. +-- If there was a gain, that regression might be acceptable. +-- Plus, we could use LetUp for thunks and share some code with local let +-- bindings. +isInterestingTopLevelFn id = + typeArity (idType id) `lengthExceeds` 0 {- Note [Stamp out space leaks in demand analysis] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -105,8 +133,80 @@ generation would hold on to an extra copy of the Core program, via unforced thunks in demand or strictness information; and it is the most memory-intensive part of the compilation process, so this added seqBinds makes a big difference in peak memory usage. --} +Note [Analysing top-level bindings] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider a CoreProgram like + e1 = ... + n1 = ... + e2 = \a b -> ... fst (n1 a b) ... + n2 = \c d -> ... snd (e2 c d) ... + ... +where e* are exported, but n* are not. +Intuitively, we can see that @n1@ is only ever called with two arguments +and in every call site, the first component of the result of the call +is evaluated. Thus, we'd like it to have idDemandInfo @UCU(C1(P(SU,A))@. +NB: We may *not* give e2 a similar annotation, because it is exported and +external callers might use it in arbitrary ways, expressed by 'topDmd'. +This can then be exploited by Nested CPR and eta-expansion, +see Note [Why care for top-level demand annotations?]. + +How do we get this result? Answer: By analysing the program as if it was a let +expression of this form: + let e1 = ... in + let n1 = ... in + let e2 = ... in + let n2 = ... in + (e1,e2, ...) +E.g. putting all bindings in nested lets and returning all exported binders in a tuple. +Of course, we will not actually build that CoreExpr! Instead we faithfully +simulate analysis of said expression by adding the free variable 'DmdEnv' +of @e*@'s strictness signatures to the 'DmdType' we get from analysing the +nested bindings. + +And even then the above form blows up analysis performance in T10370: +If @e1@ uses many free variables, we'll unnecessarily carry their demands around +with us from the moment we analyse the pair to the moment we bubble back up to +the binding for @e1 at . So instead we analyse as if we had + let e1 = ... in + (e1, let n1 = ... in + ( let e2 = ... in + (e2, let n2 = ... in + ( ...)))) +That is, a series of right-nested pairs, where the @fst@ are the exported +binders of the last enclosing let binding and @snd@ continues the nested +lets. + +Variables occuring free in RULE RHSs are to be handled the same as exported Ids. +See also Note [Absence analysis for stable unfoldings and RULES]. + +Note [Why care for top-level demand annotations?] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Reading Note [Analysing top-level bindings], you might think that we go through +quite some trouble to get useful demands for top-level bindings. They can never +be strict, for example, so why bother? + +First, we get to eta-expand top-level bindings that we weren't able to +eta-expand before without Call Arity. From T18894b: + module T18894b (f) where + eta :: Int -> Int -> Int + eta x = if fst (expensive x) == 13 then \y -> ... else \y -> ... + f m = ... eta m 2 ... eta 2 m ... +Since only @f@ is exported, we see all call sites of @eta@ and can eta-expand to +arity 2. + +The call demands we get for some top-level bindings will also allow Nested CPR +to unbox deeper. From T18894: + module T18894 (h) where + g m n = (2 * m, 2 `div` n) + {-# NOINLINE g #-} + h :: Int -> Int + h m = ... snd (g m 2) ... uncurry (+) (g 2 m) ... +Only @h@ is exported, hence we see that @g@ is always called in contexts were we +also force the division in the second component of the pair returned by @g at . +This allows Nested CPR to evalute the division eagerly and return an I# in its +position. +-} {- ************************************************************************ @@ -114,7 +214,103 @@ seqBinds makes a big difference in peak memory usage. \subsection{The analyser itself} * * ************************************************************************ +-} + +-- | Analyse a binding group and its \"body\", e.g. where it is in scope. +-- +-- It calls a function that knows how to analyse this \"body\" given +-- an 'AnalEnv' with updated demand signatures for the binding group +-- (reflecting their 'idStrictnessInfo') and expects to receive a +-- 'DmdType' in return, which it uses to annotate the binding group with their +-- 'idDemandInfo'. +dmdAnalBind + :: TopLevelFlag + -> AnalEnv + -> SubDemand -- ^ Demand put on the "body" + -- (important for join points) + -> CoreBind + -> (AnalEnv -> (DmdType, a)) -- ^ How to analyse the "body", e.g. + -- where the binding is in scope + -> (DmdType, CoreBind, a) +dmdAnalBind top_lvl env dmd bind anal_body = case bind of + NonRec id rhs + | useLetUp top_lvl id + -> dmdAnalBindLetUp top_lvl env id rhs anal_body + _ -> dmdAnalBindLetDown top_lvl env dmd bind anal_body + +-- | Annotates uninteresting top level functions ('isInterestingTopLevelFn') +-- with 'topDmd', the rest with the given demand. +setBindIdDemandInfo :: TopLevelFlag -> Id -> Demand -> Id +setBindIdDemandInfo top_lvl id dmd = setIdDemandInfo id $ case top_lvl of + TopLevel | not (isInterestingTopLevelFn id) -> topDmd + _ -> dmd + +-- | Let bindings can be processed in two ways: +-- Down (RHS before body) or Up (body before RHS). +-- This function handles the up variant. +-- +-- It is very simple. For let x = rhs in body +-- * Demand-analyse 'body' in the current environment +-- * Find the demand, 'rhs_dmd' placed on 'x' by 'body' +-- * Demand-analyse 'rhs' in 'rhs_dmd' +-- +-- This is used for a non-recursive local let without manifest lambdas (see +-- 'useLetUp'). +-- +-- This is the LetUp rule in the paper “Higher-Order Cardinality Analysis”. +dmdAnalBindLetUp :: TopLevelFlag -> AnalEnv -> Id -> CoreExpr -> (AnalEnv -> (DmdType, a)) -> (DmdType, CoreBind, a) +dmdAnalBindLetUp top_lvl env id rhs anal_body = (final_ty, NonRec id' rhs', body') + where + (body_ty, body') = anal_body env + (body_ty', id_dmd) = findBndrDmd env notArgOfDfun body_ty id + id' = setBindIdDemandInfo top_lvl id id_dmd + (rhs_ty, rhs') = dmdAnalStar env (dmdTransformThunkDmd rhs id_dmd) rhs + final_ty = body_ty' `plusDmdType` rhs_ty + +-- | Let bindings can be processed in two ways: +-- Down (RHS before body) or Up (body before RHS). +-- This function handles the down variant. +-- +-- It computes a demand signature (by means of 'dmdAnalRhsSig') and uses +-- that at call sites in the body. +-- +-- It is used for toplevel definitions, recursive definitions and local +-- non-recursive definitions that have manifest lambdas (cf. 'useLetUp'). +-- Local non-recursive definitions without a lambda are handled with LetUp. +-- +-- This is the LetDown rule in the paper “Higher-Order Cardinality Analysis”. +dmdAnalBindLetDown :: TopLevelFlag -> AnalEnv -> SubDemand -> CoreBind -> (AnalEnv -> (DmdType, a)) -> (DmdType, CoreBind, a) +dmdAnalBindLetDown top_lvl env dmd bind anal_body = case bind of + NonRec id rhs + | (env', lazy_fv, id1, rhs1) <- + dmdAnalRhsSig top_lvl NonRecursive env dmd id rhs + -> do_rest env' lazy_fv [(id1, rhs1)] (uncurry NonRec . only) + Rec pairs + | (env', lazy_fv, pairs') <- dmdFix top_lvl env dmd pairs + -> do_rest env' lazy_fv pairs' Rec + where + do_rest env' lazy_fv pairs1 build_bind = (final_ty, build_bind pairs2, body') + where + (body_ty, body') = anal_body env' + -- see Note [Lazy and unleashable free variables] + dmd_ty = addLazyFVs body_ty lazy_fv + (!final_ty, id_dmds) = findBndrsDmds env' dmd_ty (map fst pairs1) + pairs2 = zipWith do_one pairs1 id_dmds + do_one (id', rhs') dmd = (setBindIdDemandInfo top_lvl id' dmd, rhs') + -- If the actual demand is better than the vanilla call + -- demand, you might think that we might do better to re-analyse + -- the RHS with the stronger demand. + -- But (a) That seldom happens, because it means that *every* path in + -- the body of the let has to use that stronger demand + -- (b) It often happens temporarily in when fixpointing, because + -- the recursive function at first seems to place a massive demand. + -- But we don't want to go to extra work when the function will + -- probably iterate to something less demanding. + -- In practice, all the times the actual demand on id2 is more than + -- the vanilla call demand seem to be due to (b). So we don't + -- bother to re-analyse the RHS. +{- Note [Ensure demand is strict] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ It's important not to analyse e with a lazy demand because @@ -194,7 +390,7 @@ dmdAnal' env dmd (App fun arg) -- Crucially, coercions /are/ handled here, because they are -- value arguments (#10288) let - call_dmd = mkCallDmd dmd + call_dmd = mkCalledOnceDmd dmd (fun_ty, fun') = dmdAnal env call_dmd fun (arg_dmd, res_ty) = splitDmdTy fun_ty (arg_ty, arg') = dmdAnalStar env (dmdTransformThunkDmd arg arg_dmd) arg @@ -295,60 +491,11 @@ dmdAnal' env dmd (Case scrut case_bndr ty alts) -- , text "res_ty" <+> ppr res_ty ]) $ (res_ty, Case scrut' case_bndr' ty alts') --- Let bindings can be processed in two ways: --- Down (RHS before body) or Up (body before RHS). --- The following case handle the up variant. --- --- It is very simple. For let x = rhs in body --- * Demand-analyse 'body' in the current environment --- * Find the demand, 'rhs_dmd' placed on 'x' by 'body' --- * Demand-analyse 'rhs' in 'rhs_dmd' --- --- This is used for a non-recursive local let without manifest lambdas. --- This is the LetUp rule in the paper “Higher-Order Cardinality Analysis”. -dmdAnal' env dmd (Let (NonRec id rhs) body) - | useLetUp id - = (final_ty, Let (NonRec id' rhs') body') - where - (body_ty, body') = dmdAnal env dmd body - (body_ty', id_dmd) = findBndrDmd env notArgOfDfun body_ty id - id' = setIdDemandInfo id id_dmd - - (rhs_ty, rhs') = dmdAnalStar env (dmdTransformThunkDmd rhs id_dmd) rhs - final_ty = body_ty' `plusDmdType` rhs_ty - -dmdAnal' env dmd (Let (NonRec id rhs) body) - = (body_ty2, Let (NonRec id2 rhs') body') +dmdAnal' env dmd (Let bind body) + = (final_ty, Let bind' body') where - (lazy_fv, sig, rhs') = dmdAnalRhsLetDown Nothing env dmd id rhs - id1 = setIdStrictness id sig - env1 = extendAnalEnv NotTopLevel env id sig - (body_ty, body') = dmdAnal env1 dmd body - (body_ty1, id2) = annotateBndr env body_ty id1 - body_ty2 = addLazyFVs body_ty1 lazy_fv -- see Note [Lazy and unleashable free variables] - - -- If the actual demand is better than the vanilla call - -- demand, you might think that we might do better to re-analyse - -- the RHS with the stronger demand. - -- But (a) That seldom happens, because it means that *every* path in - -- the body of the let has to use that stronger demand - -- (b) It often happens temporarily in when fixpointing, because - -- the recursive function at first seems to place a massive demand. - -- But we don't want to go to extra work when the function will - -- probably iterate to something less demanding. - -- In practice, all the times the actual demand on id2 is more than - -- the vanilla call demand seem to be due to (b). So we don't - -- bother to re-analyse the RHS. - -dmdAnal' env dmd (Let (Rec pairs) body) - = let - (env', lazy_fv, pairs') = dmdFix NotTopLevel env dmd pairs - (body_ty, body') = dmdAnal env' dmd body - body_ty1 = deleteFVs body_ty (map fst pairs) - body_ty2 = addLazyFVs body_ty1 lazy_fv -- see Note [Lazy and unleashable free variables] - in - body_ty2 `seq` - (body_ty2, Let (Rec pairs') body') + (final_ty, bind', body') = dmdAnalBind NotTopLevel env dmd bind go' + go' env' = dmdAnal env' dmd body -- | A simple, syntactic analysis of whether an expression MAY throw a precise -- exception when evaluated. It's always sound to return 'True'. @@ -582,9 +729,17 @@ dmdTransform env var dmd | Just (sig, top_lvl) <- lookupSigEnv env var , let fn_ty = dmdTransformSig sig dmd = -- pprTrace "dmdTransform:LetDown" (vcat [ppr var, ppr sig, ppr dmd, ppr fn_ty]) $ - if isTopLevel top_lvl - then fn_ty -- Don't record demand on top-level things - else addVarDmd fn_ty var (C_11 :* dmd) + case top_lvl of + NotTopLevel -> addVarDmd fn_ty var (C_11 :* dmd) + TopLevel + | isInterestingTopLevelFn var + -- Top-level things will be used multiple times or not at + -- all anyway, hence the multDmd below: It means we don't + -- have to track whether @var@ is used strictly or at most + -- once, because ultimately it never will. + -> addVarDmd fn_ty var (C_0N `multDmd` (C_11 :* dmd)) -- discard strictness + | otherwise + -> fn_ty -- don't bother tracking; just annotate with 'topDmd' later -- Everything else: -- * Local let binders for which we use LetUp (cf. 'useLetUp') -- * Lambda binders @@ -599,46 +754,46 @@ dmdTransform env var dmd * * ********************************************************************* -} --- Let bindings can be processed in two ways: --- Down (RHS before body) or Up (body before RHS). --- dmdAnalRhsLetDown implements the Down variant: --- * assuming a demand of +-- | @dmdAnalRhsSig@ analyses the given RHS to compute a demand signature +-- for the LetDown rule. It works as follows: +-- +-- * assuming a demand of -- * looking at the definition -- * determining a strictness signature -- --- It is used for toplevel definition, recursive definitions and local --- non-recursive definitions that have manifest lambdas. --- Local non-recursive definitions without a lambda are handled with LetUp. --- --- This is the LetDown rule in the paper “Higher-Order Cardinality Analysis”. -dmdAnalRhsLetDown - :: Maybe [Id] -- Just bs <=> recursive, Nothing <=> non-recursive +-- Since it assumed a demand of , the resulting signature is applicable at +-- any call site. +dmdAnalRhsSig + :: TopLevelFlag + -> RecFlag -> AnalEnv -> SubDemand -> Id -> CoreExpr - -> (DmdEnv, StrictSig, CoreExpr) + -> (AnalEnv, DmdEnv, Id, CoreExpr) -- Process the RHS of the binding, add the strictness signature -- to the Id, and augment the environment with the signature as well. -- See Note [NOINLINE and strictness] -dmdAnalRhsLetDown rec_flag env let_dmd id rhs - = -- pprTrace "dmdAnalRhsLetDown" (ppr id $$ ppr let_dmd $$ ppr sig $$ ppr lazy_fv) $ - (lazy_fv, sig, rhs') +dmdAnalRhsSig top_lvl rec_flag env let_dmd id rhs + = -- pprTrace "dmdAnalRhsSig" (ppr id $$ ppr let_dmd $$ ppr sig $$ ppr lazy_fv) $ + (env', lazy_fv, id', rhs') where rhs_arity = idArity id + -- See Note [Demand signatures are computed for a threshold demand based on idArity] rhs_dmd -- See Note [Demand analysis for join points] -- See Note [Invariants on join points] invariant 2b, in GHC.Core -- rhs_arity matches the join arity of the join point | isJoinId id - = mkCallDmds rhs_arity let_dmd + = mkCalledOnceDmds rhs_arity let_dmd | otherwise - -- NB: rhs_arity - -- See Note [Demand signatures are computed for a threshold demand based on idArity] - = mkRhsDmd env rhs_arity rhs + = mkCalledOnceDmds rhs_arity topSubDmd (rhs_dmd_ty, rhs') = dmdAnal env rhs_dmd rhs DmdType rhs_fv rhs_dmds rhs_div = rhs_dmd_ty sig = mkStrictSigForArity rhs_arity (DmdType sig_fv rhs_dmds rhs_div) + id' = id `setIdStrictness` sig + env' = extendAnalEnv top_lvl env id' sig + -- See Note [Aggregated demand for cardinality] -- FIXME: That Note doesn't explain the following lines at all. The reason -- is really much different: When we have a recursive function, we'd @@ -651,8 +806,8 @@ dmdAnalRhsLetDown rec_flag env let_dmd id rhs -- we'd have to do an additional iteration. reuseEnv makes sure that -- we never get used-once info for FVs of recursive functions. rhs_fv1 = case rec_flag of - Just bs -> reuseEnv (delVarEnvList rhs_fv bs) - Nothing -> rhs_fv + Recursive -> reuseEnv rhs_fv + NonRecursive -> rhs_fv rhs_fv2 = rhs_fv1 `keepAliveDmdEnv` extra_fvs -- Find the RHS free vars of the unfoldings and RULES @@ -669,13 +824,6 @@ dmdAnalRhsLetDown rec_flag env let_dmd id rhs = exprFreeIds unf_body | otherwise = emptyVarSet --- | @mkRhsDmd env rhs_arity rhs@ creates a 'SubDemand' for --- unleashing on the given function's @rhs@, by creating --- a call demand of @rhs_arity@ --- See Historical Note [Product demands for function body] -mkRhsDmd :: AnalEnv -> Arity -> CoreExpr -> SubDemand -mkRhsDmd _env rhs_arity _rhs = mkCallDmds rhs_arity topSubDmd - -- | If given the (local, non-recursive) let-bound 'Id', 'useLetUp' determines -- whether we should process the binding up (body before rhs) or down (rhs -- before body). @@ -720,8 +868,8 @@ mkRhsDmd _env rhs_arity _rhs = mkCallDmds rhs_arity topSubDmd -- * For a more convincing example with join points, see Note [Demand analysis -- for join points]. -- -useLetUp :: Var -> Bool -useLetUp f = idArity f == 0 && not (isJoinId f) +useLetUp :: TopLevelFlag -> Var -> Bool +useLetUp top_lvl f = isNotTopLevel top_lvl && idArity f == 0 && not (isJoinId f) {- Note [Demand analysis for join points] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -939,8 +1087,6 @@ dmdFix :: TopLevelFlag dmdFix top_lvl env let_dmd orig_pairs = loop 1 initial_pairs where - bndrs = map fst orig_pairs - -- See Note [Initialising strictness] initial_pairs | ae_virgin env = [(setIdStrictness id botSig, rhs) | (id, rhs) <- orig_pairs ] | otherwise = orig_pairs @@ -990,10 +1136,8 @@ dmdFix top_lvl env let_dmd orig_pairs = -- pprTrace "my_downRhs" (ppr id $$ ppr (idStrictness id) $$ ppr sig) $ ((env', lazy_fv'), (id', rhs')) where - (lazy_fv1, sig, rhs') = dmdAnalRhsLetDown (Just bndrs) env let_dmd id rhs - lazy_fv' = plusVarEnv_C plusDmd lazy_fv lazy_fv1 - env' = extendAnalEnv top_lvl env id sig - id' = setIdStrictness id sig + (env', lazy_fv1, id', rhs') = dmdAnalRhsSig top_lvl Recursive env let_dmd id rhs + lazy_fv' = plusVarEnv_C plusDmd lazy_fv lazy_fv1 zapIdStrictness :: [(Id, CoreExpr)] -> [(Id, CoreExpr)] zapIdStrictness pairs = [(setIdStrictness id nopSig, rhs) | (id, rhs) <- pairs ] @@ -1090,7 +1234,7 @@ addLazyFVs dmd_ty lazy_fvs -- demand with the bottom coming up from 'error' -- -- I got a loop in the fixpointer without this, due to an interaction - -- with the lazy_fv filtering in dmdAnalRhsLetDown. Roughly, it was + -- with the lazy_fv filtering in dmdAnalRhsSig. Roughly, it was -- letrec f n x -- = letrec g y = x `fatbar` -- letrec h z = z + ...g... @@ -1156,10 +1300,6 @@ annotateLamIdBndr env arg_of_dfun dmd_ty id main_ty = addDemand dmd dmd_ty' (dmd_ty', dmd) = findBndrDmd env arg_of_dfun dmd_ty id -deleteFVs :: DmdType -> [Var] -> DmdType -deleteFVs (DmdType fvs dmds res) bndrs - = DmdType (delVarEnvList fvs bndrs) dmds res - {- Note [NOINLINE and strictness] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Core/Opt/Pipeline.hs ===================================== @@ -65,6 +65,7 @@ import GHC.Types.SrcLoc import GHC.Types.Id import GHC.Types.Id.Info import GHC.Types.Basic +import GHC.Types.Demand ( zapDmdEnvSig ) import GHC.Types.Var.Set import GHC.Types.Var.Env import GHC.Types.Unique.Supply ( UniqSupply, mkSplitUniqSupply, splitUniqSupply ) @@ -495,7 +496,7 @@ doCorePass CoreDoExitify = {-# SCC "Exitify" #-} doPass exitifyProgram doCorePass CoreDoDemand = {-# SCC "DmdAnal" #-} - doPassDFM dmdAnal + doPassDFRM dmdAnal doCorePass CoreDoCpr = {-# SCC "CprAnal" #-} doPassDFM cprAnalProgram @@ -575,6 +576,13 @@ doPassDFM do_pass guts = do let fam_envs = (p_fam_env, mg_fam_inst_env guts) doPassM (liftIO . do_pass dflags fam_envs) guts +doPassDFRM :: (DynFlags -> FamInstEnvs -> [CoreRule] -> CoreProgram -> IO CoreProgram) -> ModGuts -> CoreM ModGuts +doPassDFRM do_pass guts = do + dflags <- getDynFlags + p_fam_env <- getPackageFamInstEnv + let fam_envs = (p_fam_env, mg_fam_inst_env guts) + doPassM (liftIO . do_pass dflags fam_envs (mg_rules guts)) guts + doPassDFU :: (DynFlags -> FamInstEnvs -> UniqSupply -> CoreProgram -> CoreProgram) -> ModGuts -> CoreM ModGuts doPassDFU do_pass guts = do dflags <- getDynFlags @@ -1088,13 +1096,13 @@ transferIdInfo exported_id local_id -dmdAnal :: DynFlags -> FamInstEnvs -> CoreProgram -> IO CoreProgram -dmdAnal dflags fam_envs binds = do +dmdAnal :: DynFlags -> FamInstEnvs -> [CoreRule] -> CoreProgram -> IO CoreProgram +dmdAnal dflags fam_envs rules binds = do let opts = DmdAnalOpts { dmd_strict_dicts = gopt Opt_DictsStrict dflags } - binds_plus_dmds = dmdAnalProgram opts fam_envs binds + binds_plus_dmds = dmdAnalProgram opts fam_envs rules binds Err.dumpIfSet_dyn dflags Opt_D_dump_str_signatures "Strictness signatures" FormatText $ - dumpIdInfoOfProgram (ppr . strictnessInfo) binds_plus_dmds + dumpIdInfoOfProgram (ppr . zapDmdEnvSig . strictnessInfo) binds_plus_dmds -- See Note [Stamp out space leaks in demand analysis] in GHC.Core.Opt.DmdAnal seqBinds binds_plus_dmds `seq` return binds_plus_dmds ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -598,11 +598,10 @@ addJoinFlts = appOL mkRecFloats :: SimplFloats -> SimplFloats -- Flattens the floats into a single Rec group, -- They must either all be lifted LetFloats or all JoinFloats -mkRecFloats floats@(SimplFloats { sfLetFloats = LetFloats bs ff +mkRecFloats floats@(SimplFloats { sfLetFloats = LetFloats bs _ff , sfJoinFloats = jbs , sfInScope = in_scope }) - = ASSERT2( case ff of { FltLifted -> True; _ -> False }, ppr (fromOL bs) ) - ASSERT2( isNilOL bs || isNilOL jbs, ppr floats ) + = ASSERT2( isNilOL bs || isNilOL jbs, ppr floats ) SimplFloats { sfLetFloats = floats' , sfJoinFloats = jfloats' , sfInScope = in_scope } ===================================== compiler/GHC/Core/Opt/WorkWrap.hs ===================================== @@ -484,7 +484,7 @@ tryWW dflags fam_envs is_rec fn_id rhs | is_fun && is_eta_exp = splitFun dflags fam_envs new_fn_id fn_info wrap_dmds div cpr rhs - | is_thunk -- See Note [Thunk splitting] + | isNonRec is_rec, is_thunk, -- See Note [Thunk splitting] = splitThunk dflags fam_envs is_rec new_fn_id rhs | otherwise @@ -777,6 +777,10 @@ Notice that x certainly has the CPR property now! In fact, splitThunk uses the function argument w/w splitting function, so that if x's demand is deeper (say U(U(L,L),L)) then the splitting will go deeper too. + +NB: For recursive thunks, the Simplifier is unable to float `x-rhs` out of +`x*`'s RHS, because `x*` occurs freely in `x-rhs`, and will just change it +back to the original definition, so we just split non-recursive thunks. -} -- See Note [Thunk splitting] ===================================== compiler/GHC/Core/Opt/WorkWrap/Utils.hs ===================================== @@ -1275,10 +1275,14 @@ mk_absent_let dflags fam_envs arg abs_rhs = mkAbsentErrorApp arg_ty msg msg = showSDoc (gopt_set dflags Opt_SuppressUniques) - (ppr arg <+> ppr (idType arg) <+> file_msg) + (vcat + [ text "Arg:" <+> ppr arg + , text "Type:" <+> ppr arg_ty + , file_msg + ]) file_msg = case outputFile dflags of Nothing -> empty - Just f -> text "in output file " <+> quotes (text f) + Just f -> text "In output file " <+> quotes (text f) -- We need to suppress uniques here because otherwise they'd -- end up in the generated code as strings. This is bad for -- determinism, because with different uniques the strings ===================================== compiler/GHC/Core/Tidy.hs ===================================== @@ -21,7 +21,7 @@ import GHC.Core import GHC.Core.Seq ( seqUnfolding ) import GHC.Types.Id import GHC.Types.Id.Info -import GHC.Types.Demand ( zapUsageEnvSig ) +import GHC.Types.Demand ( zapDmdEnvSig ) import GHC.Core.Type ( tidyType, tidyVarBndr ) import GHC.Core.Coercion ( tidyCo ) import GHC.Types.Var @@ -206,7 +206,7 @@ tidyLetBndr rec_tidy_env env@(tidy_env, var_env) id new_info = vanillaIdInfo `setOccInfo` occInfo old_info `setArityInfo` arityInfo old_info - `setStrictnessInfo` zapUsageEnvSig (strictnessInfo old_info) + `setStrictnessInfo` zapDmdEnvSig (strictnessInfo old_info) `setDemandInfo` demandInfo old_info `setInlinePragInfo` inlinePragInfo old_info `setUnfoldingInfo` new_unf ===================================== compiler/GHC/Types/Demand.hs ===================================== @@ -34,7 +34,7 @@ module GHC.Types.Demand ( lazyApply1Dmd, lazyApply2Dmd, strictOnceApply1Dmd, strictManyApply1Dmd, -- ** Other @Demand@ operations oneifyCard, oneifyDmd, strictifyDmd, strictifyDictDmd, mkWorkerDemand, - peelCallDmd, peelManyCalls, mkCallDmd, mkCallDmds, + peelCallDmd, peelManyCalls, mkCalledOnceDmd, mkCalledOnceDmds, addCaseBndrDmd, -- ** Extracting one-shot information argOneShots, argsOneShots, saturatedByOneShots, @@ -73,7 +73,7 @@ module GHC.Types.Demand ( seqDemand, seqDemandList, seqDmdType, seqStrictSig, -- * Zapping usage information - zapUsageDemand, zapUsageEnvSig, zapUsedOnceDemand, zapUsedOnceSig + zapUsageDemand, zapDmdEnvSig, zapUsedOnceDemand, zapUsedOnceSig ) where #include "HsVersions.h" @@ -267,9 +267,11 @@ data SubDemand -- with the specified cardinality at every level. -- Expands to 'Call' via 'viewCall' and to 'Prod' via 'viewProd'. -- - -- @Poly n@ is semantically equivalent to @nP(n,n,...)@ or @Cn(Cn(..Cn(n)))@. - -- So @U === UP(U,U,...)@ and @U === CU(CU(..CU(U)))@, - -- @S === SP(S,S,...)@ and @S === CS(CS(..CS(S)))@, and so on. + -- @Poly n@ is semantically equivalent to @Prod [n :* Poly n, ...]@ or + -- @Call n (Poly n)@. 'mkCall' and 'mkProd' do these rewrites. + -- + -- In Note [Demand notation]: @U === P(U,U,...)@ and @U === CU(U)@, + -- @S === P(S,S,...)@ and @S === CS(S)@, and so on. -- -- We only really use 'Poly' with 'C_10' (bottom), 'C_00' (absent), -- 'C_0N' (top) and sometimes 'C_1N', but it's simpler to treat it uniformly @@ -278,7 +280,8 @@ data SubDemand -- ^ @Call n sd@ describes the evaluation context of @n@ function -- applications, where every individual result is evaluated according to @sd at . -- @sd@ is /relative/ to a single call, cf. Note [Call demands are relative]. - -- Used only for values of function type. + -- Used only for values of function type. Use the smart constructor 'mkCall' + -- whenever possible! | Prod ![Demand] -- ^ @Prod ds@ describes the evaluation context of a case scrutinisation -- on an expression of product type, where the product components are @@ -306,7 +309,7 @@ polyDmd C_1N = C_1N :* poly1N polyDmd C_10 = C_10 :* poly10 -- | A smart constructor for 'Prod', applying rewrite rules along the semantic --- equalities @Prod [polyDmd n, ...] === polyDmd n@, simplifying to 'Poly' +-- equality @Prod [polyDmd n, ...] === polyDmd n@, simplifying to 'Poly' -- 'SubDemand's when possible. Note that this degrades boxity information! E.g. a -- polymorphic demand will never unbox. mkProd :: [Demand] -> SubDemand @@ -335,6 +338,13 @@ viewProd _ _ = Nothing {-# INLINE viewProd #-} -- we want to fuse away the replicate and the allocation -- for Arity. Otherwise, #18304 bites us. +-- | A smart constructor for 'Call', applying rewrite rules along the semantic +-- equality @Call n (Poly n) === Poly n@, simplifying to 'Poly' 'SubDemand's +-- when possible. +mkCall :: Card -> SubDemand -> SubDemand +mkCall n cd@(Poly m) | n == m = cd +mkCall n cd = Call n cd + -- | @viewCall sd@ interprets @sd@ as a 'Call', expanding 'Poly' demands as -- necessary. viewCall :: SubDemand -> Maybe (Card, SubDemand) @@ -356,8 +366,9 @@ lubSubDmd (Prod ds1) (viewProd (length ds1) -> Just ds2) = -- Handle Call lubSubDmd (Call n1 d1) (viewCall -> Just (n2, d2)) -- See Note [Call demands are relative] - | isAbs n2 = Call (lubCard n1 n2) (lubSubDmd d1 botSubDmd) - | otherwise = Call (lubCard n1 n2) (lubSubDmd d1 d2) + | isAbs n1 = mkCall (lubCard n1 n2) (lubSubDmd botSubDmd d2) + | isAbs n2 = mkCall (lubCard n1 n2) (lubSubDmd d1 botSubDmd) + | otherwise = mkCall (lubCard n1 n2) (lubSubDmd d1 d2) -- Handle Poly lubSubDmd (Poly n1) (Poly n2) = Poly (lubCard n1 n2) -- Make use of reflexivity (so we'll match the Prod or Call cases again). @@ -367,7 +378,7 @@ lubSubDmd _ _ = topSubDmd -- | Denotes '∪' on 'Demand'. lubDmd :: Demand -> Demand -> Demand -lubDmd (n1 :* sd1) (n2 :* sd2) = lubCard n1 n2 :* lubSubDmd sd1 sd2 +lubDmd (n1 :* sd1) (n2 :* sd2) = lubCard n1 n2 :* lubSubDmd sd1 sd2 -- | Denotes '+' on 'SubDemand'. plusSubDmd :: SubDemand -> SubDemand -> SubDemand @@ -377,8 +388,9 @@ plusSubDmd (Prod ds1) (viewProd (length ds1) -> Just ds2) = -- Handle Call plusSubDmd (Call n1 d1) (viewCall -> Just (n2, d2)) -- See Note [Call demands are relative] - | isAbs n2 = Call (plusCard n1 n2) (lubSubDmd d1 botSubDmd) - | otherwise = Call (plusCard n1 n2) (lubSubDmd d1 d2) + | isAbs n1 = mkCall (plusCard n1 n2) (lubSubDmd botSubDmd d2) + | isAbs n2 = mkCall (plusCard n1 n2) (lubSubDmd d1 botSubDmd) + | otherwise = mkCall (plusCard n1 n2) (lubSubDmd d1 d2) -- Handle Poly plusSubDmd (Poly n1) (Poly n2) = Poly (plusCard n1 n2) -- Make use of reflexivity (so we'll match the Prod or Call cases again). @@ -407,7 +419,7 @@ multSubDmd :: Card -> SubDemand -> SubDemand multSubDmd n sd | Just sd' <- multTrivial n seqSubDmd sd = sd' multSubDmd n (Poly n') = Poly (multCard n n') -multSubDmd n (Call n' sd) = Call (multCard n n') sd -- See Note [Call demands are relative] +multSubDmd n (Call n' sd) = mkCall (multCard n n') sd -- See Note [Call demands are relative] multSubDmd n (Prod ds) = Prod (map (multDmd n) ds) multDmd :: Card -> Demand -> Demand @@ -457,22 +469,22 @@ evalDmd = C_1N :* topSubDmd -- | First argument of 'GHC.Exts.maskAsyncExceptions#': @SCS(U)@. -- Called exactly once. strictOnceApply1Dmd :: Demand -strictOnceApply1Dmd = C_11 :* Call C_11 topSubDmd +strictOnceApply1Dmd = C_11 :* mkCall C_11 topSubDmd -- | First argument of 'GHC.Exts.atomically#': @MCM(U)@. -- Called at least once, possibly many times. strictManyApply1Dmd :: Demand -strictManyApply1Dmd = C_1N :* Call C_1N topSubDmd +strictManyApply1Dmd = C_1N :* mkCall C_1N topSubDmd -- | First argument of catch#: @1C1(U)@. -- Evaluates its arg lazily, but then applies it exactly once to one argument. lazyApply1Dmd :: Demand -lazyApply1Dmd = C_01 :* Call C_01 topSubDmd +lazyApply1Dmd = C_01 :* mkCall C_01 topSubDmd -- | Second argument of catch#: @1C1(CS(U))@. -- Calls its arg lazily, but then applies it exactly once to an additional argument. lazyApply2Dmd :: Demand -lazyApply2Dmd = C_01 :* Call C_01 (Call C_11 topSubDmd) +lazyApply2Dmd = C_01 :* mkCall C_01 (mkCall C_11 topSubDmd) -- | Make a 'Demand' evaluated at-most-once. oneifyDmd :: Demand -> Demand @@ -512,12 +524,12 @@ strictifyDictDmd ty (n :* Prod ds) strictifyDictDmd _ dmd = dmd -- | Wraps the 'SubDemand' with a one-shot call demand: @d@ -> @CS(d)@. -mkCallDmd :: SubDemand -> SubDemand -mkCallDmd sd = Call C_11 sd +mkCalledOnceDmd :: SubDemand -> SubDemand +mkCalledOnceDmd sd = mkCall C_11 sd --- | @mkCallDmds n d@ returns @CS(CS...(CS d))@ where there are @n@ @CS@'s. -mkCallDmds :: Arity -> SubDemand -> SubDemand -mkCallDmds arity sd = iterate mkCallDmd sd !! arity +-- | @mkCalledOnceDmds n d@ returns @CS(CS...(CS d))@ where there are @n@ @CS@'s. +mkCalledOnceDmds :: Arity -> SubDemand -> SubDemand +mkCalledOnceDmds arity sd = iterate mkCalledOnceDmd sd !! arity -- | Peels one call level from the sub-demand, and also returns how many -- times we entered the lambda body. @@ -669,7 +681,7 @@ This is needed even for non-product types, in case the case-binder is used but the components of the case alternative are not. Note [Don't optimise UP(U,U,...) to U] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ These two SubDemands: UP(U,U) (@Prod [topDmd, topDmd]@) and U (@topSubDmd@) are semantically equivalent, but we do not turn the former into @@ -1571,9 +1583,9 @@ This is weird, so I'm not worried about whether this optimises brilliantly; but it should not fall over. -} -zapUsageEnvSig :: StrictSig -> StrictSig --- Remove the usage environment from the demand -zapUsageEnvSig (StrictSig (DmdType _ ds r)) = mkClosedStrictSig ds r +-- | Remove the demand environment from the signature. +zapDmdEnvSig :: StrictSig -> StrictSig +zapDmdEnvSig (StrictSig (DmdType _ ds r)) = mkClosedStrictSig ds r zapUsageDemand :: Demand -> Demand -- Remove the usage info, but not the strictness info, from the demand @@ -1615,8 +1627,8 @@ kill_usage kfs (n :* sd) = kill_usage_card kfs n :* kill_usage_sd kfs sd kill_usage_sd :: KillFlags -> SubDemand -> SubDemand kill_usage_sd kfs (Call n sd) - | kf_called_once kfs = Call (lubCard C_1N n) (kill_usage_sd kfs sd) - | otherwise = Call n (kill_usage_sd kfs sd) + | kf_called_once kfs = mkCall (lubCard C_1N n) (kill_usage_sd kfs sd) + | otherwise = mkCall n (kill_usage_sd kfs sd) kill_usage_sd kfs (Prod ds) = Prod (map (kill_usage kfs) ds) kill_usage_sd _ sd = sd @@ -1640,7 +1652,7 @@ trimToType (n :* sd) ts where go (Prod ds) (TsProd tss) | equalLength ds tss = Prod (zipWith trimToType ds tss) - go (Call n sd) (TsFun ts) = Call n (go sd ts) + go (Call n sd) (TsFun ts) = mkCall n (go sd ts) go sd at Poly{} _ = sd go _ _ = topSubDmd @@ -1804,7 +1816,7 @@ instance Binary SubDemand where h <- getByte bh case h of 0 -> Poly <$> get bh - 1 -> Call <$> get bh <*> get bh + 1 -> mkCall <$> get bh <*> get bh 2 -> Prod <$> get bh _ -> pprPanic "Binary:SubDemand" (ppr (fromIntegral h :: Int)) ===================================== compiler/GHC/Types/Id/Info.hs ===================================== @@ -650,7 +650,7 @@ zapUsageInfo info = Just (info {demandInfo = zapUsageDemand (demandInfo info)}) zapUsageEnvInfo :: IdInfo -> Maybe IdInfo zapUsageEnvInfo info | hasDemandEnvSig (strictnessInfo info) - = Just (info {strictnessInfo = zapUsageEnvSig (strictnessInfo info)}) + = Just (info {strictnessInfo = zapDmdEnvSig (strictnessInfo info)}) | otherwise = Nothing ===================================== testsuite/tests/arityanal/should_compile/Arity11.stderr ===================================== @@ -35,7 +35,7 @@ end Rec } -- RHS size: {terms: 52, types: 28, coercions: 0, joins: 0/5} F11.$wfib [InlPrag=[2]] :: forall {a} {p}. (a -> a -> Bool) -> (Num a, Num p) => a -> p -[GblId, Arity=4, Str=, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 150 60 0] 460 0}] +[GblId, Arity=4, Str=, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 150 60 0] 460 0}] F11.$wfib = \ (@a) (@p) (ww :: a -> a -> Bool) (w :: Num a) (w1 :: Num p) (w2 :: a) -> let { @@ -73,7 +73,7 @@ F11.$wfib fib [InlPrag=[2]] :: forall {a} {p}. (Eq a, Num a, Num p) => a -> p [GblId, Arity=4, - Str=, + Str=, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=4,unsat_ok=True,boring_ok=False) Tmpl= \ (@a) (@p) (w [Occ=Once1!] :: Eq a) (w1 [Occ=Once1] :: Num a) (w2 [Occ=Once1] :: Num p) (w3 [Occ=Once1] :: a) -> case w of { GHC.Classes.C:Eq ww1 [Occ=Once1] _ [Occ=Dead] -> F11.$wfib @a @p ww1 w1 w2 w3 }}] fib = \ (@a) (@p) (w :: Eq a) (w1 :: Num a) (w2 :: Num p) (w3 :: a) -> case w of { GHC.Classes.C:Eq ww1 ww2 -> F11.$wfib @a @p ww1 w1 w2 w3 } ===================================== testsuite/tests/arityanal/should_compile/Arity16.stderr ===================================== @@ -5,7 +5,7 @@ Result size of Tidy Core = {terms: 52, types: 87, coercions: 0, joins: 0/0} Rec { -- RHS size: {terms: 15, types: 17, coercions: 0, joins: 0/0} map2 [Occ=LoopBreaker] :: forall {t} {a}. (t -> a) -> [t] -> [a] -[GblId, Arity=2, Str=, Unf=OtherCon []] +[GblId, Arity=2, Str=, Unf=OtherCon []] map2 = \ (@t) (@a) (f :: t -> a) (ds :: [t]) -> case ds of { ===================================== testsuite/tests/stranal/should_compile/T18894.hs ===================================== @@ -0,0 +1,28 @@ +{-# OPTIONS_GHC -O2 -fforce-recomp #-} + +-- | The point of this test is that @g*@ get's a demand that says +-- "whenever @g*@ is called, the second component of the pair is evaluated strictly". +module T18894 (h1, h2) where + +g1 :: Int -> (Int,Int) +g1 1 = (15, 0) +g1 n = (2 * n, 2 `div` n) +{-# NOINLINE g1 #-} + +h1 :: Int -> Int +h1 1 = 0 +-- Sadly, the @g1 2@ subexpression will be floated to top-level, where we +-- don't see the specific demand placed on it by @snd at . Tracked in #19001. +h1 2 = snd (g1 2) +h1 m = uncurry (+) (g1 m) + +g2 :: Int -> Int -> (Int,Int) +g2 m 1 = (m, 0) +g2 m n = (2 * m, 2 `div` n) +{-# NOINLINE g2 #-} + +h2 :: Int -> Int +h2 1 = 0 +h2 m + | odd m = snd (g2 m 2) + | otherwise = uncurry (+) (g2 2 m) ===================================== testsuite/tests/stranal/should_compile/T18894.stderr ===================================== @@ -0,0 +1,404 @@ + +==================== Demand analysis ==================== +Result size of Demand analysis + = {terms: 177, types: 97, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 36, types: 16, coercions: 0, joins: 0/0} +g2 [InlPrag=NOINLINE, Dmd=UCU(CS(P(1P(U),SP(U))))] + :: Int -> Int -> (Int, Int) +[LclId, + Arity=2, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20 20] 161 20}] +g2 + = \ (m [Dmd=UP(U)] :: Int) (ds [Dmd=SP(SU)] :: Int) -> + case ds of { GHC.Types.I# ds [Dmd=SU] -> + case ds of ds [Dmd=1U] { + __DEFAULT -> + (case m of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.*# 2# y) }, + case ds of wild { + __DEFAULT -> + case GHC.Classes.divInt# 2# wild of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> GHC.Types.I# -2#; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + }); + 1# -> (m, lvl) + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 36, types: 19, coercions: 0, joins: 0/0} +h2 :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 162 10}] +h2 + = \ (ds [Dmd=SP(MU)] :: Int) -> + case ds of wild [Dmd=UP(U)] { GHC.Types.I# ds [Dmd=MU] -> + case ds of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> + case g2 wild lvl of { (ds1 [Dmd=A], y [Dmd=SU]) -> y }; + 0# -> + case g2 lvl wild of { (x [Dmd=SP(U)], ds [Dmd=SP(U)]) -> + case x of { GHC.Types.I# x -> + case ds of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + } + }; + 1# -> lvl + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 15# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +lvl :: (Int, Int) +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = (lvl, lvl) + +-- RHS size: {terms: 30, types: 11, coercions: 0, joins: 0/0} +g1 [InlPrag=NOINLINE, Dmd=UCU(P(UP(U),UP(U)))] :: Int -> (Int, Int) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 141 10}] +g1 + = \ (ds [Dmd=SP(SU)] :: Int) -> + case ds of { GHC.Types.I# ds [Dmd=SU] -> + case ds of ds { + __DEFAULT -> + (GHC.Types.I# (GHC.Prim.*# 2# ds), + case ds of wild { + __DEFAULT -> + case GHC.Classes.divInt# 2# wild of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> GHC.Types.I# -2#; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + }); + 1# -> lvl + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +lvl :: (Int, Int) +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=False, ConLike=False, + WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 30 0}] +lvl = g1 (GHC.Types.I# 2#) + +-- RHS size: {terms: 28, types: 18, coercions: 0, joins: 0/0} +h1 :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 111 10}] +h1 + = \ (ds [Dmd=SP(MU)] :: Int) -> + case ds of wild [Dmd=1P(1U)] { GHC.Types.I# ds [Dmd=MU] -> + case ds of { + __DEFAULT -> + case g1 wild of { (x [Dmd=SP(U)], ds [Dmd=SP(U)]) -> + case x of { GHC.Types.I# x -> + case ds of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + }; + 1# -> lvl; + 2# -> case lvl of { (ds1 [Dmd=A], y [Dmd=SU]) -> y } + } + } + + + + +==================== Demand analysis ==================== +Result size of Demand analysis + = {terms: 171, types: 120, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# -2# + +-- RHS size: {terms: 32, types: 18, coercions: 0, joins: 0/0} +$wg2 [InlPrag=NOINLINE, Dmd=UCU(CS(P(1P(U),SP(U))))] + :: Int -> GHC.Prim.Int# -> (# Int, Int #) +[LclId, + Arity=2, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20 30] 121 20}] +$wg2 + = \ (w [Dmd=UP(U)] :: Int) (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + (# case w of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.*# 2# y) }, + case ds of { + __DEFAULT -> + case GHC.Classes.divInt# 2# ds of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> lvl; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + } #); + 1# -> (# w, lvl #) + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 34, types: 21, coercions: 0, joins: 0/0} +$wh2 [InlPrag=[2]] :: GHC.Prim.Int# -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 162 10}] +$wh2 + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> + case $wg2 (GHC.Types.I# ds) 2# of + { (# ww [Dmd=A], ww [Dmd=SU] #) -> + ww + }; + 0# -> + case $wg2 lvl ds of { (# ww [Dmd=SP(U)], ww [Dmd=SP(U)] #) -> + case ww of { GHC.Types.I# x -> + case ww of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + } + }; + 1# -> lvl + } + +-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} +h2 [InlPrag=[2]] :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (w [Occ=Once1!] :: Int) -> + case w of { GHC.Types.I# ww [Occ=Once1, Dmd=MU] -> $wh2 ww }}] +h2 + = \ (w [Dmd=SP(SU)] :: Int) -> + case w of { GHC.Types.I# ww [Dmd=SU] -> $wh2 ww } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 15# + +-- RHS size: {terms: 28, types: 15, coercions: 0, joins: 0/0} +$wg1 [InlPrag=NOINLINE, Dmd=UCU(P(UP(U),UP(U)))] + :: GHC.Prim.Int# -> (# Int, Int #) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 111 20}] +$wg1 + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + (# GHC.Types.I# (GHC.Prim.*# 2# ds), + case ds of { + __DEFAULT -> + case GHC.Classes.divInt# 2# ds of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> lvl; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + } #); + 1# -> (# lvl, lvl #) + } + +-- RHS size: {terms: 7, types: 9, coercions: 0, joins: 0/0} +lvl :: (Int, Int) +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=False, ConLike=False, + WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 40 10}] +lvl = case $wg1 2# of { (# ww, ww #) -> (ww, ww) } + +-- RHS size: {terms: 25, types: 18, coercions: 0, joins: 0/0} +$wh1 [InlPrag=[2]] :: GHC.Prim.Int# -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [50] 101 10}] +$wh1 + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds [Dmd=1U] { + __DEFAULT -> + case $wg1 ds of { (# ww [Dmd=SP(U)], ww [Dmd=SP(U)] #) -> + case ww of { GHC.Types.I# x -> + case ww of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + }; + 1# -> lvl; + 2# -> case lvl of { (ds1 [Dmd=A], y [Dmd=SU]) -> y } + } + +-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} +h1 [InlPrag=[2]] :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (w [Occ=Once1!] :: Int) -> + case w of { GHC.Types.I# ww [Occ=Once1, Dmd=MU] -> $wh1 ww }}] +h1 + = \ (w [Dmd=SP(SU)] :: Int) -> + case w of { GHC.Types.I# ww [Dmd=SU] -> $wh1 ww } + + + ===================================== testsuite/tests/stranal/should_compile/T18894b.hs ===================================== @@ -0,0 +1,20 @@ +{-# OPTIONS_GHC -O -fno-call-arity -fforce-recomp #-} + +module T18894 (f) where + +expensive :: Int -> (Int, Int) +expensive n = (n+1, n+2) +{-# NOINLINE expensive #-} + +-- arity 1 by itself, but not exported, thus can be eta-expanded based on usage +eta :: Int -> Int -> Int +eta x = if fst (expensive x) == 13 + then \y -> x + y + else \y -> x * y +{-# NOINLINE eta #-} + +f :: Int -> Int +f 1 = 0 +f m + | odd m = eta m 2 + | otherwise = eta 2 m ===================================== testsuite/tests/stranal/should_compile/T18894b.stderr ===================================== @@ -0,0 +1,187 @@ + +==================== Demand analysis ==================== +Result size of Demand analysis = {terms: 83, types: 40, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 16, types: 7, coercions: 0, joins: 0/0} +expensive [InlPrag=NOINLINE, Dmd=UCU(P(SP(SU),A))] :: Int -> (Int, Int) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [40] 52 10}] +expensive + = \ (n [Dmd=UP(U)] :: Int) -> + (case n of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 1#) }, case n of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 2#) }) + +-- RHS size: {terms: 20, types: 11, coercions: 0, joins: 0/0} +eta [InlPrag=NOINLINE, Dmd=UCU(CS(U))] :: Int -> Int -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [0] 140 120}] +eta + = \ (x [Dmd=UP(U)] :: Int) -> + case expensive x of { (x [Dmd=SP(SU)], ds1 [Dmd=A]) -> + case x of { GHC.Types.I# x [Dmd=SU] -> + case x of { + __DEFAULT -> \ (y [Dmd=SP(U)] :: Int) -> GHC.Num.$fNumInt_$c* x y; + 13# -> \ (y [Dmd=SP(U)] :: Int) -> GHC.Num.$fNumInt_$c+ x y + } + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 21, types: 5, coercions: 0, joins: 0/0} +f :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 111 0}] +f = \ (ds [Dmd=SP(MU)] :: Int) -> + case ds of wild [Dmd=UP(U)] { GHC.Types.I# ds [Dmd=MU] -> + case ds of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> eta wild lvl; + 0# -> eta lvl wild + }; + 1# -> lvl + } + } + + + + +==================== Demand analysis ==================== +Result size of Demand analysis = {terms: 85, types: 47, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 16, types: 9, coercions: 0, joins: 0/0} +$wexpensive [InlPrag=NOINLINE, Dmd=UCU(P(SP(SU),A))] :: Int -> (# Int, Int #) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [40] 42 10}] +$wexpensive + = \ (w [Dmd=UP(U)] :: Int) -> + (# case w of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 1#) }, + case w of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 2#) } #) + +-- RHS size: {terms: 19, types: 12, coercions: 0, joins: 0/0} +eta [InlPrag=NOINLINE, Dmd=UCU(CS(U))] :: Int -> Int -> Int +[LclId, + Arity=2, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [0 0] 120 0}] +eta + = \ (x [Dmd=MP(U)] :: Int) (eta [Dmd=SP(U), OS=OneShot] :: Int) -> + case $wexpensive x of { (# ww [Dmd=SP(SU)], ww [Dmd=A] #) -> + case ww of { GHC.Types.I# x [Dmd=SU] -> + case x of { + __DEFAULT -> GHC.Num.$fNumInt_$c* x eta; + 13# -> GHC.Num.$fNumInt_$c+ x eta + } + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 20, types: 3, coercions: 0, joins: 0/0} +$wf [InlPrag=[2]] :: GHC.Prim.Int# -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 121 0}] +$wf + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> eta (GHC.Types.I# ds) lvl; + 0# -> eta lvl (GHC.Types.I# ds) + }; + 1# -> lvl + } + +-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} +f [InlPrag=[2]] :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (w [Occ=Once1!] :: Int) -> case w of { GHC.Types.I# ww [Occ=Once1, Dmd=MU] -> $wf ww }}] +f = \ (w [Dmd=SP(SU)] :: Int) -> case w of { GHC.Types.I# ww [Dmd=SU] -> $wf ww } + + + ===================================== testsuite/tests/stranal/should_compile/all.T ===================================== @@ -58,3 +58,7 @@ test('T18122', [ grep_errmsg(r'wfoo =') ], compile, ['-ddump-simpl']) # We care about the call demand on $wg test('T18903', [ grep_errmsg(r'Dmd=\S+C\S+') ], compile, ['-ddump-simpl -dsuppress-uniques']) +# We care about the call demand on $wg1 and $wg2 +test('T18894', [ grep_errmsg(r'Dmd=\S+C\S+') ], compile, ['-ddump-stranal -dsuppress-uniques']) +# We care about the Arity 2 on eta, as a result of the annotated Dmd +test('T18894b', [ grep_errmsg(r'Arity=2') ], compile, ['-ddump-stranal -dsuppress-uniques -fno-call-arity -dppr-cols=200']) ===================================== testsuite/tests/stranal/sigs/T5075.stderr ===================================== @@ -1,7 +1,7 @@ ==================== Strictness signatures ==================== T5075.$trModule: -T5075.loop: +T5075.loop: @@ -13,6 +13,6 @@ T5075.loop: ==================== Strictness signatures ==================== T5075.$trModule: -T5075.loop: +T5075.loop: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/46585fdb4ea0f49649294391b1a2abb33d99d49e...2d9e01d6c0bc1967dae0c58fbf53ede5ee90bb1f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/46585fdb4ea0f49649294391b1a2abb33d99d49e...2d9e01d6c0bc1967dae0c58fbf53ede5ee90bb1f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 11 14:50:41 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Fri, 11 Dec 2020 09:50:41 -0500 Subject: [Git][ghc/ghc][wip/T18894] 2 commits: DmdAnal: Annotate top-level function bindings with demands (#18894) Message-ID: <5fd387415927b_6b213272ce01124371@gitlab.mail> Sebastian Graf pushed to branch wip/T18894 at Glasgow Haskell Compiler / GHC Commits: a3011cb5 by Sebastian Graf at 2020-12-11T15:45:06+01:00 DmdAnal: Annotate top-level function bindings with demands (#18894) It's useful to annotate a non-exported top-level function like `g` in ```hs module Lib (h) where g :: Int -> Int -> (Int,Int) g m 1 = (m, 0) g m n = (2 * m, 2 `div` n) {-# NOINLINE g #-} h :: Int -> Int h 1 = 0 h m | odd m = snd (g m 2) | otherwise = uncurry (+) (g 2 m) ``` with its demand `UCU(CS(P(1P(U),SP(U))`, which tells us that whenever `g` was called, the second component of the returned pair was evaluated strictly. Since #18903 we do so for local functions, where we can see all calls. For top-level functions, we can assume that all *exported* functions are demanded according to `topDmd` and thus get sound demands for non-exported top-level functions. The demand on `g` is crucial information for Nested CPR, which may the go on and unbox `g` for the second pair component. That is true even if that pair component may diverge, as is the case for the call site `g 13 0`, which throws a div-by-zero exception. In `T18894b`, you can even see the new demand annotation enabling us to eta-expand a function that we wouldn't be able to eta-expand without Call Arity. We only track bindings of function type in order not to risk huge compile-time regressions, see `isInterestingTopLevelFn`. There was a CoreLint check that rejected strict demand annotations on recursive or top-level bindings, which seems completely unjustified. All the cases I investigated were fine, so I removed it. Fixes #18894. - - - - - d2c303b7 by Sebastian Graf at 2020-12-11T15:45:06+01:00 Demand: Simplify `CU(U)` to `U` (#19005) Both sub-demands encode the same information. This is a trivial change and already affects a few regression tests (e.g. `T5075`), so no separate regression test is necessary. - - - - - 18 changed files: - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Types/Demand.hs - compiler/GHC/Types/Id/Info.hs - testsuite/tests/arityanal/should_compile/Arity11.stderr - testsuite/tests/arityanal/should_compile/Arity16.stderr - + testsuite/tests/stranal/should_compile/T18894.hs - + testsuite/tests/stranal/should_compile/T18894.stderr - + testsuite/tests/stranal/should_compile/T18894b.hs - + testsuite/tests/stranal/should_compile/T18894b.stderr - testsuite/tests/stranal/should_compile/all.T - testsuite/tests/stranal/sigs/T5075.stderr Changes: ===================================== compiler/GHC/Core/FVs.hs ===================================== @@ -525,12 +525,11 @@ ruleLhsFVIds (Rule { ru_bndrs = bndrs, ru_args = args }) = filterFV isLocalId $ addBndrs bndrs (exprs_fvs args) ruleRhsFreeIds :: CoreRule -> VarSet --- ^ This finds all locally-defined free Ids on the left hand side of a rule +-- ^ This finds all locally-defined free Ids on the right hand side of a rule -- and returns them as a non-deterministic set ruleRhsFreeIds (BuiltinRule {}) = emptyVarSet -ruleRhsFreeIds (Rule { ru_bndrs = bndrs, ru_args = args }) - = fvVarSet $ filterFV isLocalId $ - addBndrs bndrs $ exprs_fvs args +ruleRhsFreeIds (Rule { ru_bndrs = bndrs, ru_rhs = rhs }) + = fvVarSet $ filterFV isLocalId $ addBndrs bndrs $ expr_fvs rhs {- Note [Rule free var hack] (Not a hack any more) ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -623,14 +623,6 @@ lintLetBind top_lvl rec_flag binder rhs rhs_ty || exprIsTickedString rhs) (badBndrTyMsg binder (text "unlifted")) - -- Check that if the binder is top-level or recursive, it's not - -- demanded. Primitive string literals are exempt as there is no - -- computation to perform, see Note [Core top-level string literals]. - ; checkL (not (isStrictId binder) - || (isNonRec rec_flag && not (isTopLevel top_lvl)) - || exprIsTickedString rhs) - (mkStrictMsg binder) - -- Check that if the binder is at the top level and has type Addr#, -- that it is a string literal, see -- Note [Core top-level string literals]. @@ -3119,13 +3111,6 @@ badBndrTyMsg binder what = vcat [ text "The type of this binder is" <+> what <> colon <+> ppr binder , text "Binder's type:" <+> ppr (idType binder) ] -mkStrictMsg :: Id -> MsgDoc -mkStrictMsg binder - = vcat [hsep [text "Recursive or top-level binder has strict demand info:", - ppr binder], - hsep [text "Binder's demand info:", ppr (idDemandInfo binder)] - ] - mkNonTopExportedMsg :: Id -> MsgDoc mkNonTopExportedMsg binder = hsep [text "Non-top-level binder is marked as exported:", ppr binder] ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -37,6 +37,7 @@ import GHC.Core.Type import GHC.Core.FVs ( exprFreeIds, ruleRhsFreeIds ) import GHC.Core.Coercion ( Coercion, coVarsOfCo ) import GHC.Core.FamInstEnv +import GHC.Core.Opt.Arity ( typeArity ) import GHC.Utils.Misc import GHC.Utils.Panic import GHC.Data.Maybe ( isJust ) @@ -64,28 +65,55 @@ data DmdAnalOpts = DmdAnalOpts -- -- Note: use `seqBinds` on the result to avoid leaks due to lazyness (cf Note -- [Stamp out space leaks in demand analysis]) -dmdAnalProgram :: DmdAnalOpts -> FamInstEnvs -> CoreProgram -> CoreProgram -dmdAnalProgram opts fam_envs binds = binds_plus_dmds - where - env = emptyAnalEnv opts fam_envs - binds_plus_dmds = snd $ mapAccumL dmdAnalTopBind env binds - --- Analyse a (group of) top-level binding(s) -dmdAnalTopBind :: AnalEnv - -> CoreBind - -> (AnalEnv, CoreBind) -dmdAnalTopBind env (NonRec id rhs) - = ( extendAnalEnv TopLevel env id sig - , NonRec (setIdStrictness id sig) rhs') +dmdAnalProgram :: DmdAnalOpts -> FamInstEnvs -> [CoreRule] -> CoreProgram -> CoreProgram +dmdAnalProgram opts fam_envs rules binds + = snd $ go (emptyAnalEnv opts fam_envs) binds where - ( _, sig, rhs') = dmdAnalRhsLetDown Nothing env topSubDmd id rhs + -- See Note [Analysing top-level bindings] + -- and Note [Why care for top-level demand annotations?] + go _ [] = (nopDmdType, []) + go env (b:bs) = cons_up $ dmdAnalBind TopLevel env topSubDmd b anal_body + where + anal_body env' + | (body_ty, bs') <- go env' bs + = (add_exported_uses env' body_ty (bindersOf b), bs') + + cons_up :: (a, b, [b]) -> (a, [b]) + cons_up (dmd_ty, b', bs') = (dmd_ty, b':bs') + + add_exported_uses :: AnalEnv -> DmdType -> [Id] -> DmdType + add_exported_uses env = foldl' (add_exported_use env) + + -- | If @e@ is denoted by @dmd_ty@, then @add_exported_use _ dmd_ty id@ + -- corresponds to the demand type of @(id, e)@, but is a lot more direct. + -- See Note [Analysing top-level bindings]. + add_exported_use :: AnalEnv -> DmdType -> Id -> DmdType + add_exported_use env dmd_ty id + | isExportedId id || elemVarSet id rule_fvs + -- See Note [Absence analysis for stable unfoldings and RULES] + = dmd_ty `plusDmdType` fst (dmdAnalStar env topDmd (Var id)) + | otherwise + = dmd_ty -dmdAnalTopBind env (Rec pairs) - = (env', Rec pairs') - where - (env', _, pairs') = dmdFix TopLevel env topSubDmd pairs - -- We get two iterations automatically - -- c.f. the NonRec case above + rule_fvs :: IdSet + rule_fvs = foldr (unionVarSet . ruleRhsFreeIds) emptyVarSet rules + +-- | We attach useful (e.g. not 'topDmd') 'idDemandInfo' to top-level bindings +-- that satisfy this function. +-- +-- Basically, we want to know how top-level *functions* are *used* +-- (e.g. called). The information will always be lazy. +-- Any other top-level bindings are boring. +-- +-- See also Note [Why care for top-level demand annotations?]. +isInterestingTopLevelFn :: Id -> Bool +-- SG tried to set this to True and got a +2% ghc/alloc regression in T5642 +-- (which is dominated by the Simplifier) at no gain in analysis precision. +-- If there was a gain, that regression might be acceptable. +-- Plus, we could use LetUp for thunks and share some code with local let +-- bindings. +isInterestingTopLevelFn id = + typeArity (idType id) `lengthExceeds` 0 {- Note [Stamp out space leaks in demand analysis] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -105,8 +133,80 @@ generation would hold on to an extra copy of the Core program, via unforced thunks in demand or strictness information; and it is the most memory-intensive part of the compilation process, so this added seqBinds makes a big difference in peak memory usage. --} +Note [Analysing top-level bindings] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider a CoreProgram like + e1 = ... + n1 = ... + e2 = \a b -> ... fst (n1 a b) ... + n2 = \c d -> ... snd (e2 c d) ... + ... +where e* are exported, but n* are not. +Intuitively, we can see that @n1@ is only ever called with two arguments +and in every call site, the first component of the result of the call +is evaluated. Thus, we'd like it to have idDemandInfo @UCU(C1(P(SU,A))@. +NB: We may *not* give e2 a similar annotation, because it is exported and +external callers might use it in arbitrary ways, expressed by 'topDmd'. +This can then be exploited by Nested CPR and eta-expansion, +see Note [Why care for top-level demand annotations?]. + +How do we get this result? Answer: By analysing the program as if it was a let +expression of this form: + let e1 = ... in + let n1 = ... in + let e2 = ... in + let n2 = ... in + (e1,e2, ...) +E.g. putting all bindings in nested lets and returning all exported binders in a tuple. +Of course, we will not actually build that CoreExpr! Instead we faithfully +simulate analysis of said expression by adding the free variable 'DmdEnv' +of @e*@'s strictness signatures to the 'DmdType' we get from analysing the +nested bindings. + +And even then the above form blows up analysis performance in T10370: +If @e1@ uses many free variables, we'll unnecessarily carry their demands around +with us from the moment we analyse the pair to the moment we bubble back up to +the binding for @e1 at . So instead we analyse as if we had + let e1 = ... in + (e1, let n1 = ... in + ( let e2 = ... in + (e2, let n2 = ... in + ( ...)))) +That is, a series of right-nested pairs, where the @fst@ are the exported +binders of the last enclosing let binding and @snd@ continues the nested +lets. + +Variables occuring free in RULE RHSs are to be handled the same as exported Ids. +See also Note [Absence analysis for stable unfoldings and RULES]. + +Note [Why care for top-level demand annotations?] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Reading Note [Analysing top-level bindings], you might think that we go through +quite some trouble to get useful demands for top-level bindings. They can never +be strict, for example, so why bother? + +First, we get to eta-expand top-level bindings that we weren't able to +eta-expand before without Call Arity. From T18894b: + module T18894b (f) where + eta :: Int -> Int -> Int + eta x = if fst (expensive x) == 13 then \y -> ... else \y -> ... + f m = ... eta m 2 ... eta 2 m ... +Since only @f@ is exported, we see all call sites of @eta@ and can eta-expand to +arity 2. + +The call demands we get for some top-level bindings will also allow Nested CPR +to unbox deeper. From T18894: + module T18894 (h) where + g m n = (2 * m, 2 `div` n) + {-# NOINLINE g #-} + h :: Int -> Int + h m = ... snd (g m 2) ... uncurry (+) (g 2 m) ... +Only @h@ is exported, hence we see that @g@ is always called in contexts were we +also force the division in the second component of the pair returned by @g at . +This allows Nested CPR to evalute the division eagerly and return an I# in its +position. +-} {- ************************************************************************ @@ -114,7 +214,103 @@ seqBinds makes a big difference in peak memory usage. \subsection{The analyser itself} * * ************************************************************************ +-} + +-- | Analyse a binding group and its \"body\", e.g. where it is in scope. +-- +-- It calls a function that knows how to analyse this \"body\" given +-- an 'AnalEnv' with updated demand signatures for the binding group +-- (reflecting their 'idStrictnessInfo') and expects to receive a +-- 'DmdType' in return, which it uses to annotate the binding group with their +-- 'idDemandInfo'. +dmdAnalBind + :: TopLevelFlag + -> AnalEnv + -> SubDemand -- ^ Demand put on the "body" + -- (important for join points) + -> CoreBind + -> (AnalEnv -> (DmdType, a)) -- ^ How to analyse the "body", e.g. + -- where the binding is in scope + -> (DmdType, CoreBind, a) +dmdAnalBind top_lvl env dmd bind anal_body = case bind of + NonRec id rhs + | useLetUp top_lvl id + -> dmdAnalBindLetUp top_lvl env id rhs anal_body + _ -> dmdAnalBindLetDown top_lvl env dmd bind anal_body + +-- | Annotates uninteresting top level functions ('isInterestingTopLevelFn') +-- with 'topDmd', the rest with the given demand. +setBindIdDemandInfo :: TopLevelFlag -> Id -> Demand -> Id +setBindIdDemandInfo top_lvl id dmd = setIdDemandInfo id $ case top_lvl of + TopLevel | not (isInterestingTopLevelFn id) -> topDmd + _ -> dmd + +-- | Let bindings can be processed in two ways: +-- Down (RHS before body) or Up (body before RHS). +-- This function handles the up variant. +-- +-- It is very simple. For let x = rhs in body +-- * Demand-analyse 'body' in the current environment +-- * Find the demand, 'rhs_dmd' placed on 'x' by 'body' +-- * Demand-analyse 'rhs' in 'rhs_dmd' +-- +-- This is used for a non-recursive local let without manifest lambdas (see +-- 'useLetUp'). +-- +-- This is the LetUp rule in the paper “Higher-Order Cardinality Analysis”. +dmdAnalBindLetUp :: TopLevelFlag -> AnalEnv -> Id -> CoreExpr -> (AnalEnv -> (DmdType, a)) -> (DmdType, CoreBind, a) +dmdAnalBindLetUp top_lvl env id rhs anal_body = (final_ty, NonRec id' rhs', body') + where + (body_ty, body') = anal_body env + (body_ty', id_dmd) = findBndrDmd env notArgOfDfun body_ty id + id' = setBindIdDemandInfo top_lvl id id_dmd + (rhs_ty, rhs') = dmdAnalStar env (dmdTransformThunkDmd rhs id_dmd) rhs + final_ty = body_ty' `plusDmdType` rhs_ty + +-- | Let bindings can be processed in two ways: +-- Down (RHS before body) or Up (body before RHS). +-- This function handles the down variant. +-- +-- It computes a demand signature (by means of 'dmdAnalRhsSig') and uses +-- that at call sites in the body. +-- +-- It is used for toplevel definitions, recursive definitions and local +-- non-recursive definitions that have manifest lambdas (cf. 'useLetUp'). +-- Local non-recursive definitions without a lambda are handled with LetUp. +-- +-- This is the LetDown rule in the paper “Higher-Order Cardinality Analysis”. +dmdAnalBindLetDown :: TopLevelFlag -> AnalEnv -> SubDemand -> CoreBind -> (AnalEnv -> (DmdType, a)) -> (DmdType, CoreBind, a) +dmdAnalBindLetDown top_lvl env dmd bind anal_body = case bind of + NonRec id rhs + | (env', lazy_fv, id1, rhs1) <- + dmdAnalRhsSig top_lvl NonRecursive env dmd id rhs + -> do_rest env' lazy_fv [(id1, rhs1)] (uncurry NonRec . only) + Rec pairs + | (env', lazy_fv, pairs') <- dmdFix top_lvl env dmd pairs + -> do_rest env' lazy_fv pairs' Rec + where + do_rest env' lazy_fv pairs1 build_bind = (final_ty, build_bind pairs2, body') + where + (body_ty, body') = anal_body env' + -- see Note [Lazy and unleashable free variables] + dmd_ty = addLazyFVs body_ty lazy_fv + (!final_ty, id_dmds) = findBndrsDmds env' dmd_ty (map fst pairs1) + pairs2 = zipWith do_one pairs1 id_dmds + do_one (id', rhs') dmd = (setBindIdDemandInfo top_lvl id' dmd, rhs') + -- If the actual demand is better than the vanilla call + -- demand, you might think that we might do better to re-analyse + -- the RHS with the stronger demand. + -- But (a) That seldom happens, because it means that *every* path in + -- the body of the let has to use that stronger demand + -- (b) It often happens temporarily in when fixpointing, because + -- the recursive function at first seems to place a massive demand. + -- But we don't want to go to extra work when the function will + -- probably iterate to something less demanding. + -- In practice, all the times the actual demand on id2 is more than + -- the vanilla call demand seem to be due to (b). So we don't + -- bother to re-analyse the RHS. +{- Note [Ensure demand is strict] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ It's important not to analyse e with a lazy demand because @@ -194,7 +390,7 @@ dmdAnal' env dmd (App fun arg) -- Crucially, coercions /are/ handled here, because they are -- value arguments (#10288) let - call_dmd = mkCallDmd dmd + call_dmd = mkCalledOnceDmd dmd (fun_ty, fun') = dmdAnal env call_dmd fun (arg_dmd, res_ty) = splitDmdTy fun_ty (arg_ty, arg') = dmdAnalStar env (dmdTransformThunkDmd arg arg_dmd) arg @@ -295,60 +491,11 @@ dmdAnal' env dmd (Case scrut case_bndr ty alts) -- , text "res_ty" <+> ppr res_ty ]) $ (res_ty, Case scrut' case_bndr' ty alts') --- Let bindings can be processed in two ways: --- Down (RHS before body) or Up (body before RHS). --- The following case handle the up variant. --- --- It is very simple. For let x = rhs in body --- * Demand-analyse 'body' in the current environment --- * Find the demand, 'rhs_dmd' placed on 'x' by 'body' --- * Demand-analyse 'rhs' in 'rhs_dmd' --- --- This is used for a non-recursive local let without manifest lambdas. --- This is the LetUp rule in the paper “Higher-Order Cardinality Analysis”. -dmdAnal' env dmd (Let (NonRec id rhs) body) - | useLetUp id - = (final_ty, Let (NonRec id' rhs') body') - where - (body_ty, body') = dmdAnal env dmd body - (body_ty', id_dmd) = findBndrDmd env notArgOfDfun body_ty id - id' = setIdDemandInfo id id_dmd - - (rhs_ty, rhs') = dmdAnalStar env (dmdTransformThunkDmd rhs id_dmd) rhs - final_ty = body_ty' `plusDmdType` rhs_ty - -dmdAnal' env dmd (Let (NonRec id rhs) body) - = (body_ty2, Let (NonRec id2 rhs') body') +dmdAnal' env dmd (Let bind body) + = (final_ty, Let bind' body') where - (lazy_fv, sig, rhs') = dmdAnalRhsLetDown Nothing env dmd id rhs - id1 = setIdStrictness id sig - env1 = extendAnalEnv NotTopLevel env id sig - (body_ty, body') = dmdAnal env1 dmd body - (body_ty1, id2) = annotateBndr env body_ty id1 - body_ty2 = addLazyFVs body_ty1 lazy_fv -- see Note [Lazy and unleashable free variables] - - -- If the actual demand is better than the vanilla call - -- demand, you might think that we might do better to re-analyse - -- the RHS with the stronger demand. - -- But (a) That seldom happens, because it means that *every* path in - -- the body of the let has to use that stronger demand - -- (b) It often happens temporarily in when fixpointing, because - -- the recursive function at first seems to place a massive demand. - -- But we don't want to go to extra work when the function will - -- probably iterate to something less demanding. - -- In practice, all the times the actual demand on id2 is more than - -- the vanilla call demand seem to be due to (b). So we don't - -- bother to re-analyse the RHS. - -dmdAnal' env dmd (Let (Rec pairs) body) - = let - (env', lazy_fv, pairs') = dmdFix NotTopLevel env dmd pairs - (body_ty, body') = dmdAnal env' dmd body - body_ty1 = deleteFVs body_ty (map fst pairs) - body_ty2 = addLazyFVs body_ty1 lazy_fv -- see Note [Lazy and unleashable free variables] - in - body_ty2 `seq` - (body_ty2, Let (Rec pairs') body') + (final_ty, bind', body') = dmdAnalBind NotTopLevel env dmd bind go' + go' env' = dmdAnal env' dmd body -- | A simple, syntactic analysis of whether an expression MAY throw a precise -- exception when evaluated. It's always sound to return 'True'. @@ -582,9 +729,17 @@ dmdTransform env var dmd | Just (sig, top_lvl) <- lookupSigEnv env var , let fn_ty = dmdTransformSig sig dmd = -- pprTrace "dmdTransform:LetDown" (vcat [ppr var, ppr sig, ppr dmd, ppr fn_ty]) $ - if isTopLevel top_lvl - then fn_ty -- Don't record demand on top-level things - else addVarDmd fn_ty var (C_11 :* dmd) + case top_lvl of + NotTopLevel -> addVarDmd fn_ty var (C_11 :* dmd) + TopLevel + | isInterestingTopLevelFn var + -- Top-level things will be used multiple times or not at + -- all anyway, hence the multDmd below: It means we don't + -- have to track whether @var@ is used strictly or at most + -- once, because ultimately it never will. + -> addVarDmd fn_ty var (C_0N `multDmd` (C_11 :* dmd)) -- discard strictness + | otherwise + -> fn_ty -- don't bother tracking; just annotate with 'topDmd' later -- Everything else: -- * Local let binders for which we use LetUp (cf. 'useLetUp') -- * Lambda binders @@ -599,46 +754,46 @@ dmdTransform env var dmd * * ********************************************************************* -} --- Let bindings can be processed in two ways: --- Down (RHS before body) or Up (body before RHS). --- dmdAnalRhsLetDown implements the Down variant: --- * assuming a demand of +-- | @dmdAnalRhsSig@ analyses the given RHS to compute a demand signature +-- for the LetDown rule. It works as follows: +-- +-- * assuming a demand of -- * looking at the definition -- * determining a strictness signature -- --- It is used for toplevel definition, recursive definitions and local --- non-recursive definitions that have manifest lambdas. --- Local non-recursive definitions without a lambda are handled with LetUp. --- --- This is the LetDown rule in the paper “Higher-Order Cardinality Analysis”. -dmdAnalRhsLetDown - :: Maybe [Id] -- Just bs <=> recursive, Nothing <=> non-recursive +-- Since it assumed a demand of , the resulting signature is applicable at +-- any call site. +dmdAnalRhsSig + :: TopLevelFlag + -> RecFlag -> AnalEnv -> SubDemand -> Id -> CoreExpr - -> (DmdEnv, StrictSig, CoreExpr) + -> (AnalEnv, DmdEnv, Id, CoreExpr) -- Process the RHS of the binding, add the strictness signature -- to the Id, and augment the environment with the signature as well. -- See Note [NOINLINE and strictness] -dmdAnalRhsLetDown rec_flag env let_dmd id rhs - = -- pprTrace "dmdAnalRhsLetDown" (ppr id $$ ppr let_dmd $$ ppr sig $$ ppr lazy_fv) $ - (lazy_fv, sig, rhs') +dmdAnalRhsSig top_lvl rec_flag env let_dmd id rhs + = -- pprTrace "dmdAnalRhsSig" (ppr id $$ ppr let_dmd $$ ppr sig $$ ppr lazy_fv) $ + (env', lazy_fv, id', rhs') where rhs_arity = idArity id + -- See Note [Demand signatures are computed for a threshold demand based on idArity] rhs_dmd -- See Note [Demand analysis for join points] -- See Note [Invariants on join points] invariant 2b, in GHC.Core -- rhs_arity matches the join arity of the join point | isJoinId id - = mkCallDmds rhs_arity let_dmd + = mkCalledOnceDmds rhs_arity let_dmd | otherwise - -- NB: rhs_arity - -- See Note [Demand signatures are computed for a threshold demand based on idArity] - = mkRhsDmd env rhs_arity rhs + = mkCalledOnceDmds rhs_arity topSubDmd (rhs_dmd_ty, rhs') = dmdAnal env rhs_dmd rhs DmdType rhs_fv rhs_dmds rhs_div = rhs_dmd_ty sig = mkStrictSigForArity rhs_arity (DmdType sig_fv rhs_dmds rhs_div) + id' = id `setIdStrictness` sig + env' = extendAnalEnv top_lvl env id' sig + -- See Note [Aggregated demand for cardinality] -- FIXME: That Note doesn't explain the following lines at all. The reason -- is really much different: When we have a recursive function, we'd @@ -651,8 +806,8 @@ dmdAnalRhsLetDown rec_flag env let_dmd id rhs -- we'd have to do an additional iteration. reuseEnv makes sure that -- we never get used-once info for FVs of recursive functions. rhs_fv1 = case rec_flag of - Just bs -> reuseEnv (delVarEnvList rhs_fv bs) - Nothing -> rhs_fv + Recursive -> reuseEnv rhs_fv + NonRecursive -> rhs_fv rhs_fv2 = rhs_fv1 `keepAliveDmdEnv` extra_fvs -- Find the RHS free vars of the unfoldings and RULES @@ -669,13 +824,6 @@ dmdAnalRhsLetDown rec_flag env let_dmd id rhs = exprFreeIds unf_body | otherwise = emptyVarSet --- | @mkRhsDmd env rhs_arity rhs@ creates a 'SubDemand' for --- unleashing on the given function's @rhs@, by creating --- a call demand of @rhs_arity@ --- See Historical Note [Product demands for function body] -mkRhsDmd :: AnalEnv -> Arity -> CoreExpr -> SubDemand -mkRhsDmd _env rhs_arity _rhs = mkCallDmds rhs_arity topSubDmd - -- | If given the (local, non-recursive) let-bound 'Id', 'useLetUp' determines -- whether we should process the binding up (body before rhs) or down (rhs -- before body). @@ -720,8 +868,8 @@ mkRhsDmd _env rhs_arity _rhs = mkCallDmds rhs_arity topSubDmd -- * For a more convincing example with join points, see Note [Demand analysis -- for join points]. -- -useLetUp :: Var -> Bool -useLetUp f = idArity f == 0 && not (isJoinId f) +useLetUp :: TopLevelFlag -> Var -> Bool +useLetUp top_lvl f = isNotTopLevel top_lvl && idArity f == 0 && not (isJoinId f) {- Note [Demand analysis for join points] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -939,8 +1087,6 @@ dmdFix :: TopLevelFlag dmdFix top_lvl env let_dmd orig_pairs = loop 1 initial_pairs where - bndrs = map fst orig_pairs - -- See Note [Initialising strictness] initial_pairs | ae_virgin env = [(setIdStrictness id botSig, rhs) | (id, rhs) <- orig_pairs ] | otherwise = orig_pairs @@ -990,10 +1136,8 @@ dmdFix top_lvl env let_dmd orig_pairs = -- pprTrace "my_downRhs" (ppr id $$ ppr (idStrictness id) $$ ppr sig) $ ((env', lazy_fv'), (id', rhs')) where - (lazy_fv1, sig, rhs') = dmdAnalRhsLetDown (Just bndrs) env let_dmd id rhs - lazy_fv' = plusVarEnv_C plusDmd lazy_fv lazy_fv1 - env' = extendAnalEnv top_lvl env id sig - id' = setIdStrictness id sig + (env', lazy_fv1, id', rhs') = dmdAnalRhsSig top_lvl Recursive env let_dmd id rhs + lazy_fv' = plusVarEnv_C plusDmd lazy_fv lazy_fv1 zapIdStrictness :: [(Id, CoreExpr)] -> [(Id, CoreExpr)] zapIdStrictness pairs = [(setIdStrictness id nopSig, rhs) | (id, rhs) <- pairs ] @@ -1090,7 +1234,7 @@ addLazyFVs dmd_ty lazy_fvs -- demand with the bottom coming up from 'error' -- -- I got a loop in the fixpointer without this, due to an interaction - -- with the lazy_fv filtering in dmdAnalRhsLetDown. Roughly, it was + -- with the lazy_fv filtering in dmdAnalRhsSig. Roughly, it was -- letrec f n x -- = letrec g y = x `fatbar` -- letrec h z = z + ...g... @@ -1156,10 +1300,6 @@ annotateLamIdBndr env arg_of_dfun dmd_ty id main_ty = addDemand dmd dmd_ty' (dmd_ty', dmd) = findBndrDmd env arg_of_dfun dmd_ty id -deleteFVs :: DmdType -> [Var] -> DmdType -deleteFVs (DmdType fvs dmds res) bndrs - = DmdType (delVarEnvList fvs bndrs) dmds res - {- Note [NOINLINE and strictness] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Core/Opt/Pipeline.hs ===================================== @@ -65,6 +65,7 @@ import GHC.Types.SrcLoc import GHC.Types.Id import GHC.Types.Id.Info import GHC.Types.Basic +import GHC.Types.Demand ( zapDmdEnvSig ) import GHC.Types.Var.Set import GHC.Types.Var.Env import GHC.Types.Unique.Supply ( UniqSupply, mkSplitUniqSupply, splitUniqSupply ) @@ -495,7 +496,7 @@ doCorePass CoreDoExitify = {-# SCC "Exitify" #-} doPass exitifyProgram doCorePass CoreDoDemand = {-# SCC "DmdAnal" #-} - doPassDFM dmdAnal + doPassDFRM dmdAnal doCorePass CoreDoCpr = {-# SCC "CprAnal" #-} doPassDFM cprAnalProgram @@ -575,6 +576,13 @@ doPassDFM do_pass guts = do let fam_envs = (p_fam_env, mg_fam_inst_env guts) doPassM (liftIO . do_pass dflags fam_envs) guts +doPassDFRM :: (DynFlags -> FamInstEnvs -> [CoreRule] -> CoreProgram -> IO CoreProgram) -> ModGuts -> CoreM ModGuts +doPassDFRM do_pass guts = do + dflags <- getDynFlags + p_fam_env <- getPackageFamInstEnv + let fam_envs = (p_fam_env, mg_fam_inst_env guts) + doPassM (liftIO . do_pass dflags fam_envs (mg_rules guts)) guts + doPassDFU :: (DynFlags -> FamInstEnvs -> UniqSupply -> CoreProgram -> CoreProgram) -> ModGuts -> CoreM ModGuts doPassDFU do_pass guts = do dflags <- getDynFlags @@ -1088,13 +1096,13 @@ transferIdInfo exported_id local_id -dmdAnal :: DynFlags -> FamInstEnvs -> CoreProgram -> IO CoreProgram -dmdAnal dflags fam_envs binds = do +dmdAnal :: DynFlags -> FamInstEnvs -> [CoreRule] -> CoreProgram -> IO CoreProgram +dmdAnal dflags fam_envs rules binds = do let opts = DmdAnalOpts { dmd_strict_dicts = gopt Opt_DictsStrict dflags } - binds_plus_dmds = dmdAnalProgram opts fam_envs binds + binds_plus_dmds = dmdAnalProgram opts fam_envs rules binds Err.dumpIfSet_dyn dflags Opt_D_dump_str_signatures "Strictness signatures" FormatText $ - dumpIdInfoOfProgram (ppr . strictnessInfo) binds_plus_dmds + dumpIdInfoOfProgram (ppr . zapDmdEnvSig . strictnessInfo) binds_plus_dmds -- See Note [Stamp out space leaks in demand analysis] in GHC.Core.Opt.DmdAnal seqBinds binds_plus_dmds `seq` return binds_plus_dmds ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -598,11 +598,10 @@ addJoinFlts = appOL mkRecFloats :: SimplFloats -> SimplFloats -- Flattens the floats into a single Rec group, -- They must either all be lifted LetFloats or all JoinFloats -mkRecFloats floats@(SimplFloats { sfLetFloats = LetFloats bs ff +mkRecFloats floats@(SimplFloats { sfLetFloats = LetFloats bs _ff , sfJoinFloats = jbs , sfInScope = in_scope }) - = ASSERT2( case ff of { FltLifted -> True; _ -> False }, ppr (fromOL bs) ) - ASSERT2( isNilOL bs || isNilOL jbs, ppr floats ) + = ASSERT2( isNilOL bs || isNilOL jbs, ppr floats ) SimplFloats { sfLetFloats = floats' , sfJoinFloats = jfloats' , sfInScope = in_scope } ===================================== compiler/GHC/Core/Opt/WorkWrap.hs ===================================== @@ -484,7 +484,7 @@ tryWW dflags fam_envs is_rec fn_id rhs | is_fun && is_eta_exp = splitFun dflags fam_envs new_fn_id fn_info wrap_dmds div cpr rhs - | is_thunk -- See Note [Thunk splitting] + | isNonRec is_rec, is_thunk -- See Note [Thunk splitting] = splitThunk dflags fam_envs is_rec new_fn_id rhs | otherwise @@ -777,6 +777,10 @@ Notice that x certainly has the CPR property now! In fact, splitThunk uses the function argument w/w splitting function, so that if x's demand is deeper (say U(U(L,L),L)) then the splitting will go deeper too. + +NB: For recursive thunks, the Simplifier is unable to float `x-rhs` out of +`x*`'s RHS, because `x*` occurs freely in `x-rhs`, and will just change it +back to the original definition, so we just split non-recursive thunks. -} -- See Note [Thunk splitting] ===================================== compiler/GHC/Core/Opt/WorkWrap/Utils.hs ===================================== @@ -1275,10 +1275,14 @@ mk_absent_let dflags fam_envs arg abs_rhs = mkAbsentErrorApp arg_ty msg msg = showSDoc (gopt_set dflags Opt_SuppressUniques) - (ppr arg <+> ppr (idType arg) <+> file_msg) + (vcat + [ text "Arg:" <+> ppr arg + , text "Type:" <+> ppr arg_ty + , file_msg + ]) file_msg = case outputFile dflags of Nothing -> empty - Just f -> text "in output file " <+> quotes (text f) + Just f -> text "In output file " <+> quotes (text f) -- We need to suppress uniques here because otherwise they'd -- end up in the generated code as strings. This is bad for -- determinism, because with different uniques the strings ===================================== compiler/GHC/Core/Tidy.hs ===================================== @@ -21,7 +21,7 @@ import GHC.Core import GHC.Core.Seq ( seqUnfolding ) import GHC.Types.Id import GHC.Types.Id.Info -import GHC.Types.Demand ( zapUsageEnvSig ) +import GHC.Types.Demand ( zapDmdEnvSig ) import GHC.Core.Type ( tidyType, tidyVarBndr ) import GHC.Core.Coercion ( tidyCo ) import GHC.Types.Var @@ -206,7 +206,7 @@ tidyLetBndr rec_tidy_env env@(tidy_env, var_env) id new_info = vanillaIdInfo `setOccInfo` occInfo old_info `setArityInfo` arityInfo old_info - `setStrictnessInfo` zapUsageEnvSig (strictnessInfo old_info) + `setStrictnessInfo` zapDmdEnvSig (strictnessInfo old_info) `setDemandInfo` demandInfo old_info `setInlinePragInfo` inlinePragInfo old_info `setUnfoldingInfo` new_unf ===================================== compiler/GHC/Types/Demand.hs ===================================== @@ -34,7 +34,7 @@ module GHC.Types.Demand ( lazyApply1Dmd, lazyApply2Dmd, strictOnceApply1Dmd, strictManyApply1Dmd, -- ** Other @Demand@ operations oneifyCard, oneifyDmd, strictifyDmd, strictifyDictDmd, mkWorkerDemand, - peelCallDmd, peelManyCalls, mkCallDmd, mkCallDmds, + peelCallDmd, peelManyCalls, mkCalledOnceDmd, mkCalledOnceDmds, addCaseBndrDmd, -- ** Extracting one-shot information argOneShots, argsOneShots, saturatedByOneShots, @@ -73,7 +73,7 @@ module GHC.Types.Demand ( seqDemand, seqDemandList, seqDmdType, seqStrictSig, -- * Zapping usage information - zapUsageDemand, zapUsageEnvSig, zapUsedOnceDemand, zapUsedOnceSig + zapUsageDemand, zapDmdEnvSig, zapUsedOnceDemand, zapUsedOnceSig ) where #include "HsVersions.h" @@ -267,9 +267,11 @@ data SubDemand -- with the specified cardinality at every level. -- Expands to 'Call' via 'viewCall' and to 'Prod' via 'viewProd'. -- - -- @Poly n@ is semantically equivalent to @nP(n,n,...)@ or @Cn(Cn(..Cn(n)))@. - -- So @U === UP(U,U,...)@ and @U === CU(CU(..CU(U)))@, - -- @S === SP(S,S,...)@ and @S === CS(CS(..CS(S)))@, and so on. + -- @Poly n@ is semantically equivalent to @Prod [n :* Poly n, ...]@ or + -- @Call n (Poly n)@. 'mkCall' and 'mkProd' do these rewrites. + -- + -- In Note [Demand notation]: @U === P(U,U,...)@ and @U === CU(U)@, + -- @S === P(S,S,...)@ and @S === CS(S)@, and so on. -- -- We only really use 'Poly' with 'C_10' (bottom), 'C_00' (absent), -- 'C_0N' (top) and sometimes 'C_1N', but it's simpler to treat it uniformly @@ -278,7 +280,8 @@ data SubDemand -- ^ @Call n sd@ describes the evaluation context of @n@ function -- applications, where every individual result is evaluated according to @sd at . -- @sd@ is /relative/ to a single call, cf. Note [Call demands are relative]. - -- Used only for values of function type. + -- Used only for values of function type. Use the smart constructor 'mkCall' + -- whenever possible! | Prod ![Demand] -- ^ @Prod ds@ describes the evaluation context of a case scrutinisation -- on an expression of product type, where the product components are @@ -306,7 +309,7 @@ polyDmd C_1N = C_1N :* poly1N polyDmd C_10 = C_10 :* poly10 -- | A smart constructor for 'Prod', applying rewrite rules along the semantic --- equalities @Prod [polyDmd n, ...] === polyDmd n@, simplifying to 'Poly' +-- equality @Prod [polyDmd n, ...] === polyDmd n@, simplifying to 'Poly' -- 'SubDemand's when possible. Note that this degrades boxity information! E.g. a -- polymorphic demand will never unbox. mkProd :: [Demand] -> SubDemand @@ -335,6 +338,13 @@ viewProd _ _ = Nothing {-# INLINE viewProd #-} -- we want to fuse away the replicate and the allocation -- for Arity. Otherwise, #18304 bites us. +-- | A smart constructor for 'Call', applying rewrite rules along the semantic +-- equality @Call n (Poly n) === Poly n@, simplifying to 'Poly' 'SubDemand's +-- when possible. +mkCall :: Card -> SubDemand -> SubDemand +mkCall n cd@(Poly m) | n == m = cd +mkCall n cd = Call n cd + -- | @viewCall sd@ interprets @sd@ as a 'Call', expanding 'Poly' demands as -- necessary. viewCall :: SubDemand -> Maybe (Card, SubDemand) @@ -356,8 +366,9 @@ lubSubDmd (Prod ds1) (viewProd (length ds1) -> Just ds2) = -- Handle Call lubSubDmd (Call n1 d1) (viewCall -> Just (n2, d2)) -- See Note [Call demands are relative] - | isAbs n2 = Call (lubCard n1 n2) (lubSubDmd d1 botSubDmd) - | otherwise = Call (lubCard n1 n2) (lubSubDmd d1 d2) + | isAbs n1 = mkCall (lubCard n1 n2) (lubSubDmd botSubDmd d2) + | isAbs n2 = mkCall (lubCard n1 n2) (lubSubDmd d1 botSubDmd) + | otherwise = mkCall (lubCard n1 n2) (lubSubDmd d1 d2) -- Handle Poly lubSubDmd (Poly n1) (Poly n2) = Poly (lubCard n1 n2) -- Make use of reflexivity (so we'll match the Prod or Call cases again). @@ -367,7 +378,7 @@ lubSubDmd _ _ = topSubDmd -- | Denotes '∪' on 'Demand'. lubDmd :: Demand -> Demand -> Demand -lubDmd (n1 :* sd1) (n2 :* sd2) = lubCard n1 n2 :* lubSubDmd sd1 sd2 +lubDmd (n1 :* sd1) (n2 :* sd2) = lubCard n1 n2 :* lubSubDmd sd1 sd2 -- | Denotes '+' on 'SubDemand'. plusSubDmd :: SubDemand -> SubDemand -> SubDemand @@ -377,8 +388,9 @@ plusSubDmd (Prod ds1) (viewProd (length ds1) -> Just ds2) = -- Handle Call plusSubDmd (Call n1 d1) (viewCall -> Just (n2, d2)) -- See Note [Call demands are relative] - | isAbs n2 = Call (plusCard n1 n2) (lubSubDmd d1 botSubDmd) - | otherwise = Call (plusCard n1 n2) (lubSubDmd d1 d2) + | isAbs n1 = mkCall (plusCard n1 n2) (lubSubDmd botSubDmd d2) + | isAbs n2 = mkCall (plusCard n1 n2) (lubSubDmd d1 botSubDmd) + | otherwise = mkCall (plusCard n1 n2) (lubSubDmd d1 d2) -- Handle Poly plusSubDmd (Poly n1) (Poly n2) = Poly (plusCard n1 n2) -- Make use of reflexivity (so we'll match the Prod or Call cases again). @@ -407,7 +419,7 @@ multSubDmd :: Card -> SubDemand -> SubDemand multSubDmd n sd | Just sd' <- multTrivial n seqSubDmd sd = sd' multSubDmd n (Poly n') = Poly (multCard n n') -multSubDmd n (Call n' sd) = Call (multCard n n') sd -- See Note [Call demands are relative] +multSubDmd n (Call n' sd) = mkCall (multCard n n') sd -- See Note [Call demands are relative] multSubDmd n (Prod ds) = Prod (map (multDmd n) ds) multDmd :: Card -> Demand -> Demand @@ -457,22 +469,22 @@ evalDmd = C_1N :* topSubDmd -- | First argument of 'GHC.Exts.maskAsyncExceptions#': @SCS(U)@. -- Called exactly once. strictOnceApply1Dmd :: Demand -strictOnceApply1Dmd = C_11 :* Call C_11 topSubDmd +strictOnceApply1Dmd = C_11 :* mkCall C_11 topSubDmd -- | First argument of 'GHC.Exts.atomically#': @MCM(U)@. -- Called at least once, possibly many times. strictManyApply1Dmd :: Demand -strictManyApply1Dmd = C_1N :* Call C_1N topSubDmd +strictManyApply1Dmd = C_1N :* mkCall C_1N topSubDmd -- | First argument of catch#: @1C1(U)@. -- Evaluates its arg lazily, but then applies it exactly once to one argument. lazyApply1Dmd :: Demand -lazyApply1Dmd = C_01 :* Call C_01 topSubDmd +lazyApply1Dmd = C_01 :* mkCall C_01 topSubDmd -- | Second argument of catch#: @1C1(CS(U))@. -- Calls its arg lazily, but then applies it exactly once to an additional argument. lazyApply2Dmd :: Demand -lazyApply2Dmd = C_01 :* Call C_01 (Call C_11 topSubDmd) +lazyApply2Dmd = C_01 :* mkCall C_01 (mkCall C_11 topSubDmd) -- | Make a 'Demand' evaluated at-most-once. oneifyDmd :: Demand -> Demand @@ -512,12 +524,12 @@ strictifyDictDmd ty (n :* Prod ds) strictifyDictDmd _ dmd = dmd -- | Wraps the 'SubDemand' with a one-shot call demand: @d@ -> @CS(d)@. -mkCallDmd :: SubDemand -> SubDemand -mkCallDmd sd = Call C_11 sd +mkCalledOnceDmd :: SubDemand -> SubDemand +mkCalledOnceDmd sd = mkCall C_11 sd --- | @mkCallDmds n d@ returns @CS(CS...(CS d))@ where there are @n@ @CS@'s. -mkCallDmds :: Arity -> SubDemand -> SubDemand -mkCallDmds arity sd = iterate mkCallDmd sd !! arity +-- | @mkCalledOnceDmds n d@ returns @CS(CS...(CS d))@ where there are @n@ @CS@'s. +mkCalledOnceDmds :: Arity -> SubDemand -> SubDemand +mkCalledOnceDmds arity sd = iterate mkCalledOnceDmd sd !! arity -- | Peels one call level from the sub-demand, and also returns how many -- times we entered the lambda body. @@ -669,7 +681,7 @@ This is needed even for non-product types, in case the case-binder is used but the components of the case alternative are not. Note [Don't optimise UP(U,U,...) to U] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ These two SubDemands: UP(U,U) (@Prod [topDmd, topDmd]@) and U (@topSubDmd@) are semantically equivalent, but we do not turn the former into @@ -1571,9 +1583,9 @@ This is weird, so I'm not worried about whether this optimises brilliantly; but it should not fall over. -} -zapUsageEnvSig :: StrictSig -> StrictSig --- Remove the usage environment from the demand -zapUsageEnvSig (StrictSig (DmdType _ ds r)) = mkClosedStrictSig ds r +-- | Remove the demand environment from the signature. +zapDmdEnvSig :: StrictSig -> StrictSig +zapDmdEnvSig (StrictSig (DmdType _ ds r)) = mkClosedStrictSig ds r zapUsageDemand :: Demand -> Demand -- Remove the usage info, but not the strictness info, from the demand @@ -1615,8 +1627,8 @@ kill_usage kfs (n :* sd) = kill_usage_card kfs n :* kill_usage_sd kfs sd kill_usage_sd :: KillFlags -> SubDemand -> SubDemand kill_usage_sd kfs (Call n sd) - | kf_called_once kfs = Call (lubCard C_1N n) (kill_usage_sd kfs sd) - | otherwise = Call n (kill_usage_sd kfs sd) + | kf_called_once kfs = mkCall (lubCard C_1N n) (kill_usage_sd kfs sd) + | otherwise = mkCall n (kill_usage_sd kfs sd) kill_usage_sd kfs (Prod ds) = Prod (map (kill_usage kfs) ds) kill_usage_sd _ sd = sd @@ -1640,7 +1652,7 @@ trimToType (n :* sd) ts where go (Prod ds) (TsProd tss) | equalLength ds tss = Prod (zipWith trimToType ds tss) - go (Call n sd) (TsFun ts) = Call n (go sd ts) + go (Call n sd) (TsFun ts) = mkCall n (go sd ts) go sd at Poly{} _ = sd go _ _ = topSubDmd @@ -1804,7 +1816,7 @@ instance Binary SubDemand where h <- getByte bh case h of 0 -> Poly <$> get bh - 1 -> Call <$> get bh <*> get bh + 1 -> mkCall <$> get bh <*> get bh 2 -> Prod <$> get bh _ -> pprPanic "Binary:SubDemand" (ppr (fromIntegral h :: Int)) ===================================== compiler/GHC/Types/Id/Info.hs ===================================== @@ -650,7 +650,7 @@ zapUsageInfo info = Just (info {demandInfo = zapUsageDemand (demandInfo info)}) zapUsageEnvInfo :: IdInfo -> Maybe IdInfo zapUsageEnvInfo info | hasDemandEnvSig (strictnessInfo info) - = Just (info {strictnessInfo = zapUsageEnvSig (strictnessInfo info)}) + = Just (info {strictnessInfo = zapDmdEnvSig (strictnessInfo info)}) | otherwise = Nothing ===================================== testsuite/tests/arityanal/should_compile/Arity11.stderr ===================================== @@ -35,7 +35,7 @@ end Rec } -- RHS size: {terms: 52, types: 28, coercions: 0, joins: 0/5} F11.$wfib [InlPrag=[2]] :: forall {a} {p}. (a -> a -> Bool) -> (Num a, Num p) => a -> p -[GblId, Arity=4, Str=, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 150 60 0] 460 0}] +[GblId, Arity=4, Str=, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 150 60 0] 460 0}] F11.$wfib = \ (@a) (@p) (ww :: a -> a -> Bool) (w :: Num a) (w1 :: Num p) (w2 :: a) -> let { @@ -73,7 +73,7 @@ F11.$wfib fib [InlPrag=[2]] :: forall {a} {p}. (Eq a, Num a, Num p) => a -> p [GblId, Arity=4, - Str=, + Str=, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=4,unsat_ok=True,boring_ok=False) Tmpl= \ (@a) (@p) (w [Occ=Once1!] :: Eq a) (w1 [Occ=Once1] :: Num a) (w2 [Occ=Once1] :: Num p) (w3 [Occ=Once1] :: a) -> case w of { GHC.Classes.C:Eq ww1 [Occ=Once1] _ [Occ=Dead] -> F11.$wfib @a @p ww1 w1 w2 w3 }}] fib = \ (@a) (@p) (w :: Eq a) (w1 :: Num a) (w2 :: Num p) (w3 :: a) -> case w of { GHC.Classes.C:Eq ww1 ww2 -> F11.$wfib @a @p ww1 w1 w2 w3 } ===================================== testsuite/tests/arityanal/should_compile/Arity16.stderr ===================================== @@ -5,7 +5,7 @@ Result size of Tidy Core = {terms: 52, types: 87, coercions: 0, joins: 0/0} Rec { -- RHS size: {terms: 15, types: 17, coercions: 0, joins: 0/0} map2 [Occ=LoopBreaker] :: forall {t} {a}. (t -> a) -> [t] -> [a] -[GblId, Arity=2, Str=, Unf=OtherCon []] +[GblId, Arity=2, Str=, Unf=OtherCon []] map2 = \ (@t) (@a) (f :: t -> a) (ds :: [t]) -> case ds of { ===================================== testsuite/tests/stranal/should_compile/T18894.hs ===================================== @@ -0,0 +1,28 @@ +{-# OPTIONS_GHC -O2 -fforce-recomp #-} + +-- | The point of this test is that @g*@ get's a demand that says +-- "whenever @g*@ is called, the second component of the pair is evaluated strictly". +module T18894 (h1, h2) where + +g1 :: Int -> (Int,Int) +g1 1 = (15, 0) +g1 n = (2 * n, 2 `div` n) +{-# NOINLINE g1 #-} + +h1 :: Int -> Int +h1 1 = 0 +-- Sadly, the @g1 2@ subexpression will be floated to top-level, where we +-- don't see the specific demand placed on it by @snd at . Tracked in #19001. +h1 2 = snd (g1 2) +h1 m = uncurry (+) (g1 m) + +g2 :: Int -> Int -> (Int,Int) +g2 m 1 = (m, 0) +g2 m n = (2 * m, 2 `div` n) +{-# NOINLINE g2 #-} + +h2 :: Int -> Int +h2 1 = 0 +h2 m + | odd m = snd (g2 m 2) + | otherwise = uncurry (+) (g2 2 m) ===================================== testsuite/tests/stranal/should_compile/T18894.stderr ===================================== @@ -0,0 +1,404 @@ + +==================== Demand analysis ==================== +Result size of Demand analysis + = {terms: 177, types: 97, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 36, types: 16, coercions: 0, joins: 0/0} +g2 [InlPrag=NOINLINE, Dmd=UCU(CS(P(1P(U),SP(U))))] + :: Int -> Int -> (Int, Int) +[LclId, + Arity=2, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20 20] 161 20}] +g2 + = \ (m [Dmd=UP(U)] :: Int) (ds [Dmd=SP(SU)] :: Int) -> + case ds of { GHC.Types.I# ds [Dmd=SU] -> + case ds of ds [Dmd=1U] { + __DEFAULT -> + (case m of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.*# 2# y) }, + case ds of wild { + __DEFAULT -> + case GHC.Classes.divInt# 2# wild of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> GHC.Types.I# -2#; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + }); + 1# -> (m, lvl) + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 36, types: 19, coercions: 0, joins: 0/0} +h2 :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 162 10}] +h2 + = \ (ds [Dmd=SP(MU)] :: Int) -> + case ds of wild [Dmd=UP(U)] { GHC.Types.I# ds [Dmd=MU] -> + case ds of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> + case g2 wild lvl of { (ds1 [Dmd=A], y [Dmd=SU]) -> y }; + 0# -> + case g2 lvl wild of { (x [Dmd=SP(U)], ds [Dmd=SP(U)]) -> + case x of { GHC.Types.I# x -> + case ds of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + } + }; + 1# -> lvl + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 15# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +lvl :: (Int, Int) +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = (lvl, lvl) + +-- RHS size: {terms: 30, types: 11, coercions: 0, joins: 0/0} +g1 [InlPrag=NOINLINE, Dmd=UCU(P(UP(U),UP(U)))] :: Int -> (Int, Int) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 141 10}] +g1 + = \ (ds [Dmd=SP(SU)] :: Int) -> + case ds of { GHC.Types.I# ds [Dmd=SU] -> + case ds of ds { + __DEFAULT -> + (GHC.Types.I# (GHC.Prim.*# 2# ds), + case ds of wild { + __DEFAULT -> + case GHC.Classes.divInt# 2# wild of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> GHC.Types.I# -2#; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + }); + 1# -> lvl + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +lvl :: (Int, Int) +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=False, ConLike=False, + WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 30 0}] +lvl = g1 (GHC.Types.I# 2#) + +-- RHS size: {terms: 28, types: 18, coercions: 0, joins: 0/0} +h1 :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 111 10}] +h1 + = \ (ds [Dmd=SP(MU)] :: Int) -> + case ds of wild [Dmd=1P(1U)] { GHC.Types.I# ds [Dmd=MU] -> + case ds of { + __DEFAULT -> + case g1 wild of { (x [Dmd=SP(U)], ds [Dmd=SP(U)]) -> + case x of { GHC.Types.I# x -> + case ds of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + }; + 1# -> lvl; + 2# -> case lvl of { (ds1 [Dmd=A], y [Dmd=SU]) -> y } + } + } + + + + +==================== Demand analysis ==================== +Result size of Demand analysis + = {terms: 171, types: 120, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# -2# + +-- RHS size: {terms: 32, types: 18, coercions: 0, joins: 0/0} +$wg2 [InlPrag=NOINLINE, Dmd=UCU(CS(P(1P(U),SP(U))))] + :: Int -> GHC.Prim.Int# -> (# Int, Int #) +[LclId, + Arity=2, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20 30] 121 20}] +$wg2 + = \ (w [Dmd=UP(U)] :: Int) (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + (# case w of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.*# 2# y) }, + case ds of { + __DEFAULT -> + case GHC.Classes.divInt# 2# ds of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> lvl; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + } #); + 1# -> (# w, lvl #) + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 34, types: 21, coercions: 0, joins: 0/0} +$wh2 [InlPrag=[2]] :: GHC.Prim.Int# -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 162 10}] +$wh2 + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> + case $wg2 (GHC.Types.I# ds) 2# of + { (# ww [Dmd=A], ww [Dmd=SU] #) -> + ww + }; + 0# -> + case $wg2 lvl ds of { (# ww [Dmd=SP(U)], ww [Dmd=SP(U)] #) -> + case ww of { GHC.Types.I# x -> + case ww of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + } + }; + 1# -> lvl + } + +-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} +h2 [InlPrag=[2]] :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (w [Occ=Once1!] :: Int) -> + case w of { GHC.Types.I# ww [Occ=Once1, Dmd=MU] -> $wh2 ww }}] +h2 + = \ (w [Dmd=SP(SU)] :: Int) -> + case w of { GHC.Types.I# ww [Dmd=SU] -> $wh2 ww } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 15# + +-- RHS size: {terms: 28, types: 15, coercions: 0, joins: 0/0} +$wg1 [InlPrag=NOINLINE, Dmd=UCU(P(UP(U),UP(U)))] + :: GHC.Prim.Int# -> (# Int, Int #) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 111 20}] +$wg1 + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + (# GHC.Types.I# (GHC.Prim.*# 2# ds), + case ds of { + __DEFAULT -> + case GHC.Classes.divInt# 2# ds of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> lvl; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + } #); + 1# -> (# lvl, lvl #) + } + +-- RHS size: {terms: 7, types: 9, coercions: 0, joins: 0/0} +lvl :: (Int, Int) +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=False, ConLike=False, + WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 40 10}] +lvl = case $wg1 2# of { (# ww, ww #) -> (ww, ww) } + +-- RHS size: {terms: 25, types: 18, coercions: 0, joins: 0/0} +$wh1 [InlPrag=[2]] :: GHC.Prim.Int# -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [50] 101 10}] +$wh1 + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds [Dmd=1U] { + __DEFAULT -> + case $wg1 ds of { (# ww [Dmd=SP(U)], ww [Dmd=SP(U)] #) -> + case ww of { GHC.Types.I# x -> + case ww of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + }; + 1# -> lvl; + 2# -> case lvl of { (ds1 [Dmd=A], y [Dmd=SU]) -> y } + } + +-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} +h1 [InlPrag=[2]] :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (w [Occ=Once1!] :: Int) -> + case w of { GHC.Types.I# ww [Occ=Once1, Dmd=MU] -> $wh1 ww }}] +h1 + = \ (w [Dmd=SP(SU)] :: Int) -> + case w of { GHC.Types.I# ww [Dmd=SU] -> $wh1 ww } + + + ===================================== testsuite/tests/stranal/should_compile/T18894b.hs ===================================== @@ -0,0 +1,20 @@ +{-# OPTIONS_GHC -O -fno-call-arity -fforce-recomp #-} + +module T18894 (f) where + +expensive :: Int -> (Int, Int) +expensive n = (n+1, n+2) +{-# NOINLINE expensive #-} + +-- arity 1 by itself, but not exported, thus can be eta-expanded based on usage +eta :: Int -> Int -> Int +eta x = if fst (expensive x) == 13 + then \y -> x + y + else \y -> x * y +{-# NOINLINE eta #-} + +f :: Int -> Int +f 1 = 0 +f m + | odd m = eta m 2 + | otherwise = eta 2 m ===================================== testsuite/tests/stranal/should_compile/T18894b.stderr ===================================== @@ -0,0 +1,187 @@ + +==================== Demand analysis ==================== +Result size of Demand analysis = {terms: 83, types: 40, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 16, types: 7, coercions: 0, joins: 0/0} +expensive [InlPrag=NOINLINE, Dmd=UCU(P(SP(SU),A))] :: Int -> (Int, Int) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [40] 52 10}] +expensive + = \ (n [Dmd=UP(U)] :: Int) -> + (case n of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 1#) }, case n of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 2#) }) + +-- RHS size: {terms: 20, types: 11, coercions: 0, joins: 0/0} +eta [InlPrag=NOINLINE, Dmd=UCU(CS(U))] :: Int -> Int -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [0] 140 120}] +eta + = \ (x [Dmd=UP(U)] :: Int) -> + case expensive x of { (x [Dmd=SP(SU)], ds1 [Dmd=A]) -> + case x of { GHC.Types.I# x [Dmd=SU] -> + case x of { + __DEFAULT -> \ (y [Dmd=SP(U)] :: Int) -> GHC.Num.$fNumInt_$c* x y; + 13# -> \ (y [Dmd=SP(U)] :: Int) -> GHC.Num.$fNumInt_$c+ x y + } + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 21, types: 5, coercions: 0, joins: 0/0} +f :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 111 0}] +f = \ (ds [Dmd=SP(MU)] :: Int) -> + case ds of wild [Dmd=UP(U)] { GHC.Types.I# ds [Dmd=MU] -> + case ds of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> eta wild lvl; + 0# -> eta lvl wild + }; + 1# -> lvl + } + } + + + + +==================== Demand analysis ==================== +Result size of Demand analysis = {terms: 85, types: 47, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 16, types: 9, coercions: 0, joins: 0/0} +$wexpensive [InlPrag=NOINLINE, Dmd=UCU(P(SP(SU),A))] :: Int -> (# Int, Int #) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [40] 42 10}] +$wexpensive + = \ (w [Dmd=UP(U)] :: Int) -> + (# case w of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 1#) }, + case w of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 2#) } #) + +-- RHS size: {terms: 19, types: 12, coercions: 0, joins: 0/0} +eta [InlPrag=NOINLINE, Dmd=UCU(CS(U))] :: Int -> Int -> Int +[LclId, + Arity=2, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [0 0] 120 0}] +eta + = \ (x [Dmd=MP(U)] :: Int) (eta [Dmd=SP(U), OS=OneShot] :: Int) -> + case $wexpensive x of { (# ww [Dmd=SP(SU)], ww [Dmd=A] #) -> + case ww of { GHC.Types.I# x [Dmd=SU] -> + case x of { + __DEFAULT -> GHC.Num.$fNumInt_$c* x eta; + 13# -> GHC.Num.$fNumInt_$c+ x eta + } + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 20, types: 3, coercions: 0, joins: 0/0} +$wf [InlPrag=[2]] :: GHC.Prim.Int# -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 121 0}] +$wf + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> eta (GHC.Types.I# ds) lvl; + 0# -> eta lvl (GHC.Types.I# ds) + }; + 1# -> lvl + } + +-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} +f [InlPrag=[2]] :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (w [Occ=Once1!] :: Int) -> case w of { GHC.Types.I# ww [Occ=Once1, Dmd=MU] -> $wf ww }}] +f = \ (w [Dmd=SP(SU)] :: Int) -> case w of { GHC.Types.I# ww [Dmd=SU] -> $wf ww } + + + ===================================== testsuite/tests/stranal/should_compile/all.T ===================================== @@ -58,3 +58,7 @@ test('T18122', [ grep_errmsg(r'wfoo =') ], compile, ['-ddump-simpl']) # We care about the call demand on $wg test('T18903', [ grep_errmsg(r'Dmd=\S+C\S+') ], compile, ['-ddump-simpl -dsuppress-uniques']) +# We care about the call demand on $wg1 and $wg2 +test('T18894', [ grep_errmsg(r'Dmd=\S+C\S+') ], compile, ['-ddump-stranal -dsuppress-uniques']) +# We care about the Arity 2 on eta, as a result of the annotated Dmd +test('T18894b', [ grep_errmsg(r'Arity=2') ], compile, ['-ddump-stranal -dsuppress-uniques -fno-call-arity -dppr-cols=200']) ===================================== testsuite/tests/stranal/sigs/T5075.stderr ===================================== @@ -1,7 +1,7 @@ ==================== Strictness signatures ==================== T5075.$trModule: -T5075.loop: +T5075.loop: @@ -13,6 +13,6 @@ T5075.loop: ==================== Strictness signatures ==================== T5075.$trModule: -T5075.loop: +T5075.loop: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2d9e01d6c0bc1967dae0c58fbf53ede5ee90bb1f...d2c303b7981d1cb9d298870eb0cb4db2bb3bd3e9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2d9e01d6c0bc1967dae0c58fbf53ede5ee90bb1f...d2c303b7981d1cb9d298870eb0cb4db2bb3bd3e9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 11 15:45:36 2020 From: gitlab at gitlab.haskell.org (Danya Rogozin) Date: Fri, 11 Dec 2020 10:45:36 -0500 Subject: [Git][ghc/ghc][wip/ghc-11342-char-kind] the char kind: type families, functionality, and submodule updates Message-ID: <5fd3942053cb9_6b2131d5c381139733@gitlab.mail> Danya Rogozin pushed to branch wip/ghc-11342-char-kind at Glasgow Haskell Compiler / GHC Commits: 368d334f by Daniel Rogozin at 2020-12-11T18:45:09+03:00 the char kind: type families, functionality, and submodule updates Co-authored-by: Rinat Stryungis <rinat.stryungis at serokell.io> Metric Decrease: T5205 Metric Increase: Naperian T13035 - - - - - 30 changed files: - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Types/Literals.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/Type.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Data/FastString.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Parser.y - compiler/GHC/Rename/HsType.hs - compiler/GHC/StgToCmm/Closure.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Instance/Typeable.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/Binary/Typeable.hs - libraries/base/Data/Typeable/Internal.hs - libraries/base/GHC/TypeLits.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/368d334fbdf1675dcbc77bf098e6628858778f4d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/368d334fbdf1675dcbc77bf098e6628858778f4d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 11 16:14:35 2020 From: gitlab at gitlab.haskell.org (Richard Eisenberg) Date: Fri, 11 Dec 2020 11:14:35 -0500 Subject: [Git][ghc/ghc][wip/T18998] Unfortunate dirty hack to overcome #18998. Message-ID: <5fd39aeb539a1_6b2131d5c381142541@gitlab.mail> Richard Eisenberg pushed to branch wip/T18998 at Glasgow Haskell Compiler / GHC Commits: c73a55fd by Richard Eisenberg at 2020-12-11T11:14:08-05:00 Unfortunate dirty hack to overcome #18998. See commentary in tcCheckUsage. Close #18998. Test case: typecheck/should_compile/T18998 - - - - - 3 changed files: - compiler/GHC/Tc/Utils/Env.hs - + testsuite/tests/typecheck/should_compile/T18998.hs - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== compiler/GHC/Tc/Utils/Env.hs ===================================== @@ -102,6 +102,7 @@ import GHC.Core.ConLike import GHC.Core.TyCon import GHC.Core.Type import GHC.Core.Coercion.Axiom +import GHC.Core.Coercion import GHC.Core.Class import GHC.Unit.Module @@ -663,10 +664,40 @@ tcCheckUsage name id_mult thing_inside ; wrapper <- case actual_u of Bottom -> return idHsWrapper Zero -> tcSubMult (UsageEnvironmentOf name) Many id_mult - MUsage m -> tcSubMult (UsageEnvironmentOf name) m id_mult + MUsage m -> do { m' <- promote_mult m + ; tcSubMult (UsageEnvironmentOf name) m' id_mult } ; tcEmitBindingUsage (deleteUE uenv name) ; return wrapper } + -- This is gross. The problem is in test case typecheck/should_compile/T18998: + -- f :: a %1-> Id n a -> Id n a + -- f x (MkId _) = MkId x + -- where MkId is a GADT constructor. Multiplicity polymorphism of constructors + -- invents a new multiplicity variable p[2] for the application MkId x. This + -- variable is at level 2, bumped because of the GADT pattern-match (MkId _). + -- We eventually unify the variable with One, due to the call to tcSubMult in + -- tcCheckUsage. But by then, we're at TcLevel 1, and so the level-check + -- fails. + -- + -- What to do? If we did inference "for real", the sub-multiplicity constraint + -- would end up in the implication of the GADT pattern-match, and all would + -- be well. But we don't have a real sub-multiplicity constraint to put in + -- the implication. (Multiplicity inference works outside the usual generate- + -- constraints-and-solve scheme.) Here, where the multiplicity arrives, we + -- must promote all multiplicity variables to reflect this outer TcLevel. + -- It's reminiscent of floating a constraint, really, so promotion is + -- appropriate. The promoteTcType function works only on types of kind TYPE rr, + -- so we can't use it here. Thus, this dirtiness. + -- + -- It works nicely in practice. + (promote_mult, _, _, _) = mapTyCo mapper + mapper = TyCoMapper { tcm_tyvar = \ () tv -> do { _ <- promoteTyVar tv + ; zonkTcTyVar tv } + , tcm_covar = \ () cv -> return (mkCoVarCo cv) + , tcm_hole = \ () h -> return (mkHoleCo h) + , tcm_tycobinder = \ () tcv _flag -> return ((), tcv) + , tcm_tycon = return } + {- ********************************************************************* * * The TcBinderStack ===================================== testsuite/tests/typecheck/should_compile/T18998.hs ===================================== @@ -0,0 +1,14 @@ +{-# LANGUAGE LinearTypes, GADTs, DataKinds, KindSignatures #-} + +-- this caused a TcLevel assertion failure + +module T18998 where + +import GHC.Types +import GHC.TypeLits + +data Id :: Nat -> Type -> Type where + MkId :: a %1-> Id 0 a + +f :: a %1-> Id n a -> Id n a +f a (MkId _) = MkId a ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -737,3 +737,4 @@ test('InstanceGivenOverlap2', normal, compile, ['']) test('LocalGivenEqs', normal, compile, ['']) test('LocalGivenEqs2', normal, compile, ['']) test('T18891', normal, compile, ['']) +test('T18998', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c73a55fdf63ed5fa31540d15275bdff03c872f70 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c73a55fdf63ed5fa31540d15275bdff03c872f70 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 11 16:50:58 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Fri, 11 Dec 2020 11:50:58 -0500 Subject: [Git][ghc/ghc][wip/T17656] 2 commits: Adjust error message Message-ID: <5fd3a372e3a9f_6b214a47f781143286@gitlab.mail> Simon Peyton Jones pushed to branch wip/T17656 at Glasgow Haskell Compiler / GHC Commits: fb595fea by Simon Peyton Jones at 2020-12-10T14:27:19+00:00 Adjust error message - - - - - 038ea202 by Simon Peyton Jones at 2020-12-11T16:50:22+00:00 wibbles - - - - - 2 changed files: - compiler/GHC/Tc/Utils/Unify.hs - testsuite/tests/polykinds/T7594.stderr Changes: ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -1466,6 +1466,7 @@ uUnfilledVar2 origin t_or_k swapped tv1 ty2 defer = unSwap swapped (uType_defer t_or_k origin) ty1 ty2 canSolveByUnification :: MetaInfo -> TcType -> Bool +-- See Note [When unification can happen] canSolveByUnification info xi = case info of CycleBreakerTv -> False @@ -1523,8 +1524,76 @@ lhsPriority tv TauTv -> 2 RuntimeUnkTv -> 3 -{- Note [TyVar/TyVar orientation] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [When unification can happen] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Question: given a homogeneous equality (alpha ~# ty), where +"homogenous" means both sides have the same kind, when is it OK to +unify alpha := ty? + +There are three reasons not to unify: + +(SKOL-ESC) Skolem-escape + Consider the constraint + forall[2] a[2]. alpha[1] ~ Maybe a[2] + If we unify alpha := Maybe a, the skolem 'a' may escape its scope. + The level alpha[1] says that alpha may be used outside this constraint, + where 'a' is not in scope at all. So we must not unify. + + Bottom line: when looking at a constraint alpha[n] := ty, do not unify + if any free varaible of 'ty' has level deeper (greater) than n + +(GIVEN-EQ) Given equalities + Consider the constraint + forall[2] a[2]. b[1] ~ Int => alpha[1] ~ Int + There is no (SKOL-ESC) problem with unifying alpha := Int, but it might + not be the principal solution. Perhpas the "right" solution is alpha := b. + We simply can't tell. See "OutsideIn(X): modular type inference with local + assumptions", section 2.2. + + Bottom line: at amibient level 'l', when looking at a constraint + alpha[n] ~ ty, do not unify alpha := ty if there are any given equalities + between levels 'n' and 'l'. + +(TYVAR-TV) Unifying TyVarTvs + When considering alpha{tyv} ~ ty, if alpha{tyv} is a TyVarTv it can + only unify with a type variable, not with a structured type. So if + 'ty' is a structured type, such as (Maybe x), don't unify. + + +Needless to say, all three have wrinkles: + +* (SKOL-ESC) Promotion. Given alpha[n] ~ ty, what if beta[k] is free + in 'ty', where beta is a unification variable, and k>n? 'beta' + stands for a monotype, and since it is part of a level-n type + (equal to alpha[n]), we must /promote/ beta to level n. Just make + up a fresh gamma[n], and unify beta[k] := gamma[n]. + +* (TYVAR-TV) Unification variables. Suppose alpha[tyv,n] is a level-n + TyVarTv (see Note [Signature skolems] in GHC.Tc.Types.TcType)? Now + consider alpha[tyv,n] ~ Bool. We don't want to unify because that + would break the TyVarTv invariant. + + What about alpha[tyv,n] ~ beta[tau,n], where beta is an ordinary + TauTv? Again, don't unify, because beta might later be unified + with, say Bool. (If levels permit, we reverse the orientation here; + see Note [TyVar/TyVar orientation].) + +* (GIVEN-EQ) Given equalites. When considering (alpha[n] ~ ty), how + do we know whether there are any given equalities between level n + and the ambient level. We answer in two ways: + + * In the eager unifier, we only unify if l=n. If not, we say that + alpha is "untouchable", and defer to the constraint solver. + This check is made in GHC.Tc.Utils.uUnifilledVar2, in the guard + isTouchableMetaTyVar. + + * In the constraint solver, we track where Given equalities occur + and use that to guard unification in GHC.Tc.Solver.Canonical.unifyTest + More details in Note [Tracking given equalities in the solver] + + +Note [TyVar/TyVar orientation] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Given (a ~ b), should we orient the CEqCan as (a~b) or (b~a)? This is a surprisingly tricky question! This is invariant (TyEq:TV). @@ -1649,11 +1718,9 @@ But, to my surprise, it didn't seem to make any significant difference to the compiler's performance, so I didn't take it any further. Still it seemed too nice to discard altogether, so I'm leaving these notes. SLPJ Jan 18. --} - -{- Note [Prevent unification with type families] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [Prevent unification with type families] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We prevent unification with type families because of an uneasy compromise. It's perfectly sound to unify with type families, and it even improves the error messages in the testsuite. It also modestly improves performance, at ===================================== testsuite/tests/polykinds/T7594.stderr ===================================== @@ -1,14 +1,17 @@ T7594.hs:37:12: error: - • Couldn't match type ‘b0’ with ‘IO ()’ - Expected: a -> b0 + • Could not deduce: b ~ IO () + from the context: (:&:) c0 Real a + bound by a type expected by the context: + forall a. (:&:) c0 Real a => a -> b + at T7594.hs:37:12-16 + Expected: a -> b Actual: a -> IO () - ‘b0’ is untouchable - inside the constraints: (:&:) c0 Real a - bound by a type expected by the context: - forall a. (:&:) c0 Real a => a -> b0 - at T7594.hs:37:12-16 + ‘b’ is a rigid type variable bound by + the inferred type of bar2 :: b + at T7594.hs:37:1-19 + Possible fix: add a type signature for ‘bar2’ • In the first argument of ‘app’, namely ‘print’ In the expression: app print q2 In an equation for ‘bar2’: bar2 = app print q2 - • Relevant bindings include bar2 :: b0 (bound at T7594.hs:37:1) + • Relevant bindings include bar2 :: b (bound at T7594.hs:37:1) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/da9cab26faedb886de0b563f293a15b8bd9b6c21...038ea2025161516387d06274f23a27ec336a9a8c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/da9cab26faedb886de0b563f293a15b8bd9b6c21...038ea2025161516387d06274f23a27ec336a9a8c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 11 17:10:43 2020 From: gitlab at gitlab.haskell.org (John Ericson) Date: Fri, 11 Dec 2020 12:10:43 -0500 Subject: [Git][ghc/ghc][wip/primop-naming-consistency] Fix array and cleanup conversion primops (#19026) Message-ID: <5fd3a8132f402_6b214011b8011489b4@gitlab.mail> John Ericson pushed to branch wip/primop-naming-consistency at Glasgow Haskell Compiler / GHC Commits: 3600633a by Sylvain Henry at 2020-12-11T17:05:56+00:00 Fix array and cleanup conversion primops (#19026) The first change makes the array ones use the proper fixed-size types, which also means that just like before, they can be used without explicit conversions with the boxed sized types. (Before, it was Int# / Word# on both sides, now it is fixed sized on both sides). For the second change, don't use "extend" or "narrow" in some of the user-facing primops names for conversions. - Names like `narrowInt32#` are misleading when `Int` is 32-bits. - Names like `extendInt64#` are flat-out wrong when `Int is 32-bits. - `narrow{Int,Word}<N>#` however map a type to itself, and so don't suffer from this problem. They are left as-is. These changes are batched together because Alex happend to use the array ops. We can only use released versions of Alex at this time, sadly, and I don't want to have to have a release thatwon't work for the final GHC 9.2. So by combining these we get all the changes for Alex done at once. Bump Cabal, array, bytestring, text, and binary submodules TODO bump alex version - - - - - 30 changed files: - compiler/GHC/Builtin/bytearray-ops.txt.pp - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Data/FastString.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/Tc/Deriv/Generate.hs - libraries/Cabal - libraries/array - libraries/base/GHC/IO/Encoding/CodePage.hs - libraries/base/GHC/IO/Encoding/UTF16.hs - libraries/base/GHC/IO/Encoding/UTF32.hs - libraries/base/GHC/IO/Encoding/UTF8.hs - libraries/base/GHC/Int.hs - libraries/base/GHC/Storable.hs - libraries/base/GHC/Word.hs - libraries/binary - libraries/bytestring - libraries/ghc-bignum/src/GHC/Num/Backend/GMP.hs - libraries/ghc-bignum/src/GHC/Num/Primitives.hs - libraries/ghc-boot/GHC/Utils/Encoding.hs - libraries/ghc-heap/tests/tso_and_stack_closures.hs - libraries/ghci/GHCi/BreakArray.hs - libraries/text - testsuite/tests/array/should_run/arr020.hs - testsuite/tests/cmm/opt/T18141.hs - testsuite/tests/codeGen/should_compile/T18614.hs - testsuite/tests/codeGen/should_run/cgrun070.hs - testsuite/tests/codeGen/should_run/cgrun072.hs - testsuite/tests/codeGen/should_run/cgrun075.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3600633a6af4b78234eb820cce710d2d4bce1743 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3600633a6af4b78234eb820cce710d2d4bce1743 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 11 17:57:43 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 11 Dec 2020 12:57:43 -0500 Subject: [Git][ghc/ghc][master] Display FFI labels (fix #18539) Message-ID: <5fd3b31741193_6b214011b8011598d9@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 381eb660 by Sylvain Henry at 2020-12-11T12:57:35-05:00 Display FFI labels (fix #18539) - - - - - 2 changed files: - compiler/GHC/Types/ForeignCall.hs - testsuite/tests/numeric/should_compile/all.T Changes: ===================================== compiler/GHC/Types/ForeignCall.hs ===================================== @@ -206,24 +206,26 @@ instance Outputable CExportSpec where instance Outputable CCallSpec where ppr (CCallSpec fun cconv safety) - = hcat [ whenPprDebug callconv, ppr_fun fun ] + = hcat [ whenPprDebug callconv, ppr_fun fun, text " ::" ] where callconv = text "{-" <> ppr cconv <> text "-}" - gc_suf | playSafe safety = text "_GC" - | otherwise = empty + gc_suf | playSafe safety = text "_safe" + | otherwise = text "_unsafe" - ppr_fun (StaticTarget st _fn mPkgId isFun) - = text (if isFun then "__pkg_ccall" - else "__pkg_ccall_value") + ppr_fun (StaticTarget st lbl mPkgId isFun) + = text (if isFun then "__ffi_static_ccall" + else "__ffi_static_ccall_value") <> gc_suf <+> (case mPkgId of Nothing -> empty Just pkgId -> ppr pkgId) + <> text ":" + <> ppr lbl <+> (pprWithSourceText st empty) ppr_fun DynamicTarget - = text "__dyn_ccall" <> gc_suf <+> text "\"\"" + = text "__ffi_dyn_ccall" <> gc_suf <+> text "\"\"" -- The filename for a C header file -- Note [Pragma source text] in GHC.Types.SourceText ===================================== testsuite/tests/numeric/should_compile/all.T ===================================== @@ -8,4 +8,4 @@ test('T7881', normal, compile, ['']) # desugaring, so we don't get the warning we expect. test('T8542', omit_ways(['hpc']), compile, ['']) test('T10929', normal, compile, ['']) -test('T16402', [ grep_errmsg(r'and') ], compile, ['']) +test('T16402', [ grep_errmsg(r'and'), when(wordsize(32), expect_broken(19024)) ], compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/381eb66012c2b1b9ef50008df57293fe443c2972 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/381eb66012c2b1b9ef50008df57293fe443c2972 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 11 17:58:21 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 11 Dec 2020 12:58:21 -0500 Subject: [Git][ghc/ghc][master] 2 commits: Elide extraneous messages for :doc command (#15784) Message-ID: <5fd3b33da126e_6b21501685011629ce@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 4548d1f8 by Aaron Allen at 2020-12-11T12:58:14-05:00 Elide extraneous messages for :doc command (#15784) Do not print `<has no documentation>` alongside a valid doc. Additionally, if two matching symbols lack documentation then the message will only be printed once. Hence, `<has no documentation>` will be printed at most once and only if all matching symbols are lacking docs. - - - - - 5eba91b6 by Aaron Allen at 2020-12-11T12:58:14-05:00 Add :doc test case for duplicate record fields Tests that the output of the `:doc` command is correct for duplicate record fields defined using -XDuplicateRecordFields. - - - - - 4 changed files: - ghc/GHCi/UI.hs - testsuite/tests/ghci/scripts/ghci065.hs - testsuite/tests/ghci/scripts/ghci065.script - testsuite/tests/ghci/scripts/ghci065.stdout Changes: ===================================== ghc/GHCi/UI.hs ===================================== @@ -1791,22 +1791,32 @@ docCmd "" = docCmd s = do -- TODO: Maybe also get module headers for module names names <- GHC.parseName s - e_docss <- mapM GHC.getDocs names - sdocs <- mapM (either handleGetDocsFailure (pure . pprDocs)) e_docss + e_docss <- sequence <$> mapM GHC.getDocs names + sdocs <- either handleGetDocsFailure (pure . pprDocs) e_docss let sdocs' = vcat (intersperse (text "") sdocs) unqual <- GHC.getPrintUnqual dflags <- getDynFlags (liftIO . putStrLn . showSDocForUser dflags unqual) sdocs' +pprDocs :: [(Maybe HsDocString, Map Int HsDocString)] -> [SDoc] +pprDocs docs + | null nonEmptyDocs = pprDoc <$> take 1 docs + -- elide if there's at least one non-empty doc (#15784) + | otherwise = pprDoc <$> nonEmptyDocs + where + empty (mb_decl_docs, arg_docs) + = isNothing mb_decl_docs && null arg_docs + nonEmptyDocs = filter (not . empty) docs + -- TODO: also print arg docs. -pprDocs :: (Maybe HsDocString, Map Int HsDocString) -> SDoc -pprDocs (mb_decl_docs, _arg_docs) = +pprDoc :: (Maybe HsDocString, Map Int HsDocString) -> SDoc +pprDoc (mb_decl_docs, _arg_docs) = maybe (text "") (text . unpackHDS) mb_decl_docs -handleGetDocsFailure :: GHC.GhcMonad m => GetDocsFailure -> m SDoc +handleGetDocsFailure :: GHC.GhcMonad m => GetDocsFailure -> m [SDoc] handleGetDocsFailure no_docs = do dflags <- getDynFlags let msg = showPpr dflags no_docs ===================================== testsuite/tests/ghci/scripts/ghci065.hs ===================================== @@ -5,6 +5,7 @@ -- this test is constructed with simple text (without markup) only. -- +{-# LANGUAGE DuplicateRecordFields #-} module Test where -- | This is the haddock comment of a data declaration for Data1. @@ -13,6 +14,25 @@ data Data1 = Val1a | Val1b data Data2 = Val2a -- ^ This is the haddock comment of a data value for Val2a | Val2b -- ^ This is the haddock comment of a data value for Val2b +-- | This is the haddock comment of a data declaration for Data3. +newtype Data3 = + Data3 { getData3 :: Int } + +newtype Data4 = + -- | This is the haddock comment of a data constructor for Data4. + Data4 { getData4 :: Int } + +data DupeFields1 = + DF1 { dupeField :: Int -- ^ This is the first haddock comment of a duplicate record field. + } + +data DupeFields2 = + DF2 { dupeField :: Int -- ^ This is the second haddock comment of a duplicate record field. + } + +data DupeFields3 = + DF3 { dupeField :: Int -- No haddock + } -- | This is the haddock comment of a function declaration for func1. func1 :: Int -> Int -> Int ===================================== testsuite/tests/ghci/scripts/ghci065.script ===================================== @@ -5,6 +5,9 @@ :doc Data1 :doc Val2a :doc Val2b +:doc Data3 +:doc Data4 +:doc dupeField :doc func1 :doc func2 ===================================== testsuite/tests/ghci/scripts/ghci065.stdout ===================================== @@ -1,6 +1,11 @@ This is the haddock comment of a data declaration for Data1. This is the haddock comment of a data value for Val2a This is the haddock comment of a data value for Val2b + This is the haddock comment of a data declaration for Data3. + This is the haddock comment of a data constructor for Data4. + This is the second haddock comment of a duplicate record field. + + This is the first haddock comment of a duplicate record field. This is the haddock comment of a function declaration for func1. This is the haddock comment of a function declaration for func3. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/381eb66012c2b1b9ef50008df57293fe443c2972...5eba91b629745746397ed36f25fe592d08ec667b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/381eb66012c2b1b9ef50008df57293fe443c2972...5eba91b629745746397ed36f25fe592d08ec667b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 11 18:29:32 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 11 Dec 2020 13:29:32 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 13 commits: Display FFI labels (fix #18539) Message-ID: <5fd3ba8ce8e44_6b21410d5e81168310@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 381eb660 by Sylvain Henry at 2020-12-11T12:57:35-05:00 Display FFI labels (fix #18539) - - - - - 4548d1f8 by Aaron Allen at 2020-12-11T12:58:14-05:00 Elide extraneous messages for :doc command (#15784) Do not print `<has no documentation>` alongside a valid doc. Additionally, if two matching symbols lack documentation then the message will only be printed once. Hence, `<has no documentation>` will be printed at most once and only if all matching symbols are lacking docs. - - - - - 5eba91b6 by Aaron Allen at 2020-12-11T12:58:14-05:00 Add :doc test case for duplicate record fields Tests that the output of the `:doc` command is correct for duplicate record fields defined using -XDuplicateRecordFields. - - - - - e9d4d651 by Ryan Scott at 2020-12-11T13:29:06-05:00 Delete outdated Note [Kind-checking tyvar binders for associated types] This Note has severely bitrotted, as it has no references anywhere in the codebase, and none of the functions that it mentions exist anymore. Let's just delete this. While I was in town, I deleted some outdated comments from `checkFamPatBinders` of a similar caliber. Fixes #19008. [ci skip] - - - - - 35ad9b32 by Sylvain Henry at 2020-12-11T13:29:08-05:00 Arrows: correctly query arrow methods (#17423) Consider the following code: proc (C x y) -> ... Before this patch, the evidence binding for the Arrow dictionary was attached to the C pattern: proc (C x y) { $dArrow = ... } -> ... But then when we desugar this, we use arrow operations ("arr", ">>>"...) specialised for this arrow: let arr_xy = arr $dArrow -- <-- Not in scope! ... in arr_xy (\(C x y) { $dArrow = ... } -> ...) This patch allows arrow operations to be type-checked before the proc itself, avoiding this issue. Fix #17423 - - - - - 2e1a3ea3 by Sylvain Henry at 2020-12-11T13:29:09-05:00 Validate script: fix configure command when using stack - - - - - 3ce19314 by Sylvain Henry at 2020-12-11T13:29:11-05:00 Hadrian: fix libffi tarball parsing Fix parsing of "libffi-3.3.tar.gz". NB: switch to a newer libffi isn't done in this patch - - - - - 042e0745 by Sylvain Henry at 2020-12-11T13:29:13-05:00 Parser: move parser utils into their own module Move code unrelated to runtime evaluation out of GHC.Runtime.Eval - - - - - 7bf4421a by Sylvain Henry at 2020-12-11T13:29:15-05:00 Move SizedSeq into ghc-boot - - - - - ccbac10d by Sylvain Henry at 2020-12-11T13:29:15-05:00 ghci: don't compile unneeded modules - - - - - d5c3cbff by Sylvain Henry at 2020-12-11T13:29:15-05:00 ghci: reuse Arch from ghc-boot - - - - - c4a46af9 by Sylvain Henry at 2020-12-11T13:29:17-05:00 rts: don't use siginterrupt (#19019) - - - - - fde4be6d by Sylvain Henry at 2020-12-11T13:29:19-05:00 Use static array in zeroCount - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - + compiler/GHC/Parser/Utils.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/Tc/Gen/Arrow.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/ForeignCall.hs - compiler/ghc.cabal.in - ghc/GHCi/UI.hs - hadrian/src/Rules/Libffi.hs - libraries/base/GHC/Float/ConversionUtils.hs - libraries/ghci/SizedSeq.hs → libraries/ghc-boot/GHC/Data/SizedSeq.hs - libraries/ghc-boot/GHC/Platform/ArchOS.hs - libraries/ghc-boot/ghc-boot.cabal.in - libraries/ghci/GHCi/CreateBCO.hs - libraries/ghci/GHCi/InfoTable.hsc - libraries/ghci/GHCi/ResolvedBCO.hs - libraries/ghci/ghci.cabal.in - rts/posix/Signals.c - testsuite/tests/gadt/T17423.hs → testsuite/tests/arrows/should_compile/T17423.hs - testsuite/tests/arrows/should_compile/all.T - testsuite/tests/gadt/all.T - testsuite/tests/ghci/scripts/ghci065.hs - testsuite/tests/ghci/scripts/ghci065.script - testsuite/tests/ghci/scripts/ghci065.stdout - testsuite/tests/numeric/should_compile/all.T - validate Changes: ===================================== compiler/GHC.hs ===================================== @@ -325,6 +325,7 @@ import qualified GHC.Parser as Parser import GHC.Parser.Lexer import GHC.Parser.Annotation import GHC.Parser.Errors.Ppr +import GHC.Parser.Utils import GHC.Iface.Load ( loadSysInterface ) import GHC.Hs @@ -1347,6 +1348,18 @@ getPackageModuleInfo hsc_env mdl minf_modBreaks = emptyModBreaks })) +availsToGlobalRdrEnv :: ModuleName -> [AvailInfo] -> GlobalRdrEnv +availsToGlobalRdrEnv mod_name avails + = mkGlobalRdrEnv (gresFromAvails (Just imp_spec) avails) + where + -- We're building a GlobalRdrEnv as if the user imported + -- all the specified modules into the global interactive module + imp_spec = ImpSpec { is_decl = decl, is_item = ImpAll} + decl = ImpDeclSpec { is_mod = mod_name, is_as = mod_name, + is_qual = False, + is_dloc = srcLocSpan interactiveSrcLoc } + + getHomeModuleInfo :: HscEnv -> Module -> IO (Maybe ModuleInfo) getHomeModuleInfo hsc_env mdl = case lookupHpt (hsc_HPT hsc_env) (moduleName mdl) of ===================================== compiler/GHC/ByteCode/Asm.hs ===================================== @@ -41,12 +41,11 @@ import GHC.Utils.Misc import GHC.Core.TyCon import GHC.Data.FastString +import GHC.Data.SizedSeq + import GHC.StgToCmm.Layout ( ArgRep(..) ) import GHC.Platform --- From iserv -import SizedSeq - import Control.Monad import Control.Monad.ST ( runST ) import Control.Monad.Trans.Class ===================================== compiler/GHC/ByteCode/Linker.hs ===================================== @@ -26,7 +26,6 @@ import GHC.ByteCode.Types import GHCi.RemoteTypes import GHCi.ResolvedBCO import GHCi.BreakArray -import SizedSeq import GHC.Builtin.PrimOps @@ -34,6 +33,7 @@ import GHC.Unit.Types import GHC.Unit.Module.Name import GHC.Data.FastString +import GHC.Data.SizedSeq import GHC.Utils.Panic import GHC.Utils.Outputable ===================================== compiler/GHC/ByteCode/Types.hs ===================================== @@ -17,12 +17,12 @@ module GHC.ByteCode.Types import GHC.Prelude import GHC.Data.FastString +import GHC.Data.SizedSeq import GHC.Types.Id import GHC.Types.Name import GHC.Types.Name.Env import GHC.Utils.Outputable import GHC.Builtin.PrimOps -import SizedSeq import GHC.Core.Type import GHC.Types.SrcLoc import GHCi.BreakArray ===================================== compiler/GHC/Parser/Utils.hs ===================================== @@ -0,0 +1,58 @@ +module GHC.Parser.Utils + ( isStmt + , hasImport + , isImport + , isDecl + ) +where + +import GHC.Prelude +import GHC.Hs +import GHC.Data.StringBuffer +import GHC.Data.FastString +import GHC.Types.SrcLoc + +import qualified GHC.Parser.Lexer as Lexer (P (..), ParseResult(..), unP, initParserState) +import GHC.Parser.Lexer (ParserOpts) +import qualified GHC.Parser as Parser (parseStmt, parseModule, parseDeclaration, parseImport) + + +-- | Returns @True@ if passed string is a statement. +isStmt :: ParserOpts -> String -> Bool +isStmt pflags stmt = + case parseThing Parser.parseStmt pflags stmt of + Lexer.POk _ _ -> True + Lexer.PFailed _ -> False + +-- | Returns @True@ if passed string has an import declaration. +hasImport :: ParserOpts -> String -> Bool +hasImport pflags stmt = + case parseThing Parser.parseModule pflags stmt of + Lexer.POk _ thing -> hasImports thing + Lexer.PFailed _ -> False + where + hasImports = not . null . hsmodImports . unLoc + +-- | Returns @True@ if passed string is an import declaration. +isImport :: ParserOpts -> String -> Bool +isImport pflags stmt = + case parseThing Parser.parseImport pflags stmt of + Lexer.POk _ _ -> True + Lexer.PFailed _ -> False + +-- | Returns @True@ if passed string is a declaration but __/not a splice/__. +isDecl :: ParserOpts -> String -> Bool +isDecl pflags stmt = + case parseThing Parser.parseDeclaration pflags stmt of + Lexer.POk _ thing -> + case unLoc thing of + SpliceD _ _ -> False + _ -> True + Lexer.PFailed _ -> False + +parseThing :: Lexer.P thing -> ParserOpts -> String -> Lexer.ParseResult thing +parseThing parser opts stmt = do + let buf = stringToStringBuffer stmt + loc = mkRealSrcLoc (fsLit "") 1 1 + + Lexer.unP parser (Lexer.initParserState opts buf loc) ===================================== compiler/GHC/Runtime/Eval.hs ===================================== @@ -17,7 +17,6 @@ module GHC.Runtime.Eval ( Resume(..), History(..), execStmt, execStmt', ExecOptions(..), execOptions, ExecResult(..), resumeExec, runDecls, runDeclsWithLocation, runParsedDecls, - isStmt, hasImport, isImport, isDecl, parseImportDecl, SingleStep(..), abandon, abandonAll, getResumeContext, @@ -26,7 +25,6 @@ module GHC.Runtime.Eval ( getHistoryModule, back, forward, setContext, getContext, - availsToGlobalRdrEnv, getNamesInScope, getRdrNamesInScope, moduleIsInterpreted, @@ -96,17 +94,12 @@ import GHC.Utils.Error import GHC.Utils.Outputable import GHC.Utils.Misc -import qualified GHC.Parser.Lexer as Lexer (P (..), ParseResult(..), unP, initParserState) -import GHC.Parser.Lexer (ParserOpts) -import qualified GHC.Parser as Parser (parseStmt, parseModule, parseDeclaration, parseImport) - import GHC.Types.RepType import GHC.Types.Fixity.Env import GHC.Types.Var import GHC.Types.Id as Id import GHC.Types.Name hiding ( varName ) import GHC.Types.Name.Set -import GHC.Types.Avail import GHC.Types.Name.Reader import GHC.Types.Var.Env import GHC.Types.SrcLoc @@ -126,7 +119,6 @@ import qualified Data.IntMap as IntMap import Data.List (find,intercalate) import Data.Map (Map) import qualified Data.Map as Map -import GHC.Data.StringBuffer (stringToStringBuffer) import Control.Monad import Control.Monad.Catch as MC import Data.Array @@ -796,17 +788,6 @@ findGlobalRdrEnv hsc_env imports Left err -> Left (mod, err) Right env -> Right env -availsToGlobalRdrEnv :: ModuleName -> [AvailInfo] -> GlobalRdrEnv -availsToGlobalRdrEnv mod_name avails - = mkGlobalRdrEnv (gresFromAvails (Just imp_spec) avails) - where - -- We're building a GlobalRdrEnv as if the user imported - -- all the specified modules into the global interactive module - imp_spec = ImpSpec { is_decl = decl, is_item = ImpAll} - decl = ImpDeclSpec { is_mod = mod_name, is_as = mod_name, - is_qual = False, - is_dloc = srcLocSpan interactiveSrcLoc } - mkTopLevEnv :: HomePackageTable -> ModuleName -> Either String GlobalRdrEnv mkTopLevEnv hpt modl = case lookupHpt hpt modl of @@ -892,45 +873,6 @@ parseName str = withSession $ \hsc_env -> liftIO $ do { lrdr_name <- hscParseIdentifier hsc_env str ; hscTcRnLookupRdrName hsc_env lrdr_name } --- | Returns @True@ if passed string is a statement. -isStmt :: ParserOpts -> String -> Bool -isStmt pflags stmt = - case parseThing Parser.parseStmt pflags stmt of - Lexer.POk _ _ -> True - Lexer.PFailed _ -> False - --- | Returns @True@ if passed string has an import declaration. -hasImport :: ParserOpts -> String -> Bool -hasImport pflags stmt = - case parseThing Parser.parseModule pflags stmt of - Lexer.POk _ thing -> hasImports thing - Lexer.PFailed _ -> False - where - hasImports = not . null . hsmodImports . unLoc - --- | Returns @True@ if passed string is an import declaration. -isImport :: ParserOpts -> String -> Bool -isImport pflags stmt = - case parseThing Parser.parseImport pflags stmt of - Lexer.POk _ _ -> True - Lexer.PFailed _ -> False - --- | Returns @True@ if passed string is a declaration but __/not a splice/__. -isDecl :: ParserOpts -> String -> Bool -isDecl pflags stmt = - case parseThing Parser.parseDeclaration pflags stmt of - Lexer.POk _ thing -> - case unLoc thing of - SpliceD _ _ -> False - _ -> True - Lexer.PFailed _ -> False - -parseThing :: Lexer.P thing -> ParserOpts -> String -> Lexer.ParseResult thing -parseThing parser opts stmt = do - let buf = stringToStringBuffer stmt - loc = mkRealSrcLoc (fsLit "") 1 1 - - Lexer.unP parser (Lexer.initParserState opts buf loc) getDocs :: GhcMonad m => Name ===================================== compiler/GHC/Tc/Gen/Arrow.hs ===================================== @@ -89,14 +89,17 @@ tcProc :: LPat GhcRn -> LHsCmdTop GhcRn -- proc pat -> expr -> ExpRhoType -- Expected type of whole proc expression -> TcM (LPat GhcTc, LHsCmdTop GhcTc, TcCoercion) -tcProc pat cmd exp_ty - = newArrowScope $ - do { exp_ty <- expTypeToType exp_ty -- no higher-rank stuff with arrows +tcProc pat cmd@(L _ (HsCmdTop names _)) exp_ty + = do { exp_ty <- expTypeToType exp_ty -- no higher-rank stuff with arrows ; (co, (exp_ty1, res_ty)) <- matchExpectedAppTy exp_ty ; (co1, (arr_ty, arg_ty)) <- matchExpectedAppTy exp_ty1 + -- start with the names as they are used to desugar the proc itself + -- See #17423 + ; names' <- mapM (tcSyntaxName ProcOrigin arr_ty) names ; let cmd_env = CmdEnv { cmd_arr = arr_ty } - ; (pat', cmd') <- tcCheckPat ProcExpr pat (unrestricted arg_ty) $ - tcCmdTop cmd_env cmd (unitTy, res_ty) + ; (pat', cmd') <- newArrowScope + $ tcCheckPat ProcExpr pat (unrestricted arg_ty) + $ tcCmdTop cmd_env names' cmd (unitTy, res_ty) ; let res_co = mkTcTransCo co (mkTcAppCo co1 (mkTcNomReflCo res_ty)) ; return (pat', cmd', res_co) } @@ -115,7 +118,7 @@ type CmdArgType = TcTauType -- carg_type, a nested tuple data CmdEnv = CmdEnv { - cmd_arr :: TcType -- arrow type constructor, of kind *->*->* + cmd_arr :: TcType -- ^ Arrow type constructor, of kind *->*->* } mkCmdArrTy :: CmdEnv -> TcTauType -> TcTauType -> TcTauType @@ -123,15 +126,15 @@ mkCmdArrTy env t1 t2 = mkAppTys (cmd_arr env) [t1, t2] --------------------------------------- tcCmdTop :: CmdEnv + -> CmdSyntaxTable GhcTc -- ^ Type-checked Arrow class methods (arr, (>>>), ...) -> LHsCmdTop GhcRn -> CmdType -> TcM (LHsCmdTop GhcTc) -tcCmdTop env (L loc (HsCmdTop names cmd)) cmd_ty@(cmd_stk, res_ty) +tcCmdTop env names (L loc (HsCmdTop _names cmd)) cmd_ty@(cmd_stk, res_ty) = setSrcSpan loc $ - do { cmd' <- tcCmd env cmd cmd_ty - ; names' <- mapM (tcSyntaxName ProcOrigin (cmd_arr env)) names - ; return (L loc $ HsCmdTop (CmdTopTc cmd_stk res_ty names') cmd') } + do { cmd' <- tcCmd env cmd cmd_ty + ; return (L loc $ HsCmdTop (CmdTopTc cmd_stk res_ty names) cmd') } ---------------------------------------- tcCmd :: CmdEnv -> LHsCmd GhcRn -> CmdType -> TcM (LHsCmd GhcTc) @@ -319,12 +322,13 @@ tc_cmd env cmd@(HsCmdArrForm x expr f fixity cmd_args) (cmd_stk, res_ty) where tc_cmd_arg :: LHsCmdTop GhcRn -> TcM (LHsCmdTop GhcTc, TcType) - tc_cmd_arg cmd + tc_cmd_arg cmd@(L _ (HsCmdTop names _)) = do { arr_ty <- newFlexiTyVarTy arrowTyConKind ; stk_ty <- newFlexiTyVarTy liftedTypeKind ; res_ty <- newFlexiTyVarTy liftedTypeKind + ; names' <- mapM (tcSyntaxName ProcOrigin arr_ty) names ; let env' = env { cmd_arr = arr_ty } - ; cmd' <- tcCmdTop env' cmd (stk_ty, res_ty) + ; cmd' <- tcCmdTop env' names' cmd (stk_ty, res_ty) ; return (cmd', mkCmdArrTy env' (mkPairTy alphaTy stk_ty) res_ty) } ----------------------------------------------------------------- ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -2819,24 +2819,6 @@ But notice that (#16322 comment:3) although T3 is really polymorphic-recursive too. Perhaps we should somehow reject that. -Note [Kind-checking tyvar binders for associated types] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -When kind-checking the type-variable binders for associated - data/newtype decls - family decls -we behave specially for type variables that are already in scope; -that is, bound by the enclosing class decl. This is done in -kcLHsQTyVarBndrs: - * The use of tcImplicitQTKBndrs - * The tcLookupLocal_maybe code in kc_hs_tv - -See Note [Associated type tyvar names] in GHC.Core.Class and - Note [TyVar binders for associated decls] in GHC.Hs.Decls - -We must do the same for family instance decls, where the in-scope -variables may be bound by the enclosing class instance decl. -Hence the use of tcImplicitQTKBndrs in tcFamTyPatsAndGen. - Note [Kind variable ordering for associated types] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ What should be the kind of `T` in the following example? (#15591) ===================================== compiler/GHC/Tc/Validity.hs ===================================== @@ -2263,12 +2263,6 @@ checkFamPatBinders :: TyCon -> [TcType] -- LHS patterns -> Type -- RHS -> TcM () --- We do these binder checks now, in tcFamTyPatsAndGen, rather --- than later, in checkValidFamEqn, for two reasons: --- - We have the implicitly and explicitly --- bound type variables conveniently to hand --- - If implicit variables are out of scope it may --- cause a crash; notably in tcConDecl in tcDataFamInstDecl checkFamPatBinders fam_tc qtvs pats rhs = do { traceTc "checkFamPatBinders" $ vcat [ debugPprType (mkTyConApp fam_tc pats) ===================================== compiler/GHC/Types/ForeignCall.hs ===================================== @@ -206,24 +206,26 @@ instance Outputable CExportSpec where instance Outputable CCallSpec where ppr (CCallSpec fun cconv safety) - = hcat [ whenPprDebug callconv, ppr_fun fun ] + = hcat [ whenPprDebug callconv, ppr_fun fun, text " ::" ] where callconv = text "{-" <> ppr cconv <> text "-}" - gc_suf | playSafe safety = text "_GC" - | otherwise = empty + gc_suf | playSafe safety = text "_safe" + | otherwise = text "_unsafe" - ppr_fun (StaticTarget st _fn mPkgId isFun) - = text (if isFun then "__pkg_ccall" - else "__pkg_ccall_value") + ppr_fun (StaticTarget st lbl mPkgId isFun) + = text (if isFun then "__ffi_static_ccall" + else "__ffi_static_ccall_value") <> gc_suf <+> (case mPkgId of Nothing -> empty Just pkgId -> ppr pkgId) + <> text ":" + <> ppr lbl <+> (pprWithSourceText st empty) ppr_fun DynamicTarget - = text "__dyn_ccall" <> gc_suf <+> text "\"\"" + = text "__ffi_dyn_ccall" <> gc_suf <+> text "\"\"" -- The filename for a C header file -- Note [Pragma source text] in GHC.Types.SourceText ===================================== compiler/ghc.cabal.in ===================================== @@ -480,6 +480,7 @@ Library GHC.Parser.PostProcess GHC.Parser.PostProcess.Haddock GHC.Parser.Types + GHC.Parser.Utils GHC.Platform GHC.Platform.ARM GHC.Platform.AArch64 ===================================== ghc/GHCi/UI.hs ===================================== @@ -1791,22 +1791,32 @@ docCmd "" = docCmd s = do -- TODO: Maybe also get module headers for module names names <- GHC.parseName s - e_docss <- mapM GHC.getDocs names - sdocs <- mapM (either handleGetDocsFailure (pure . pprDocs)) e_docss + e_docss <- sequence <$> mapM GHC.getDocs names + sdocs <- either handleGetDocsFailure (pure . pprDocs) e_docss let sdocs' = vcat (intersperse (text "") sdocs) unqual <- GHC.getPrintUnqual dflags <- getDynFlags (liftIO . putStrLn . showSDocForUser dflags unqual) sdocs' +pprDocs :: [(Maybe HsDocString, Map Int HsDocString)] -> [SDoc] +pprDocs docs + | null nonEmptyDocs = pprDoc <$> take 1 docs + -- elide if there's at least one non-empty doc (#15784) + | otherwise = pprDoc <$> nonEmptyDocs + where + empty (mb_decl_docs, arg_docs) + = isNothing mb_decl_docs && null arg_docs + nonEmptyDocs = filter (not . empty) docs + -- TODO: also print arg docs. -pprDocs :: (Maybe HsDocString, Map Int HsDocString) -> SDoc -pprDocs (mb_decl_docs, _arg_docs) = +pprDoc :: (Maybe HsDocString, Map Int HsDocString) -> SDoc +pprDoc (mb_decl_docs, _arg_docs) = maybe (text "") (text . unpackHDS) mb_decl_docs -handleGetDocsFailure :: GHC.GhcMonad m => GetDocsFailure -> m SDoc +handleGetDocsFailure :: GHC.GhcMonad m => GetDocsFailure -> m [SDoc] handleGetDocsFailure no_docs = do dflags <- getDynFlags let msg = showPpr dflags no_docs ===================================== hadrian/src/Rules/Libffi.hs ===================================== @@ -190,7 +190,7 @@ libffiRules = do removeDirectory libffiPath tarball <- needLibfffiArchive libffiPath -- Go from 'libffi-3.99999+git20171002+77e130c.tar.gz' to 'libffi-3.99999' - let libname = takeWhile (/= '+') $ takeFileName tarball + let libname = takeWhile (/= '+') $ fromJust $ stripExtension "tar.gz" $ takeFileName tarball -- Move extracted directory to libffiPath. root <- buildRoot ===================================== libraries/base/GHC/Float/ConversionUtils.hs ===================================== @@ -33,13 +33,10 @@ default () #define TO64 integerToInt64# -toByte64# :: Int64# -> Int# -toByte64# i = word2Int# (and# 255## (int2Word# (int64ToInt# i))) - -- Double mantissae have 53 bits, too much for Int# elim64# :: Int64# -> Int# -> (# Integer, Int# #) elim64# n e = - case zeroCount (toByte64# n) of + case zeroCount (int64ToInt# n) of t | isTrue# (e <=# t) -> (# integerFromInt64# (uncheckedIShiftRA64# n e), 0# #) | isTrue# (t <# 8#) -> (# integerFromInt64# (uncheckedIShiftRA64# n t), e -# t #) | otherwise -> elim64# (uncheckedIShiftRA64# n 8#) (e -# 8#) @@ -60,41 +57,13 @@ elimZerosInteger m e = elim64# (TO64 m) e elimZerosInt# :: Int# -> Int# -> (# Integer, Int# #) elimZerosInt# n e = - case zeroCount (toByte# n) of + case zeroCount n of t | isTrue# (e <=# t) -> (# IS (uncheckedIShiftRA# n e), 0# #) | isTrue# (t <# 8#) -> (# IS (uncheckedIShiftRA# n t), e -# t #) | otherwise -> elimZerosInt# (uncheckedIShiftRA# n 8#) (e -# 8#) -{-# INLINE zeroCount #-} +-- | Number of trailing zero bits in a byte zeroCount :: Int# -> Int# -zeroCount i = - case zeroCountArr of - BA ba -> indexInt8Array# ba i - -toByte# :: Int# -> Int# -toByte# i = word2Int# (and# 255## (int2Word# i)) - - -data BA = BA ByteArray# - --- Number of trailing zero bits in a byte -zeroCountArr :: BA -zeroCountArr = - let mkArr s = - case newByteArray# 256# s of - (# s1, mba #) -> - case writeInt8Array# mba 0# 8# s1 of - s2 -> - let fillA step val idx st - | isTrue# (idx <# 256#) = - case writeInt8Array# mba idx val st of - nx -> fillA step val (idx +# step) nx - | isTrue# (step <# 256#) = - fillA (2# *# step) (val +# 1#) step st - | otherwise = st - in case fillA 2# 0# 1# s2 of - s3 -> case unsafeFreezeByteArray# mba s3 of - (# _, ba #) -> ba - in case mkArr realWorld# of - b -> BA b - +zeroCount i = indexInt8OffAddr# arr (word2Int# (narrow8Word# (int2Word# i))) -- index must be in [0,255] + where + arr = "\8\0\1\0\2\0\1\0\3\0\1\0\2\0\1\0\4\0\1\0\2\0\1\0\3\0\1\0\2\0\1\0\5\0\1\0\2\0\1\0\3\0\1\0\2\0\1\0\4\0\1\0\2\0\1\0\3\0\1\0\2\0\1\0\6\0\1\0\2\0\1\0\3\0\1\0\2\0\1\0\4\0\1\0\2\0\1\0\3\0\1\0\2\0\1\0\5\0\1\0\2\0\1\0\3\0\1\0\2\0\1\0\4\0\1\0\2\0\1\0\3\0\1\0\2\0\1\0\7\0\1\0\2\0\1\0\3\0\1\0\2\0\1\0\4\0\1\0\2\0\1\0\3\0\1\0\2\0\1\0\5\0\1\0\2\0\1\0\3\0\1\0\2\0\1\0\4\0\1\0\2\0\1\0\3\0\1\0\2\0\1\0\6\0\1\0\2\0\1\0\3\0\1\0\2\0\1\0\4\0\1\0\2\0\1\0\3\0\1\0\2\0\1\0\5\0\1\0\2\0\1\0\3\0\1\0\2\0\1\0\4\0\1\0\2\0\1\0\3\0\1\0\2\0\1\0"# ===================================== libraries/ghci/SizedSeq.hs → libraries/ghc-boot/GHC/Data/SizedSeq.hs ===================================== @@ -1,5 +1,5 @@ {-# LANGUAGE StandaloneDeriving, DeriveGeneric #-} -module SizedSeq +module GHC.Data.SizedSeq ( SizedSeq(..) , emptySS , addToSS ===================================== libraries/ghc-boot/GHC/Platform/ArchOS.hs ===================================== @@ -73,8 +73,8 @@ data ArmABI -- | PowerPC 64-bit ABI data PPC_64ABI - = ELF_V1 - | ELF_V2 + = ELF_V1 -- ^ PowerPC64 + | ELF_V2 -- ^ PowerPC64 LE deriving (Read, Show, Eq) -- | Operating systems. ===================================== libraries/ghc-boot/ghc-boot.cabal.in ===================================== @@ -39,6 +39,7 @@ Library exposed-modules: GHC.BaseDir GHC.Data.ShortText + GHC.Data.SizedSeq GHC.Utils.Encoding GHC.LanguageExtensions GHC.Unit.Database ===================================== libraries/ghci/GHCi/CreateBCO.hs ===================================== @@ -17,7 +17,7 @@ import Prelude -- See note [Why do we import Prelude here?] import GHCi.ResolvedBCO import GHCi.RemoteTypes import GHCi.BreakArray -import SizedSeq +import GHC.Data.SizedSeq import System.IO (fixIO) import Control.Monad ===================================== libraries/ghci/GHCi/InfoTable.hsc ===================================== @@ -23,6 +23,8 @@ import GHC.Exts.Heap import Data.ByteString (ByteString) import Control.Monad.Fail import qualified Data.ByteString as BS +import GHC.Platform.Host (hostPlatformArch) +import GHC.Platform.ArchOS -- NOTE: Must return a pointer acceptable for use in the header of a closure. -- If tables_next_to_code is enabled, then it must point the 'code' field. @@ -63,59 +65,9 @@ mkConInfoTable tables_next_to_code ptr_words nonptr_words tag ptrtag con_desc = funPtrToInt :: FunPtr a -> Int funPtrToInt (FunPtr a) = I## (addr2Int## a) -data Arch = ArchSPARC - | ArchPPC - | ArchX86 - | ArchX86_64 - | ArchAlpha - | ArchARM - | ArchAArch64 - | ArchPPC64 - | ArchPPC64LE - | ArchS390X - deriving Show - mkJumpToAddr :: MonadFail m => EntryFunPtr-> m ItblCodes -mkJumpToAddr ptr = do - arch <- case mArch of - Just a -> pure a - Nothing -> - -- This code must not be called. You either need to add your - -- architecture as a distinct case to 'Arch' and 'mArch', or use - -- non-TABLES_NEXT_TO_CODE mode. - fail "mkJumpToAddr: Unknown obscure arch is not supported with TABLES_NEXT_TO_CODE" - pure $ mkJumpToAddr' arch ptr - --- | 'Just' if it's a known OS, or 'Nothing' otherwise. -mArch :: Maybe Arch -mArch = -#if defined(sparc_HOST_ARCH) - Just ArchSPARC -#elif defined(powerpc_HOST_ARCH) - Just ArchPPC -#elif defined(i386_HOST_ARCH) - Just ArchX86 -#elif defined(x86_64_HOST_ARCH) - Just ArchX86_64 -#elif defined(alpha_HOST_ARCH) - Just ArchAlpha -#elif defined(arm_HOST_ARCH) - Just ArchARM -#elif defined(aarch64_HOST_ARCH) - Just ArchAArch64 -#elif defined(powerpc64_HOST_ARCH) - Just ArchPPC64 -#elif defined(powerpc64le_HOST_ARCH) - Just ArchPPC64LE -#elif defined(s390x_HOST_ARCH) - Just ArchS390X -#else - Nothing -#endif - -mkJumpToAddr' :: Arch -> EntryFunPtr -> ItblCodes -mkJumpToAddr' platform a = case platform of - ArchSPARC -> +mkJumpToAddr a = case hostPlatformArch of + ArchSPARC -> pure $ -- After some consideration, we'll try this, where -- 0x55555555 stands in for the address to jump to. -- According to includes/rts/MachRegs.h, %g3 is very @@ -137,7 +89,7 @@ mkJumpToAddr' platform a = case platform of 0x81C0C000, 0x01000000 ] - ArchPPC -> + ArchPPC -> pure $ -- We'll use r12, for no particular reason. -- 0xDEADBEEF stands for the address: -- 3D80DEAD lis r12,0xDEAD @@ -152,7 +104,7 @@ mkJumpToAddr' platform a = case platform of 0x618C0000 .|. lo16 w32, 0x7D8903A6, 0x4E800420 ] - ArchX86 -> + ArchX86 -> pure $ -- Let the address to jump to be 0xWWXXYYZZ. -- Generate movl $0xWWXXYYZZ,%eax ; jmp *%eax -- which is @@ -167,7 +119,7 @@ mkJumpToAddr' platform a = case platform of in Left insnBytes - ArchX86_64 -> + ArchX86_64 -> pure $ -- Generates: -- jmpq *.L1(%rip) -- .align 8 @@ -191,7 +143,7 @@ mkJumpToAddr' platform a = case platform of in Left insnBytes - ArchAlpha -> + ArchAlpha -> pure $ let w64 = fromIntegral (funPtrToInt a) :: Word64 in Right [ 0xc3800000 -- br at, .+4 , 0xa79c000c -- ldq at, 12(at) @@ -200,7 +152,7 @@ mkJumpToAddr' platform a = case platform of , fromIntegral (w64 .&. 0x0000FFFF) , fromIntegral ((w64 `shiftR` 32) .&. 0x0000FFFF) ] - ArchARM { } -> + ArchARM {} -> pure $ -- Generates Arm sequence, -- ldr r1, [pc, #0] -- bx r1 @@ -214,7 +166,7 @@ mkJumpToAddr' platform a = case platform of , 0x11, 0xff, 0x2f, 0xe1 , byte0 w32, byte1 w32, byte2 w32, byte3 w32] - ArchAArch64 { } -> + ArchAArch64 {} -> pure $ -- Generates: -- -- ldr x1, label @@ -230,7 +182,8 @@ mkJumpToAddr' platform a = case platform of , 0xd61f0020 , fromIntegral w64 , fromIntegral (w64 `shiftR` 32) ] - ArchPPC64 -> + + ArchPPC_64 ELF_V1 -> pure $ -- We use the compiler's register r12 to read the function -- descriptor and the linker's register r11 as a temporary -- register to hold the function entry point. @@ -256,7 +209,7 @@ mkJumpToAddr' platform a = case platform of 0xE96C0010, 0x4E800420] - ArchPPC64LE -> + ArchPPC_64 ELF_V2 -> pure $ -- The ABI requires r12 to point to the function's entry point. -- We use the medium code model where code resides in the first -- two gigabytes, so loading a non-negative32 bit address @@ -274,7 +227,7 @@ mkJumpToAddr' platform a = case platform of 0x618C0000 .|. lo16 w32, 0x7D8903A6, 0x4E800420 ] - ArchS390X -> + ArchS390X -> pure $ -- Let 0xAABBCCDDEEFFGGHH be the address to jump to. -- The following code loads the address into scratch -- register r1 and jumps to it. @@ -288,6 +241,12 @@ mkJumpToAddr' platform a = case platform of 0xC0, 0x19, byte3 w64, byte2 w64, byte1 w64, byte0 w64, 0x07, 0xF1 ] + arch -> + -- The arch isn't supported. You either need to add your architecture as a + -- distinct case, or use non-TABLES_NEXT_TO_CODE mode. + fail $ "mkJumpToAddr: arch is not supported with TABLES_NEXT_TO_CODE (" + ++ show arch ++ ")" + byte0 :: (Integral w) => w -> Word8 byte0 w = fromIntegral w ===================================== libraries/ghci/GHCi/ResolvedBCO.hs ===================================== @@ -7,7 +7,7 @@ module GHCi.ResolvedBCO ) where import Prelude -- See note [Why do we import Prelude here?] -import SizedSeq +import GHC.Data.SizedSeq import GHCi.RemoteTypes import GHCi.BreakArray ===================================== libraries/ghci/ghci.cabal.in ===================================== @@ -50,10 +50,12 @@ library if flag(internal-interpreter) CPP-Options: -DHAVE_INTERNAL_INTERPRETER exposed-modules: + GHCi.InfoTable GHCi.Run GHCi.CreateBCO GHCi.ObjLink GHCi.Signals + GHCi.StaticPtrTable GHCi.TH include-dirs: @FFIIncludeDir@ @@ -65,10 +67,7 @@ library GHCi.ResolvedBCO GHCi.RemoteTypes GHCi.FFI - GHCi.InfoTable - GHCi.StaticPtrTable GHCi.TH.Binary - SizedSeq Build-Depends: array == 0.5.*, ===================================== rts/posix/Signals.c ===================================== @@ -680,15 +680,11 @@ initDefaultHandlers(void) // install the SIGINT handler action.sa_handler = shutdown_handler; sigemptyset(&action.sa_mask); - action.sa_flags = 0; + action.sa_flags = 0; // disable SA_RESTART if (sigaction(SIGINT, &action, &oact) != 0) { sysErrorBelch("warning: failed to install SIGINT handler"); } -#if defined(HAVE_SIGINTERRUPT) - siginterrupt(SIGINT, 1); // isn't this the default? --SDM -#endif - // install the SIGFPE handler // In addition to handling SIGINT, also handle SIGFPE by ignoring it. ===================================== testsuite/tests/gadt/T17423.hs → testsuite/tests/arrows/should_compile/T17423.hs ===================================== ===================================== testsuite/tests/arrows/should_compile/all.T ===================================== @@ -16,3 +16,4 @@ test('T5283', normal, compile, ['']) test('T5267', expect_broken(5267), compile, ['']) test('T5022', normalise_fun(normalise_errmsg), compile, ['']) test('T5333', normal, compile, ['']) +test('T17423', normal, compile, ['']) ===================================== testsuite/tests/gadt/all.T ===================================== @@ -119,6 +119,5 @@ test('T14808', normal, compile, ['']) test('T15009', normal, compile, ['']) test('T15558', normal, compile, ['']) test('T16427', normal, compile_fail, ['']) -test('T17423', expect_broken(17423), compile_and_run, ['']) test('T18191', normal, compile_fail, ['']) test('SynDataRec', normal, compile, ['']) ===================================== testsuite/tests/ghci/scripts/ghci065.hs ===================================== @@ -5,6 +5,7 @@ -- this test is constructed with simple text (without markup) only. -- +{-# LANGUAGE DuplicateRecordFields #-} module Test where -- | This is the haddock comment of a data declaration for Data1. @@ -13,6 +14,25 @@ data Data1 = Val1a | Val1b data Data2 = Val2a -- ^ This is the haddock comment of a data value for Val2a | Val2b -- ^ This is the haddock comment of a data value for Val2b +-- | This is the haddock comment of a data declaration for Data3. +newtype Data3 = + Data3 { getData3 :: Int } + +newtype Data4 = + -- | This is the haddock comment of a data constructor for Data4. + Data4 { getData4 :: Int } + +data DupeFields1 = + DF1 { dupeField :: Int -- ^ This is the first haddock comment of a duplicate record field. + } + +data DupeFields2 = + DF2 { dupeField :: Int -- ^ This is the second haddock comment of a duplicate record field. + } + +data DupeFields3 = + DF3 { dupeField :: Int -- No haddock + } -- | This is the haddock comment of a function declaration for func1. func1 :: Int -> Int -> Int ===================================== testsuite/tests/ghci/scripts/ghci065.script ===================================== @@ -5,6 +5,9 @@ :doc Data1 :doc Val2a :doc Val2b +:doc Data3 +:doc Data4 +:doc dupeField :doc func1 :doc func2 ===================================== testsuite/tests/ghci/scripts/ghci065.stdout ===================================== @@ -1,6 +1,11 @@ This is the haddock comment of a data declaration for Data1. This is the haddock comment of a data value for Val2a This is the haddock comment of a data value for Val2b + This is the haddock comment of a data declaration for Data3. + This is the haddock comment of a data constructor for Data4. + This is the second haddock comment of a duplicate record field. + + This is the first haddock comment of a duplicate record field. This is the haddock comment of a function declaration for func1. This is the haddock comment of a function declaration for func3. ===================================== testsuite/tests/numeric/should_compile/all.T ===================================== @@ -8,4 +8,4 @@ test('T7881', normal, compile, ['']) # desugaring, so we don't get the warning we expect. test('T8542', omit_ways(['hpc']), compile, ['']) test('T10929', normal, compile, ['']) -test('T16402', [ grep_errmsg(r'and') ], compile, ['']) +test('T16402', [ grep_errmsg(r'and'), when(wordsize(32), expect_broken(19024)) ], compile, ['']) ===================================== validate ===================================== @@ -145,6 +145,8 @@ fi echo "using THREADS=${threads}" >&2 +configure_cmd="./configure" + if [ "$use_hadrian" = "NO" ] then make="gmake" @@ -173,6 +175,7 @@ else hadrian/build-stack --help > /dev/null cd hadrian hadrian_cmd=$(stack exec -- which hadrian) + configure_cmd="stack --stack-yaml hadrian/stack.yaml exec -- ./configure" fi cd .. # TODO: define a hadrian Flavour that mimics @@ -199,7 +202,7 @@ if [ $testsuite_only -eq 0 ]; then INSTDIR="$thisdir/inst" python3 ./boot --validate - ./configure --prefix="$INSTDIR" $config_args + $configure_cmd --prefix="$INSTDIR" $config_args fi if [ "$use_hadrian" = "NO" ] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d112fb3dbd8519b33bfb3cea22000022f68169d4...fde4be6db8c3dd1dd1b029e34b93d09e51ac2b23 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d112fb3dbd8519b33bfb3cea22000022f68169d4...fde4be6db8c3dd1dd1b029e34b93d09e51ac2b23 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 11 18:45:21 2020 From: gitlab at gitlab.haskell.org (John Ericson) Date: Fri, 11 Dec 2020 13:45:21 -0500 Subject: [Git][ghc/ghc][wip/primop-naming-consistency] Fix array and cleanup conversion primops (#19026) Message-ID: <5fd3be41d4a7b_6b2131d5c38117751@gitlab.mail> John Ericson pushed to branch wip/primop-naming-consistency at Glasgow Haskell Compiler / GHC Commits: 9425fabf by Sylvain Henry at 2020-12-11T18:07:22+00:00 Fix array and cleanup conversion primops (#19026) The first change makes the array ones use the proper fixed-size types, which also means that just like before, they can be used without explicit conversions with the boxed sized types. (Before, it was Int# / Word# on both sides, now it is fixed sized on both sides). For the second change, don't use "extend" or "narrow" in some of the user-facing primops names for conversions. - Names like `narrowInt32#` are misleading when `Int` is 32-bits. - Names like `extendInt64#` are flat-out wrong when `Int is 32-bits. - `narrow{Int,Word}<N>#` however map a type to itself, and so don't suffer from this problem. They are left as-is. These changes are batched together because Alex happend to use the array ops. We can only use released versions of Alex at this time, sadly, and I don't want to have to have a release thatwon't work for the final GHC 9.2. So by combining these we get all the changes for Alex done at once. Bump Cabal, array, bytestring, text, and binary submodules TODO bump alex version - - - - - 30 changed files: - compiler/GHC/Builtin/bytearray-ops.txt.pp - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Data/FastString.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/Tc/Deriv/Generate.hs - libraries/Cabal - libraries/array - libraries/base/GHC/Float/ConversionUtils.hs - libraries/base/GHC/IO/Encoding/CodePage.hs - libraries/base/GHC/IO/Encoding/UTF16.hs - libraries/base/GHC/IO/Encoding/UTF32.hs - libraries/base/GHC/IO/Encoding/UTF8.hs - libraries/base/GHC/Int.hs - libraries/base/GHC/Storable.hs - libraries/base/GHC/Word.hs - libraries/binary - libraries/bytestring - libraries/ghc-bignum/src/GHC/Num/Backend/GMP.hs - libraries/ghc-bignum/src/GHC/Num/Primitives.hs - libraries/ghc-boot/GHC/Utils/Encoding.hs - libraries/ghc-heap/tests/tso_and_stack_closures.hs - libraries/ghci/GHCi/BreakArray.hs - libraries/text - testsuite/tests/array/should_run/arr020.hs - testsuite/tests/cmm/opt/T18141.hs - testsuite/tests/codeGen/should_compile/T18614.hs - testsuite/tests/codeGen/should_run/cgrun070.hs - testsuite/tests/codeGen/should_run/cgrun072.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9425fabffa0901f7c2f670b65f40e9e59e0d66bc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9425fabffa0901f7c2f670b65f40e9e59e0d66bc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 11 19:23:00 2020 From: gitlab at gitlab.haskell.org (Richard Eisenberg) Date: Fri, 11 Dec 2020 14:23:00 -0500 Subject: [Git][ghc/ghc][wip/T19044] Fix #19044 by tweaking unification in inst lookup Message-ID: <5fd3c71414426_6b21410d5e811784ec@gitlab.mail> Richard Eisenberg pushed to branch wip/T19044 at Glasgow Haskell Compiler / GHC Commits: 9ea5ac77 by Richard Eisenberg at 2020-12-11T14:22:38-05:00 Fix #19044 by tweaking unification in inst lookup See Note [Infinitary substitution in lookup] in GHC.Core.InstEnv Test case: typecheck/should_compile/T19044 Close #19044 - - - - - 4 changed files: - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/Unify.hs - + testsuite/tests/typecheck/should_compile/T19044.hs - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== compiler/GHC/Core/InstEnv.hs ===================================== @@ -760,6 +760,47 @@ When we match this against D [ty], we return the instantiating types where the 'Nothing' indicates that 'b' can be freely instantiated. (The caller instantiates it to a flexi type variable, which will presumably later become fixed via functional dependencies.) + +Note [Infinitary substitution in lookup] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + + class C a b + instance C c c + instance C d (Maybe d) + [W] C e (Maybe e) + +You would think we could just use the second instance, because the first doesn't +unify. But that's just ever so slightly wrong. The reason we check for unifiers +along with matchers is that we don't want the possibility that a type variable +instantiation could cause an instance choice to change. Yet if we have + type family M = Maybe M +and choose (e |-> M), then both instances match. This is absurd, but we cannot +rule it out. Yet, worrying about this case is awfully inconvenient to users, +and so we pretend the problem doesn't exist, by considering a lookup runs into +this occurs-check issue to indicate that an instance surely does not apply (i.e. +is like the SurelyApart case). + +Why don't we just exclude any instances that are MaybeApart? Because we might +have a [W] C e (F e), where F is a type family. The second instance above does +not match, but it should be included as a future possibility. Unification will +return MaybeApart MARTypeFamily in this case. + +What can go wrong with this design choice? We might get incoherence -- but not +loss of type safety. In particular, if we have [W] C M M (for the M type family +above), then GHC might arbitrarily choose either instance, depending on how +M reduces (or doesn't). + +For type families, we can't just ignore the problem (as we essentially do here), +because doing so would give us a hole in the type safety proof (as explored in +Section 6 of "Closed Type Families with Overlapping Equations", POPL'14). This +possibility of an infinitary substitution manifests as closed type families that +look like they should reduce, but don't. Users complain: #9082 and #17311. For +open type families, we actually can have unsoundness if we don't take infinitary +substitutions into account: #8162. But, luckily, for class instances, we just +risk coherence -- not great, but it seems better to give users what they likely +want. (Also, note that this problem existed for the entire decade of 201x without +anyone noticing, so it's manifestly not ruining anyone's day.) -} -- |Look up an instance in the given instance environment. The given class application must match exactly @@ -839,8 +880,10 @@ lookupInstEnv' ie vis_mods cls tys -- We consider MaybeApart to be a case where the instance might -- apply in the future. This covers an instance like C Int and -- a target like [W] C (F a), where F is a type family. - SurelyApart -> find ms us rest - _ -> find ms (item:us) rest + SurelyApart -> find ms us rest + -- Note [Infinitary substitution in lookup] + MaybeApart MARInfinite _ -> find ms us rest + _ -> find ms (item:us) rest where tpl_tv_set = mkVarSet tpl_tvs tys_tv_set = tyCoVarsOfTypes tys ===================================== compiler/GHC/Core/Unify.hs ===================================== @@ -18,7 +18,7 @@ module GHC.Core.Unify ( tcUnifyTy, tcUnifyTyKi, tcUnifyTys, tcUnifyTyKis, tcUnifyTysFG, tcUnifyTyWithTFs, BindFlag(..), - UnifyResult, UnifyResultM(..), + UnifyResult, UnifyResultM(..), MaybeApartReason(..), -- Matching a type against a lifted type (coercion) liftCoMatch, @@ -391,8 +391,8 @@ tcUnifyTyWithTFs twoWay t1 t2 = case tc_unify_tys (const BindMe) twoWay True False rn_env emptyTvSubstEnv emptyCvSubstEnv [t1] [t2] of - Unifiable (subst, _) -> Just $ maybe_fix subst - MaybeApart (subst, _) -> Just $ maybe_fix subst + Unifiable (subst, _) -> Just $ maybe_fix subst + MaybeApart _reason (subst, _) -> Just $ maybe_fix subst -- we want to *succeed* in questionable cases. This is a -- pre-unification algorithm. SurelyApart -> Nothing @@ -432,12 +432,23 @@ tcUnifyTyKis bind_fn tys1 tys2 -- return the final result. See Note [Fine-grained unification] type UnifyResult = UnifyResultM TCvSubst data UnifyResultM a = Unifiable a -- the subst that unifies the types - | MaybeApart a -- the subst has as much as we know + | MaybeApart MaybeApartReason + a -- the subst has as much as we know -- it must be part of a most general unifier -- See Note [The substitution in MaybeApart] | SurelyApart deriving Functor +-- | Why are two types 'MaybeApart'? 'MARTypeFamily' takes precedence. +-- This is used (only) in Note [Infinitary substitution in lookup] in GHC.Core.InstEnv +data MaybeApartReason = MARInfinite -- ^ matching e.g. a ~? Maybe a + | MARTypeFamily -- ^ matching e.g. F Int ~? Bool + deriving (Eq, Ord) + +instance Outputable MaybeApartReason where + ppr MARInfinite = text "MARInfinite" + ppr MARTypeFamily = text "MARTypeFamily" + instance Applicative UnifyResultM where pure = Unifiable (<*>) = ap @@ -445,9 +456,10 @@ instance Applicative UnifyResultM where instance Monad UnifyResultM where SurelyApart >>= _ = SurelyApart - MaybeApart x >>= f = case f x of - Unifiable y -> MaybeApart y - other -> other + MaybeApart r1 x >>= f = case f x of + Unifiable y -> MaybeApart r1 y + MaybeApart r2 y -> MaybeApart (max r1 r2) y + SurelyApart -> SurelyApart Unifiable x >>= f = f x instance Alternative UnifyResultM where @@ -530,9 +542,9 @@ tc_unify_tys bind_fn unif inj_check match_kis rn_env tv_env cv_env tys1 tys2 kis2 = map typeKind tys2 instance Outputable a => Outputable (UnifyResultM a) where - ppr SurelyApart = text "SurelyApart" - ppr (Unifiable x) = text "Unifiable" <+> ppr x - ppr (MaybeApart x) = text "MaybeApart" <+> ppr x + ppr SurelyApart = text "SurelyApart" + ppr (Unifiable x) = text "Unifiable" <+> ppr x + ppr (MaybeApart r x) = text "MaybeApart" <+> ppr r <+> ppr x {- ************************************************************************ @@ -994,7 +1006,7 @@ unify_ty env ty1 ty2 _kco ; unify_tys env inj_tys1 inj_tys2 ; unless (um_inj_tf env) $ -- See (end of) Note [Specification of unification] - don'tBeSoSure $ unify_tys env noninj_tys1 noninj_tys2 } + don'tBeSoSure MARTypeFamily $ unify_tys env noninj_tys1 noninj_tys2 } | Just (tc1, _) <- mb_tc_app1 , not (isGenerativeTyCon tc1 Nominal) @@ -1002,7 +1014,7 @@ unify_ty env ty1 ty2 _kco -- because the (F ty1) behaves like a variable -- NB: if unifying, we have already dealt -- with the 'ty2 = variable' case - = maybeApart + = maybeApart MARTypeFamily | Just (tc2, _) <- mb_tc_app2 , not (isGenerativeTyCon tc2 Nominal) @@ -1010,7 +1022,7 @@ unify_ty env ty1 ty2 _kco -- E.g. unify_ty [a] (F ty2) = MaybeApart, when unifying (only) -- because the (F ty2) behaves like a variable -- NB: we have already dealt with the 'ty1 = variable' case - = maybeApart + = maybeApart MARTypeFamily where mb_tc_app1 = tcSplitTyConApp_maybe ty1 @@ -1190,7 +1202,7 @@ bindTv env tv1 ty2 -- Make sure you include 'kco' (which ty2 does) #14846 ; occurs <- occursCheck env tv1 free_tvs2 - ; if occurs then maybeApart + ; if occurs then maybeApart MARInfinite else extendTvEnv tv1 ty2 } occursCheck :: UMEnv -> TyVar -> VarSet -> UM Bool @@ -1291,9 +1303,9 @@ initUM :: TvSubstEnv -- subst to extend -> UM a -> UnifyResultM a initUM subst_env cv_subst_env um = case unUM um state of - Unifiable (_, subst) -> Unifiable subst - MaybeApart (_, subst) -> MaybeApart subst - SurelyApart -> SurelyApart + Unifiable (_, subst) -> Unifiable subst + MaybeApart r (_, subst) -> MaybeApart r subst + SurelyApart -> SurelyApart where state = UMState { um_tv_env = subst_env , um_cv_env = cv_subst_env } @@ -1333,9 +1345,7 @@ checkRnEnv :: UMEnv -> VarSet -> UM () checkRnEnv env varset | isEmptyVarSet skol_vars = return () | varset `disjointVarSet` skol_vars = return () - | otherwise = maybeApart - -- ToDo: why MaybeApart? - -- I think SurelyApart would be right + | otherwise = surelyApart where skol_vars = um_skols env -- NB: That isEmptyVarSet guard is a critical optimization; @@ -1343,10 +1353,10 @@ checkRnEnv env varset -- the type, often saving quite a bit of allocation. -- | Converts any SurelyApart to a MaybeApart -don'tBeSoSure :: UM () -> UM () -don'tBeSoSure um = UM $ \ state -> +don'tBeSoSure :: MaybeApartReason -> UM () -> UM () +don'tBeSoSure r um = UM $ \ state -> case unUM um state of - SurelyApart -> MaybeApart (state, ()) + SurelyApart -> MaybeApart r (state, ()) other -> other umRnOccL :: UMEnv -> TyVar -> TyVar @@ -1358,8 +1368,8 @@ umRnOccR env v = rnOccR (um_rn_env env) v umSwapRn :: UMEnv -> UMEnv umSwapRn env = env { um_rn_env = rnSwap (um_rn_env env) } -maybeApart :: UM () -maybeApart = UM (\state -> MaybeApart (state, ())) +maybeApart :: MaybeApartReason -> UM () +maybeApart r = UM (\state -> MaybeApart r (state, ())) surelyApart :: UM a surelyApart = UM (\_ -> SurelyApart) ===================================== testsuite/tests/typecheck/should_compile/T19044.hs ===================================== @@ -0,0 +1,20 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +module T19044 where + +class C a b where + m :: a -> b + +instance C a a where + m = id + +instance C a (Maybe a) where + m _ = Nothing + +f :: a -> Maybe a +f = g + where + g x = h (m x) x + +h :: Maybe a -> a -> Maybe a +h = const ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -734,6 +734,7 @@ test('T17186', normal, compile, ['']) test('CbvOverlap', normal, compile, ['']) test('InstanceGivenOverlap', normal, compile, ['']) test('InstanceGivenOverlap2', normal, compile, ['']) +test('T19044', normal, compile, ['']) test('LocalGivenEqs', normal, compile, ['']) test('LocalGivenEqs2', normal, compile, ['']) test('T18891', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9ea5ac7742d2f1baa5d68f3a578561f2d106fc84 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9ea5ac7742d2f1baa5d68f3a578561f2d106fc84 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 11 20:13:55 2020 From: gitlab at gitlab.haskell.org (Richard Eisenberg) Date: Fri, 11 Dec 2020 15:13:55 -0500 Subject: [Git][ghc/ghc][wip/T18998] Unfortunate dirty hack to overcome #18998. Message-ID: <5fd3d303c542a_6b21491119011843d7@gitlab.mail> Richard Eisenberg pushed to branch wip/T18998 at Glasgow Haskell Compiler / GHC Commits: eb5e4454 by Richard Eisenberg at 2020-12-11T15:13:42-05:00 Unfortunate dirty hack to overcome #18998. See commentary in tcCheckUsage. Close #18998. Test case: typecheck/should_compile/T18998 - - - - - 4 changed files: - compiler/GHC/Tc/Utils/Env.hs - + testsuite/tests/typecheck/should_compile/T18998.hs - + testsuite/tests/typecheck/should_compile/T18998b.hs - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== compiler/GHC/Tc/Utils/Env.hs ===================================== @@ -102,6 +102,7 @@ import GHC.Core.ConLike import GHC.Core.TyCon import GHC.Core.Type import GHC.Core.Coercion.Axiom +import GHC.Core.Coercion import GHC.Core.Class import GHC.Unit.Module @@ -663,10 +664,41 @@ tcCheckUsage name id_mult thing_inside ; wrapper <- case actual_u of Bottom -> return idHsWrapper Zero -> tcSubMult (UsageEnvironmentOf name) Many id_mult - MUsage m -> tcSubMult (UsageEnvironmentOf name) m id_mult + MUsage m -> do { m <- zonkTcType m + ; m <- promote_mult m + ; tcSubMult (UsageEnvironmentOf name) m id_mult } ; tcEmitBindingUsage (deleteUE uenv name) ; return wrapper } + -- This is gross. The problem is in test case typecheck/should_compile/T18998: + -- f :: a %1-> Id n a -> Id n a + -- f x (MkId _) = MkId x + -- where MkId is a GADT constructor. Multiplicity polymorphism of constructors + -- invents a new multiplicity variable p[2] for the application MkId x. This + -- variable is at level 2, bumped because of the GADT pattern-match (MkId _). + -- We eventually unify the variable with One, due to the call to tcSubMult in + -- tcCheckUsage. But by then, we're at TcLevel 1, and so the level-check + -- fails. + -- + -- What to do? If we did inference "for real", the sub-multiplicity constraint + -- would end up in the implication of the GADT pattern-match, and all would + -- be well. But we don't have a real sub-multiplicity constraint to put in + -- the implication. (Multiplicity inference works outside the usual generate- + -- constraints-and-solve scheme.) Here, where the multiplicity arrives, we + -- must promote all multiplicity variables to reflect this outer TcLevel. + -- It's reminiscent of floating a constraint, really, so promotion is + -- appropriate. The promoteTcType function works only on types of kind TYPE rr, + -- so we can't use it here. Thus, this dirtiness. + -- + -- It works nicely in practice. + (promote_mult, _, _, _) = mapTyCo mapper + mapper = TyCoMapper { tcm_tyvar = \ () tv -> do { _ <- promoteTyVar tv + ; zonkTcTyVar tv } + , tcm_covar = \ () cv -> return (mkCoVarCo cv) + , tcm_hole = \ () h -> return (mkHoleCo h) + , tcm_tycobinder = \ () tcv _flag -> return ((), tcv) + , tcm_tycon = return } + {- ********************************************************************* * * The TcBinderStack ===================================== testsuite/tests/typecheck/should_compile/T18998.hs ===================================== @@ -0,0 +1,14 @@ +{-# LANGUAGE LinearTypes, GADTs, DataKinds, KindSignatures #-} + +-- this caused a TcLevel assertion failure + +module T18998 where + +import GHC.Types +import GHC.TypeLits + +data Id :: Nat -> Type -> Type where + MkId :: a %1-> Id 0 a + +f :: a %1-> Id n a -> Id n a +f a (MkId _) = MkId a ===================================== testsuite/tests/typecheck/should_compile/T18998b.hs ===================================== @@ -0,0 +1,27 @@ +{-# LANGUAGE ScopedTypeVariables, LinearTypes, DataKinds, TypeOperators, GADTs, + PolyKinds, ConstraintKinds, TypeApplications #-} + +module T18998b where + +import GHC.TypeLits +import Data.Kind +import Unsafe.Coerce + +data Dict :: Constraint -> Type where + Dict :: c => Dict c +knowPred :: Dict (KnownNat (n+1)) -> Dict (KnownNat n) +knowPred Dict = unsafeCoerce (Dict :: Dict ()) +data NList :: Nat -> Type -> Type where + Nil :: NList 0 a + Cons :: a %1-> NList n a %1-> NList (n+1) a +-- Alright, this breaks linearity for some unknown reason + +snoc :: forall n a. KnownNat n => a %1-> NList n a %1-> NList (n+1) a +snoc a Nil = Cons a Nil +snoc a (Cons x (xs :: NList n' a)) = case knowPred (Dict :: Dict (KnownNat n)) of + Dict -> Cons x (snoc a xs) +-- This works fine + +snoc' :: forall n a. a %1-> NList n a %1-> NList (n+1) a +snoc' a Nil = Cons a Nil +snoc' a (Cons x xs) = Cons x (snoc' a xs) ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -737,3 +737,5 @@ test('InstanceGivenOverlap2', normal, compile, ['']) test('LocalGivenEqs', normal, compile, ['']) test('LocalGivenEqs2', normal, compile, ['']) test('T18891', normal, compile, ['']) +test('T18998', normal, compile, ['']) +test('T18998b', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eb5e44547603513cad06ce6ef0392d15506f5f27 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eb5e44547603513cad06ce6ef0392d15506f5f27 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Dec 12 03:39:32 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 11 Dec 2020 22:39:32 -0500 Subject: [Git][ghc/ghc][master] Delete outdated Note [Kind-checking tyvar binders for associated types] Message-ID: <5fd43b74be1e9_6b21491119012083d2@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 5feb9b2d by Ryan Scott at 2020-12-11T22:39:29-05:00 Delete outdated Note [Kind-checking tyvar binders for associated types] This Note has severely bitrotted, as it has no references anywhere in the codebase, and none of the functions that it mentions exist anymore. Let's just delete this. While I was in town, I deleted some outdated comments from `checkFamPatBinders` of a similar caliber. Fixes #19008. [ci skip] - - - - - 2 changed files: - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Validity.hs Changes: ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -2819,24 +2819,6 @@ But notice that (#16322 comment:3) although T3 is really polymorphic-recursive too. Perhaps we should somehow reject that. -Note [Kind-checking tyvar binders for associated types] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -When kind-checking the type-variable binders for associated - data/newtype decls - family decls -we behave specially for type variables that are already in scope; -that is, bound by the enclosing class decl. This is done in -kcLHsQTyVarBndrs: - * The use of tcImplicitQTKBndrs - * The tcLookupLocal_maybe code in kc_hs_tv - -See Note [Associated type tyvar names] in GHC.Core.Class and - Note [TyVar binders for associated decls] in GHC.Hs.Decls - -We must do the same for family instance decls, where the in-scope -variables may be bound by the enclosing class instance decl. -Hence the use of tcImplicitQTKBndrs in tcFamTyPatsAndGen. - Note [Kind variable ordering for associated types] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ What should be the kind of `T` in the following example? (#15591) ===================================== compiler/GHC/Tc/Validity.hs ===================================== @@ -2263,12 +2263,6 @@ checkFamPatBinders :: TyCon -> [TcType] -- LHS patterns -> Type -- RHS -> TcM () --- We do these binder checks now, in tcFamTyPatsAndGen, rather --- than later, in checkValidFamEqn, for two reasons: --- - We have the implicitly and explicitly --- bound type variables conveniently to hand --- - If implicit variables are out of scope it may --- cause a crash; notably in tcConDecl in tcDataFamInstDecl checkFamPatBinders fam_tc qtvs pats rhs = do { traceTc "checkFamPatBinders" $ vcat [ debugPprType (mkTyConApp fam_tc pats) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5feb9b2dad0ce609e3cfb537a6ca758a09a6898e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5feb9b2dad0ce609e3cfb537a6ca758a09a6898e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Dec 12 03:40:16 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 11 Dec 2020 22:40:16 -0500 Subject: [Git][ghc/ghc][master] Arrows: correctly query arrow methods (#17423) Message-ID: <5fd43ba0899d6_6b213272ce01216691@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: f9f9f030 by Sylvain Henry at 2020-12-11T22:40:08-05:00 Arrows: correctly query arrow methods (#17423) Consider the following code: proc (C x y) -> ... Before this patch, the evidence binding for the Arrow dictionary was attached to the C pattern: proc (C x y) { $dArrow = ... } -> ... But then when we desugar this, we use arrow operations ("arr", ">>>"...) specialised for this arrow: let arr_xy = arr $dArrow -- <-- Not in scope! ... in arr_xy (\(C x y) { $dArrow = ... } -> ...) This patch allows arrow operations to be type-checked before the proc itself, avoiding this issue. Fix #17423 - - - - - 4 changed files: - compiler/GHC/Tc/Gen/Arrow.hs - testsuite/tests/gadt/T17423.hs → testsuite/tests/arrows/should_compile/T17423.hs - testsuite/tests/arrows/should_compile/all.T - testsuite/tests/gadt/all.T Changes: ===================================== compiler/GHC/Tc/Gen/Arrow.hs ===================================== @@ -89,14 +89,17 @@ tcProc :: LPat GhcRn -> LHsCmdTop GhcRn -- proc pat -> expr -> ExpRhoType -- Expected type of whole proc expression -> TcM (LPat GhcTc, LHsCmdTop GhcTc, TcCoercion) -tcProc pat cmd exp_ty - = newArrowScope $ - do { exp_ty <- expTypeToType exp_ty -- no higher-rank stuff with arrows +tcProc pat cmd@(L _ (HsCmdTop names _)) exp_ty + = do { exp_ty <- expTypeToType exp_ty -- no higher-rank stuff with arrows ; (co, (exp_ty1, res_ty)) <- matchExpectedAppTy exp_ty ; (co1, (arr_ty, arg_ty)) <- matchExpectedAppTy exp_ty1 + -- start with the names as they are used to desugar the proc itself + -- See #17423 + ; names' <- mapM (tcSyntaxName ProcOrigin arr_ty) names ; let cmd_env = CmdEnv { cmd_arr = arr_ty } - ; (pat', cmd') <- tcCheckPat ProcExpr pat (unrestricted arg_ty) $ - tcCmdTop cmd_env cmd (unitTy, res_ty) + ; (pat', cmd') <- newArrowScope + $ tcCheckPat ProcExpr pat (unrestricted arg_ty) + $ tcCmdTop cmd_env names' cmd (unitTy, res_ty) ; let res_co = mkTcTransCo co (mkTcAppCo co1 (mkTcNomReflCo res_ty)) ; return (pat', cmd', res_co) } @@ -115,7 +118,7 @@ type CmdArgType = TcTauType -- carg_type, a nested tuple data CmdEnv = CmdEnv { - cmd_arr :: TcType -- arrow type constructor, of kind *->*->* + cmd_arr :: TcType -- ^ Arrow type constructor, of kind *->*->* } mkCmdArrTy :: CmdEnv -> TcTauType -> TcTauType -> TcTauType @@ -123,15 +126,15 @@ mkCmdArrTy env t1 t2 = mkAppTys (cmd_arr env) [t1, t2] --------------------------------------- tcCmdTop :: CmdEnv + -> CmdSyntaxTable GhcTc -- ^ Type-checked Arrow class methods (arr, (>>>), ...) -> LHsCmdTop GhcRn -> CmdType -> TcM (LHsCmdTop GhcTc) -tcCmdTop env (L loc (HsCmdTop names cmd)) cmd_ty@(cmd_stk, res_ty) +tcCmdTop env names (L loc (HsCmdTop _names cmd)) cmd_ty@(cmd_stk, res_ty) = setSrcSpan loc $ - do { cmd' <- tcCmd env cmd cmd_ty - ; names' <- mapM (tcSyntaxName ProcOrigin (cmd_arr env)) names - ; return (L loc $ HsCmdTop (CmdTopTc cmd_stk res_ty names') cmd') } + do { cmd' <- tcCmd env cmd cmd_ty + ; return (L loc $ HsCmdTop (CmdTopTc cmd_stk res_ty names) cmd') } ---------------------------------------- tcCmd :: CmdEnv -> LHsCmd GhcRn -> CmdType -> TcM (LHsCmd GhcTc) @@ -319,12 +322,13 @@ tc_cmd env cmd@(HsCmdArrForm x expr f fixity cmd_args) (cmd_stk, res_ty) where tc_cmd_arg :: LHsCmdTop GhcRn -> TcM (LHsCmdTop GhcTc, TcType) - tc_cmd_arg cmd + tc_cmd_arg cmd@(L _ (HsCmdTop names _)) = do { arr_ty <- newFlexiTyVarTy arrowTyConKind ; stk_ty <- newFlexiTyVarTy liftedTypeKind ; res_ty <- newFlexiTyVarTy liftedTypeKind + ; names' <- mapM (tcSyntaxName ProcOrigin arr_ty) names ; let env' = env { cmd_arr = arr_ty } - ; cmd' <- tcCmdTop env' cmd (stk_ty, res_ty) + ; cmd' <- tcCmdTop env' names' cmd (stk_ty, res_ty) ; return (cmd', mkCmdArrTy env' (mkPairTy alphaTy stk_ty) res_ty) } ----------------------------------------------------------------- ===================================== testsuite/tests/gadt/T17423.hs → testsuite/tests/arrows/should_compile/T17423.hs ===================================== ===================================== testsuite/tests/arrows/should_compile/all.T ===================================== @@ -16,3 +16,4 @@ test('T5283', normal, compile, ['']) test('T5267', expect_broken(5267), compile, ['']) test('T5022', normalise_fun(normalise_errmsg), compile, ['']) test('T5333', normal, compile, ['']) +test('T17423', normal, compile, ['']) ===================================== testsuite/tests/gadt/all.T ===================================== @@ -119,6 +119,5 @@ test('T14808', normal, compile, ['']) test('T15009', normal, compile, ['']) test('T15558', normal, compile, ['']) test('T16427', normal, compile_fail, ['']) -test('T17423', expect_broken(17423), compile_and_run, ['']) test('T18191', normal, compile_fail, ['']) test('SynDataRec', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f9f9f030d77ee6fb882897246a67b527937b8f66 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f9f9f030d77ee6fb882897246a67b527937b8f66 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Dec 12 03:40:54 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 11 Dec 2020 22:40:54 -0500 Subject: [Git][ghc/ghc][master] Validate script: fix configure command when using stack Message-ID: <5fd43bc69e1c8_6b2131d5c381217949@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: aaa8f00f by Sylvain Henry at 2020-12-11T22:40:48-05:00 Validate script: fix configure command when using stack - - - - - 1 changed file: - validate Changes: ===================================== validate ===================================== @@ -145,6 +145,8 @@ fi echo "using THREADS=${threads}" >&2 +configure_cmd="./configure" + if [ "$use_hadrian" = "NO" ] then make="gmake" @@ -173,6 +175,7 @@ else hadrian/build-stack --help > /dev/null cd hadrian hadrian_cmd=$(stack exec -- which hadrian) + configure_cmd="stack --stack-yaml hadrian/stack.yaml exec -- ./configure" fi cd .. # TODO: define a hadrian Flavour that mimics @@ -199,7 +202,7 @@ if [ $testsuite_only -eq 0 ]; then INSTDIR="$thisdir/inst" python3 ./boot --validate - ./configure --prefix="$INSTDIR" $config_args + $configure_cmd --prefix="$INSTDIR" $config_args fi if [ "$use_hadrian" = "NO" ] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/aaa8f00fa03dbc29511283f93fde3b627023f4fe -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/aaa8f00fa03dbc29511283f93fde3b627023f4fe You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Dec 12 03:41:41 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 11 Dec 2020 22:41:41 -0500 Subject: [Git][ghc/ghc][master] Hadrian: fix libffi tarball parsing Message-ID: <5fd43bf5811c0_6b211e6fbe4122246a@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: b4a929a1 by Sylvain Henry at 2020-12-11T22:41:30-05:00 Hadrian: fix libffi tarball parsing Fix parsing of "libffi-3.3.tar.gz". NB: switch to a newer libffi isn't done in this patch - - - - - 1 changed file: - hadrian/src/Rules/Libffi.hs Changes: ===================================== hadrian/src/Rules/Libffi.hs ===================================== @@ -190,7 +190,7 @@ libffiRules = do removeDirectory libffiPath tarball <- needLibfffiArchive libffiPath -- Go from 'libffi-3.99999+git20171002+77e130c.tar.gz' to 'libffi-3.99999' - let libname = takeWhile (/= '+') $ takeFileName tarball + let libname = takeWhile (/= '+') $ fromJust $ stripExtension "tar.gz" $ takeFileName tarball -- Move extracted directory to libffiPath. root <- buildRoot View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b4a929a1e54272ff6ba67c1a2baba635bae93b0b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b4a929a1e54272ff6ba67c1a2baba635bae93b0b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Dec 12 03:42:20 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 11 Dec 2020 22:42:20 -0500 Subject: [Git][ghc/ghc][master] Parser: move parser utils into their own module Message-ID: <5fd43c1c4304c_6b214a47f781225350@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 690c8946 by Sylvain Henry at 2020-12-11T22:42:09-05:00 Parser: move parser utils into their own module Move code unrelated to runtime evaluation out of GHC.Runtime.Eval - - - - - 4 changed files: - compiler/GHC.hs - + compiler/GHC/Parser/Utils.hs - compiler/GHC/Runtime/Eval.hs - compiler/ghc.cabal.in Changes: ===================================== compiler/GHC.hs ===================================== @@ -325,6 +325,7 @@ import qualified GHC.Parser as Parser import GHC.Parser.Lexer import GHC.Parser.Annotation import GHC.Parser.Errors.Ppr +import GHC.Parser.Utils import GHC.Iface.Load ( loadSysInterface ) import GHC.Hs @@ -1347,6 +1348,18 @@ getPackageModuleInfo hsc_env mdl minf_modBreaks = emptyModBreaks })) +availsToGlobalRdrEnv :: ModuleName -> [AvailInfo] -> GlobalRdrEnv +availsToGlobalRdrEnv mod_name avails + = mkGlobalRdrEnv (gresFromAvails (Just imp_spec) avails) + where + -- We're building a GlobalRdrEnv as if the user imported + -- all the specified modules into the global interactive module + imp_spec = ImpSpec { is_decl = decl, is_item = ImpAll} + decl = ImpDeclSpec { is_mod = mod_name, is_as = mod_name, + is_qual = False, + is_dloc = srcLocSpan interactiveSrcLoc } + + getHomeModuleInfo :: HscEnv -> Module -> IO (Maybe ModuleInfo) getHomeModuleInfo hsc_env mdl = case lookupHpt (hsc_HPT hsc_env) (moduleName mdl) of ===================================== compiler/GHC/Parser/Utils.hs ===================================== @@ -0,0 +1,58 @@ +module GHC.Parser.Utils + ( isStmt + , hasImport + , isImport + , isDecl + ) +where + +import GHC.Prelude +import GHC.Hs +import GHC.Data.StringBuffer +import GHC.Data.FastString +import GHC.Types.SrcLoc + +import qualified GHC.Parser.Lexer as Lexer (P (..), ParseResult(..), unP, initParserState) +import GHC.Parser.Lexer (ParserOpts) +import qualified GHC.Parser as Parser (parseStmt, parseModule, parseDeclaration, parseImport) + + +-- | Returns @True@ if passed string is a statement. +isStmt :: ParserOpts -> String -> Bool +isStmt pflags stmt = + case parseThing Parser.parseStmt pflags stmt of + Lexer.POk _ _ -> True + Lexer.PFailed _ -> False + +-- | Returns @True@ if passed string has an import declaration. +hasImport :: ParserOpts -> String -> Bool +hasImport pflags stmt = + case parseThing Parser.parseModule pflags stmt of + Lexer.POk _ thing -> hasImports thing + Lexer.PFailed _ -> False + where + hasImports = not . null . hsmodImports . unLoc + +-- | Returns @True@ if passed string is an import declaration. +isImport :: ParserOpts -> String -> Bool +isImport pflags stmt = + case parseThing Parser.parseImport pflags stmt of + Lexer.POk _ _ -> True + Lexer.PFailed _ -> False + +-- | Returns @True@ if passed string is a declaration but __/not a splice/__. +isDecl :: ParserOpts -> String -> Bool +isDecl pflags stmt = + case parseThing Parser.parseDeclaration pflags stmt of + Lexer.POk _ thing -> + case unLoc thing of + SpliceD _ _ -> False + _ -> True + Lexer.PFailed _ -> False + +parseThing :: Lexer.P thing -> ParserOpts -> String -> Lexer.ParseResult thing +parseThing parser opts stmt = do + let buf = stringToStringBuffer stmt + loc = mkRealSrcLoc (fsLit "") 1 1 + + Lexer.unP parser (Lexer.initParserState opts buf loc) ===================================== compiler/GHC/Runtime/Eval.hs ===================================== @@ -17,7 +17,6 @@ module GHC.Runtime.Eval ( Resume(..), History(..), execStmt, execStmt', ExecOptions(..), execOptions, ExecResult(..), resumeExec, runDecls, runDeclsWithLocation, runParsedDecls, - isStmt, hasImport, isImport, isDecl, parseImportDecl, SingleStep(..), abandon, abandonAll, getResumeContext, @@ -26,7 +25,6 @@ module GHC.Runtime.Eval ( getHistoryModule, back, forward, setContext, getContext, - availsToGlobalRdrEnv, getNamesInScope, getRdrNamesInScope, moduleIsInterpreted, @@ -96,17 +94,12 @@ import GHC.Utils.Error import GHC.Utils.Outputable import GHC.Utils.Misc -import qualified GHC.Parser.Lexer as Lexer (P (..), ParseResult(..), unP, initParserState) -import GHC.Parser.Lexer (ParserOpts) -import qualified GHC.Parser as Parser (parseStmt, parseModule, parseDeclaration, parseImport) - import GHC.Types.RepType import GHC.Types.Fixity.Env import GHC.Types.Var import GHC.Types.Id as Id import GHC.Types.Name hiding ( varName ) import GHC.Types.Name.Set -import GHC.Types.Avail import GHC.Types.Name.Reader import GHC.Types.Var.Env import GHC.Types.SrcLoc @@ -126,7 +119,6 @@ import qualified Data.IntMap as IntMap import Data.List (find,intercalate) import Data.Map (Map) import qualified Data.Map as Map -import GHC.Data.StringBuffer (stringToStringBuffer) import Control.Monad import Control.Monad.Catch as MC import Data.Array @@ -796,17 +788,6 @@ findGlobalRdrEnv hsc_env imports Left err -> Left (mod, err) Right env -> Right env -availsToGlobalRdrEnv :: ModuleName -> [AvailInfo] -> GlobalRdrEnv -availsToGlobalRdrEnv mod_name avails - = mkGlobalRdrEnv (gresFromAvails (Just imp_spec) avails) - where - -- We're building a GlobalRdrEnv as if the user imported - -- all the specified modules into the global interactive module - imp_spec = ImpSpec { is_decl = decl, is_item = ImpAll} - decl = ImpDeclSpec { is_mod = mod_name, is_as = mod_name, - is_qual = False, - is_dloc = srcLocSpan interactiveSrcLoc } - mkTopLevEnv :: HomePackageTable -> ModuleName -> Either String GlobalRdrEnv mkTopLevEnv hpt modl = case lookupHpt hpt modl of @@ -892,45 +873,6 @@ parseName str = withSession $ \hsc_env -> liftIO $ do { lrdr_name <- hscParseIdentifier hsc_env str ; hscTcRnLookupRdrName hsc_env lrdr_name } --- | Returns @True@ if passed string is a statement. -isStmt :: ParserOpts -> String -> Bool -isStmt pflags stmt = - case parseThing Parser.parseStmt pflags stmt of - Lexer.POk _ _ -> True - Lexer.PFailed _ -> False - --- | Returns @True@ if passed string has an import declaration. -hasImport :: ParserOpts -> String -> Bool -hasImport pflags stmt = - case parseThing Parser.parseModule pflags stmt of - Lexer.POk _ thing -> hasImports thing - Lexer.PFailed _ -> False - where - hasImports = not . null . hsmodImports . unLoc - --- | Returns @True@ if passed string is an import declaration. -isImport :: ParserOpts -> String -> Bool -isImport pflags stmt = - case parseThing Parser.parseImport pflags stmt of - Lexer.POk _ _ -> True - Lexer.PFailed _ -> False - --- | Returns @True@ if passed string is a declaration but __/not a splice/__. -isDecl :: ParserOpts -> String -> Bool -isDecl pflags stmt = - case parseThing Parser.parseDeclaration pflags stmt of - Lexer.POk _ thing -> - case unLoc thing of - SpliceD _ _ -> False - _ -> True - Lexer.PFailed _ -> False - -parseThing :: Lexer.P thing -> ParserOpts -> String -> Lexer.ParseResult thing -parseThing parser opts stmt = do - let buf = stringToStringBuffer stmt - loc = mkRealSrcLoc (fsLit "") 1 1 - - Lexer.unP parser (Lexer.initParserState opts buf loc) getDocs :: GhcMonad m => Name ===================================== compiler/ghc.cabal.in ===================================== @@ -480,6 +480,7 @@ Library GHC.Parser.PostProcess GHC.Parser.PostProcess.Haddock GHC.Parser.Types + GHC.Parser.Utils GHC.Platform GHC.Platform.ARM GHC.Platform.AArch64 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/690c894616a539c59cb8e58d2bba8b9c02c5ad4c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/690c894616a539c59cb8e58d2bba8b9c02c5ad4c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Dec 12 03:42:57 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 11 Dec 2020 22:42:57 -0500 Subject: [Git][ghc/ghc][master] 3 commits: Move SizedSeq into ghc-boot Message-ID: <5fd43c417e077_6b214a47f7812284f3@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 76be0e32 by Sylvain Henry at 2020-12-11T22:42:48-05:00 Move SizedSeq into ghc-boot - - - - - 3a16d764 by Sylvain Henry at 2020-12-11T22:42:48-05:00 ghci: don't compile unneeded modules - - - - - 2895fa60 by Sylvain Henry at 2020-12-11T22:42:48-05:00 ghci: reuse Arch from ghc-boot - - - - - 10 changed files: - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - libraries/ghci/SizedSeq.hs → libraries/ghc-boot/GHC/Data/SizedSeq.hs - libraries/ghc-boot/GHC/Platform/ArchOS.hs - libraries/ghc-boot/ghc-boot.cabal.in - libraries/ghci/GHCi/CreateBCO.hs - libraries/ghci/GHCi/InfoTable.hsc - libraries/ghci/GHCi/ResolvedBCO.hs - libraries/ghci/ghci.cabal.in Changes: ===================================== compiler/GHC/ByteCode/Asm.hs ===================================== @@ -41,12 +41,11 @@ import GHC.Utils.Misc import GHC.Core.TyCon import GHC.Data.FastString +import GHC.Data.SizedSeq + import GHC.StgToCmm.Layout ( ArgRep(..) ) import GHC.Platform --- From iserv -import SizedSeq - import Control.Monad import Control.Monad.ST ( runST ) import Control.Monad.Trans.Class ===================================== compiler/GHC/ByteCode/Linker.hs ===================================== @@ -26,7 +26,6 @@ import GHC.ByteCode.Types import GHCi.RemoteTypes import GHCi.ResolvedBCO import GHCi.BreakArray -import SizedSeq import GHC.Builtin.PrimOps @@ -34,6 +33,7 @@ import GHC.Unit.Types import GHC.Unit.Module.Name import GHC.Data.FastString +import GHC.Data.SizedSeq import GHC.Utils.Panic import GHC.Utils.Outputable ===================================== compiler/GHC/ByteCode/Types.hs ===================================== @@ -17,12 +17,12 @@ module GHC.ByteCode.Types import GHC.Prelude import GHC.Data.FastString +import GHC.Data.SizedSeq import GHC.Types.Id import GHC.Types.Name import GHC.Types.Name.Env import GHC.Utils.Outputable import GHC.Builtin.PrimOps -import SizedSeq import GHC.Core.Type import GHC.Types.SrcLoc import GHCi.BreakArray ===================================== libraries/ghci/SizedSeq.hs → libraries/ghc-boot/GHC/Data/SizedSeq.hs ===================================== @@ -1,5 +1,5 @@ {-# LANGUAGE StandaloneDeriving, DeriveGeneric #-} -module SizedSeq +module GHC.Data.SizedSeq ( SizedSeq(..) , emptySS , addToSS ===================================== libraries/ghc-boot/GHC/Platform/ArchOS.hs ===================================== @@ -73,8 +73,8 @@ data ArmABI -- | PowerPC 64-bit ABI data PPC_64ABI - = ELF_V1 - | ELF_V2 + = ELF_V1 -- ^ PowerPC64 + | ELF_V2 -- ^ PowerPC64 LE deriving (Read, Show, Eq) -- | Operating systems. ===================================== libraries/ghc-boot/ghc-boot.cabal.in ===================================== @@ -39,6 +39,7 @@ Library exposed-modules: GHC.BaseDir GHC.Data.ShortText + GHC.Data.SizedSeq GHC.Utils.Encoding GHC.LanguageExtensions GHC.Unit.Database ===================================== libraries/ghci/GHCi/CreateBCO.hs ===================================== @@ -17,7 +17,7 @@ import Prelude -- See note [Why do we import Prelude here?] import GHCi.ResolvedBCO import GHCi.RemoteTypes import GHCi.BreakArray -import SizedSeq +import GHC.Data.SizedSeq import System.IO (fixIO) import Control.Monad ===================================== libraries/ghci/GHCi/InfoTable.hsc ===================================== @@ -23,6 +23,8 @@ import GHC.Exts.Heap import Data.ByteString (ByteString) import Control.Monad.Fail import qualified Data.ByteString as BS +import GHC.Platform.Host (hostPlatformArch) +import GHC.Platform.ArchOS -- NOTE: Must return a pointer acceptable for use in the header of a closure. -- If tables_next_to_code is enabled, then it must point the 'code' field. @@ -63,59 +65,9 @@ mkConInfoTable tables_next_to_code ptr_words nonptr_words tag ptrtag con_desc = funPtrToInt :: FunPtr a -> Int funPtrToInt (FunPtr a) = I## (addr2Int## a) -data Arch = ArchSPARC - | ArchPPC - | ArchX86 - | ArchX86_64 - | ArchAlpha - | ArchARM - | ArchAArch64 - | ArchPPC64 - | ArchPPC64LE - | ArchS390X - deriving Show - mkJumpToAddr :: MonadFail m => EntryFunPtr-> m ItblCodes -mkJumpToAddr ptr = do - arch <- case mArch of - Just a -> pure a - Nothing -> - -- This code must not be called. You either need to add your - -- architecture as a distinct case to 'Arch' and 'mArch', or use - -- non-TABLES_NEXT_TO_CODE mode. - fail "mkJumpToAddr: Unknown obscure arch is not supported with TABLES_NEXT_TO_CODE" - pure $ mkJumpToAddr' arch ptr - --- | 'Just' if it's a known OS, or 'Nothing' otherwise. -mArch :: Maybe Arch -mArch = -#if defined(sparc_HOST_ARCH) - Just ArchSPARC -#elif defined(powerpc_HOST_ARCH) - Just ArchPPC -#elif defined(i386_HOST_ARCH) - Just ArchX86 -#elif defined(x86_64_HOST_ARCH) - Just ArchX86_64 -#elif defined(alpha_HOST_ARCH) - Just ArchAlpha -#elif defined(arm_HOST_ARCH) - Just ArchARM -#elif defined(aarch64_HOST_ARCH) - Just ArchAArch64 -#elif defined(powerpc64_HOST_ARCH) - Just ArchPPC64 -#elif defined(powerpc64le_HOST_ARCH) - Just ArchPPC64LE -#elif defined(s390x_HOST_ARCH) - Just ArchS390X -#else - Nothing -#endif - -mkJumpToAddr' :: Arch -> EntryFunPtr -> ItblCodes -mkJumpToAddr' platform a = case platform of - ArchSPARC -> +mkJumpToAddr a = case hostPlatformArch of + ArchSPARC -> pure $ -- After some consideration, we'll try this, where -- 0x55555555 stands in for the address to jump to. -- According to includes/rts/MachRegs.h, %g3 is very @@ -137,7 +89,7 @@ mkJumpToAddr' platform a = case platform of 0x81C0C000, 0x01000000 ] - ArchPPC -> + ArchPPC -> pure $ -- We'll use r12, for no particular reason. -- 0xDEADBEEF stands for the address: -- 3D80DEAD lis r12,0xDEAD @@ -152,7 +104,7 @@ mkJumpToAddr' platform a = case platform of 0x618C0000 .|. lo16 w32, 0x7D8903A6, 0x4E800420 ] - ArchX86 -> + ArchX86 -> pure $ -- Let the address to jump to be 0xWWXXYYZZ. -- Generate movl $0xWWXXYYZZ,%eax ; jmp *%eax -- which is @@ -167,7 +119,7 @@ mkJumpToAddr' platform a = case platform of in Left insnBytes - ArchX86_64 -> + ArchX86_64 -> pure $ -- Generates: -- jmpq *.L1(%rip) -- .align 8 @@ -191,7 +143,7 @@ mkJumpToAddr' platform a = case platform of in Left insnBytes - ArchAlpha -> + ArchAlpha -> pure $ let w64 = fromIntegral (funPtrToInt a) :: Word64 in Right [ 0xc3800000 -- br at, .+4 , 0xa79c000c -- ldq at, 12(at) @@ -200,7 +152,7 @@ mkJumpToAddr' platform a = case platform of , fromIntegral (w64 .&. 0x0000FFFF) , fromIntegral ((w64 `shiftR` 32) .&. 0x0000FFFF) ] - ArchARM { } -> + ArchARM {} -> pure $ -- Generates Arm sequence, -- ldr r1, [pc, #0] -- bx r1 @@ -214,7 +166,7 @@ mkJumpToAddr' platform a = case platform of , 0x11, 0xff, 0x2f, 0xe1 , byte0 w32, byte1 w32, byte2 w32, byte3 w32] - ArchAArch64 { } -> + ArchAArch64 {} -> pure $ -- Generates: -- -- ldr x1, label @@ -230,7 +182,8 @@ mkJumpToAddr' platform a = case platform of , 0xd61f0020 , fromIntegral w64 , fromIntegral (w64 `shiftR` 32) ] - ArchPPC64 -> + + ArchPPC_64 ELF_V1 -> pure $ -- We use the compiler's register r12 to read the function -- descriptor and the linker's register r11 as a temporary -- register to hold the function entry point. @@ -256,7 +209,7 @@ mkJumpToAddr' platform a = case platform of 0xE96C0010, 0x4E800420] - ArchPPC64LE -> + ArchPPC_64 ELF_V2 -> pure $ -- The ABI requires r12 to point to the function's entry point. -- We use the medium code model where code resides in the first -- two gigabytes, so loading a non-negative32 bit address @@ -274,7 +227,7 @@ mkJumpToAddr' platform a = case platform of 0x618C0000 .|. lo16 w32, 0x7D8903A6, 0x4E800420 ] - ArchS390X -> + ArchS390X -> pure $ -- Let 0xAABBCCDDEEFFGGHH be the address to jump to. -- The following code loads the address into scratch -- register r1 and jumps to it. @@ -288,6 +241,12 @@ mkJumpToAddr' platform a = case platform of 0xC0, 0x19, byte3 w64, byte2 w64, byte1 w64, byte0 w64, 0x07, 0xF1 ] + arch -> + -- The arch isn't supported. You either need to add your architecture as a + -- distinct case, or use non-TABLES_NEXT_TO_CODE mode. + fail $ "mkJumpToAddr: arch is not supported with TABLES_NEXT_TO_CODE (" + ++ show arch ++ ")" + byte0 :: (Integral w) => w -> Word8 byte0 w = fromIntegral w ===================================== libraries/ghci/GHCi/ResolvedBCO.hs ===================================== @@ -7,7 +7,7 @@ module GHCi.ResolvedBCO ) where import Prelude -- See note [Why do we import Prelude here?] -import SizedSeq +import GHC.Data.SizedSeq import GHCi.RemoteTypes import GHCi.BreakArray ===================================== libraries/ghci/ghci.cabal.in ===================================== @@ -50,10 +50,12 @@ library if flag(internal-interpreter) CPP-Options: -DHAVE_INTERNAL_INTERPRETER exposed-modules: + GHCi.InfoTable GHCi.Run GHCi.CreateBCO GHCi.ObjLink GHCi.Signals + GHCi.StaticPtrTable GHCi.TH include-dirs: @FFIIncludeDir@ @@ -65,10 +67,7 @@ library GHCi.ResolvedBCO GHCi.RemoteTypes GHCi.FFI - GHCi.InfoTable - GHCi.StaticPtrTable GHCi.TH.Binary - SizedSeq Build-Depends: array == 0.5.*, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/690c894616a539c59cb8e58d2bba8b9c02c5ad4c...2895fa60350e19016ee4babc1a1ce8bc5179364d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/690c894616a539c59cb8e58d2bba8b9c02c5ad4c...2895fa60350e19016ee4babc1a1ce8bc5179364d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Dec 12 03:43:38 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 11 Dec 2020 22:43:38 -0500 Subject: [Git][ghc/ghc][master] rts: don't use siginterrupt (#19019) Message-ID: <5fd43c6aa6e63_6b214011b80123137b@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 480a38d4 by Sylvain Henry at 2020-12-11T22:43:30-05:00 rts: don't use siginterrupt (#19019) - - - - - 1 changed file: - rts/posix/Signals.c Changes: ===================================== rts/posix/Signals.c ===================================== @@ -680,15 +680,11 @@ initDefaultHandlers(void) // install the SIGINT handler action.sa_handler = shutdown_handler; sigemptyset(&action.sa_mask); - action.sa_flags = 0; + action.sa_flags = 0; // disable SA_RESTART if (sigaction(SIGINT, &action, &oact) != 0) { sysErrorBelch("warning: failed to install SIGINT handler"); } -#if defined(HAVE_SIGINTERRUPT) - siginterrupt(SIGINT, 1); // isn't this the default? --SDM -#endif - // install the SIGFPE handler // In addition to handling SIGINT, also handle SIGFPE by ignoring it. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/480a38d4ad2f6fa2137e81e9f318dda445858e9c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/480a38d4ad2f6fa2137e81e9f318dda445858e9c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Dec 12 03:44:19 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 11 Dec 2020 22:44:19 -0500 Subject: [Git][ghc/ghc][master] Use static array in zeroCount Message-ID: <5fd43c93f165b_6b213272ce01235983@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 4af6126d by Sylvain Henry at 2020-12-11T22:44:11-05:00 Use static array in zeroCount - - - - - 1 changed file: - libraries/base/GHC/Float/ConversionUtils.hs Changes: ===================================== libraries/base/GHC/Float/ConversionUtils.hs ===================================== @@ -33,13 +33,10 @@ default () #define TO64 integerToInt64# -toByte64# :: Int64# -> Int# -toByte64# i = word2Int# (and# 255## (int2Word# (int64ToInt# i))) - -- Double mantissae have 53 bits, too much for Int# elim64# :: Int64# -> Int# -> (# Integer, Int# #) elim64# n e = - case zeroCount (toByte64# n) of + case zeroCount (int64ToInt# n) of t | isTrue# (e <=# t) -> (# integerFromInt64# (uncheckedIShiftRA64# n e), 0# #) | isTrue# (t <# 8#) -> (# integerFromInt64# (uncheckedIShiftRA64# n t), e -# t #) | otherwise -> elim64# (uncheckedIShiftRA64# n 8#) (e -# 8#) @@ -60,41 +57,13 @@ elimZerosInteger m e = elim64# (TO64 m) e elimZerosInt# :: Int# -> Int# -> (# Integer, Int# #) elimZerosInt# n e = - case zeroCount (toByte# n) of + case zeroCount n of t | isTrue# (e <=# t) -> (# IS (uncheckedIShiftRA# n e), 0# #) | isTrue# (t <# 8#) -> (# IS (uncheckedIShiftRA# n t), e -# t #) | otherwise -> elimZerosInt# (uncheckedIShiftRA# n 8#) (e -# 8#) -{-# INLINE zeroCount #-} +-- | Number of trailing zero bits in a byte zeroCount :: Int# -> Int# -zeroCount i = - case zeroCountArr of - BA ba -> indexInt8Array# ba i - -toByte# :: Int# -> Int# -toByte# i = word2Int# (and# 255## (int2Word# i)) - - -data BA = BA ByteArray# - --- Number of trailing zero bits in a byte -zeroCountArr :: BA -zeroCountArr = - let mkArr s = - case newByteArray# 256# s of - (# s1, mba #) -> - case writeInt8Array# mba 0# 8# s1 of - s2 -> - let fillA step val idx st - | isTrue# (idx <# 256#) = - case writeInt8Array# mba idx val st of - nx -> fillA step val (idx +# step) nx - | isTrue# (step <# 256#) = - fillA (2# *# step) (val +# 1#) step st - | otherwise = st - in case fillA 2# 0# 1# s2 of - s3 -> case unsafeFreezeByteArray# mba s3 of - (# _, ba #) -> ba - in case mkArr realWorld# of - b -> BA b - +zeroCount i = indexInt8OffAddr# arr (word2Int# (narrow8Word# (int2Word# i))) -- index must be in [0,255] + where + arr = "\8\0\1\0\2\0\1\0\3\0\1\0\2\0\1\0\4\0\1\0\2\0\1\0\3\0\1\0\2\0\1\0\5\0\1\0\2\0\1\0\3\0\1\0\2\0\1\0\4\0\1\0\2\0\1\0\3\0\1\0\2\0\1\0\6\0\1\0\2\0\1\0\3\0\1\0\2\0\1\0\4\0\1\0\2\0\1\0\3\0\1\0\2\0\1\0\5\0\1\0\2\0\1\0\3\0\1\0\2\0\1\0\4\0\1\0\2\0\1\0\3\0\1\0\2\0\1\0\7\0\1\0\2\0\1\0\3\0\1\0\2\0\1\0\4\0\1\0\2\0\1\0\3\0\1\0\2\0\1\0\5\0\1\0\2\0\1\0\3\0\1\0\2\0\1\0\4\0\1\0\2\0\1\0\3\0\1\0\2\0\1\0\6\0\1\0\2\0\1\0\3\0\1\0\2\0\1\0\4\0\1\0\2\0\1\0\3\0\1\0\2\0\1\0\5\0\1\0\2\0\1\0\3\0\1\0\2\0\1\0\4\0\1\0\2\0\1\0\3\0\1\0\2\0\1\0"# View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4af6126d1758d5e365cadf032e34c99489f13dee -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4af6126d1758d5e365cadf032e34c99489f13dee You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Dec 12 04:15:12 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 11 Dec 2020 23:15:12 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 13 commits: Delete outdated Note [Kind-checking tyvar binders for associated types] Message-ID: <5fd443d01ac82_6b211e6fbe41241956@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 5feb9b2d by Ryan Scott at 2020-12-11T22:39:29-05:00 Delete outdated Note [Kind-checking tyvar binders for associated types] This Note has severely bitrotted, as it has no references anywhere in the codebase, and none of the functions that it mentions exist anymore. Let's just delete this. While I was in town, I deleted some outdated comments from `checkFamPatBinders` of a similar caliber. Fixes #19008. [ci skip] - - - - - f9f9f030 by Sylvain Henry at 2020-12-11T22:40:08-05:00 Arrows: correctly query arrow methods (#17423) Consider the following code: proc (C x y) -> ... Before this patch, the evidence binding for the Arrow dictionary was attached to the C pattern: proc (C x y) { $dArrow = ... } -> ... But then when we desugar this, we use arrow operations ("arr", ">>>"...) specialised for this arrow: let arr_xy = arr $dArrow -- <-- Not in scope! ... in arr_xy (\(C x y) { $dArrow = ... } -> ...) This patch allows arrow operations to be type-checked before the proc itself, avoiding this issue. Fix #17423 - - - - - aaa8f00f by Sylvain Henry at 2020-12-11T22:40:48-05:00 Validate script: fix configure command when using stack - - - - - b4a929a1 by Sylvain Henry at 2020-12-11T22:41:30-05:00 Hadrian: fix libffi tarball parsing Fix parsing of "libffi-3.3.tar.gz". NB: switch to a newer libffi isn't done in this patch - - - - - 690c8946 by Sylvain Henry at 2020-12-11T22:42:09-05:00 Parser: move parser utils into their own module Move code unrelated to runtime evaluation out of GHC.Runtime.Eval - - - - - 76be0e32 by Sylvain Henry at 2020-12-11T22:42:48-05:00 Move SizedSeq into ghc-boot - - - - - 3a16d764 by Sylvain Henry at 2020-12-11T22:42:48-05:00 ghci: don't compile unneeded modules - - - - - 2895fa60 by Sylvain Henry at 2020-12-11T22:42:48-05:00 ghci: reuse Arch from ghc-boot - - - - - 480a38d4 by Sylvain Henry at 2020-12-11T22:43:30-05:00 rts: don't use siginterrupt (#19019) - - - - - 4af6126d by Sylvain Henry at 2020-12-11T22:44:11-05:00 Use static array in zeroCount - - - - - d80ca5ba by Sebastian Graf at 2020-12-11T23:15:01-05:00 DmdAnal: Annotate top-level function bindings with demands (#18894) It's useful to annotate a non-exported top-level function like `g` in ```hs module Lib (h) where g :: Int -> Int -> (Int,Int) g m 1 = (m, 0) g m n = (2 * m, 2 `div` n) {-# NOINLINE g #-} h :: Int -> Int h 1 = 0 h m | odd m = snd (g m 2) | otherwise = uncurry (+) (g 2 m) ``` with its demand `UCU(CS(P(1P(U),SP(U))`, which tells us that whenever `g` was called, the second component of the returned pair was evaluated strictly. Since #18903 we do so for local functions, where we can see all calls. For top-level functions, we can assume that all *exported* functions are demanded according to `topDmd` and thus get sound demands for non-exported top-level functions. The demand on `g` is crucial information for Nested CPR, which may the go on and unbox `g` for the second pair component. That is true even if that pair component may diverge, as is the case for the call site `g 13 0`, which throws a div-by-zero exception. In `T18894b`, you can even see the new demand annotation enabling us to eta-expand a function that we wouldn't be able to eta-expand without Call Arity. We only track bindings of function type in order not to risk huge compile-time regressions, see `isInterestingTopLevelFn`. There was a CoreLint check that rejected strict demand annotations on recursive or top-level bindings, which seems completely unjustified. All the cases I investigated were fine, so I removed it. Fixes #18894. - - - - - d99590cf by Sebastian Graf at 2020-12-11T23:15:01-05:00 Demand: Simplify `CU(U)` to `U` (#19005) Both sub-demands encode the same information. This is a trivial change and already affects a few regression tests (e.g. `T5075`), so no separate regression test is necessary. - - - - - 05d4b26b by Adam Sandberg Ericsson at 2020-12-11T23:15:03-05:00 hadrian: correctly copy the docs dir into the bindist #18669 - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Tidy.hs - + compiler/GHC/Parser/Utils.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/Tc/Gen/Arrow.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Demand.hs - compiler/GHC/Types/Id/Info.hs - compiler/ghc.cabal.in - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Libffi.hs - libraries/base/GHC/Float/ConversionUtils.hs - libraries/ghci/SizedSeq.hs → libraries/ghc-boot/GHC/Data/SizedSeq.hs - libraries/ghc-boot/GHC/Platform/ArchOS.hs - libraries/ghc-boot/ghc-boot.cabal.in - libraries/ghci/GHCi/CreateBCO.hs - libraries/ghci/GHCi/InfoTable.hsc - libraries/ghci/GHCi/ResolvedBCO.hs - libraries/ghci/ghci.cabal.in The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fde4be6db8c3dd1dd1b029e34b93d09e51ac2b23...05d4b26bcaaa34f5506440f00aee191292bc244a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fde4be6db8c3dd1dd1b029e34b93d09e51ac2b23...05d4b26bcaaa34f5506440f00aee191292bc244a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Dec 12 09:45:20 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sat, 12 Dec 2020 04:45:20 -0500 Subject: [Git][ghc/ghc][master] 2 commits: DmdAnal: Annotate top-level function bindings with demands (#18894) Message-ID: <5fd491301b0e9_6b214a47f7812471c8@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 5bd71bfd by Sebastian Graf at 2020-12-12T04:45:09-05:00 DmdAnal: Annotate top-level function bindings with demands (#18894) It's useful to annotate a non-exported top-level function like `g` in ```hs module Lib (h) where g :: Int -> Int -> (Int,Int) g m 1 = (m, 0) g m n = (2 * m, 2 `div` n) {-# NOINLINE g #-} h :: Int -> Int h 1 = 0 h m | odd m = snd (g m 2) | otherwise = uncurry (+) (g 2 m) ``` with its demand `UCU(CS(P(1P(U),SP(U))`, which tells us that whenever `g` was called, the second component of the returned pair was evaluated strictly. Since #18903 we do so for local functions, where we can see all calls. For top-level functions, we can assume that all *exported* functions are demanded according to `topDmd` and thus get sound demands for non-exported top-level functions. The demand on `g` is crucial information for Nested CPR, which may the go on and unbox `g` for the second pair component. That is true even if that pair component may diverge, as is the case for the call site `g 13 0`, which throws a div-by-zero exception. In `T18894b`, you can even see the new demand annotation enabling us to eta-expand a function that we wouldn't be able to eta-expand without Call Arity. We only track bindings of function type in order not to risk huge compile-time regressions, see `isInterestingTopLevelFn`. There was a CoreLint check that rejected strict demand annotations on recursive or top-level bindings, which seems completely unjustified. All the cases I investigated were fine, so I removed it. Fixes #18894. - - - - - 3aae036e by Sebastian Graf at 2020-12-12T04:45:09-05:00 Demand: Simplify `CU(U)` to `U` (#19005) Both sub-demands encode the same information. This is a trivial change and already affects a few regression tests (e.g. `T5075`), so no separate regression test is necessary. - - - - - 18 changed files: - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Types/Demand.hs - compiler/GHC/Types/Id/Info.hs - testsuite/tests/arityanal/should_compile/Arity11.stderr - testsuite/tests/arityanal/should_compile/Arity16.stderr - + testsuite/tests/stranal/should_compile/T18894.hs - + testsuite/tests/stranal/should_compile/T18894.stderr - + testsuite/tests/stranal/should_compile/T18894b.hs - + testsuite/tests/stranal/should_compile/T18894b.stderr - testsuite/tests/stranal/should_compile/all.T - testsuite/tests/stranal/sigs/T5075.stderr Changes: ===================================== compiler/GHC/Core/FVs.hs ===================================== @@ -525,12 +525,11 @@ ruleLhsFVIds (Rule { ru_bndrs = bndrs, ru_args = args }) = filterFV isLocalId $ addBndrs bndrs (exprs_fvs args) ruleRhsFreeIds :: CoreRule -> VarSet --- ^ This finds all locally-defined free Ids on the left hand side of a rule +-- ^ This finds all locally-defined free Ids on the right hand side of a rule -- and returns them as a non-deterministic set ruleRhsFreeIds (BuiltinRule {}) = emptyVarSet -ruleRhsFreeIds (Rule { ru_bndrs = bndrs, ru_args = args }) - = fvVarSet $ filterFV isLocalId $ - addBndrs bndrs $ exprs_fvs args +ruleRhsFreeIds (Rule { ru_bndrs = bndrs, ru_rhs = rhs }) + = fvVarSet $ filterFV isLocalId $ addBndrs bndrs $ expr_fvs rhs {- Note [Rule free var hack] (Not a hack any more) ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -624,14 +624,6 @@ lintLetBind top_lvl rec_flag binder rhs rhs_ty || exprIsTickedString rhs) (badBndrTyMsg binder (text "unlifted")) - -- Check that if the binder is top-level or recursive, it's not - -- demanded. Primitive string literals are exempt as there is no - -- computation to perform, see Note [Core top-level string literals]. - ; checkL (not (isStrictId binder) - || (isNonRec rec_flag && not (isTopLevel top_lvl)) - || exprIsTickedString rhs) - (mkStrictMsg binder) - -- Check that if the binder is at the top level and has type Addr#, -- that it is a string literal, see -- Note [Core top-level string literals]. @@ -3120,13 +3112,6 @@ badBndrTyMsg binder what = vcat [ text "The type of this binder is" <+> what <> colon <+> ppr binder , text "Binder's type:" <+> ppr (idType binder) ] -mkStrictMsg :: Id -> MsgDoc -mkStrictMsg binder - = vcat [hsep [text "Recursive or top-level binder has strict demand info:", - ppr binder], - hsep [text "Binder's demand info:", ppr (idDemandInfo binder)] - ] - mkNonTopExportedMsg :: Id -> MsgDoc mkNonTopExportedMsg binder = hsep [text "Non-top-level binder is marked as exported:", ppr binder] ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -37,6 +37,7 @@ import GHC.Core.Type import GHC.Core.FVs ( exprFreeIds, ruleRhsFreeIds ) import GHC.Core.Coercion ( Coercion, coVarsOfCo ) import GHC.Core.FamInstEnv +import GHC.Core.Opt.Arity ( typeArity ) import GHC.Utils.Misc import GHC.Utils.Panic import GHC.Data.Maybe ( isJust ) @@ -64,28 +65,55 @@ data DmdAnalOpts = DmdAnalOpts -- -- Note: use `seqBinds` on the result to avoid leaks due to lazyness (cf Note -- [Stamp out space leaks in demand analysis]) -dmdAnalProgram :: DmdAnalOpts -> FamInstEnvs -> CoreProgram -> CoreProgram -dmdAnalProgram opts fam_envs binds = binds_plus_dmds - where - env = emptyAnalEnv opts fam_envs - binds_plus_dmds = snd $ mapAccumL dmdAnalTopBind env binds - --- Analyse a (group of) top-level binding(s) -dmdAnalTopBind :: AnalEnv - -> CoreBind - -> (AnalEnv, CoreBind) -dmdAnalTopBind env (NonRec id rhs) - = ( extendAnalEnv TopLevel env id sig - , NonRec (setIdStrictness id sig) rhs') +dmdAnalProgram :: DmdAnalOpts -> FamInstEnvs -> [CoreRule] -> CoreProgram -> CoreProgram +dmdAnalProgram opts fam_envs rules binds + = snd $ go (emptyAnalEnv opts fam_envs) binds where - ( _, sig, rhs') = dmdAnalRhsLetDown Nothing env topSubDmd id rhs + -- See Note [Analysing top-level bindings] + -- and Note [Why care for top-level demand annotations?] + go _ [] = (nopDmdType, []) + go env (b:bs) = cons_up $ dmdAnalBind TopLevel env topSubDmd b anal_body + where + anal_body env' + | (body_ty, bs') <- go env' bs + = (add_exported_uses env' body_ty (bindersOf b), bs') + + cons_up :: (a, b, [b]) -> (a, [b]) + cons_up (dmd_ty, b', bs') = (dmd_ty, b':bs') + + add_exported_uses :: AnalEnv -> DmdType -> [Id] -> DmdType + add_exported_uses env = foldl' (add_exported_use env) + + -- | If @e@ is denoted by @dmd_ty@, then @add_exported_use _ dmd_ty id@ + -- corresponds to the demand type of @(id, e)@, but is a lot more direct. + -- See Note [Analysing top-level bindings]. + add_exported_use :: AnalEnv -> DmdType -> Id -> DmdType + add_exported_use env dmd_ty id + | isExportedId id || elemVarSet id rule_fvs + -- See Note [Absence analysis for stable unfoldings and RULES] + = dmd_ty `plusDmdType` fst (dmdAnalStar env topDmd (Var id)) + | otherwise + = dmd_ty -dmdAnalTopBind env (Rec pairs) - = (env', Rec pairs') - where - (env', _, pairs') = dmdFix TopLevel env topSubDmd pairs - -- We get two iterations automatically - -- c.f. the NonRec case above + rule_fvs :: IdSet + rule_fvs = foldr (unionVarSet . ruleRhsFreeIds) emptyVarSet rules + +-- | We attach useful (e.g. not 'topDmd') 'idDemandInfo' to top-level bindings +-- that satisfy this function. +-- +-- Basically, we want to know how top-level *functions* are *used* +-- (e.g. called). The information will always be lazy. +-- Any other top-level bindings are boring. +-- +-- See also Note [Why care for top-level demand annotations?]. +isInterestingTopLevelFn :: Id -> Bool +-- SG tried to set this to True and got a +2% ghc/alloc regression in T5642 +-- (which is dominated by the Simplifier) at no gain in analysis precision. +-- If there was a gain, that regression might be acceptable. +-- Plus, we could use LetUp for thunks and share some code with local let +-- bindings. +isInterestingTopLevelFn id = + typeArity (idType id) `lengthExceeds` 0 {- Note [Stamp out space leaks in demand analysis] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -105,8 +133,80 @@ generation would hold on to an extra copy of the Core program, via unforced thunks in demand or strictness information; and it is the most memory-intensive part of the compilation process, so this added seqBinds makes a big difference in peak memory usage. --} +Note [Analysing top-level bindings] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider a CoreProgram like + e1 = ... + n1 = ... + e2 = \a b -> ... fst (n1 a b) ... + n2 = \c d -> ... snd (e2 c d) ... + ... +where e* are exported, but n* are not. +Intuitively, we can see that @n1@ is only ever called with two arguments +and in every call site, the first component of the result of the call +is evaluated. Thus, we'd like it to have idDemandInfo @UCU(C1(P(SU,A))@. +NB: We may *not* give e2 a similar annotation, because it is exported and +external callers might use it in arbitrary ways, expressed by 'topDmd'. +This can then be exploited by Nested CPR and eta-expansion, +see Note [Why care for top-level demand annotations?]. + +How do we get this result? Answer: By analysing the program as if it was a let +expression of this form: + let e1 = ... in + let n1 = ... in + let e2 = ... in + let n2 = ... in + (e1,e2, ...) +E.g. putting all bindings in nested lets and returning all exported binders in a tuple. +Of course, we will not actually build that CoreExpr! Instead we faithfully +simulate analysis of said expression by adding the free variable 'DmdEnv' +of @e*@'s strictness signatures to the 'DmdType' we get from analysing the +nested bindings. + +And even then the above form blows up analysis performance in T10370: +If @e1@ uses many free variables, we'll unnecessarily carry their demands around +with us from the moment we analyse the pair to the moment we bubble back up to +the binding for @e1 at . So instead we analyse as if we had + let e1 = ... in + (e1, let n1 = ... in + ( let e2 = ... in + (e2, let n2 = ... in + ( ...)))) +That is, a series of right-nested pairs, where the @fst@ are the exported +binders of the last enclosing let binding and @snd@ continues the nested +lets. + +Variables occuring free in RULE RHSs are to be handled the same as exported Ids. +See also Note [Absence analysis for stable unfoldings and RULES]. + +Note [Why care for top-level demand annotations?] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Reading Note [Analysing top-level bindings], you might think that we go through +quite some trouble to get useful demands for top-level bindings. They can never +be strict, for example, so why bother? + +First, we get to eta-expand top-level bindings that we weren't able to +eta-expand before without Call Arity. From T18894b: + module T18894b (f) where + eta :: Int -> Int -> Int + eta x = if fst (expensive x) == 13 then \y -> ... else \y -> ... + f m = ... eta m 2 ... eta 2 m ... +Since only @f@ is exported, we see all call sites of @eta@ and can eta-expand to +arity 2. + +The call demands we get for some top-level bindings will also allow Nested CPR +to unbox deeper. From T18894: + module T18894 (h) where + g m n = (2 * m, 2 `div` n) + {-# NOINLINE g #-} + h :: Int -> Int + h m = ... snd (g m 2) ... uncurry (+) (g 2 m) ... +Only @h@ is exported, hence we see that @g@ is always called in contexts were we +also force the division in the second component of the pair returned by @g at . +This allows Nested CPR to evalute the division eagerly and return an I# in its +position. +-} {- ************************************************************************ @@ -114,7 +214,103 @@ seqBinds makes a big difference in peak memory usage. \subsection{The analyser itself} * * ************************************************************************ +-} + +-- | Analyse a binding group and its \"body\", e.g. where it is in scope. +-- +-- It calls a function that knows how to analyse this \"body\" given +-- an 'AnalEnv' with updated demand signatures for the binding group +-- (reflecting their 'idStrictnessInfo') and expects to receive a +-- 'DmdType' in return, which it uses to annotate the binding group with their +-- 'idDemandInfo'. +dmdAnalBind + :: TopLevelFlag + -> AnalEnv + -> SubDemand -- ^ Demand put on the "body" + -- (important for join points) + -> CoreBind + -> (AnalEnv -> (DmdType, a)) -- ^ How to analyse the "body", e.g. + -- where the binding is in scope + -> (DmdType, CoreBind, a) +dmdAnalBind top_lvl env dmd bind anal_body = case bind of + NonRec id rhs + | useLetUp top_lvl id + -> dmdAnalBindLetUp top_lvl env id rhs anal_body + _ -> dmdAnalBindLetDown top_lvl env dmd bind anal_body + +-- | Annotates uninteresting top level functions ('isInterestingTopLevelFn') +-- with 'topDmd', the rest with the given demand. +setBindIdDemandInfo :: TopLevelFlag -> Id -> Demand -> Id +setBindIdDemandInfo top_lvl id dmd = setIdDemandInfo id $ case top_lvl of + TopLevel | not (isInterestingTopLevelFn id) -> topDmd + _ -> dmd + +-- | Let bindings can be processed in two ways: +-- Down (RHS before body) or Up (body before RHS). +-- This function handles the up variant. +-- +-- It is very simple. For let x = rhs in body +-- * Demand-analyse 'body' in the current environment +-- * Find the demand, 'rhs_dmd' placed on 'x' by 'body' +-- * Demand-analyse 'rhs' in 'rhs_dmd' +-- +-- This is used for a non-recursive local let without manifest lambdas (see +-- 'useLetUp'). +-- +-- This is the LetUp rule in the paper “Higher-Order Cardinality Analysis”. +dmdAnalBindLetUp :: TopLevelFlag -> AnalEnv -> Id -> CoreExpr -> (AnalEnv -> (DmdType, a)) -> (DmdType, CoreBind, a) +dmdAnalBindLetUp top_lvl env id rhs anal_body = (final_ty, NonRec id' rhs', body') + where + (body_ty, body') = anal_body env + (body_ty', id_dmd) = findBndrDmd env notArgOfDfun body_ty id + id' = setBindIdDemandInfo top_lvl id id_dmd + (rhs_ty, rhs') = dmdAnalStar env (dmdTransformThunkDmd rhs id_dmd) rhs + final_ty = body_ty' `plusDmdType` rhs_ty + +-- | Let bindings can be processed in two ways: +-- Down (RHS before body) or Up (body before RHS). +-- This function handles the down variant. +-- +-- It computes a demand signature (by means of 'dmdAnalRhsSig') and uses +-- that at call sites in the body. +-- +-- It is used for toplevel definitions, recursive definitions and local +-- non-recursive definitions that have manifest lambdas (cf. 'useLetUp'). +-- Local non-recursive definitions without a lambda are handled with LetUp. +-- +-- This is the LetDown rule in the paper “Higher-Order Cardinality Analysis”. +dmdAnalBindLetDown :: TopLevelFlag -> AnalEnv -> SubDemand -> CoreBind -> (AnalEnv -> (DmdType, a)) -> (DmdType, CoreBind, a) +dmdAnalBindLetDown top_lvl env dmd bind anal_body = case bind of + NonRec id rhs + | (env', lazy_fv, id1, rhs1) <- + dmdAnalRhsSig top_lvl NonRecursive env dmd id rhs + -> do_rest env' lazy_fv [(id1, rhs1)] (uncurry NonRec . only) + Rec pairs + | (env', lazy_fv, pairs') <- dmdFix top_lvl env dmd pairs + -> do_rest env' lazy_fv pairs' Rec + where + do_rest env' lazy_fv pairs1 build_bind = (final_ty, build_bind pairs2, body') + where + (body_ty, body') = anal_body env' + -- see Note [Lazy and unleashable free variables] + dmd_ty = addLazyFVs body_ty lazy_fv + (!final_ty, id_dmds) = findBndrsDmds env' dmd_ty (map fst pairs1) + pairs2 = zipWith do_one pairs1 id_dmds + do_one (id', rhs') dmd = (setBindIdDemandInfo top_lvl id' dmd, rhs') + -- If the actual demand is better than the vanilla call + -- demand, you might think that we might do better to re-analyse + -- the RHS with the stronger demand. + -- But (a) That seldom happens, because it means that *every* path in + -- the body of the let has to use that stronger demand + -- (b) It often happens temporarily in when fixpointing, because + -- the recursive function at first seems to place a massive demand. + -- But we don't want to go to extra work when the function will + -- probably iterate to something less demanding. + -- In practice, all the times the actual demand on id2 is more than + -- the vanilla call demand seem to be due to (b). So we don't + -- bother to re-analyse the RHS. +{- Note [Ensure demand is strict] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ It's important not to analyse e with a lazy demand because @@ -194,7 +390,7 @@ dmdAnal' env dmd (App fun arg) -- Crucially, coercions /are/ handled here, because they are -- value arguments (#10288) let - call_dmd = mkCallDmd dmd + call_dmd = mkCalledOnceDmd dmd (fun_ty, fun') = dmdAnal env call_dmd fun (arg_dmd, res_ty) = splitDmdTy fun_ty (arg_ty, arg') = dmdAnalStar env (dmdTransformThunkDmd arg arg_dmd) arg @@ -295,60 +491,11 @@ dmdAnal' env dmd (Case scrut case_bndr ty alts) -- , text "res_ty" <+> ppr res_ty ]) $ (res_ty, Case scrut' case_bndr' ty alts') --- Let bindings can be processed in two ways: --- Down (RHS before body) or Up (body before RHS). --- The following case handle the up variant. --- --- It is very simple. For let x = rhs in body --- * Demand-analyse 'body' in the current environment --- * Find the demand, 'rhs_dmd' placed on 'x' by 'body' --- * Demand-analyse 'rhs' in 'rhs_dmd' --- --- This is used for a non-recursive local let without manifest lambdas. --- This is the LetUp rule in the paper “Higher-Order Cardinality Analysis”. -dmdAnal' env dmd (Let (NonRec id rhs) body) - | useLetUp id - = (final_ty, Let (NonRec id' rhs') body') - where - (body_ty, body') = dmdAnal env dmd body - (body_ty', id_dmd) = findBndrDmd env notArgOfDfun body_ty id - id' = setIdDemandInfo id id_dmd - - (rhs_ty, rhs') = dmdAnalStar env (dmdTransformThunkDmd rhs id_dmd) rhs - final_ty = body_ty' `plusDmdType` rhs_ty - -dmdAnal' env dmd (Let (NonRec id rhs) body) - = (body_ty2, Let (NonRec id2 rhs') body') +dmdAnal' env dmd (Let bind body) + = (final_ty, Let bind' body') where - (lazy_fv, sig, rhs') = dmdAnalRhsLetDown Nothing env dmd id rhs - id1 = setIdStrictness id sig - env1 = extendAnalEnv NotTopLevel env id sig - (body_ty, body') = dmdAnal env1 dmd body - (body_ty1, id2) = annotateBndr env body_ty id1 - body_ty2 = addLazyFVs body_ty1 lazy_fv -- see Note [Lazy and unleashable free variables] - - -- If the actual demand is better than the vanilla call - -- demand, you might think that we might do better to re-analyse - -- the RHS with the stronger demand. - -- But (a) That seldom happens, because it means that *every* path in - -- the body of the let has to use that stronger demand - -- (b) It often happens temporarily in when fixpointing, because - -- the recursive function at first seems to place a massive demand. - -- But we don't want to go to extra work when the function will - -- probably iterate to something less demanding. - -- In practice, all the times the actual demand on id2 is more than - -- the vanilla call demand seem to be due to (b). So we don't - -- bother to re-analyse the RHS. - -dmdAnal' env dmd (Let (Rec pairs) body) - = let - (env', lazy_fv, pairs') = dmdFix NotTopLevel env dmd pairs - (body_ty, body') = dmdAnal env' dmd body - body_ty1 = deleteFVs body_ty (map fst pairs) - body_ty2 = addLazyFVs body_ty1 lazy_fv -- see Note [Lazy and unleashable free variables] - in - body_ty2 `seq` - (body_ty2, Let (Rec pairs') body') + (final_ty, bind', body') = dmdAnalBind NotTopLevel env dmd bind go' + go' env' = dmdAnal env' dmd body -- | A simple, syntactic analysis of whether an expression MAY throw a precise -- exception when evaluated. It's always sound to return 'True'. @@ -582,9 +729,17 @@ dmdTransform env var dmd | Just (sig, top_lvl) <- lookupSigEnv env var , let fn_ty = dmdTransformSig sig dmd = -- pprTrace "dmdTransform:LetDown" (vcat [ppr var, ppr sig, ppr dmd, ppr fn_ty]) $ - if isTopLevel top_lvl - then fn_ty -- Don't record demand on top-level things - else addVarDmd fn_ty var (C_11 :* dmd) + case top_lvl of + NotTopLevel -> addVarDmd fn_ty var (C_11 :* dmd) + TopLevel + | isInterestingTopLevelFn var + -- Top-level things will be used multiple times or not at + -- all anyway, hence the multDmd below: It means we don't + -- have to track whether @var@ is used strictly or at most + -- once, because ultimately it never will. + -> addVarDmd fn_ty var (C_0N `multDmd` (C_11 :* dmd)) -- discard strictness + | otherwise + -> fn_ty -- don't bother tracking; just annotate with 'topDmd' later -- Everything else: -- * Local let binders for which we use LetUp (cf. 'useLetUp') -- * Lambda binders @@ -599,46 +754,46 @@ dmdTransform env var dmd * * ********************************************************************* -} --- Let bindings can be processed in two ways: --- Down (RHS before body) or Up (body before RHS). --- dmdAnalRhsLetDown implements the Down variant: --- * assuming a demand of +-- | @dmdAnalRhsSig@ analyses the given RHS to compute a demand signature +-- for the LetDown rule. It works as follows: +-- +-- * assuming a demand of -- * looking at the definition -- * determining a strictness signature -- --- It is used for toplevel definition, recursive definitions and local --- non-recursive definitions that have manifest lambdas. --- Local non-recursive definitions without a lambda are handled with LetUp. --- --- This is the LetDown rule in the paper “Higher-Order Cardinality Analysis”. -dmdAnalRhsLetDown - :: Maybe [Id] -- Just bs <=> recursive, Nothing <=> non-recursive +-- Since it assumed a demand of , the resulting signature is applicable at +-- any call site. +dmdAnalRhsSig + :: TopLevelFlag + -> RecFlag -> AnalEnv -> SubDemand -> Id -> CoreExpr - -> (DmdEnv, StrictSig, CoreExpr) + -> (AnalEnv, DmdEnv, Id, CoreExpr) -- Process the RHS of the binding, add the strictness signature -- to the Id, and augment the environment with the signature as well. -- See Note [NOINLINE and strictness] -dmdAnalRhsLetDown rec_flag env let_dmd id rhs - = -- pprTrace "dmdAnalRhsLetDown" (ppr id $$ ppr let_dmd $$ ppr sig $$ ppr lazy_fv) $ - (lazy_fv, sig, rhs') +dmdAnalRhsSig top_lvl rec_flag env let_dmd id rhs + = -- pprTrace "dmdAnalRhsSig" (ppr id $$ ppr let_dmd $$ ppr sig $$ ppr lazy_fv) $ + (env', lazy_fv, id', rhs') where rhs_arity = idArity id + -- See Note [Demand signatures are computed for a threshold demand based on idArity] rhs_dmd -- See Note [Demand analysis for join points] -- See Note [Invariants on join points] invariant 2b, in GHC.Core -- rhs_arity matches the join arity of the join point | isJoinId id - = mkCallDmds rhs_arity let_dmd + = mkCalledOnceDmds rhs_arity let_dmd | otherwise - -- NB: rhs_arity - -- See Note [Demand signatures are computed for a threshold demand based on idArity] - = mkRhsDmd env rhs_arity rhs + = mkCalledOnceDmds rhs_arity topSubDmd (rhs_dmd_ty, rhs') = dmdAnal env rhs_dmd rhs DmdType rhs_fv rhs_dmds rhs_div = rhs_dmd_ty sig = mkStrictSigForArity rhs_arity (DmdType sig_fv rhs_dmds rhs_div) + id' = id `setIdStrictness` sig + env' = extendAnalEnv top_lvl env id' sig + -- See Note [Aggregated demand for cardinality] -- FIXME: That Note doesn't explain the following lines at all. The reason -- is really much different: When we have a recursive function, we'd @@ -651,8 +806,8 @@ dmdAnalRhsLetDown rec_flag env let_dmd id rhs -- we'd have to do an additional iteration. reuseEnv makes sure that -- we never get used-once info for FVs of recursive functions. rhs_fv1 = case rec_flag of - Just bs -> reuseEnv (delVarEnvList rhs_fv bs) - Nothing -> rhs_fv + Recursive -> reuseEnv rhs_fv + NonRecursive -> rhs_fv rhs_fv2 = rhs_fv1 `keepAliveDmdEnv` extra_fvs -- Find the RHS free vars of the unfoldings and RULES @@ -669,13 +824,6 @@ dmdAnalRhsLetDown rec_flag env let_dmd id rhs = exprFreeIds unf_body | otherwise = emptyVarSet --- | @mkRhsDmd env rhs_arity rhs@ creates a 'SubDemand' for --- unleashing on the given function's @rhs@, by creating --- a call demand of @rhs_arity@ --- See Historical Note [Product demands for function body] -mkRhsDmd :: AnalEnv -> Arity -> CoreExpr -> SubDemand -mkRhsDmd _env rhs_arity _rhs = mkCallDmds rhs_arity topSubDmd - -- | If given the (local, non-recursive) let-bound 'Id', 'useLetUp' determines -- whether we should process the binding up (body before rhs) or down (rhs -- before body). @@ -720,8 +868,8 @@ mkRhsDmd _env rhs_arity _rhs = mkCallDmds rhs_arity topSubDmd -- * For a more convincing example with join points, see Note [Demand analysis -- for join points]. -- -useLetUp :: Var -> Bool -useLetUp f = idArity f == 0 && not (isJoinId f) +useLetUp :: TopLevelFlag -> Var -> Bool +useLetUp top_lvl f = isNotTopLevel top_lvl && idArity f == 0 && not (isJoinId f) {- Note [Demand analysis for join points] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -939,8 +1087,6 @@ dmdFix :: TopLevelFlag dmdFix top_lvl env let_dmd orig_pairs = loop 1 initial_pairs where - bndrs = map fst orig_pairs - -- See Note [Initialising strictness] initial_pairs | ae_virgin env = [(setIdStrictness id botSig, rhs) | (id, rhs) <- orig_pairs ] | otherwise = orig_pairs @@ -990,10 +1136,8 @@ dmdFix top_lvl env let_dmd orig_pairs = -- pprTrace "my_downRhs" (ppr id $$ ppr (idStrictness id) $$ ppr sig) $ ((env', lazy_fv'), (id', rhs')) where - (lazy_fv1, sig, rhs') = dmdAnalRhsLetDown (Just bndrs) env let_dmd id rhs - lazy_fv' = plusVarEnv_C plusDmd lazy_fv lazy_fv1 - env' = extendAnalEnv top_lvl env id sig - id' = setIdStrictness id sig + (env', lazy_fv1, id', rhs') = dmdAnalRhsSig top_lvl Recursive env let_dmd id rhs + lazy_fv' = plusVarEnv_C plusDmd lazy_fv lazy_fv1 zapIdStrictness :: [(Id, CoreExpr)] -> [(Id, CoreExpr)] zapIdStrictness pairs = [(setIdStrictness id nopSig, rhs) | (id, rhs) <- pairs ] @@ -1090,7 +1234,7 @@ addLazyFVs dmd_ty lazy_fvs -- demand with the bottom coming up from 'error' -- -- I got a loop in the fixpointer without this, due to an interaction - -- with the lazy_fv filtering in dmdAnalRhsLetDown. Roughly, it was + -- with the lazy_fv filtering in dmdAnalRhsSig. Roughly, it was -- letrec f n x -- = letrec g y = x `fatbar` -- letrec h z = z + ...g... @@ -1156,10 +1300,6 @@ annotateLamIdBndr env arg_of_dfun dmd_ty id main_ty = addDemand dmd dmd_ty' (dmd_ty', dmd) = findBndrDmd env arg_of_dfun dmd_ty id -deleteFVs :: DmdType -> [Var] -> DmdType -deleteFVs (DmdType fvs dmds res) bndrs - = DmdType (delVarEnvList fvs bndrs) dmds res - {- Note [NOINLINE and strictness] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Core/Opt/Pipeline.hs ===================================== @@ -66,6 +66,7 @@ import GHC.Types.SrcLoc import GHC.Types.Id import GHC.Types.Id.Info import GHC.Types.Basic +import GHC.Types.Demand ( zapDmdEnvSig ) import GHC.Types.Var.Set import GHC.Types.Var.Env import GHC.Types.Unique.Supply ( UniqSupply, mkSplitUniqSupply, splitUniqSupply ) @@ -499,7 +500,7 @@ doCorePass CoreDoExitify = {-# SCC "Exitify" #-} doPass exitifyProgram doCorePass CoreDoDemand = {-# SCC "DmdAnal" #-} - doPassDFM dmdAnal + doPassDFRM dmdAnal doCorePass CoreDoCpr = {-# SCC "CprAnal" #-} doPassDFM cprAnalProgram @@ -582,6 +583,13 @@ doPassDFM do_pass guts = do let fam_envs = (p_fam_env, mg_fam_inst_env guts) doPassM (liftIO . do_pass dflags fam_envs) guts +doPassDFRM :: (DynFlags -> FamInstEnvs -> [CoreRule] -> CoreProgram -> IO CoreProgram) -> ModGuts -> CoreM ModGuts +doPassDFRM do_pass guts = do + dflags <- getDynFlags + p_fam_env <- getPackageFamInstEnv + let fam_envs = (p_fam_env, mg_fam_inst_env guts) + doPassM (liftIO . do_pass dflags fam_envs (mg_rules guts)) guts + doPassDFU :: (DynFlags -> FamInstEnvs -> UniqSupply -> CoreProgram -> CoreProgram) -> ModGuts -> CoreM ModGuts doPassDFU do_pass guts = do dflags <- getDynFlags @@ -1095,13 +1103,13 @@ transferIdInfo exported_id local_id -dmdAnal :: DynFlags -> FamInstEnvs -> CoreProgram -> IO CoreProgram -dmdAnal dflags fam_envs binds = do +dmdAnal :: DynFlags -> FamInstEnvs -> [CoreRule] -> CoreProgram -> IO CoreProgram +dmdAnal dflags fam_envs rules binds = do let opts = DmdAnalOpts { dmd_strict_dicts = gopt Opt_DictsStrict dflags } - binds_plus_dmds = dmdAnalProgram opts fam_envs binds + binds_plus_dmds = dmdAnalProgram opts fam_envs rules binds Err.dumpIfSet_dyn dflags Opt_D_dump_str_signatures "Strictness signatures" FormatText $ - dumpIdInfoOfProgram (ppr . strictnessInfo) binds_plus_dmds + dumpIdInfoOfProgram (ppr . zapDmdEnvSig . strictnessInfo) binds_plus_dmds -- See Note [Stamp out space leaks in demand analysis] in GHC.Core.Opt.DmdAnal seqBinds binds_plus_dmds `seq` return binds_plus_dmds ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -598,11 +598,10 @@ addJoinFlts = appOL mkRecFloats :: SimplFloats -> SimplFloats -- Flattens the floats into a single Rec group, -- They must either all be lifted LetFloats or all JoinFloats -mkRecFloats floats@(SimplFloats { sfLetFloats = LetFloats bs ff +mkRecFloats floats@(SimplFloats { sfLetFloats = LetFloats bs _ff , sfJoinFloats = jbs , sfInScope = in_scope }) - = ASSERT2( case ff of { FltLifted -> True; _ -> False }, ppr (fromOL bs) ) - ASSERT2( isNilOL bs || isNilOL jbs, ppr floats ) + = ASSERT2( isNilOL bs || isNilOL jbs, ppr floats ) SimplFloats { sfLetFloats = floats' , sfJoinFloats = jfloats' , sfInScope = in_scope } ===================================== compiler/GHC/Core/Opt/WorkWrap.hs ===================================== @@ -484,7 +484,7 @@ tryWW dflags fam_envs is_rec fn_id rhs | is_fun && is_eta_exp = splitFun dflags fam_envs new_fn_id fn_info wrap_dmds div cpr rhs - | is_thunk -- See Note [Thunk splitting] + | isNonRec is_rec, is_thunk -- See Note [Thunk splitting] = splitThunk dflags fam_envs is_rec new_fn_id rhs | otherwise @@ -777,6 +777,10 @@ Notice that x certainly has the CPR property now! In fact, splitThunk uses the function argument w/w splitting function, so that if x's demand is deeper (say U(U(L,L),L)) then the splitting will go deeper too. + +NB: For recursive thunks, the Simplifier is unable to float `x-rhs` out of +`x*`'s RHS, because `x*` occurs freely in `x-rhs`, and will just change it +back to the original definition, so we just split non-recursive thunks. -} -- See Note [Thunk splitting] ===================================== compiler/GHC/Core/Opt/WorkWrap/Utils.hs ===================================== @@ -1275,10 +1275,14 @@ mk_absent_let dflags fam_envs arg abs_rhs = mkAbsentErrorApp arg_ty msg msg = showSDoc (gopt_set dflags Opt_SuppressUniques) - (ppr arg <+> ppr (idType arg) <+> file_msg) + (vcat + [ text "Arg:" <+> ppr arg + , text "Type:" <+> ppr arg_ty + , file_msg + ]) file_msg = case outputFile dflags of Nothing -> empty - Just f -> text "in output file " <+> quotes (text f) + Just f -> text "In output file " <+> quotes (text f) -- We need to suppress uniques here because otherwise they'd -- end up in the generated code as strings. This is bad for -- determinism, because with different uniques the strings ===================================== compiler/GHC/Core/Tidy.hs ===================================== @@ -21,7 +21,7 @@ import GHC.Core import GHC.Core.Seq ( seqUnfolding ) import GHC.Types.Id import GHC.Types.Id.Info -import GHC.Types.Demand ( zapUsageEnvSig ) +import GHC.Types.Demand ( zapDmdEnvSig ) import GHC.Core.Type ( tidyType, tidyVarBndr ) import GHC.Core.Coercion ( tidyCo ) import GHC.Types.Var @@ -206,7 +206,7 @@ tidyLetBndr rec_tidy_env env@(tidy_env, var_env) id new_info = vanillaIdInfo `setOccInfo` occInfo old_info `setArityInfo` arityInfo old_info - `setStrictnessInfo` zapUsageEnvSig (strictnessInfo old_info) + `setStrictnessInfo` zapDmdEnvSig (strictnessInfo old_info) `setDemandInfo` demandInfo old_info `setInlinePragInfo` inlinePragInfo old_info `setUnfoldingInfo` new_unf ===================================== compiler/GHC/Types/Demand.hs ===================================== @@ -34,7 +34,7 @@ module GHC.Types.Demand ( lazyApply1Dmd, lazyApply2Dmd, strictOnceApply1Dmd, strictManyApply1Dmd, -- ** Other @Demand@ operations oneifyCard, oneifyDmd, strictifyDmd, strictifyDictDmd, mkWorkerDemand, - peelCallDmd, peelManyCalls, mkCallDmd, mkCallDmds, + peelCallDmd, peelManyCalls, mkCalledOnceDmd, mkCalledOnceDmds, addCaseBndrDmd, -- ** Extracting one-shot information argOneShots, argsOneShots, saturatedByOneShots, @@ -73,7 +73,7 @@ module GHC.Types.Demand ( seqDemand, seqDemandList, seqDmdType, seqStrictSig, -- * Zapping usage information - zapUsageDemand, zapUsageEnvSig, zapUsedOnceDemand, zapUsedOnceSig + zapUsageDemand, zapDmdEnvSig, zapUsedOnceDemand, zapUsedOnceSig ) where #include "HsVersions.h" @@ -267,9 +267,11 @@ data SubDemand -- with the specified cardinality at every level. -- Expands to 'Call' via 'viewCall' and to 'Prod' via 'viewProd'. -- - -- @Poly n@ is semantically equivalent to @nP(n,n,...)@ or @Cn(Cn(..Cn(n)))@. - -- So @U === UP(U,U,...)@ and @U === CU(CU(..CU(U)))@, - -- @S === SP(S,S,...)@ and @S === CS(CS(..CS(S)))@, and so on. + -- @Poly n@ is semantically equivalent to @Prod [n :* Poly n, ...]@ or + -- @Call n (Poly n)@. 'mkCall' and 'mkProd' do these rewrites. + -- + -- In Note [Demand notation]: @U === P(U,U,...)@ and @U === CU(U)@, + -- @S === P(S,S,...)@ and @S === CS(S)@, and so on. -- -- We only really use 'Poly' with 'C_10' (bottom), 'C_00' (absent), -- 'C_0N' (top) and sometimes 'C_1N', but it's simpler to treat it uniformly @@ -278,7 +280,8 @@ data SubDemand -- ^ @Call n sd@ describes the evaluation context of @n@ function -- applications, where every individual result is evaluated according to @sd at . -- @sd@ is /relative/ to a single call, cf. Note [Call demands are relative]. - -- Used only for values of function type. + -- Used only for values of function type. Use the smart constructor 'mkCall' + -- whenever possible! | Prod ![Demand] -- ^ @Prod ds@ describes the evaluation context of a case scrutinisation -- on an expression of product type, where the product components are @@ -306,7 +309,7 @@ polyDmd C_1N = C_1N :* poly1N polyDmd C_10 = C_10 :* poly10 -- | A smart constructor for 'Prod', applying rewrite rules along the semantic --- equalities @Prod [polyDmd n, ...] === polyDmd n@, simplifying to 'Poly' +-- equality @Prod [polyDmd n, ...] === polyDmd n@, simplifying to 'Poly' -- 'SubDemand's when possible. Note that this degrades boxity information! E.g. a -- polymorphic demand will never unbox. mkProd :: [Demand] -> SubDemand @@ -335,6 +338,13 @@ viewProd _ _ = Nothing {-# INLINE viewProd #-} -- we want to fuse away the replicate and the allocation -- for Arity. Otherwise, #18304 bites us. +-- | A smart constructor for 'Call', applying rewrite rules along the semantic +-- equality @Call n (Poly n) === Poly n@, simplifying to 'Poly' 'SubDemand's +-- when possible. +mkCall :: Card -> SubDemand -> SubDemand +mkCall n cd@(Poly m) | n == m = cd +mkCall n cd = Call n cd + -- | @viewCall sd@ interprets @sd@ as a 'Call', expanding 'Poly' demands as -- necessary. viewCall :: SubDemand -> Maybe (Card, SubDemand) @@ -356,8 +366,9 @@ lubSubDmd (Prod ds1) (viewProd (length ds1) -> Just ds2) = -- Handle Call lubSubDmd (Call n1 d1) (viewCall -> Just (n2, d2)) -- See Note [Call demands are relative] - | isAbs n2 = Call (lubCard n1 n2) (lubSubDmd d1 botSubDmd) - | otherwise = Call (lubCard n1 n2) (lubSubDmd d1 d2) + | isAbs n1 = mkCall (lubCard n1 n2) (lubSubDmd botSubDmd d2) + | isAbs n2 = mkCall (lubCard n1 n2) (lubSubDmd d1 botSubDmd) + | otherwise = mkCall (lubCard n1 n2) (lubSubDmd d1 d2) -- Handle Poly lubSubDmd (Poly n1) (Poly n2) = Poly (lubCard n1 n2) -- Make use of reflexivity (so we'll match the Prod or Call cases again). @@ -367,7 +378,7 @@ lubSubDmd _ _ = topSubDmd -- | Denotes '∪' on 'Demand'. lubDmd :: Demand -> Demand -> Demand -lubDmd (n1 :* sd1) (n2 :* sd2) = lubCard n1 n2 :* lubSubDmd sd1 sd2 +lubDmd (n1 :* sd1) (n2 :* sd2) = lubCard n1 n2 :* lubSubDmd sd1 sd2 -- | Denotes '+' on 'SubDemand'. plusSubDmd :: SubDemand -> SubDemand -> SubDemand @@ -377,8 +388,9 @@ plusSubDmd (Prod ds1) (viewProd (length ds1) -> Just ds2) = -- Handle Call plusSubDmd (Call n1 d1) (viewCall -> Just (n2, d2)) -- See Note [Call demands are relative] - | isAbs n2 = Call (plusCard n1 n2) (lubSubDmd d1 botSubDmd) - | otherwise = Call (plusCard n1 n2) (lubSubDmd d1 d2) + | isAbs n1 = mkCall (plusCard n1 n2) (lubSubDmd botSubDmd d2) + | isAbs n2 = mkCall (plusCard n1 n2) (lubSubDmd d1 botSubDmd) + | otherwise = mkCall (plusCard n1 n2) (lubSubDmd d1 d2) -- Handle Poly plusSubDmd (Poly n1) (Poly n2) = Poly (plusCard n1 n2) -- Make use of reflexivity (so we'll match the Prod or Call cases again). @@ -407,7 +419,7 @@ multSubDmd :: Card -> SubDemand -> SubDemand multSubDmd n sd | Just sd' <- multTrivial n seqSubDmd sd = sd' multSubDmd n (Poly n') = Poly (multCard n n') -multSubDmd n (Call n' sd) = Call (multCard n n') sd -- See Note [Call demands are relative] +multSubDmd n (Call n' sd) = mkCall (multCard n n') sd -- See Note [Call demands are relative] multSubDmd n (Prod ds) = Prod (map (multDmd n) ds) multDmd :: Card -> Demand -> Demand @@ -457,22 +469,22 @@ evalDmd = C_1N :* topSubDmd -- | First argument of 'GHC.Exts.maskAsyncExceptions#': @SCS(U)@. -- Called exactly once. strictOnceApply1Dmd :: Demand -strictOnceApply1Dmd = C_11 :* Call C_11 topSubDmd +strictOnceApply1Dmd = C_11 :* mkCall C_11 topSubDmd -- | First argument of 'GHC.Exts.atomically#': @MCM(U)@. -- Called at least once, possibly many times. strictManyApply1Dmd :: Demand -strictManyApply1Dmd = C_1N :* Call C_1N topSubDmd +strictManyApply1Dmd = C_1N :* mkCall C_1N topSubDmd -- | First argument of catch#: @1C1(U)@. -- Evaluates its arg lazily, but then applies it exactly once to one argument. lazyApply1Dmd :: Demand -lazyApply1Dmd = C_01 :* Call C_01 topSubDmd +lazyApply1Dmd = C_01 :* mkCall C_01 topSubDmd -- | Second argument of catch#: @1C1(CS(U))@. -- Calls its arg lazily, but then applies it exactly once to an additional argument. lazyApply2Dmd :: Demand -lazyApply2Dmd = C_01 :* Call C_01 (Call C_11 topSubDmd) +lazyApply2Dmd = C_01 :* mkCall C_01 (mkCall C_11 topSubDmd) -- | Make a 'Demand' evaluated at-most-once. oneifyDmd :: Demand -> Demand @@ -512,12 +524,12 @@ strictifyDictDmd ty (n :* Prod ds) strictifyDictDmd _ dmd = dmd -- | Wraps the 'SubDemand' with a one-shot call demand: @d@ -> @CS(d)@. -mkCallDmd :: SubDemand -> SubDemand -mkCallDmd sd = Call C_11 sd +mkCalledOnceDmd :: SubDemand -> SubDemand +mkCalledOnceDmd sd = mkCall C_11 sd --- | @mkCallDmds n d@ returns @CS(CS...(CS d))@ where there are @n@ @CS@'s. -mkCallDmds :: Arity -> SubDemand -> SubDemand -mkCallDmds arity sd = iterate mkCallDmd sd !! arity +-- | @mkCalledOnceDmds n d@ returns @CS(CS...(CS d))@ where there are @n@ @CS@'s. +mkCalledOnceDmds :: Arity -> SubDemand -> SubDemand +mkCalledOnceDmds arity sd = iterate mkCalledOnceDmd sd !! arity -- | Peels one call level from the sub-demand, and also returns how many -- times we entered the lambda body. @@ -669,7 +681,7 @@ This is needed even for non-product types, in case the case-binder is used but the components of the case alternative are not. Note [Don't optimise UP(U,U,...) to U] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ These two SubDemands: UP(U,U) (@Prod [topDmd, topDmd]@) and U (@topSubDmd@) are semantically equivalent, but we do not turn the former into @@ -1571,9 +1583,9 @@ This is weird, so I'm not worried about whether this optimises brilliantly; but it should not fall over. -} -zapUsageEnvSig :: StrictSig -> StrictSig --- Remove the usage environment from the demand -zapUsageEnvSig (StrictSig (DmdType _ ds r)) = mkClosedStrictSig ds r +-- | Remove the demand environment from the signature. +zapDmdEnvSig :: StrictSig -> StrictSig +zapDmdEnvSig (StrictSig (DmdType _ ds r)) = mkClosedStrictSig ds r zapUsageDemand :: Demand -> Demand -- Remove the usage info, but not the strictness info, from the demand @@ -1615,8 +1627,8 @@ kill_usage kfs (n :* sd) = kill_usage_card kfs n :* kill_usage_sd kfs sd kill_usage_sd :: KillFlags -> SubDemand -> SubDemand kill_usage_sd kfs (Call n sd) - | kf_called_once kfs = Call (lubCard C_1N n) (kill_usage_sd kfs sd) - | otherwise = Call n (kill_usage_sd kfs sd) + | kf_called_once kfs = mkCall (lubCard C_1N n) (kill_usage_sd kfs sd) + | otherwise = mkCall n (kill_usage_sd kfs sd) kill_usage_sd kfs (Prod ds) = Prod (map (kill_usage kfs) ds) kill_usage_sd _ sd = sd @@ -1640,7 +1652,7 @@ trimToType (n :* sd) ts where go (Prod ds) (TsProd tss) | equalLength ds tss = Prod (zipWith trimToType ds tss) - go (Call n sd) (TsFun ts) = Call n (go sd ts) + go (Call n sd) (TsFun ts) = mkCall n (go sd ts) go sd at Poly{} _ = sd go _ _ = topSubDmd @@ -1804,7 +1816,7 @@ instance Binary SubDemand where h <- getByte bh case h of 0 -> Poly <$> get bh - 1 -> Call <$> get bh <*> get bh + 1 -> mkCall <$> get bh <*> get bh 2 -> Prod <$> get bh _ -> pprPanic "Binary:SubDemand" (ppr (fromIntegral h :: Int)) ===================================== compiler/GHC/Types/Id/Info.hs ===================================== @@ -650,7 +650,7 @@ zapUsageInfo info = Just (info {demandInfo = zapUsageDemand (demandInfo info)}) zapUsageEnvInfo :: IdInfo -> Maybe IdInfo zapUsageEnvInfo info | hasDemandEnvSig (strictnessInfo info) - = Just (info {strictnessInfo = zapUsageEnvSig (strictnessInfo info)}) + = Just (info {strictnessInfo = zapDmdEnvSig (strictnessInfo info)}) | otherwise = Nothing ===================================== testsuite/tests/arityanal/should_compile/Arity11.stderr ===================================== @@ -35,7 +35,7 @@ end Rec } -- RHS size: {terms: 52, types: 28, coercions: 0, joins: 0/5} F11.$wfib [InlPrag=[2]] :: forall {a} {p}. (a -> a -> Bool) -> (Num a, Num p) => a -> p -[GblId, Arity=4, Str=, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 150 60 0] 460 0}] +[GblId, Arity=4, Str=, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 150 60 0] 460 0}] F11.$wfib = \ (@a) (@p) (ww :: a -> a -> Bool) (w :: Num a) (w1 :: Num p) (w2 :: a) -> let { @@ -73,7 +73,7 @@ F11.$wfib fib [InlPrag=[2]] :: forall {a} {p}. (Eq a, Num a, Num p) => a -> p [GblId, Arity=4, - Str=, + Str=, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=4,unsat_ok=True,boring_ok=False) Tmpl= \ (@a) (@p) (w [Occ=Once1!] :: Eq a) (w1 [Occ=Once1] :: Num a) (w2 [Occ=Once1] :: Num p) (w3 [Occ=Once1] :: a) -> case w of { GHC.Classes.C:Eq ww1 [Occ=Once1] _ [Occ=Dead] -> F11.$wfib @a @p ww1 w1 w2 w3 }}] fib = \ (@a) (@p) (w :: Eq a) (w1 :: Num a) (w2 :: Num p) (w3 :: a) -> case w of { GHC.Classes.C:Eq ww1 ww2 -> F11.$wfib @a @p ww1 w1 w2 w3 } ===================================== testsuite/tests/arityanal/should_compile/Arity16.stderr ===================================== @@ -5,7 +5,7 @@ Result size of Tidy Core = {terms: 52, types: 87, coercions: 0, joins: 0/0} Rec { -- RHS size: {terms: 15, types: 17, coercions: 0, joins: 0/0} map2 [Occ=LoopBreaker] :: forall {t} {a}. (t -> a) -> [t] -> [a] -[GblId, Arity=2, Str=, Unf=OtherCon []] +[GblId, Arity=2, Str=, Unf=OtherCon []] map2 = \ (@t) (@a) (f :: t -> a) (ds :: [t]) -> case ds of { ===================================== testsuite/tests/stranal/should_compile/T18894.hs ===================================== @@ -0,0 +1,28 @@ +{-# OPTIONS_GHC -O2 -fforce-recomp #-} + +-- | The point of this test is that @g*@ get's a demand that says +-- "whenever @g*@ is called, the second component of the pair is evaluated strictly". +module T18894 (h1, h2) where + +g1 :: Int -> (Int,Int) +g1 1 = (15, 0) +g1 n = (2 * n, 2 `div` n) +{-# NOINLINE g1 #-} + +h1 :: Int -> Int +h1 1 = 0 +-- Sadly, the @g1 2@ subexpression will be floated to top-level, where we +-- don't see the specific demand placed on it by @snd at . Tracked in #19001. +h1 2 = snd (g1 2) +h1 m = uncurry (+) (g1 m) + +g2 :: Int -> Int -> (Int,Int) +g2 m 1 = (m, 0) +g2 m n = (2 * m, 2 `div` n) +{-# NOINLINE g2 #-} + +h2 :: Int -> Int +h2 1 = 0 +h2 m + | odd m = snd (g2 m 2) + | otherwise = uncurry (+) (g2 2 m) ===================================== testsuite/tests/stranal/should_compile/T18894.stderr ===================================== @@ -0,0 +1,404 @@ + +==================== Demand analysis ==================== +Result size of Demand analysis + = {terms: 177, types: 97, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 36, types: 16, coercions: 0, joins: 0/0} +g2 [InlPrag=NOINLINE, Dmd=UCU(CS(P(1P(U),SP(U))))] + :: Int -> Int -> (Int, Int) +[LclId, + Arity=2, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20 20] 161 20}] +g2 + = \ (m [Dmd=UP(U)] :: Int) (ds [Dmd=SP(SU)] :: Int) -> + case ds of { GHC.Types.I# ds [Dmd=SU] -> + case ds of ds [Dmd=1U] { + __DEFAULT -> + (case m of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.*# 2# y) }, + case ds of wild { + __DEFAULT -> + case GHC.Classes.divInt# 2# wild of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> GHC.Types.I# -2#; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + }); + 1# -> (m, lvl) + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 36, types: 19, coercions: 0, joins: 0/0} +h2 :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 162 10}] +h2 + = \ (ds [Dmd=SP(MU)] :: Int) -> + case ds of wild [Dmd=UP(U)] { GHC.Types.I# ds [Dmd=MU] -> + case ds of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> + case g2 wild lvl of { (ds1 [Dmd=A], y [Dmd=SU]) -> y }; + 0# -> + case g2 lvl wild of { (x [Dmd=SP(U)], ds [Dmd=SP(U)]) -> + case x of { GHC.Types.I# x -> + case ds of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + } + }; + 1# -> lvl + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 15# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +lvl :: (Int, Int) +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = (lvl, lvl) + +-- RHS size: {terms: 30, types: 11, coercions: 0, joins: 0/0} +g1 [InlPrag=NOINLINE, Dmd=UCU(P(UP(U),UP(U)))] :: Int -> (Int, Int) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 141 10}] +g1 + = \ (ds [Dmd=SP(SU)] :: Int) -> + case ds of { GHC.Types.I# ds [Dmd=SU] -> + case ds of ds { + __DEFAULT -> + (GHC.Types.I# (GHC.Prim.*# 2# ds), + case ds of wild { + __DEFAULT -> + case GHC.Classes.divInt# 2# wild of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> GHC.Types.I# -2#; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + }); + 1# -> lvl + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +lvl :: (Int, Int) +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=False, ConLike=False, + WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 30 0}] +lvl = g1 (GHC.Types.I# 2#) + +-- RHS size: {terms: 28, types: 18, coercions: 0, joins: 0/0} +h1 :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 111 10}] +h1 + = \ (ds [Dmd=SP(MU)] :: Int) -> + case ds of wild [Dmd=1P(1U)] { GHC.Types.I# ds [Dmd=MU] -> + case ds of { + __DEFAULT -> + case g1 wild of { (x [Dmd=SP(U)], ds [Dmd=SP(U)]) -> + case x of { GHC.Types.I# x -> + case ds of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + }; + 1# -> lvl; + 2# -> case lvl of { (ds1 [Dmd=A], y [Dmd=SU]) -> y } + } + } + + + + +==================== Demand analysis ==================== +Result size of Demand analysis + = {terms: 171, types: 120, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# -2# + +-- RHS size: {terms: 32, types: 18, coercions: 0, joins: 0/0} +$wg2 [InlPrag=NOINLINE, Dmd=UCU(CS(P(1P(U),SP(U))))] + :: Int -> GHC.Prim.Int# -> (# Int, Int #) +[LclId, + Arity=2, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20 30] 121 20}] +$wg2 + = \ (w [Dmd=UP(U)] :: Int) (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + (# case w of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.*# 2# y) }, + case ds of { + __DEFAULT -> + case GHC.Classes.divInt# 2# ds of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> lvl; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + } #); + 1# -> (# w, lvl #) + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 34, types: 21, coercions: 0, joins: 0/0} +$wh2 [InlPrag=[2]] :: GHC.Prim.Int# -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 162 10}] +$wh2 + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> + case $wg2 (GHC.Types.I# ds) 2# of + { (# ww [Dmd=A], ww [Dmd=SU] #) -> + ww + }; + 0# -> + case $wg2 lvl ds of { (# ww [Dmd=SP(U)], ww [Dmd=SP(U)] #) -> + case ww of { GHC.Types.I# x -> + case ww of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + } + }; + 1# -> lvl + } + +-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} +h2 [InlPrag=[2]] :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (w [Occ=Once1!] :: Int) -> + case w of { GHC.Types.I# ww [Occ=Once1, Dmd=MU] -> $wh2 ww }}] +h2 + = \ (w [Dmd=SP(SU)] :: Int) -> + case w of { GHC.Types.I# ww [Dmd=SU] -> $wh2 ww } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 15# + +-- RHS size: {terms: 28, types: 15, coercions: 0, joins: 0/0} +$wg1 [InlPrag=NOINLINE, Dmd=UCU(P(UP(U),UP(U)))] + :: GHC.Prim.Int# -> (# Int, Int #) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 111 20}] +$wg1 + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + (# GHC.Types.I# (GHC.Prim.*# 2# ds), + case ds of { + __DEFAULT -> + case GHC.Classes.divInt# 2# ds of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> lvl; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + } #); + 1# -> (# lvl, lvl #) + } + +-- RHS size: {terms: 7, types: 9, coercions: 0, joins: 0/0} +lvl :: (Int, Int) +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=False, ConLike=False, + WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 40 10}] +lvl = case $wg1 2# of { (# ww, ww #) -> (ww, ww) } + +-- RHS size: {terms: 25, types: 18, coercions: 0, joins: 0/0} +$wh1 [InlPrag=[2]] :: GHC.Prim.Int# -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [50] 101 10}] +$wh1 + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds [Dmd=1U] { + __DEFAULT -> + case $wg1 ds of { (# ww [Dmd=SP(U)], ww [Dmd=SP(U)] #) -> + case ww of { GHC.Types.I# x -> + case ww of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + }; + 1# -> lvl; + 2# -> case lvl of { (ds1 [Dmd=A], y [Dmd=SU]) -> y } + } + +-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} +h1 [InlPrag=[2]] :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (w [Occ=Once1!] :: Int) -> + case w of { GHC.Types.I# ww [Occ=Once1, Dmd=MU] -> $wh1 ww }}] +h1 + = \ (w [Dmd=SP(SU)] :: Int) -> + case w of { GHC.Types.I# ww [Dmd=SU] -> $wh1 ww } + + + ===================================== testsuite/tests/stranal/should_compile/T18894b.hs ===================================== @@ -0,0 +1,20 @@ +{-# OPTIONS_GHC -O -fno-call-arity -fforce-recomp #-} + +module T18894 (f) where + +expensive :: Int -> (Int, Int) +expensive n = (n+1, n+2) +{-# NOINLINE expensive #-} + +-- arity 1 by itself, but not exported, thus can be eta-expanded based on usage +eta :: Int -> Int -> Int +eta x = if fst (expensive x) == 13 + then \y -> x + y + else \y -> x * y +{-# NOINLINE eta #-} + +f :: Int -> Int +f 1 = 0 +f m + | odd m = eta m 2 + | otherwise = eta 2 m ===================================== testsuite/tests/stranal/should_compile/T18894b.stderr ===================================== @@ -0,0 +1,187 @@ + +==================== Demand analysis ==================== +Result size of Demand analysis = {terms: 83, types: 40, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 16, types: 7, coercions: 0, joins: 0/0} +expensive [InlPrag=NOINLINE, Dmd=UCU(P(SP(SU),A))] :: Int -> (Int, Int) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [40] 52 10}] +expensive + = \ (n [Dmd=UP(U)] :: Int) -> + (case n of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 1#) }, case n of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 2#) }) + +-- RHS size: {terms: 20, types: 11, coercions: 0, joins: 0/0} +eta [InlPrag=NOINLINE, Dmd=UCU(CS(U))] :: Int -> Int -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [0] 140 120}] +eta + = \ (x [Dmd=UP(U)] :: Int) -> + case expensive x of { (x [Dmd=SP(SU)], ds1 [Dmd=A]) -> + case x of { GHC.Types.I# x [Dmd=SU] -> + case x of { + __DEFAULT -> \ (y [Dmd=SP(U)] :: Int) -> GHC.Num.$fNumInt_$c* x y; + 13# -> \ (y [Dmd=SP(U)] :: Int) -> GHC.Num.$fNumInt_$c+ x y + } + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 21, types: 5, coercions: 0, joins: 0/0} +f :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 111 0}] +f = \ (ds [Dmd=SP(MU)] :: Int) -> + case ds of wild [Dmd=UP(U)] { GHC.Types.I# ds [Dmd=MU] -> + case ds of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> eta wild lvl; + 0# -> eta lvl wild + }; + 1# -> lvl + } + } + + + + +==================== Demand analysis ==================== +Result size of Demand analysis = {terms: 85, types: 47, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 16, types: 9, coercions: 0, joins: 0/0} +$wexpensive [InlPrag=NOINLINE, Dmd=UCU(P(SP(SU),A))] :: Int -> (# Int, Int #) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [40] 42 10}] +$wexpensive + = \ (w [Dmd=UP(U)] :: Int) -> + (# case w of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 1#) }, + case w of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 2#) } #) + +-- RHS size: {terms: 19, types: 12, coercions: 0, joins: 0/0} +eta [InlPrag=NOINLINE, Dmd=UCU(CS(U))] :: Int -> Int -> Int +[LclId, + Arity=2, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [0 0] 120 0}] +eta + = \ (x [Dmd=MP(U)] :: Int) (eta [Dmd=SP(U), OS=OneShot] :: Int) -> + case $wexpensive x of { (# ww [Dmd=SP(SU)], ww [Dmd=A] #) -> + case ww of { GHC.Types.I# x [Dmd=SU] -> + case x of { + __DEFAULT -> GHC.Num.$fNumInt_$c* x eta; + 13# -> GHC.Num.$fNumInt_$c+ x eta + } + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 20, types: 3, coercions: 0, joins: 0/0} +$wf [InlPrag=[2]] :: GHC.Prim.Int# -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 121 0}] +$wf + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> eta (GHC.Types.I# ds) lvl; + 0# -> eta lvl (GHC.Types.I# ds) + }; + 1# -> lvl + } + +-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} +f [InlPrag=[2]] :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (w [Occ=Once1!] :: Int) -> case w of { GHC.Types.I# ww [Occ=Once1, Dmd=MU] -> $wf ww }}] +f = \ (w [Dmd=SP(SU)] :: Int) -> case w of { GHC.Types.I# ww [Dmd=SU] -> $wf ww } + + + ===================================== testsuite/tests/stranal/should_compile/all.T ===================================== @@ -58,3 +58,7 @@ test('T18122', [ grep_errmsg(r'wfoo =') ], compile, ['-ddump-simpl']) # We care about the call demand on $wg test('T18903', [ grep_errmsg(r'Dmd=\S+C\S+') ], compile, ['-ddump-simpl -dsuppress-uniques']) +# We care about the call demand on $wg1 and $wg2 +test('T18894', [ grep_errmsg(r'Dmd=\S+C\S+') ], compile, ['-ddump-stranal -dsuppress-uniques']) +# We care about the Arity 2 on eta, as a result of the annotated Dmd +test('T18894b', [ grep_errmsg(r'Arity=2') ], compile, ['-ddump-stranal -dsuppress-uniques -fno-call-arity -dppr-cols=200']) ===================================== testsuite/tests/stranal/sigs/T5075.stderr ===================================== @@ -1,7 +1,7 @@ ==================== Strictness signatures ==================== T5075.$trModule: -T5075.loop: +T5075.loop: @@ -13,6 +13,6 @@ T5075.loop: ==================== Strictness signatures ==================== T5075.$trModule: -T5075.loop: +T5075.loop: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4af6126d1758d5e365cadf032e34c99489f13dee...3aae036eded89603756d025e0fac2ec0642edeaf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4af6126d1758d5e365cadf032e34c99489f13dee...3aae036eded89603756d025e0fac2ec0642edeaf You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Dec 12 09:45:54 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sat, 12 Dec 2020 04:45:54 -0500 Subject: [Git][ghc/ghc][master] hadrian: correctly copy the docs dir into the bindist #18669 Message-ID: <5fd49152e11d7_6b214011b8012502ee@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: c6477639 by Adam Sandberg Ericsson at 2020-12-12T04:45:48-05:00 hadrian: correctly copy the docs dir into the bindist #18669 - - - - - 1 changed file: - hadrian/src/Rules/BinaryDist.hs Changes: ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -12,6 +12,7 @@ import Settings import Settings.Program (programContext) import Target import Utilities +import qualified System.Directory.Extra as IO {- Note [Binary distributions] @@ -136,13 +137,20 @@ bindistRules = do copyDirectory (ghcBuildDir -/- "bin") bindistFilesDir copyDirectory (ghcBuildDir -/- "lib") bindistFilesDir copyDirectory (rtsIncludeDir) bindistFilesDir + unless cross $ need ["docs"] + -- TODO: we should only embed the docs that have been generated -- depending on the current settings (flavours' "ghcDocs" field and -- "--docs=.." command-line flag) -- Currently we embed the "docs" directory if it exists but it may -- contain outdated or even invalid data. - whenM (doesDirectoryExist (root -/- "docs")) $ do + + -- Use the IO version of doesDirectoryExist because the Shake Action + -- version should not be used for directories the build system can + -- create. Using the Action version caused documentation to not be + -- included in the bindist in the past (part of the problem in #18669). + whenM (liftIO (IO.doesDirectoryExist (root -/- "docs"))) $ do copyDirectory (root -/- "docs") bindistFilesDir when windowsHost $ do copyDirectory (root -/- "mingw") bindistFilesDir View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c647763954717d9853d08ff04eece7f1ddeae15c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c647763954717d9853d08ff04eece7f1ddeae15c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Dec 12 10:16:29 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Sat, 12 Dec 2020 05:16:29 -0500 Subject: [Git][ghc/ghc][wip/sgraf-dmdanal-stuff] 107 commits: users-guide: A bit of clean-up in profiling flag documentation Message-ID: <5fd4987de3029_6b21410d5e8125205c@gitlab.mail> Sebastian Graf pushed to branch wip/sgraf-dmdanal-stuff at Glasgow Haskell Compiler / GHC Commits: 2a8a979c by Ben Gamari at 2020-11-21T01:13:26-05:00 users-guide: A bit of clean-up in profiling flag documentation - - - - - 56804e33 by Ben Gamari at 2020-11-21T01:13:26-05:00 testsuite: Refactor CountParserDeps - - - - - 53ad67ea by Ben Gamari at 2020-11-21T01:13:26-05:00 Introduce -fprof-callers flag This introducing a new compiler flag to provide a convenient way to introduce profiler cost-centers on all occurrences of the named identifier. Closes #18566. - - - - - ecfd0278 by Sylvain Henry at 2020-11-21T01:14:09-05:00 Move Plugins into HscEnv (#17957) Loaded plugins have nothing to do in DynFlags so this patch moves them into HscEnv (session state). "DynFlags plugins" become "Driver plugins" to still be able to register static plugins. Bump haddock submodule - - - - - 72f2257c by Sylvain Henry at 2020-11-21T01:14:09-05:00 Don't initialize plugins in the Core2Core pipeline Some plugins can be added via TH (cf addCorePlugin). Initialize them in the driver instead of in the Core2Core pipeline. - - - - - ddbeeb3c by Ryan Scott at 2020-11-21T01:14:44-05:00 Add regression test for #10504 This issue was fixed at some point between GHC 8.0 and 8.2. Let's add a regression test to ensure that it stays fixed. Fixes #10504. - - - - - a4a6dc2a by Ben Gamari at 2020-11-21T01:15:21-05:00 dwarf: Apply info table offset consistently Previously we failed to apply the info table offset to the aranges and DIEs, meaning that we often failed to unwind in gdb. For some reason this only seemed to manifest in the RTS's Cmm closures. Nevertheless, now we can unwind completely up to `main` - - - - - 69bfbc21 by Ben Gamari at 2020-11-21T01:15:56-05:00 hadrian: Disable stripping when debug information is enabled - - - - - 7e93ae8b by Ben Gamari at 2020-11-21T13:13:29-05:00 rts: Post ticky entry counts to the eventlog We currently only post the entry counters, not the other global counters as in my experience the former are more useful. We use the heap profiler's census period to decide when to dump. Also spruces up the documentation surrounding ticky-ticky a bit. - - - - - bc9c3916 by Ben Gamari at 2020-11-22T06:28:10-05:00 Implement -ddump-c-backend argument To dump output of the C backend. - - - - - 901bc220 by Ben Gamari at 2020-11-22T12:39:02-05:00 Bump time submodule to 1.11.1 Also bumps directory, Cabal, hpc, time, and unix submodules. Closes #18847. - - - - - 92c0afbf by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Dump STG when ticky is enabled This changes the "ticky" modifier to enable dumping of final STG as this is generally needed to make sense of the ticky profiles. - - - - - d23fef68 by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Introduce notion of flavour transformers This extends Hadrian's notion of "flavour", as described in #18942. - - - - - 179d0bec by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Add a viaLlvmBackend modifier Note that this also slightly changes the semantics of these flavours as we only use LLVM for >= stage1 builds. - - - - - d4d95e51 by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Add profiled_ghc and no_dynamic_ghc modifiers - - - - - 6815603f by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Drop redundant flavour definitions Drop the profiled, LLVM, and ThreadSanitizer flavour definitions as these can now be realized with flavour transformers. - - - - - f88f4339 by Ben Gamari at 2020-11-24T02:43:20-05:00 rts: Flush eventlog buffers from flushEventLog As noted in #18043, flushTrace failed flush anything beyond the writer. This means that a significant amount of data sitting in capability-local event buffers may never get flushed, despite the users' pleads for us to flush. Fix this by making flushEventLog flush all of the event buffers before flushing the writer. Fixes #18043. - - - - - 7c03cc50 by Ben Gamari at 2020-11-24T02:43:55-05:00 gitlab-ci: Run LLVM job on appropriately-labelled MRs Namely, those marked with the ~"LLVM backend" label - - - - - 9b95d815 by Ben Gamari at 2020-11-24T02:43:55-05:00 gitlab-ci: Run LLVM builds on Debian 10 The current Debian 9 image doesn't provide LLVM 7. - - - - - 2ed3e6c0 by Ben Gamari at 2020-11-24T02:43:55-05:00 CmmToLlvm: Declare signature for memcmp Otherwise `opt` fails with: error: use of undefined value '@memcmp$def' - - - - - be5d74ca by Moritz Angermann at 2020-11-26T16:00:32-05:00 [Sized Cmm] properly retain sizes. This replaces all Word<N> = W<N># Word# and Int<N> = I<N># Int# with Word<N> = W<N># Word<N># and Int<N> = I<N># Int<N>#, thus providing us with properly sized primitives in the codegenerator instead of pretending they are all full machine words. This came up when implementing darwinpcs for arm64. The darwinpcs reqires us to pack function argugments in excess of registers on the stack. While most procedure call standards (pcs) assume arguments are just passed in 8 byte slots; and thus the caller does not know the exact signature to make the call, darwinpcs requires us to adhere to the prototype, and thus have the correct sizes. If we specify CInt in the FFI call, it should correspond to the C int, and not just be Word sized, when it's only half the size. This does change the expected output of T16402 but the new result is no less correct as it eliminates the narrowing (instead of the `and` as was previously done). Bumps the array, bytestring, text, and binary submodules. Co-Authored-By: Ben Gamari <ben at well-typed.com> Metric Increase: T13701 T14697 - - - - - a84e53f9 by Andreas Klebinger at 2020-11-26T16:00:32-05:00 RTS: Fix failed inlining of copy_tag. On windows using gcc-10 gcc failed to inline copy_tag into evacuate. To fix this we now set the always_inline attribute for the various copy* functions in Evac.c. The main motivation here is not the overhead of the function call, but rather that this allows the code to "specialize" for the size of the closure we copy which is often known at compile time. An earlier commit also tried to avoid evacuate_large inlining. But didn't quite succeed. So I also marked evacuate_large as noinline. Fixes #12416 - - - - - cdbd16f5 by Sylvain Henry at 2020-11-26T16:00:33-05:00 Fix toArgRep to support 64-bit reps on all systems [This is @Ericson2314 writing a commit message for @hsyl20's patch.] (Progress towards #11953, #17377, #17375) `Int64Rep` and `Word64Rep` are currently broken on 64-bit systems. This is because they should use "native arg rep" but instead use "large arg rep" as they do on 32-bit systems, which is either a non-concept or a 128-bit rep depending on one's vantage point. Now, these reps currently aren't used during 64-bit compilation, so the brokenness isn't observed, but I don't think that constitutes reasons not to fix it. Firstly, the linked issues there is a clearly expressed desire to use explicit-bitwidth constructs in more places. Secondly, per [1], there are other bugs that *do* manifest from not threading explicit-bitwidth information all the way through the compilation pipeline. One can therefore view this as one piece of the larger effort to do that, improve ergnomics, and squash remaining bugs. Also, this is needed for !3658. I could just merge this as part of that, but I'm keen on merging fixes "as they are ready" so the fixes that aren't ready are isolated and easier to debug. [1]: https://mail.haskell.org/pipermail/ghc-devs/2020-October/019332.html - - - - - a9378e69 by Tim Barnes at 2020-11-26T16:00:34-05:00 Set dynamic users-guide TOC spacing (fixes #18554) - - - - - 86a59d93 by Ben Gamari at 2020-11-26T16:00:34-05:00 rts: Use RTS_LIKELY in CHECK Most compilers probably already infer that `barf` diverges but it nevertheless doesn't hurt to be explicit. - - - - - 5757e82b by Matthew Pickering at 2020-11-26T16:00:35-05:00 Remove special case for GHC.ByteCode.Instr This was added in https://github.com/nomeata/ghc-heap-view/commit/34935206e51b9c86902481d84d2f368a6fd93423 GHC.ByteCode.Instr.BreakInfo no longer exists so the special case is dead code. Any check like this can be easily dealt with in client code. - - - - - d9c8b5b4 by Matthew Pickering at 2020-11-26T16:00:35-05:00 Split Up getClosureDataFromHeapRep Motivation 1. Don't enforce the repeated decoding of an info table, when the client can cache it (ghc-debug) 2. Allow the constructor information decoding to be overridden, this casues segfaults in ghc-debug - - - - - 3e3555cc by Andreas Klebinger at 2020-11-26T16:00:35-05:00 RegAlloc: Add missing raPlatformfield to RegAllocStatsSpill Fixes #18994 Co-Author: Benjamin Maurer <maurer.benjamin at gmail.com> - - - - - a1a75aa9 by Ben Gamari at 2020-11-27T06:20:41-05:00 rts: Allocate MBlocks with MAP_TOP_DOWN on Windows As noted in #18991, we would previously allocate heap in low memory. Due to this the linker, which typically *needs* low memory, would end up competing with the heap. In longer builds we end up running out of low memory entirely, leading to linking failures. - - - - - 75fc1ed5 by Sylvain Henry at 2020-11-28T15:40:23-05:00 Hadrian: fix detection of ghc-pkg for cross-compilers - - - - - 7cb5df96 by Sylvain Henry at 2020-11-28T15:40:23-05:00 hadrian: fix ghc-pkg uses (#17601) Make sure ghc-pkg doesn't read the compiler "settings" file by passing --no-user-package-db. - - - - - e3fd4226 by Ben Gamari at 2020-11-28T15:40:23-05:00 gitlab-ci: Introduce a nightly cross-compilation job This adds a job to test cross-compilation from x86-64 to AArch64 with Hadrian. Fixes #18234 - - - - - 698d3d96 by Ben Gamari at 2020-11-28T15:41:00-05:00 gitlab-ci: Only deploy GitLab Pages in ghc/ghc> The deployments are quite large and yet are currently only served for the ghc/ghc> project. - - - - - 625726f9 by David Eichmann at 2020-11-28T15:41:37-05:00 ghc-heap: partial TSO/STACK decoding Co-authored-by: Sven Tennie <sven.tennie at gmail.com> Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> Co-authored-by: Ben Gamari <bgamari.foss at gmail.com> - - - - - 22ea9c29 by Andreas Klebinger at 2020-11-28T15:42:13-05:00 Small optimization to CmmSink. Inside `regsUsedIn` we can avoid some thunks by specializing the recursion. In particular we avoid the thunk for `(f e z)` in the MachOp/Load branches, where we know this will evaluate to z. Reduces allocations for T3294 by ~1%. - - - - - bba42c62 by John Ericson at 2020-11-28T15:42:49-05:00 Make primop handler indentation more consistent - - - - - c82bc8e9 by John Ericson at 2020-11-28T15:42:49-05:00 Cleanup some primop constructor names Harmonize the internal (big sum type) names of the native vs fixed-sized number primops a bit. (Mainly by renaming the former.) No user-facing names are changed. - - - - - ae14f160 by Ben Gamari at 2020-11-28T15:43:25-05:00 testsuite: Mark T14702 as fragile on Windows Due to #18953. - - - - - 1bc104b0 by Ben Gamari at 2020-11-29T15:33:18-05:00 withTimings: Emit allocations counter This will allow us to back out the allocations per compiler pass from the eventlog. Note that we dump the allocation counter rather than the difference since this will allow us to determine how much work is done *between* `withTiming` blocks. - - - - - e992ea84 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 ThreadPaused: Don't zero slop until free vars are pushed When threadPaused blackholes a thunk it calls `OVERWRITING_CLOSURE` to zero the slop for the benefit of the sanity checker. Previously this was done *before* pushing the thunk's free variables to the update remembered set. Consequently we would pull zero'd pointers to the update remembered set. - - - - - e82cd140 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Fix regression from TSAN work The TSAN rework (specifically aad1f803) introduced a subtle regression in GC.c, swapping `g0` in place of `gen`. Whoops! Fixes #18997. - - - - - 35a5207e by GHC GitLab CI at 2020-11-29T15:33:54-05:00 rts/Messages: Add missing write barrier in THROWTO message update After a THROWTO message has been handle the message closure is overwritten by a NULL message. We must ensure that the original closure's pointers continue to be visible to the nonmoving GC. - - - - - 0120829f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Add missing write barrier in shrinkSmallByteArray - - - - - 8a4d8fb6 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 Updates: Don't zero slop until closure has been pushed Ensure that the the free variables have been pushed to the update remembered set before we zero the slop. - - - - - 2793cfdc by GHC GitLab CI at 2020-11-29T15:33:54-05:00 OSThreads: Fix error code checking pthread_join returns its error code and apparently doesn't set errno. - - - - - e391a16f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Don't join to mark_thread on shutdown The mark thread is not joinable as we detach from it on creation. - - - - - 60d088ab by Ben Gamari at 2020-11-29T15:33:54-05:00 nonmoving: Add reference to Ueno 2016 - - - - - 3aa60362 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Ensure that evacuated large objects are marked See Note [Non-moving GC: Marking evacuated objects]. - - - - - 8d304a99 by Ben Gamari at 2020-11-30T10:15:22-05:00 rts/m32: Refactor handling of allocator seeding Previously, in an attempt to reduce fragmentation, each new allocator would map a region of M32_MAX_PAGES fresh pages to seed itself. However, this ends up being extremely wasteful since it turns out that we often use fewer than this. Consequently, these pages end up getting freed which, ends up fragmenting our address space more than than we would have if we had naively allocated pages on-demand. Here we refactor m32 to avoid this waste while achieving the fragmentation mitigation previously desired. In particular, we move all page allocation into the global m32_alloc_page, which will pull a page from the free page pool. If the free page pool is empty we then refill it by allocating a region of M32_MAP_PAGES and adding them to the pool. Furthermore, we do away with the initial seeding entirely. That is, the allocator starts with no active pages: pages are rather allocated on an as-needed basis. On the whole this ends up being a pleasingly simple change, simultaneously making m32 more efficient, more robust, and simpler. Fixes #18980. - - - - - b6629289 by Ben Gamari at 2020-11-30T10:15:58-05:00 rts: Use CHECK instead of assert Use the GHC wrappers instead of <assert.h>. - - - - - 9f4efa6a by Ben Gamari at 2020-11-30T10:15:58-05:00 rts/linker: Replace some ASSERTs with CHECK In the past some people have confused ASSERT, which is for checking internal invariants, which CHECK, which should be used when checking things that might fail due to bad input (and therefore should be enabled even in the release compiler). Change some of these cases in the linker to use CHECK. - - - - - 0f8a4655 by Ryan Scott at 2020-11-30T10:16:34-05:00 Allow deploy:pages job to fail See #18973. - - - - - 49ebe369 by chessai at 2020-11-30T19:47:40-05:00 Optimisations in Data.Foldable (T17867) This PR concerns the following functions from `Data.Foldable`: * minimum * maximum * sum * product * minimumBy * maximumBy - Default implementations of these functions now use `foldl'` or `foldMap'`. - All have been marked with INLINEABLE to make room for further optimisations. - - - - - 4d79ef65 by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - 6af074ce by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - ab334262 by Viktor Dukhovni at 2020-11-30T19:48:17-05:00 dirty MVAR after mutating TSO queue head While the original head and tail of the TSO queue may be in the same generation as the MVAR, interior elements of the queue could be younger after a GC run and may then be exposed by putMVar operation that updates the queue head. Resolves #18919 - - - - - 5eb163f3 by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Don't allow shared libraries to be loaded multiple times - - - - - 490aa14d by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Initialise CCSs from native shared objects - - - - - 6ac3db5f by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Move shared library loading logic into Elf.c - - - - - b6698d73 by GHC GitLab CI at 2020-11-30T19:48:53-05:00 rts/linker: Don't declare dynamic objects with image_mapped This previously resulted in warnings due to spurious unmap failures. - - - - - b94a65af by jneira at 2020-11-30T19:49:31-05:00 Include tried paths in findToolDir error - - - - - 72a87fbc by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Move core flattening algorithm to Core.Unify This sets the stage for a later change, where this algorithm will be needed from GHC.Core.InstEnv. This commit also splits GHC.Core.Map into GHC.Core.Map.Type and GHC.Core.Map.Expr, in order to avoid module import cycles with GHC.Core. - - - - - 0dd45d0a by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Bump the # of commits searched for perf baseline The previous value of 75 meant that a feature branch with more than 75 commits would get spurious CI passes. This affects #18692, but does not fix that ticket, because if a baseline cannot be found, we should fail, not succeed. - - - - - 8bb52d91 by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Remove flattening variables This patch redesigns the flattener to simplify type family applications directly instead of using flattening meta-variables and skolems. The key new innovation is the CanEqLHS type and the new CEqCan constraint (Ct). A CanEqLHS is either a type variable or exactly-saturated type family application; either can now be rewritten using a CEqCan constraint in the inert set. Because the flattener no longer reduces all type family applications to variables, there was some performance degradation if a lengthy type family application is now flattened over and over (not making progress). To compensate, this patch contains some extra optimizations in the flattener, leading to a number of performance improvements. Close #18875. Close #18910. There are many extra parts of the compiler that had to be affected in writing this patch: * The family-application cache (formerly the flat-cache) sometimes stores coercions built from Given inerts. When these inerts get kicked out, we must kick out from the cache as well. (This was, I believe, true previously, but somehow never caused trouble.) Kicking out from the cache requires adding a filterTM function to TrieMap. * This patch obviates the need to distinguish "blocking" coercion holes from non-blocking ones (which, previously, arose from CFunEqCans). There is thus some simplification around coercion holes. * Extra commentary throughout parts of the code I read through, to preserve the knowledge I gained while working. * A change in the pure unifier around unifying skolems with other types. Unifying a skolem now leads to SurelyApart, not MaybeApart, as documented in Note [Binding when looking up instances] in GHC.Core.InstEnv. * Some more use of MCoercion where appropriate. * Previously, class-instance lookup automatically noticed that e.g. C Int was a "unifier" to a target [W] C (F Bool), because the F Bool was flattened to a variable. Now, a little more care must be taken around checking for unifying instances. * Previously, tcSplitTyConApp_maybe would split (Eq a => a). This is silly, because (=>) is not a tycon in Haskell. Fixed now, but there are some knock-on changes in e.g. TrieMap code and in the canonicaliser. * New function anyFreeVarsOf{Type,Co} to check whether a free variable satisfies a certain predicate. * Type synonyms now remember whether or not they are "forgetful"; a forgetful synonym drops at least one argument. This is useful when flattening; see flattenView. * The pattern-match completeness checker invokes the solver. This invocation might need to look through newtypes when checking representational equality. Thus, the desugarer needs to keep track of the in-scope variables to know what newtype constructors are in scope. I bet this bug was around before but never noticed. * Extra-constraints wildcards are no longer simplified before printing. See Note [Do not simplify ConstraintHoles] in GHC.Tc.Solver. * Whether or not there are Given equalities has become slightly subtler. See the new HasGivenEqs datatype. * Note [Type variable cycles in Givens] in GHC.Tc.Solver.Canonical explains a significant new wrinkle in the new approach. * See Note [What might match later?] in GHC.Tc.Solver.Interact, which explains the fix to #18910. * The inert_count field of InertCans wasn't actually used, so I removed it. Though I (Richard) did the implementation, Simon PJ was very involved in design and review. This updates the Haddock submodule to avoid #18932 by adding a type signature. ------------------------- Metric Decrease: T12227 T5030 T9872a T9872b T9872c Metric Increase: T9872d ------------------------- - - - - - d66660ba by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Rename the flattener to become the rewriter. Now that flattening doesn't produce flattening variables, it's not really flattening anything: it's rewriting. This change also means that the rewriter can no longer be confused the core flattener (in GHC.Core.Unify), which is sometimes used during type-checking. - - - - - add0aeae by Ben Gamari at 2020-12-01T19:58:17-05:00 rts: Introduce mmapAnonForLinker Previously most of the uses of mmapForLinker were mapping anonymous memory, resulting in a great deal of unnecessary repetition. Factor this out into a new helper. Also fixes a few places where error checking was missing or suboptimal. - - - - - 97d71646 by Ben Gamari at 2020-12-01T19:58:17-05:00 rts/linker: Introduce munmapForLinker Consolidates munmap calls to ensure consistent error handling. - - - - - d8872af0 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/Linker: Introduce Windows implementations for mmapForLinker, et al. - - - - - c35d0e03 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/m32: Introduce NEEDS_M32 macro Instead of relying on RTS_LINKER_USE_MMAP - - - - - 41c64eb5 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/linker: Use m32 to allocate symbol extras in PEi386 - - - - - e0b08c5f by Ben Gamari at 2020-12-03T13:01:47-05:00 gitlab-ci: Fix copy-paste error Also be more consistent in quoting. - - - - - 33ec3a06 by Ben Gamari at 2020-12-03T23:11:31-05:00 gitlab-ci: Run linters through ci.sh Ensuring that the right toolchain is used. - - - - - 4a437bc1 by Shayne Fletcher at 2020-12-05T09:06:38-05:00 Fix bad span calculations of post qualified imports - - - - - 8fac4b93 by Ben Gamari at 2020-12-05T09:07:13-05:00 testsuite: Add a test for #18923 - - - - - 62ed6957 by Simon Peyton Jones at 2020-12-08T15:31:41-05:00 Fix kind inference for data types. Again. This patch fixes several aspects of kind inference for data type declarations, especially data /instance/ declarations Specifically 1. In kcConDecls/kcConDecl make it clear that the tc_res_kind argument is only used in the H98 case; and in that case there is no result kind signature; and hence no need for the disgusting splitPiTys in kcConDecls (now thankfully gone). The GADT case is a bit different to before, and much nicer. This is what fixes #18891. See Note [kcConDecls: kind-checking data type decls] 2. Do not look at the constructor decls of a data/newtype instance in tcDataFamInstanceHeader. See GHC.Tc.TyCl.Instance Note [Kind inference for data family instances]. This was a new realisation that arose when doing (1) This causes a few knock-on effects in the tests suite, because we require more information than before in the instance /header/. New user-manual material about this in "Kind inference in data type declarations" and "Kind inference for data/newtype instance declarations". 3. Minor improvement in kcTyClDecl, combining GADT and H98 cases 4. Fix #14111 and #8707 by allowing the header of a data instance to affect kind inferece for the the data constructor signatures; as described at length in Note [GADT return types] in GHC.Tc.TyCl This led to a modest refactoring of the arguments (and argument order) of tcConDecl/tcConDecls. 5. Fix #19000 by inverting the sense of the test in new_locs in GHC.Tc.Solver.Canonical.canDecomposableTyConAppOK. - - - - - 0abe3ddf by Adam Sandberg Ericsson at 2020-12-08T15:32:19-05:00 hadrian: build the _l and _thr_l rts flavours in the develN flavours The ghc binary requires the eventlog rts since fc644b1a643128041cfec25db84e417851e28bab - - - - - 51e3bb6d by Andreas Klebinger at 2020-12-08T22:43:21-05:00 CodeGen: Make folds User/DefinerOfRegs INLINEABLE. Reduces allocation for the test case I was looking at by about 1.2%. Mostly from avoiding allocation of some folding functions which turn into let-no-escape bindings which just reuse their environment instead. We also force inlining in a few key places in CmmSink which helps a bit more. - - - - - 69ae10c3 by Andreas Klebinger at 2020-12-08T22:43:21-05:00 CmmSink: Force inlining of foldRegsDefd Helps avoid allocating the folding function. Improves perf for T3294 by about 1%. - - - - - 6e3da800 by Andreas Klebinger at 2020-12-08T22:43:21-05:00 Cmm: Make a few types and utility function slightly stricter. About 0.6% reduction in allocations for the code I was looking at. Not a huge difference but no need to throw away performance. - - - - - aef44d7f by Andreas Klebinger at 2020-12-08T22:43:21-05:00 Cmm.Sink: Optimize retaining of assignments, live sets. Sinking requires us to track live local regs after each cmm statement. We used to do this via "Set LocalReg". However we can replace this with a solution based on IntSet which is overall more efficient without losing much. The thing we lose is width of the variables, which isn't used by the sinking pass anyway. I also reworked how we keep assignments to regs mentioned in skipped assignments. I put the details into Note [Keeping assignemnts mentioned in skipped RHSs]. The gist of it is instead of keeping track of it via the use count which is a `IntMap Int` we now use the live regs set (IntSet) which is quite a bit faster. I think it also matches the semantics a lot better. The skipped (not discarded) assignment does in fact keep the regs on it's rhs alive so keeping track of this in the live set seems like the clearer solution as well. Improves allocations for T3294 by yet another 1%. - - - - - 59f2249b by Andreas Klebinger at 2020-12-08T22:43:21-05:00 GHC.Cmm.Opt: Be stricter in results. Optimization either returns Nothing if nothing is to be done or `Just <cmmExpr>` otherwise. There is no point in being lazy in `cmmExpr`. We usually inspect this element so the thunk gets forced not long after. We might eliminate it as dead code once in a blue moon but that's not a case worth optimizing for. Overall the impact of this is rather low. As Cmm.Opt doesn't allocate much (compared to the rest of GHC) to begin with. - - - - - 54b88eac by Andreas Klebinger at 2020-12-08T22:43:57-05:00 Bump time submodule. This should fix #19002. - - - - - 35e7b0c6 by Kirill Elagin at 2020-12-10T01:45:54-05:00 doc: Clarify the default for -fomit-yields “Yield points enabled” is confusing (and probably wrong? I am not 100% sure what it means). Change it to a simple “on”. Undo this change from 2c23fff2e03e77187dc4d01f325f5f43a0e7cad2. - - - - - 3551c554 by Kirill Elagin at 2020-12-10T01:45:54-05:00 doc: Extra-clarify -fomit-yields Be more clear on what this optimisation being on by default means in terms of yields. - - - - - 6484f0d7 by Sergei Trofimovich at 2020-12-10T01:46:33-05:00 rts/linker/Elf.c: add missing <dlfcn.h> include (musl support) The change fixes build failure on musl: ``` rts/linker/Elf.c:2031:3: error: warning: implicit declaration of function 'dlclose'; did you mean 'close'? [-Wimplicit-function-declaration] 2031 | dlclose(nc->dlopen_handle); | ^~~~~~~ | close ``` Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - ab24ed9b by Ben Gamari at 2020-12-11T03:55:51-05:00 users guide: Fix syntax errors Fixes errors introduced by 3a55b3a2574f913d046f3a6f82db48d7f6df32e3. - - - - - d3a24d31 by Ben Gamari at 2020-12-11T03:55:51-05:00 users guide: Describe GC lifecycle events Every time I am asked about how to interpret these events I need to figure it out from scratch. It's well past time that the users guide properly documents these. - - - - - 741309b9 by Ben Gamari at 2020-12-11T03:56:27-05:00 gitlab-ci: Fix incorrect Docker image for nightly cross job Also refactor the job definition to eliminate the bug by construction. - - - - - 19703bc8 by Ben Gamari at 2020-12-11T03:56:27-05:00 gitlab-ci: Fix name of flavour in ThreadSanitizer job It looks like I neglected to update this after introduce flavour transformers. - - - - - 381eb660 by Sylvain Henry at 2020-12-11T12:57:35-05:00 Display FFI labels (fix #18539) - - - - - 4548d1f8 by Aaron Allen at 2020-12-11T12:58:14-05:00 Elide extraneous messages for :doc command (#15784) Do not print `<has no documentation>` alongside a valid doc. Additionally, if two matching symbols lack documentation then the message will only be printed once. Hence, `<has no documentation>` will be printed at most once and only if all matching symbols are lacking docs. - - - - - 5eba91b6 by Aaron Allen at 2020-12-11T12:58:14-05:00 Add :doc test case for duplicate record fields Tests that the output of the `:doc` command is correct for duplicate record fields defined using -XDuplicateRecordFields. - - - - - 5feb9b2d by Ryan Scott at 2020-12-11T22:39:29-05:00 Delete outdated Note [Kind-checking tyvar binders for associated types] This Note has severely bitrotted, as it has no references anywhere in the codebase, and none of the functions that it mentions exist anymore. Let's just delete this. While I was in town, I deleted some outdated comments from `checkFamPatBinders` of a similar caliber. Fixes #19008. [ci skip] - - - - - f9f9f030 by Sylvain Henry at 2020-12-11T22:40:08-05:00 Arrows: correctly query arrow methods (#17423) Consider the following code: proc (C x y) -> ... Before this patch, the evidence binding for the Arrow dictionary was attached to the C pattern: proc (C x y) { $dArrow = ... } -> ... But then when we desugar this, we use arrow operations ("arr", ">>>"...) specialised for this arrow: let arr_xy = arr $dArrow -- <-- Not in scope! ... in arr_xy (\(C x y) { $dArrow = ... } -> ...) This patch allows arrow operations to be type-checked before the proc itself, avoiding this issue. Fix #17423 - - - - - aaa8f00f by Sylvain Henry at 2020-12-11T22:40:48-05:00 Validate script: fix configure command when using stack - - - - - b4a929a1 by Sylvain Henry at 2020-12-11T22:41:30-05:00 Hadrian: fix libffi tarball parsing Fix parsing of "libffi-3.3.tar.gz". NB: switch to a newer libffi isn't done in this patch - - - - - 690c8946 by Sylvain Henry at 2020-12-11T22:42:09-05:00 Parser: move parser utils into their own module Move code unrelated to runtime evaluation out of GHC.Runtime.Eval - - - - - 76be0e32 by Sylvain Henry at 2020-12-11T22:42:48-05:00 Move SizedSeq into ghc-boot - - - - - 3a16d764 by Sylvain Henry at 2020-12-11T22:42:48-05:00 ghci: don't compile unneeded modules - - - - - 2895fa60 by Sylvain Henry at 2020-12-11T22:42:48-05:00 ghci: reuse Arch from ghc-boot - - - - - 480a38d4 by Sylvain Henry at 2020-12-11T22:43:30-05:00 rts: don't use siginterrupt (#19019) - - - - - 4af6126d by Sylvain Henry at 2020-12-11T22:44:11-05:00 Use static array in zeroCount - - - - - 5bd71bfd by Sebastian Graf at 2020-12-12T04:45:09-05:00 DmdAnal: Annotate top-level function bindings with demands (#18894) It's useful to annotate a non-exported top-level function like `g` in ```hs module Lib (h) where g :: Int -> Int -> (Int,Int) g m 1 = (m, 0) g m n = (2 * m, 2 `div` n) {-# NOINLINE g #-} h :: Int -> Int h 1 = 0 h m | odd m = snd (g m 2) | otherwise = uncurry (+) (g 2 m) ``` with its demand `UCU(CS(P(1P(U),SP(U))`, which tells us that whenever `g` was called, the second component of the returned pair was evaluated strictly. Since #18903 we do so for local functions, where we can see all calls. For top-level functions, we can assume that all *exported* functions are demanded according to `topDmd` and thus get sound demands for non-exported top-level functions. The demand on `g` is crucial information for Nested CPR, which may the go on and unbox `g` for the second pair component. That is true even if that pair component may diverge, as is the case for the call site `g 13 0`, which throws a div-by-zero exception. In `T18894b`, you can even see the new demand annotation enabling us to eta-expand a function that we wouldn't be able to eta-expand without Call Arity. We only track bindings of function type in order not to risk huge compile-time regressions, see `isInterestingTopLevelFn`. There was a CoreLint check that rejected strict demand annotations on recursive or top-level bindings, which seems completely unjustified. All the cases I investigated were fine, so I removed it. Fixes #18894. - - - - - 3aae036e by Sebastian Graf at 2020-12-12T04:45:09-05:00 Demand: Simplify `CU(U)` to `U` (#19005) Both sub-demands encode the same information. This is a trivial change and already affects a few regression tests (e.g. `T5075`), so no separate regression test is necessary. - - - - - c6477639 by Adam Sandberg Ericsson at 2020-12-12T04:45:48-05:00 hadrian: correctly copy the docs dir into the bindist #18669 - - - - - f752e884 by Sebastian Graf at 2020-12-12T11:16:18+01:00 DmdAnal: Keep alive RULE vars in LetUp (#18971) I also took the liberty to refactor the logic around `ruleFVs`. - - - - - 401618b9 by Sebastian Graf at 2020-12-12T11:16:18+01:00 WorkWrap: Unbox constructors with existentials (#18982) I found that by relaxing the "no existential" checks in `isDataProductType_maybe` and `isDataSumType_maybe`, the former becomes identical to `tyConSingleAlgDataCon_maybe`. So I deleted both and introduced a new function, `tyConAlgDataCons_maybe` for the sum case. I cleaned up a couple of call sites, some of which weren't very explicit about whether they cared for existentials or not. Most of the new stuff happens in worker/wrapper, where handling of existentials means a bit of substitution work carried out by `GHC.Core.Utils.dataConRepFSInstPat`. The test output of `T18013` changed, because we now unbox the `Rule` data type. Its constructor carries existential state and will be w/w'd now. In the particular example, the worker functions inlines right back into the wrapper, which then unnecessarily has a (quite big) stable unfolding. I think this kind of fallout is inevitable; see also Note [Don't w/w inline small non-loop-breaker things]. There's a new regression test case `T18982`. Fixes #18982. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Expr.hs - + compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Liveness.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/Reg/Graph.hs - compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Axiom.hs - compiler/GHC/Core/Coercion/Opt.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/eda02f1eb2d90464cd09551ea2bb6e6cc98e7e98...401618b9859a819f55112031515e01742d81b942 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/eda02f1eb2d90464cd09551ea2bb6e6cc98e7e98...401618b9859a819f55112031515e01742d81b942 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Dec 12 17:08:02 2020 From: gitlab at gitlab.haskell.org (John Ericson) Date: Sat, 12 Dec 2020 12:08:02 -0500 Subject: [Git][ghc/ghc][wip/primop-naming-consistency] 21 commits: users guide: Fix syntax errors Message-ID: <5fd4f8f29eb85_6b2174471c1258398@gitlab.mail> John Ericson pushed to branch wip/primop-naming-consistency at Glasgow Haskell Compiler / GHC Commits: ab24ed9b by Ben Gamari at 2020-12-11T03:55:51-05:00 users guide: Fix syntax errors Fixes errors introduced by 3a55b3a2574f913d046f3a6f82db48d7f6df32e3. - - - - - d3a24d31 by Ben Gamari at 2020-12-11T03:55:51-05:00 users guide: Describe GC lifecycle events Every time I am asked about how to interpret these events I need to figure it out from scratch. It's well past time that the users guide properly documents these. - - - - - 741309b9 by Ben Gamari at 2020-12-11T03:56:27-05:00 gitlab-ci: Fix incorrect Docker image for nightly cross job Also refactor the job definition to eliminate the bug by construction. - - - - - 19703bc8 by Ben Gamari at 2020-12-11T03:56:27-05:00 gitlab-ci: Fix name of flavour in ThreadSanitizer job It looks like I neglected to update this after introduce flavour transformers. - - - - - 381eb660 by Sylvain Henry at 2020-12-11T12:57:35-05:00 Display FFI labels (fix #18539) - - - - - 4548d1f8 by Aaron Allen at 2020-12-11T12:58:14-05:00 Elide extraneous messages for :doc command (#15784) Do not print `<has no documentation>` alongside a valid doc. Additionally, if two matching symbols lack documentation then the message will only be printed once. Hence, `<has no documentation>` will be printed at most once and only if all matching symbols are lacking docs. - - - - - 5eba91b6 by Aaron Allen at 2020-12-11T12:58:14-05:00 Add :doc test case for duplicate record fields Tests that the output of the `:doc` command is correct for duplicate record fields defined using -XDuplicateRecordFields. - - - - - 5feb9b2d by Ryan Scott at 2020-12-11T22:39:29-05:00 Delete outdated Note [Kind-checking tyvar binders for associated types] This Note has severely bitrotted, as it has no references anywhere in the codebase, and none of the functions that it mentions exist anymore. Let's just delete this. While I was in town, I deleted some outdated comments from `checkFamPatBinders` of a similar caliber. Fixes #19008. [ci skip] - - - - - f9f9f030 by Sylvain Henry at 2020-12-11T22:40:08-05:00 Arrows: correctly query arrow methods (#17423) Consider the following code: proc (C x y) -> ... Before this patch, the evidence binding for the Arrow dictionary was attached to the C pattern: proc (C x y) { $dArrow = ... } -> ... But then when we desugar this, we use arrow operations ("arr", ">>>"...) specialised for this arrow: let arr_xy = arr $dArrow -- <-- Not in scope! ... in arr_xy (\(C x y) { $dArrow = ... } -> ...) This patch allows arrow operations to be type-checked before the proc itself, avoiding this issue. Fix #17423 - - - - - aaa8f00f by Sylvain Henry at 2020-12-11T22:40:48-05:00 Validate script: fix configure command when using stack - - - - - b4a929a1 by Sylvain Henry at 2020-12-11T22:41:30-05:00 Hadrian: fix libffi tarball parsing Fix parsing of "libffi-3.3.tar.gz". NB: switch to a newer libffi isn't done in this patch - - - - - 690c8946 by Sylvain Henry at 2020-12-11T22:42:09-05:00 Parser: move parser utils into their own module Move code unrelated to runtime evaluation out of GHC.Runtime.Eval - - - - - 76be0e32 by Sylvain Henry at 2020-12-11T22:42:48-05:00 Move SizedSeq into ghc-boot - - - - - 3a16d764 by Sylvain Henry at 2020-12-11T22:42:48-05:00 ghci: don't compile unneeded modules - - - - - 2895fa60 by Sylvain Henry at 2020-12-11T22:42:48-05:00 ghci: reuse Arch from ghc-boot - - - - - 480a38d4 by Sylvain Henry at 2020-12-11T22:43:30-05:00 rts: don't use siginterrupt (#19019) - - - - - 4af6126d by Sylvain Henry at 2020-12-11T22:44:11-05:00 Use static array in zeroCount - - - - - 5bd71bfd by Sebastian Graf at 2020-12-12T04:45:09-05:00 DmdAnal: Annotate top-level function bindings with demands (#18894) It's useful to annotate a non-exported top-level function like `g` in ```hs module Lib (h) where g :: Int -> Int -> (Int,Int) g m 1 = (m, 0) g m n = (2 * m, 2 `div` n) {-# NOINLINE g #-} h :: Int -> Int h 1 = 0 h m | odd m = snd (g m 2) | otherwise = uncurry (+) (g 2 m) ``` with its demand `UCU(CS(P(1P(U),SP(U))`, which tells us that whenever `g` was called, the second component of the returned pair was evaluated strictly. Since #18903 we do so for local functions, where we can see all calls. For top-level functions, we can assume that all *exported* functions are demanded according to `topDmd` and thus get sound demands for non-exported top-level functions. The demand on `g` is crucial information for Nested CPR, which may the go on and unbox `g` for the second pair component. That is true even if that pair component may diverge, as is the case for the call site `g 13 0`, which throws a div-by-zero exception. In `T18894b`, you can even see the new demand annotation enabling us to eta-expand a function that we wouldn't be able to eta-expand without Call Arity. We only track bindings of function type in order not to risk huge compile-time regressions, see `isInterestingTopLevelFn`. There was a CoreLint check that rejected strict demand annotations on recursive or top-level bindings, which seems completely unjustified. All the cases I investigated were fine, so I removed it. Fixes #18894. - - - - - 3aae036e by Sebastian Graf at 2020-12-12T04:45:09-05:00 Demand: Simplify `CU(U)` to `U` (#19005) Both sub-demands encode the same information. This is a trivial change and already affects a few regression tests (e.g. `T5075`), so no separate regression test is necessary. - - - - - c6477639 by Adam Sandberg Ericsson at 2020-12-12T04:45:48-05:00 hadrian: correctly copy the docs dir into the bindist #18669 - - - - - ef1fa440 by Sylvain Henry at 2020-12-12T17:05:31+00:00 Fix array and cleanup conversion primops (#19026) The first change makes the array ones use the proper fixed-size types, which also means that just like before, they can be used without explicit conversions with the boxed sized types. (Before, it was Int# / Word# on both sides, now it is fixed sized on both sides). For the second change, don't use "extend" or "narrow" in some of the user-facing primops names for conversions. - Names like `narrowInt32#` are misleading when `Int` is 32-bits. - Names like `extendInt64#` are flat-out wrong when `Int is 32-bits. - `narrow{Int,Word}<N>#` however map a type to itself, and so don't suffer from this problem. They are left as-is. These changes are batched together because Alex happend to use the array ops. We can only use released versions of Alex at this time, sadly, and I don't want to have to have a release thatwon't work for the final GHC 9.2. So by combining these we get all the changes for Alex done at once. Bump Cabal, array, bytestring, text, and binary submodules TODO bump alex version - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC.hs - compiler/GHC/Builtin/bytearray-ops.txt.pp - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Data/FastString.hs - + compiler/GHC/Parser/Utils.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Gen/Arrow.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Demand.hs - compiler/GHC/Types/ForeignCall.hs - compiler/GHC/Types/Id/Info.hs - compiler/ghc.cabal.in - docs/users_guide/eventlog-formats.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9425fabffa0901f7c2f670b65f40e9e59e0d66bc...ef1fa44040d877a6f6200d7b8c1560c44aa19eca -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9425fabffa0901f7c2f670b65f40e9e59e0d66bc...ef1fa44040d877a6f6200d7b8c1560c44aa19eca You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Dec 12 18:15:22 2020 From: gitlab at gitlab.haskell.org (Alan Zimmerman) Date: Sat, 12 Dec 2020 13:15:22 -0500 Subject: [Git][ghc/ghc][wip/az/exactprint] WIP on delta printing. Message-ID: <5fd508ba92e3c_6b2131d5c3812619bf@gitlab.mail> Alan Zimmerman pushed to branch wip/az/exactprint at Glasgow Haskell Compiler / GHC Commits: 79d2ce81 by Alan Zimmerman at 2020-12-12T18:15:02+00:00 WIP on delta printing. Making progress - - - - - 30 changed files: - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/ThToHs.hs - libraries/Cabal - libraries/directory - libraries/hpc - libraries/time - libraries/unix - testsuite/tests/ghc-api/annotations/InTreeAnnotations1.stderr - testsuite/tests/parser/should_compile/DumpParsedAst.stderr - testsuite/tests/parser/should_compile/DumpRenamedAst.stderr - testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr - testsuite/tests/parser/should_compile/KindSigs.stderr - testsuite/tests/printer/Ppr001.hs - testsuite/tests/printer/Ppr004.hs - testsuite/tests/printer/Ppr024.hs - testsuite/tests/printer/Ppr025.hs - utils/check-exact/Main.hs - utils/check-exact/Test.hs - + utils/check-exact/cases/LayoutIn1.hs - + utils/check-exact/cases/LayoutIn3.expected.hs - + utils/check-exact/cases/LayoutIn3.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/79d2ce81d3776385dd4e75506d73f230f0f31372 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/79d2ce81d3776385dd4e75506d73f230f0f31372 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Dec 12 19:43:53 2020 From: gitlab at gitlab.haskell.org (John Ericson) Date: Sat, 12 Dec 2020 14:43:53 -0500 Subject: [Git][ghc/ghc][wip/primop-naming-consistency] Fix array and cleanup conversion primops (#19026) Message-ID: <5fd51d7966647_6b215ab2cc8126923e@gitlab.mail> John Ericson pushed to branch wip/primop-naming-consistency at Glasgow Haskell Compiler / GHC Commits: dc7171ee by Sylvain Henry at 2020-12-12T19:32:31+00:00 Fix array and cleanup conversion primops (#19026) The first change makes the array ones use the proper fixed-size types, which also means that just like before, they can be used without explicit conversions with the boxed sized types. (Before, it was Int# / Word# on both sides, now it is fixed sized on both sides). For the second change, don't use "extend" or "narrow" in some of the user-facing primops names for conversions. - Names like `narrowInt32#` are misleading when `Int` is 32-bits. - Names like `extendInt64#` are flat-out wrong when `Int is 32-bits. - `narrow{Int,Word}<N>#` however map a type to itself, and so don't suffer from this problem. They are left as-is. These changes are batched together because Alex happend to use the array ops. We can only use released versions of Alex at this time, sadly, and I don't want to have to have a release thatwon't work for the final GHC 9.2. So by combining these we get all the changes for Alex done at once. Bump Cabal, array, bytestring, text, and binary submodules TODO bump alex version - - - - - 30 changed files: - compiler/GHC/Builtin/bytearray-ops.txt.pp - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Data/FastString.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/Tc/Deriv/Generate.hs - libraries/Cabal - libraries/array - libraries/base/GHC/Float/ConversionUtils.hs - libraries/base/GHC/IO/Encoding/CodePage.hs - libraries/base/GHC/IO/Encoding/UTF16.hs - libraries/base/GHC/IO/Encoding/UTF32.hs - libraries/base/GHC/IO/Encoding/UTF8.hs - libraries/base/GHC/Int.hs - libraries/base/GHC/Storable.hs - libraries/base/GHC/Word.hs - libraries/binary - libraries/bytestring - libraries/ghc-bignum/src/GHC/Num/Backend/GMP.hs - libraries/ghc-bignum/src/GHC/Num/Primitives.hs - libraries/ghc-boot/GHC/Utils/Encoding.hs - libraries/ghc-heap/tests/tso_and_stack_closures.hs - libraries/ghci/GHCi/BreakArray.hs - libraries/text - testsuite/tests/array/should_run/arr020.hs - testsuite/tests/cmm/opt/T18141.hs - testsuite/tests/codeGen/should_compile/T18614.hs - testsuite/tests/codeGen/should_run/cgrun070.hs - testsuite/tests/codeGen/should_run/cgrun072.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dc7171ee7d5e26c2b2fe57b4cdf99cd5d58e1e88 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dc7171ee7d5e26c2b2fe57b4cdf99cd5d58e1e88 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Dec 13 00:24:52 2020 From: gitlab at gitlab.haskell.org (John Ericson) Date: Sat, 12 Dec 2020 19:24:52 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/remove-travis Message-ID: <5fd55f54bedcd_6b215b9af781283994@gitlab.mail> John Ericson pushed new branch wip/remove-travis at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/remove-travis You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Dec 13 00:25:25 2020 From: gitlab at gitlab.haskell.org (John Ericson) Date: Sat, 12 Dec 2020 19:25:25 -0500 Subject: [Git][ghc/ghc][wip/remove-travis] Remove old .travis.yml Message-ID: <5fd55f7530cca_6b215b9af7812841b3@gitlab.mail> John Ericson pushed to branch wip/remove-travis at Glasgow Haskell Compiler / GHC Commits: 3e711f9a by John Ericson at 2020-12-13T00:25:17+00:00 Remove old .travis.yml - - - - - 1 changed file: - − .travis.yml Changes: ===================================== .travis.yml deleted ===================================== @@ -1,61 +0,0 @@ -# The following enables container-based travis instances -sudo: false - -git: - submodules: false - -env: - - DEBUG_STAGE2=YES - - DEBUG_STAGE2=NO - -# TODO. Install llvm once llvm's APT repository is working again. -# See http://lists.llvm.org/pipermail/llvm-dev/2016-May/100303.html. -addons: - apt: - sources: - - hvr-ghc - #- llvm-toolchain-precise-3.7 - - ubuntu-toolchain-r-test - packages: - - cabal-install-2.2 - - ghc-8.4.3 - - alex-3.1.7 - - happy-1.19.5 - - python3 - #- llvm-3.7 - -before_install: - - export PATH=/opt/ghc/8.4.3/bin:/opt/cabal/2.2/bin:/opt/alex/3.1.7/bin:/opt/happy/1.19.5/bin:/usr/lib/llvm-3.7/bin:$PATH - -# Be explicit about which protocol to use, such that we don't have to repeat the rewrite command for each. - - git config remote.origin.url git://github.com/${TRAVIS_REPO_SLUG}.git - - git config --global url."git://github.com/${TRAVIS_REPO_SLUG%/*}/packages-".insteadOf "git://github.com/${TRAVIS_REPO_SLUG%/*}/packages/" - - git submodule --quiet init # Be quiet about these urls, as we may override them later. - -# Check if submodule repositories exist. - - git config --get-regexp submodule.*.url | while read entry url; do git ls-remote "$url" dummyref 2>/dev/null && echo "$entry = $url" || git config --unset-all "$entry" ; done - -# Use github.com/ghc for those submodule repositories we couldn't connect to. - - git config remote.origin.url git://github.com/ghc/ghc.git - - git config --global url."git://github.com/ghc/packages-".insteadOf git://github.com/ghc/packages/ - - git submodule init # Don't be quiet, we want to show these urls. - - git submodule --quiet update --recursive # Now we can be quiet again. - -script: - # do not build docs - - echo 'HADDOCK_DOCS = NO' >> mk/validate.mk - - echo 'BUILD_SPHINX_HTML = NO' >> mk/validate.mk - - echo 'BUILD_SPHINX_PDF = NO' >> mk/validate.mk - # do not build dynamic libraries - - echo 'DYNAMIC_GHC_PROGRAMS = NO' >> mk/validate.mk - - echo 'GhcLibWays = v' >> mk/validate.mk - - if [ "$DEBUG_STAGE2" = "YES" ]; then echo 'GhcStage2HcOpts += -DDEBUG' >> mk/validate.mk; fi - # * Use --quiet, otherwise the build log might exceed the limit of 4 - # megabytes, causing Travis to kill our job. - # * But use VERBOSE=2 (the default, but not when using --quiet) otherwise - # the testsuite might not print output for over 10 minutes (more likely so - # when DEBUG_STAGE2=NO), causing Travis to again kill our job. - # * Use --fast, to stay within the time limits set by Travis. - # See Note [validate and testsuite speed] in toplevel Makefile. - # Actually, do not run test suite. Takes too long. - - THREADS=3 SKIP_PERF_TESTS=YES VERBOSE=2 ./validate --fast --quiet --build-only View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3e711f9a0ff31699dcd7bd7b9d1c0f795126129e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3e711f9a0ff31699dcd7bd7b9d1c0f795126129e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Dec 13 02:15:56 2020 From: gitlab at gitlab.haskell.org (Shayne Fletcher) Date: Sat, 12 Dec 2020 21:15:56 -0500 Subject: [Git][ghc/ghc][wip/T18599] Prepare for disambiguation on RebindableSyntax Message-ID: <5fd5795cc2180_6b2150168501286076@gitlab.mail> Shayne Fletcher pushed to branch wip/T18599 at Glasgow Haskell Compiler / GHC Commits: f3c53246 by Shayne Fletcher at 2020-12-12T21:15:36-05:00 Prepare for disambiguation on RebindableSyntax - - - - - 6 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Types/Origin.hs Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -494,8 +494,12 @@ data HsExpr p gf_ext :: XGetField p , gf_expr :: LHsExpr p , gf_field :: Located FastString + , gf_get_field :: Maybe (IdP p) , gf_getField :: LHsExpr p -- Desugared equivalent 'getField' term. } + -- ^ @Just id@ means @RebindableSyntax@ is in use and gives the id + -- of the in-scope 'getField'. + -- NB: Not in use after typechecking. -- Record dot update e.g. @a{foo.bar.baz=1, quux}@. -- @@ -510,8 +514,12 @@ data HsExpr p rdupd_ext :: XRecordDotUpd p , rdupd_expr :: LHsExpr p , rdupd_upds :: [LHsRecUpdProj p] + , rdupd_get_set_field :: Maybe (IdP p, IdP p) , rdupd_setField :: LHsExpr p -- Desugared equivalent 'setField' term. } + -- ^ @Just id@ means @RebindableSyntax@ is in use and gives the ids + -- of the in-scope 'getField' and 'setField'. + -- NB: Not in use after typechecking. -- | Record field selector. e.g. @(.x)@ or @(.x.y)@ -- @@ -524,8 +532,12 @@ data HsExpr p | Projection { proj_ext :: XProjection p , proj_flds :: [Located FastString] + , proj_get_field :: Maybe (IdP p) , proj_proj :: LHsExpr p -- Desugared equivalent 'getField' term. } + -- ^ @Just id@ means @RebindableSyntax@ is in use and gives the id + -- of the in-scope 'getField'. + -- NB: Not in use after typechecking. -- | Expression with an explicit type signature. @e :: type@ -- ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -1154,9 +1154,9 @@ instance HiePass p => ToHie (Located (HsExpr (GhcPass p))) where HsSpliceE _ x -> [ toHie $ L mspan x ] - GetField _ _ _ g -> [ toHie $ L mspan (unLoc g) ] - Projection _ _ p -> [ toHie $ L mspan (unLoc p) ] - RecordDotUpd _ _ _ u -> [ toHie $ L mspan (unLoc u) ] + GetField {} -> [] + Projection {} -> [] + RecordDotUpd {} -> [] XExpr x | GhcTc <- ghcPass @p , WrapExpr (HsWrap w a) <- x ===================================== compiler/GHC/Parser/PostProcess.hs ===================================== @@ -2198,7 +2198,9 @@ mkRdrRecordDotUpd dot exp@(L _ _) fbinds = rdupd_ext = noExtField , rdupd_expr = exp , rdupd_upds = updates - , rdupd_setField = setField } + , rdupd_get_set_field = Nothing + , rdupd_setField = setField + } where toProjUpdates :: [Fbind (HsExpr GhcPs)] -> [LHsRecUpdProj GhcPs] toProjUpdates = map (\case { Pbind p -> p @@ -2760,6 +2762,7 @@ mkGetField loc arg field = gf_ext = noExtField , gf_expr = arg , gf_field = field + , gf_get_field = Nothing , gf_getField = mkGet arg field } @@ -2769,6 +2772,7 @@ mkProjection loc flds = L loc Projection { proj_ext = noExtField , proj_flds = flds + , proj_get_field = Nothing , proj_proj = mkProj flds } ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -212,22 +212,22 @@ rnExpr (NegApp _ e _) ------------------------------------------ -- Record dot syntax -rnExpr (GetField x e f g) +rnExpr (GetField x e f _ g) = do { (e', _) <- rnLExpr e ; (g', fv) <- rnLExpr g - ; return (GetField x e' f g', fv) + ; return (GetField x e' f Nothing g', fv) } -rnExpr (Projection x fs p) +rnExpr (Projection x fs _ p) = do { (p', fv) <- rnLExpr p - ; return (Projection x fs p', fv) + ; return (Projection x fs Nothing p', fv) } -rnExpr (RecordDotUpd x e us f) +rnExpr (RecordDotUpd x e us _ f) = do { (e', _) <- rnLExpr e ; us' <- map fst <$> mapM rnRecUpdProj us ; (f', fv) <- rnLExpr f - ; return (RecordDotUpd x e' us' f', fv) + ; return (RecordDotUpd x e' us' Nothing f', fv) } where rnRecUpdProj :: LHsRecUpdProj GhcPs -> RnM (LHsRecUpdProj GhcRn, FreeVars) ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -934,9 +934,9 @@ tcExpr (ArithSeq _ witness seq) res_ty * * ************************************************************************ -} -tcExpr (GetField _ _ _ (L _ g)) res_ty = tcExpr g res_ty -tcExpr (Projection _ _ (L _ p)) res_ty = tcExpr p res_ty -tcExpr (RecordDotUpd _ _ _ (L _ s)) res_ty = tcExpr s res_ty +tcExpr (GetField _ _ _ _ (L _ g)) res_ty = tcExpr g res_ty +tcExpr (Projection _ _ _ (L _ p)) res_ty = tcExpr p res_ty +tcExpr (RecordDotUpd _ _ _ _ (L _ s)) res_ty = tcExpr s res_ty {- ************************************************************************ ===================================== compiler/GHC/Tc/Types/Origin.hs ===================================== @@ -493,8 +493,8 @@ exprCtOrigin (HsAppType _ e1 _) = lexprCtOrigin e1 exprCtOrigin (OpApp _ _ op _) = lexprCtOrigin op exprCtOrigin (NegApp _ e _) = lexprCtOrigin e exprCtOrigin (HsPar _ e) = lexprCtOrigin e -exprCtOrigin (GetField _ e _ _) = lexprCtOrigin e -exprCtOrigin (Projection _ _ _) = SectionOrigin +exprCtOrigin (GetField _ e _ _ _) = lexprCtOrigin e +exprCtOrigin (Projection _ _ _ _) = SectionOrigin exprCtOrigin (SectionL _ _ _) = SectionOrigin exprCtOrigin (SectionR _ _ _) = SectionOrigin exprCtOrigin (ExplicitTuple {}) = Shouldn'tHappenOrigin "explicit tuple" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f3c53246107862507f0d6553d7bb126e16af5613 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f3c53246107862507f0d6553d7bb126e16af5613 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Dec 13 06:24:19 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sun, 13 Dec 2020 01:24:19 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: DmdAnal: Annotate top-level function bindings with demands (#18894) Message-ID: <5fd5b3938188d_6b213272cb812992ea@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 5bd71bfd by Sebastian Graf at 2020-12-12T04:45:09-05:00 DmdAnal: Annotate top-level function bindings with demands (#18894) It's useful to annotate a non-exported top-level function like `g` in ```hs module Lib (h) where g :: Int -> Int -> (Int,Int) g m 1 = (m, 0) g m n = (2 * m, 2 `div` n) {-# NOINLINE g #-} h :: Int -> Int h 1 = 0 h m | odd m = snd (g m 2) | otherwise = uncurry (+) (g 2 m) ``` with its demand `UCU(CS(P(1P(U),SP(U))`, which tells us that whenever `g` was called, the second component of the returned pair was evaluated strictly. Since #18903 we do so for local functions, where we can see all calls. For top-level functions, we can assume that all *exported* functions are demanded according to `topDmd` and thus get sound demands for non-exported top-level functions. The demand on `g` is crucial information for Nested CPR, which may the go on and unbox `g` for the second pair component. That is true even if that pair component may diverge, as is the case for the call site `g 13 0`, which throws a div-by-zero exception. In `T18894b`, you can even see the new demand annotation enabling us to eta-expand a function that we wouldn't be able to eta-expand without Call Arity. We only track bindings of function type in order not to risk huge compile-time regressions, see `isInterestingTopLevelFn`. There was a CoreLint check that rejected strict demand annotations on recursive or top-level bindings, which seems completely unjustified. All the cases I investigated were fine, so I removed it. Fixes #18894. - - - - - 3aae036e by Sebastian Graf at 2020-12-12T04:45:09-05:00 Demand: Simplify `CU(U)` to `U` (#19005) Both sub-demands encode the same information. This is a trivial change and already affects a few regression tests (e.g. `T5075`), so no separate regression test is necessary. - - - - - c6477639 by Adam Sandberg Ericsson at 2020-12-12T04:45:48-05:00 hadrian: correctly copy the docs dir into the bindist #18669 - - - - - e033dd05 by Adam Sandberg Ericsson at 2020-12-12T10:52:19+00:00 mkDocs: support hadrian bindists #18973 - - - - - 9cc868bf by John Ericson at 2020-12-13T01:24:07-05:00 Remove old .travis.yml - - - - - 21 changed files: - − .travis.yml - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Types/Demand.hs - compiler/GHC/Types/Id/Info.hs - distrib/mkDocs/mkDocs - hadrian/src/Rules/BinaryDist.hs - testsuite/tests/arityanal/should_compile/Arity11.stderr - testsuite/tests/arityanal/should_compile/Arity16.stderr - + testsuite/tests/stranal/should_compile/T18894.hs - + testsuite/tests/stranal/should_compile/T18894.stderr - + testsuite/tests/stranal/should_compile/T18894b.hs - + testsuite/tests/stranal/should_compile/T18894b.stderr - testsuite/tests/stranal/should_compile/all.T - testsuite/tests/stranal/sigs/T5075.stderr Changes: ===================================== .travis.yml deleted ===================================== @@ -1,61 +0,0 @@ -# The following enables container-based travis instances -sudo: false - -git: - submodules: false - -env: - - DEBUG_STAGE2=YES - - DEBUG_STAGE2=NO - -# TODO. Install llvm once llvm's APT repository is working again. -# See http://lists.llvm.org/pipermail/llvm-dev/2016-May/100303.html. -addons: - apt: - sources: - - hvr-ghc - #- llvm-toolchain-precise-3.7 - - ubuntu-toolchain-r-test - packages: - - cabal-install-2.2 - - ghc-8.4.3 - - alex-3.1.7 - - happy-1.19.5 - - python3 - #- llvm-3.7 - -before_install: - - export PATH=/opt/ghc/8.4.3/bin:/opt/cabal/2.2/bin:/opt/alex/3.1.7/bin:/opt/happy/1.19.5/bin:/usr/lib/llvm-3.7/bin:$PATH - -# Be explicit about which protocol to use, such that we don't have to repeat the rewrite command for each. - - git config remote.origin.url git://github.com/${TRAVIS_REPO_SLUG}.git - - git config --global url."git://github.com/${TRAVIS_REPO_SLUG%/*}/packages-".insteadOf "git://github.com/${TRAVIS_REPO_SLUG%/*}/packages/" - - git submodule --quiet init # Be quiet about these urls, as we may override them later. - -# Check if submodule repositories exist. - - git config --get-regexp submodule.*.url | while read entry url; do git ls-remote "$url" dummyref 2>/dev/null && echo "$entry = $url" || git config --unset-all "$entry" ; done - -# Use github.com/ghc for those submodule repositories we couldn't connect to. - - git config remote.origin.url git://github.com/ghc/ghc.git - - git config --global url."git://github.com/ghc/packages-".insteadOf git://github.com/ghc/packages/ - - git submodule init # Don't be quiet, we want to show these urls. - - git submodule --quiet update --recursive # Now we can be quiet again. - -script: - # do not build docs - - echo 'HADDOCK_DOCS = NO' >> mk/validate.mk - - echo 'BUILD_SPHINX_HTML = NO' >> mk/validate.mk - - echo 'BUILD_SPHINX_PDF = NO' >> mk/validate.mk - # do not build dynamic libraries - - echo 'DYNAMIC_GHC_PROGRAMS = NO' >> mk/validate.mk - - echo 'GhcLibWays = v' >> mk/validate.mk - - if [ "$DEBUG_STAGE2" = "YES" ]; then echo 'GhcStage2HcOpts += -DDEBUG' >> mk/validate.mk; fi - # * Use --quiet, otherwise the build log might exceed the limit of 4 - # megabytes, causing Travis to kill our job. - # * But use VERBOSE=2 (the default, but not when using --quiet) otherwise - # the testsuite might not print output for over 10 minutes (more likely so - # when DEBUG_STAGE2=NO), causing Travis to again kill our job. - # * Use --fast, to stay within the time limits set by Travis. - # See Note [validate and testsuite speed] in toplevel Makefile. - # Actually, do not run test suite. Takes too long. - - THREADS=3 SKIP_PERF_TESTS=YES VERBOSE=2 ./validate --fast --quiet --build-only ===================================== compiler/GHC/Core/FVs.hs ===================================== @@ -525,12 +525,11 @@ ruleLhsFVIds (Rule { ru_bndrs = bndrs, ru_args = args }) = filterFV isLocalId $ addBndrs bndrs (exprs_fvs args) ruleRhsFreeIds :: CoreRule -> VarSet --- ^ This finds all locally-defined free Ids on the left hand side of a rule +-- ^ This finds all locally-defined free Ids on the right hand side of a rule -- and returns them as a non-deterministic set ruleRhsFreeIds (BuiltinRule {}) = emptyVarSet -ruleRhsFreeIds (Rule { ru_bndrs = bndrs, ru_args = args }) - = fvVarSet $ filterFV isLocalId $ - addBndrs bndrs $ exprs_fvs args +ruleRhsFreeIds (Rule { ru_bndrs = bndrs, ru_rhs = rhs }) + = fvVarSet $ filterFV isLocalId $ addBndrs bndrs $ expr_fvs rhs {- Note [Rule free var hack] (Not a hack any more) ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -624,14 +624,6 @@ lintLetBind top_lvl rec_flag binder rhs rhs_ty || exprIsTickedString rhs) (badBndrTyMsg binder (text "unlifted")) - -- Check that if the binder is top-level or recursive, it's not - -- demanded. Primitive string literals are exempt as there is no - -- computation to perform, see Note [Core top-level string literals]. - ; checkL (not (isStrictId binder) - || (isNonRec rec_flag && not (isTopLevel top_lvl)) - || exprIsTickedString rhs) - (mkStrictMsg binder) - -- Check that if the binder is at the top level and has type Addr#, -- that it is a string literal, see -- Note [Core top-level string literals]. @@ -3120,13 +3112,6 @@ badBndrTyMsg binder what = vcat [ text "The type of this binder is" <+> what <> colon <+> ppr binder , text "Binder's type:" <+> ppr (idType binder) ] -mkStrictMsg :: Id -> MsgDoc -mkStrictMsg binder - = vcat [hsep [text "Recursive or top-level binder has strict demand info:", - ppr binder], - hsep [text "Binder's demand info:", ppr (idDemandInfo binder)] - ] - mkNonTopExportedMsg :: Id -> MsgDoc mkNonTopExportedMsg binder = hsep [text "Non-top-level binder is marked as exported:", ppr binder] ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -37,6 +37,7 @@ import GHC.Core.Type import GHC.Core.FVs ( exprFreeIds, ruleRhsFreeIds ) import GHC.Core.Coercion ( Coercion, coVarsOfCo ) import GHC.Core.FamInstEnv +import GHC.Core.Opt.Arity ( typeArity ) import GHC.Utils.Misc import GHC.Utils.Panic import GHC.Data.Maybe ( isJust ) @@ -64,28 +65,55 @@ data DmdAnalOpts = DmdAnalOpts -- -- Note: use `seqBinds` on the result to avoid leaks due to lazyness (cf Note -- [Stamp out space leaks in demand analysis]) -dmdAnalProgram :: DmdAnalOpts -> FamInstEnvs -> CoreProgram -> CoreProgram -dmdAnalProgram opts fam_envs binds = binds_plus_dmds - where - env = emptyAnalEnv opts fam_envs - binds_plus_dmds = snd $ mapAccumL dmdAnalTopBind env binds - --- Analyse a (group of) top-level binding(s) -dmdAnalTopBind :: AnalEnv - -> CoreBind - -> (AnalEnv, CoreBind) -dmdAnalTopBind env (NonRec id rhs) - = ( extendAnalEnv TopLevel env id sig - , NonRec (setIdStrictness id sig) rhs') +dmdAnalProgram :: DmdAnalOpts -> FamInstEnvs -> [CoreRule] -> CoreProgram -> CoreProgram +dmdAnalProgram opts fam_envs rules binds + = snd $ go (emptyAnalEnv opts fam_envs) binds where - ( _, sig, rhs') = dmdAnalRhsLetDown Nothing env topSubDmd id rhs + -- See Note [Analysing top-level bindings] + -- and Note [Why care for top-level demand annotations?] + go _ [] = (nopDmdType, []) + go env (b:bs) = cons_up $ dmdAnalBind TopLevel env topSubDmd b anal_body + where + anal_body env' + | (body_ty, bs') <- go env' bs + = (add_exported_uses env' body_ty (bindersOf b), bs') + + cons_up :: (a, b, [b]) -> (a, [b]) + cons_up (dmd_ty, b', bs') = (dmd_ty, b':bs') + + add_exported_uses :: AnalEnv -> DmdType -> [Id] -> DmdType + add_exported_uses env = foldl' (add_exported_use env) + + -- | If @e@ is denoted by @dmd_ty@, then @add_exported_use _ dmd_ty id@ + -- corresponds to the demand type of @(id, e)@, but is a lot more direct. + -- See Note [Analysing top-level bindings]. + add_exported_use :: AnalEnv -> DmdType -> Id -> DmdType + add_exported_use env dmd_ty id + | isExportedId id || elemVarSet id rule_fvs + -- See Note [Absence analysis for stable unfoldings and RULES] + = dmd_ty `plusDmdType` fst (dmdAnalStar env topDmd (Var id)) + | otherwise + = dmd_ty -dmdAnalTopBind env (Rec pairs) - = (env', Rec pairs') - where - (env', _, pairs') = dmdFix TopLevel env topSubDmd pairs - -- We get two iterations automatically - -- c.f. the NonRec case above + rule_fvs :: IdSet + rule_fvs = foldr (unionVarSet . ruleRhsFreeIds) emptyVarSet rules + +-- | We attach useful (e.g. not 'topDmd') 'idDemandInfo' to top-level bindings +-- that satisfy this function. +-- +-- Basically, we want to know how top-level *functions* are *used* +-- (e.g. called). The information will always be lazy. +-- Any other top-level bindings are boring. +-- +-- See also Note [Why care for top-level demand annotations?]. +isInterestingTopLevelFn :: Id -> Bool +-- SG tried to set this to True and got a +2% ghc/alloc regression in T5642 +-- (which is dominated by the Simplifier) at no gain in analysis precision. +-- If there was a gain, that regression might be acceptable. +-- Plus, we could use LetUp for thunks and share some code with local let +-- bindings. +isInterestingTopLevelFn id = + typeArity (idType id) `lengthExceeds` 0 {- Note [Stamp out space leaks in demand analysis] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -105,8 +133,80 @@ generation would hold on to an extra copy of the Core program, via unforced thunks in demand or strictness information; and it is the most memory-intensive part of the compilation process, so this added seqBinds makes a big difference in peak memory usage. --} +Note [Analysing top-level bindings] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider a CoreProgram like + e1 = ... + n1 = ... + e2 = \a b -> ... fst (n1 a b) ... + n2 = \c d -> ... snd (e2 c d) ... + ... +where e* are exported, but n* are not. +Intuitively, we can see that @n1@ is only ever called with two arguments +and in every call site, the first component of the result of the call +is evaluated. Thus, we'd like it to have idDemandInfo @UCU(C1(P(SU,A))@. +NB: We may *not* give e2 a similar annotation, because it is exported and +external callers might use it in arbitrary ways, expressed by 'topDmd'. +This can then be exploited by Nested CPR and eta-expansion, +see Note [Why care for top-level demand annotations?]. + +How do we get this result? Answer: By analysing the program as if it was a let +expression of this form: + let e1 = ... in + let n1 = ... in + let e2 = ... in + let n2 = ... in + (e1,e2, ...) +E.g. putting all bindings in nested lets and returning all exported binders in a tuple. +Of course, we will not actually build that CoreExpr! Instead we faithfully +simulate analysis of said expression by adding the free variable 'DmdEnv' +of @e*@'s strictness signatures to the 'DmdType' we get from analysing the +nested bindings. + +And even then the above form blows up analysis performance in T10370: +If @e1@ uses many free variables, we'll unnecessarily carry their demands around +with us from the moment we analyse the pair to the moment we bubble back up to +the binding for @e1 at . So instead we analyse as if we had + let e1 = ... in + (e1, let n1 = ... in + ( let e2 = ... in + (e2, let n2 = ... in + ( ...)))) +That is, a series of right-nested pairs, where the @fst@ are the exported +binders of the last enclosing let binding and @snd@ continues the nested +lets. + +Variables occuring free in RULE RHSs are to be handled the same as exported Ids. +See also Note [Absence analysis for stable unfoldings and RULES]. + +Note [Why care for top-level demand annotations?] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Reading Note [Analysing top-level bindings], you might think that we go through +quite some trouble to get useful demands for top-level bindings. They can never +be strict, for example, so why bother? + +First, we get to eta-expand top-level bindings that we weren't able to +eta-expand before without Call Arity. From T18894b: + module T18894b (f) where + eta :: Int -> Int -> Int + eta x = if fst (expensive x) == 13 then \y -> ... else \y -> ... + f m = ... eta m 2 ... eta 2 m ... +Since only @f@ is exported, we see all call sites of @eta@ and can eta-expand to +arity 2. + +The call demands we get for some top-level bindings will also allow Nested CPR +to unbox deeper. From T18894: + module T18894 (h) where + g m n = (2 * m, 2 `div` n) + {-# NOINLINE g #-} + h :: Int -> Int + h m = ... snd (g m 2) ... uncurry (+) (g 2 m) ... +Only @h@ is exported, hence we see that @g@ is always called in contexts were we +also force the division in the second component of the pair returned by @g at . +This allows Nested CPR to evalute the division eagerly and return an I# in its +position. +-} {- ************************************************************************ @@ -114,7 +214,103 @@ seqBinds makes a big difference in peak memory usage. \subsection{The analyser itself} * * ************************************************************************ +-} + +-- | Analyse a binding group and its \"body\", e.g. where it is in scope. +-- +-- It calls a function that knows how to analyse this \"body\" given +-- an 'AnalEnv' with updated demand signatures for the binding group +-- (reflecting their 'idStrictnessInfo') and expects to receive a +-- 'DmdType' in return, which it uses to annotate the binding group with their +-- 'idDemandInfo'. +dmdAnalBind + :: TopLevelFlag + -> AnalEnv + -> SubDemand -- ^ Demand put on the "body" + -- (important for join points) + -> CoreBind + -> (AnalEnv -> (DmdType, a)) -- ^ How to analyse the "body", e.g. + -- where the binding is in scope + -> (DmdType, CoreBind, a) +dmdAnalBind top_lvl env dmd bind anal_body = case bind of + NonRec id rhs + | useLetUp top_lvl id + -> dmdAnalBindLetUp top_lvl env id rhs anal_body + _ -> dmdAnalBindLetDown top_lvl env dmd bind anal_body + +-- | Annotates uninteresting top level functions ('isInterestingTopLevelFn') +-- with 'topDmd', the rest with the given demand. +setBindIdDemandInfo :: TopLevelFlag -> Id -> Demand -> Id +setBindIdDemandInfo top_lvl id dmd = setIdDemandInfo id $ case top_lvl of + TopLevel | not (isInterestingTopLevelFn id) -> topDmd + _ -> dmd + +-- | Let bindings can be processed in two ways: +-- Down (RHS before body) or Up (body before RHS). +-- This function handles the up variant. +-- +-- It is very simple. For let x = rhs in body +-- * Demand-analyse 'body' in the current environment +-- * Find the demand, 'rhs_dmd' placed on 'x' by 'body' +-- * Demand-analyse 'rhs' in 'rhs_dmd' +-- +-- This is used for a non-recursive local let without manifest lambdas (see +-- 'useLetUp'). +-- +-- This is the LetUp rule in the paper “Higher-Order Cardinality Analysis”. +dmdAnalBindLetUp :: TopLevelFlag -> AnalEnv -> Id -> CoreExpr -> (AnalEnv -> (DmdType, a)) -> (DmdType, CoreBind, a) +dmdAnalBindLetUp top_lvl env id rhs anal_body = (final_ty, NonRec id' rhs', body') + where + (body_ty, body') = anal_body env + (body_ty', id_dmd) = findBndrDmd env notArgOfDfun body_ty id + id' = setBindIdDemandInfo top_lvl id id_dmd + (rhs_ty, rhs') = dmdAnalStar env (dmdTransformThunkDmd rhs id_dmd) rhs + final_ty = body_ty' `plusDmdType` rhs_ty + +-- | Let bindings can be processed in two ways: +-- Down (RHS before body) or Up (body before RHS). +-- This function handles the down variant. +-- +-- It computes a demand signature (by means of 'dmdAnalRhsSig') and uses +-- that at call sites in the body. +-- +-- It is used for toplevel definitions, recursive definitions and local +-- non-recursive definitions that have manifest lambdas (cf. 'useLetUp'). +-- Local non-recursive definitions without a lambda are handled with LetUp. +-- +-- This is the LetDown rule in the paper “Higher-Order Cardinality Analysis”. +dmdAnalBindLetDown :: TopLevelFlag -> AnalEnv -> SubDemand -> CoreBind -> (AnalEnv -> (DmdType, a)) -> (DmdType, CoreBind, a) +dmdAnalBindLetDown top_lvl env dmd bind anal_body = case bind of + NonRec id rhs + | (env', lazy_fv, id1, rhs1) <- + dmdAnalRhsSig top_lvl NonRecursive env dmd id rhs + -> do_rest env' lazy_fv [(id1, rhs1)] (uncurry NonRec . only) + Rec pairs + | (env', lazy_fv, pairs') <- dmdFix top_lvl env dmd pairs + -> do_rest env' lazy_fv pairs' Rec + where + do_rest env' lazy_fv pairs1 build_bind = (final_ty, build_bind pairs2, body') + where + (body_ty, body') = anal_body env' + -- see Note [Lazy and unleashable free variables] + dmd_ty = addLazyFVs body_ty lazy_fv + (!final_ty, id_dmds) = findBndrsDmds env' dmd_ty (map fst pairs1) + pairs2 = zipWith do_one pairs1 id_dmds + do_one (id', rhs') dmd = (setBindIdDemandInfo top_lvl id' dmd, rhs') + -- If the actual demand is better than the vanilla call + -- demand, you might think that we might do better to re-analyse + -- the RHS with the stronger demand. + -- But (a) That seldom happens, because it means that *every* path in + -- the body of the let has to use that stronger demand + -- (b) It often happens temporarily in when fixpointing, because + -- the recursive function at first seems to place a massive demand. + -- But we don't want to go to extra work when the function will + -- probably iterate to something less demanding. + -- In practice, all the times the actual demand on id2 is more than + -- the vanilla call demand seem to be due to (b). So we don't + -- bother to re-analyse the RHS. +{- Note [Ensure demand is strict] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ It's important not to analyse e with a lazy demand because @@ -194,7 +390,7 @@ dmdAnal' env dmd (App fun arg) -- Crucially, coercions /are/ handled here, because they are -- value arguments (#10288) let - call_dmd = mkCallDmd dmd + call_dmd = mkCalledOnceDmd dmd (fun_ty, fun') = dmdAnal env call_dmd fun (arg_dmd, res_ty) = splitDmdTy fun_ty (arg_ty, arg') = dmdAnalStar env (dmdTransformThunkDmd arg arg_dmd) arg @@ -295,60 +491,11 @@ dmdAnal' env dmd (Case scrut case_bndr ty alts) -- , text "res_ty" <+> ppr res_ty ]) $ (res_ty, Case scrut' case_bndr' ty alts') --- Let bindings can be processed in two ways: --- Down (RHS before body) or Up (body before RHS). --- The following case handle the up variant. --- --- It is very simple. For let x = rhs in body --- * Demand-analyse 'body' in the current environment --- * Find the demand, 'rhs_dmd' placed on 'x' by 'body' --- * Demand-analyse 'rhs' in 'rhs_dmd' --- --- This is used for a non-recursive local let without manifest lambdas. --- This is the LetUp rule in the paper “Higher-Order Cardinality Analysis”. -dmdAnal' env dmd (Let (NonRec id rhs) body) - | useLetUp id - = (final_ty, Let (NonRec id' rhs') body') - where - (body_ty, body') = dmdAnal env dmd body - (body_ty', id_dmd) = findBndrDmd env notArgOfDfun body_ty id - id' = setIdDemandInfo id id_dmd - - (rhs_ty, rhs') = dmdAnalStar env (dmdTransformThunkDmd rhs id_dmd) rhs - final_ty = body_ty' `plusDmdType` rhs_ty - -dmdAnal' env dmd (Let (NonRec id rhs) body) - = (body_ty2, Let (NonRec id2 rhs') body') +dmdAnal' env dmd (Let bind body) + = (final_ty, Let bind' body') where - (lazy_fv, sig, rhs') = dmdAnalRhsLetDown Nothing env dmd id rhs - id1 = setIdStrictness id sig - env1 = extendAnalEnv NotTopLevel env id sig - (body_ty, body') = dmdAnal env1 dmd body - (body_ty1, id2) = annotateBndr env body_ty id1 - body_ty2 = addLazyFVs body_ty1 lazy_fv -- see Note [Lazy and unleashable free variables] - - -- If the actual demand is better than the vanilla call - -- demand, you might think that we might do better to re-analyse - -- the RHS with the stronger demand. - -- But (a) That seldom happens, because it means that *every* path in - -- the body of the let has to use that stronger demand - -- (b) It often happens temporarily in when fixpointing, because - -- the recursive function at first seems to place a massive demand. - -- But we don't want to go to extra work when the function will - -- probably iterate to something less demanding. - -- In practice, all the times the actual demand on id2 is more than - -- the vanilla call demand seem to be due to (b). So we don't - -- bother to re-analyse the RHS. - -dmdAnal' env dmd (Let (Rec pairs) body) - = let - (env', lazy_fv, pairs') = dmdFix NotTopLevel env dmd pairs - (body_ty, body') = dmdAnal env' dmd body - body_ty1 = deleteFVs body_ty (map fst pairs) - body_ty2 = addLazyFVs body_ty1 lazy_fv -- see Note [Lazy and unleashable free variables] - in - body_ty2 `seq` - (body_ty2, Let (Rec pairs') body') + (final_ty, bind', body') = dmdAnalBind NotTopLevel env dmd bind go' + go' env' = dmdAnal env' dmd body -- | A simple, syntactic analysis of whether an expression MAY throw a precise -- exception when evaluated. It's always sound to return 'True'. @@ -582,9 +729,17 @@ dmdTransform env var dmd | Just (sig, top_lvl) <- lookupSigEnv env var , let fn_ty = dmdTransformSig sig dmd = -- pprTrace "dmdTransform:LetDown" (vcat [ppr var, ppr sig, ppr dmd, ppr fn_ty]) $ - if isTopLevel top_lvl - then fn_ty -- Don't record demand on top-level things - else addVarDmd fn_ty var (C_11 :* dmd) + case top_lvl of + NotTopLevel -> addVarDmd fn_ty var (C_11 :* dmd) + TopLevel + | isInterestingTopLevelFn var + -- Top-level things will be used multiple times or not at + -- all anyway, hence the multDmd below: It means we don't + -- have to track whether @var@ is used strictly or at most + -- once, because ultimately it never will. + -> addVarDmd fn_ty var (C_0N `multDmd` (C_11 :* dmd)) -- discard strictness + | otherwise + -> fn_ty -- don't bother tracking; just annotate with 'topDmd' later -- Everything else: -- * Local let binders for which we use LetUp (cf. 'useLetUp') -- * Lambda binders @@ -599,46 +754,46 @@ dmdTransform env var dmd * * ********************************************************************* -} --- Let bindings can be processed in two ways: --- Down (RHS before body) or Up (body before RHS). --- dmdAnalRhsLetDown implements the Down variant: --- * assuming a demand of +-- | @dmdAnalRhsSig@ analyses the given RHS to compute a demand signature +-- for the LetDown rule. It works as follows: +-- +-- * assuming a demand of -- * looking at the definition -- * determining a strictness signature -- --- It is used for toplevel definition, recursive definitions and local --- non-recursive definitions that have manifest lambdas. --- Local non-recursive definitions without a lambda are handled with LetUp. --- --- This is the LetDown rule in the paper “Higher-Order Cardinality Analysis”. -dmdAnalRhsLetDown - :: Maybe [Id] -- Just bs <=> recursive, Nothing <=> non-recursive +-- Since it assumed a demand of , the resulting signature is applicable at +-- any call site. +dmdAnalRhsSig + :: TopLevelFlag + -> RecFlag -> AnalEnv -> SubDemand -> Id -> CoreExpr - -> (DmdEnv, StrictSig, CoreExpr) + -> (AnalEnv, DmdEnv, Id, CoreExpr) -- Process the RHS of the binding, add the strictness signature -- to the Id, and augment the environment with the signature as well. -- See Note [NOINLINE and strictness] -dmdAnalRhsLetDown rec_flag env let_dmd id rhs - = -- pprTrace "dmdAnalRhsLetDown" (ppr id $$ ppr let_dmd $$ ppr sig $$ ppr lazy_fv) $ - (lazy_fv, sig, rhs') +dmdAnalRhsSig top_lvl rec_flag env let_dmd id rhs + = -- pprTrace "dmdAnalRhsSig" (ppr id $$ ppr let_dmd $$ ppr sig $$ ppr lazy_fv) $ + (env', lazy_fv, id', rhs') where rhs_arity = idArity id + -- See Note [Demand signatures are computed for a threshold demand based on idArity] rhs_dmd -- See Note [Demand analysis for join points] -- See Note [Invariants on join points] invariant 2b, in GHC.Core -- rhs_arity matches the join arity of the join point | isJoinId id - = mkCallDmds rhs_arity let_dmd + = mkCalledOnceDmds rhs_arity let_dmd | otherwise - -- NB: rhs_arity - -- See Note [Demand signatures are computed for a threshold demand based on idArity] - = mkRhsDmd env rhs_arity rhs + = mkCalledOnceDmds rhs_arity topSubDmd (rhs_dmd_ty, rhs') = dmdAnal env rhs_dmd rhs DmdType rhs_fv rhs_dmds rhs_div = rhs_dmd_ty sig = mkStrictSigForArity rhs_arity (DmdType sig_fv rhs_dmds rhs_div) + id' = id `setIdStrictness` sig + env' = extendAnalEnv top_lvl env id' sig + -- See Note [Aggregated demand for cardinality] -- FIXME: That Note doesn't explain the following lines at all. The reason -- is really much different: When we have a recursive function, we'd @@ -651,8 +806,8 @@ dmdAnalRhsLetDown rec_flag env let_dmd id rhs -- we'd have to do an additional iteration. reuseEnv makes sure that -- we never get used-once info for FVs of recursive functions. rhs_fv1 = case rec_flag of - Just bs -> reuseEnv (delVarEnvList rhs_fv bs) - Nothing -> rhs_fv + Recursive -> reuseEnv rhs_fv + NonRecursive -> rhs_fv rhs_fv2 = rhs_fv1 `keepAliveDmdEnv` extra_fvs -- Find the RHS free vars of the unfoldings and RULES @@ -669,13 +824,6 @@ dmdAnalRhsLetDown rec_flag env let_dmd id rhs = exprFreeIds unf_body | otherwise = emptyVarSet --- | @mkRhsDmd env rhs_arity rhs@ creates a 'SubDemand' for --- unleashing on the given function's @rhs@, by creating --- a call demand of @rhs_arity@ --- See Historical Note [Product demands for function body] -mkRhsDmd :: AnalEnv -> Arity -> CoreExpr -> SubDemand -mkRhsDmd _env rhs_arity _rhs = mkCallDmds rhs_arity topSubDmd - -- | If given the (local, non-recursive) let-bound 'Id', 'useLetUp' determines -- whether we should process the binding up (body before rhs) or down (rhs -- before body). @@ -720,8 +868,8 @@ mkRhsDmd _env rhs_arity _rhs = mkCallDmds rhs_arity topSubDmd -- * For a more convincing example with join points, see Note [Demand analysis -- for join points]. -- -useLetUp :: Var -> Bool -useLetUp f = idArity f == 0 && not (isJoinId f) +useLetUp :: TopLevelFlag -> Var -> Bool +useLetUp top_lvl f = isNotTopLevel top_lvl && idArity f == 0 && not (isJoinId f) {- Note [Demand analysis for join points] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -939,8 +1087,6 @@ dmdFix :: TopLevelFlag dmdFix top_lvl env let_dmd orig_pairs = loop 1 initial_pairs where - bndrs = map fst orig_pairs - -- See Note [Initialising strictness] initial_pairs | ae_virgin env = [(setIdStrictness id botSig, rhs) | (id, rhs) <- orig_pairs ] | otherwise = orig_pairs @@ -990,10 +1136,8 @@ dmdFix top_lvl env let_dmd orig_pairs = -- pprTrace "my_downRhs" (ppr id $$ ppr (idStrictness id) $$ ppr sig) $ ((env', lazy_fv'), (id', rhs')) where - (lazy_fv1, sig, rhs') = dmdAnalRhsLetDown (Just bndrs) env let_dmd id rhs - lazy_fv' = plusVarEnv_C plusDmd lazy_fv lazy_fv1 - env' = extendAnalEnv top_lvl env id sig - id' = setIdStrictness id sig + (env', lazy_fv1, id', rhs') = dmdAnalRhsSig top_lvl Recursive env let_dmd id rhs + lazy_fv' = plusVarEnv_C plusDmd lazy_fv lazy_fv1 zapIdStrictness :: [(Id, CoreExpr)] -> [(Id, CoreExpr)] zapIdStrictness pairs = [(setIdStrictness id nopSig, rhs) | (id, rhs) <- pairs ] @@ -1090,7 +1234,7 @@ addLazyFVs dmd_ty lazy_fvs -- demand with the bottom coming up from 'error' -- -- I got a loop in the fixpointer without this, due to an interaction - -- with the lazy_fv filtering in dmdAnalRhsLetDown. Roughly, it was + -- with the lazy_fv filtering in dmdAnalRhsSig. Roughly, it was -- letrec f n x -- = letrec g y = x `fatbar` -- letrec h z = z + ...g... @@ -1156,10 +1300,6 @@ annotateLamIdBndr env arg_of_dfun dmd_ty id main_ty = addDemand dmd dmd_ty' (dmd_ty', dmd) = findBndrDmd env arg_of_dfun dmd_ty id -deleteFVs :: DmdType -> [Var] -> DmdType -deleteFVs (DmdType fvs dmds res) bndrs - = DmdType (delVarEnvList fvs bndrs) dmds res - {- Note [NOINLINE and strictness] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Core/Opt/Pipeline.hs ===================================== @@ -66,6 +66,7 @@ import GHC.Types.SrcLoc import GHC.Types.Id import GHC.Types.Id.Info import GHC.Types.Basic +import GHC.Types.Demand ( zapDmdEnvSig ) import GHC.Types.Var.Set import GHC.Types.Var.Env import GHC.Types.Unique.Supply ( UniqSupply, mkSplitUniqSupply, splitUniqSupply ) @@ -499,7 +500,7 @@ doCorePass CoreDoExitify = {-# SCC "Exitify" #-} doPass exitifyProgram doCorePass CoreDoDemand = {-# SCC "DmdAnal" #-} - doPassDFM dmdAnal + doPassDFRM dmdAnal doCorePass CoreDoCpr = {-# SCC "CprAnal" #-} doPassDFM cprAnalProgram @@ -582,6 +583,13 @@ doPassDFM do_pass guts = do let fam_envs = (p_fam_env, mg_fam_inst_env guts) doPassM (liftIO . do_pass dflags fam_envs) guts +doPassDFRM :: (DynFlags -> FamInstEnvs -> [CoreRule] -> CoreProgram -> IO CoreProgram) -> ModGuts -> CoreM ModGuts +doPassDFRM do_pass guts = do + dflags <- getDynFlags + p_fam_env <- getPackageFamInstEnv + let fam_envs = (p_fam_env, mg_fam_inst_env guts) + doPassM (liftIO . do_pass dflags fam_envs (mg_rules guts)) guts + doPassDFU :: (DynFlags -> FamInstEnvs -> UniqSupply -> CoreProgram -> CoreProgram) -> ModGuts -> CoreM ModGuts doPassDFU do_pass guts = do dflags <- getDynFlags @@ -1095,13 +1103,13 @@ transferIdInfo exported_id local_id -dmdAnal :: DynFlags -> FamInstEnvs -> CoreProgram -> IO CoreProgram -dmdAnal dflags fam_envs binds = do +dmdAnal :: DynFlags -> FamInstEnvs -> [CoreRule] -> CoreProgram -> IO CoreProgram +dmdAnal dflags fam_envs rules binds = do let opts = DmdAnalOpts { dmd_strict_dicts = gopt Opt_DictsStrict dflags } - binds_plus_dmds = dmdAnalProgram opts fam_envs binds + binds_plus_dmds = dmdAnalProgram opts fam_envs rules binds Err.dumpIfSet_dyn dflags Opt_D_dump_str_signatures "Strictness signatures" FormatText $ - dumpIdInfoOfProgram (ppr . strictnessInfo) binds_plus_dmds + dumpIdInfoOfProgram (ppr . zapDmdEnvSig . strictnessInfo) binds_plus_dmds -- See Note [Stamp out space leaks in demand analysis] in GHC.Core.Opt.DmdAnal seqBinds binds_plus_dmds `seq` return binds_plus_dmds ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -598,11 +598,10 @@ addJoinFlts = appOL mkRecFloats :: SimplFloats -> SimplFloats -- Flattens the floats into a single Rec group, -- They must either all be lifted LetFloats or all JoinFloats -mkRecFloats floats@(SimplFloats { sfLetFloats = LetFloats bs ff +mkRecFloats floats@(SimplFloats { sfLetFloats = LetFloats bs _ff , sfJoinFloats = jbs , sfInScope = in_scope }) - = ASSERT2( case ff of { FltLifted -> True; _ -> False }, ppr (fromOL bs) ) - ASSERT2( isNilOL bs || isNilOL jbs, ppr floats ) + = ASSERT2( isNilOL bs || isNilOL jbs, ppr floats ) SimplFloats { sfLetFloats = floats' , sfJoinFloats = jfloats' , sfInScope = in_scope } ===================================== compiler/GHC/Core/Opt/WorkWrap.hs ===================================== @@ -484,7 +484,7 @@ tryWW dflags fam_envs is_rec fn_id rhs | is_fun && is_eta_exp = splitFun dflags fam_envs new_fn_id fn_info wrap_dmds div cpr rhs - | is_thunk -- See Note [Thunk splitting] + | isNonRec is_rec, is_thunk -- See Note [Thunk splitting] = splitThunk dflags fam_envs is_rec new_fn_id rhs | otherwise @@ -777,6 +777,10 @@ Notice that x certainly has the CPR property now! In fact, splitThunk uses the function argument w/w splitting function, so that if x's demand is deeper (say U(U(L,L),L)) then the splitting will go deeper too. + +NB: For recursive thunks, the Simplifier is unable to float `x-rhs` out of +`x*`'s RHS, because `x*` occurs freely in `x-rhs`, and will just change it +back to the original definition, so we just split non-recursive thunks. -} -- See Note [Thunk splitting] ===================================== compiler/GHC/Core/Opt/WorkWrap/Utils.hs ===================================== @@ -1275,10 +1275,14 @@ mk_absent_let dflags fam_envs arg abs_rhs = mkAbsentErrorApp arg_ty msg msg = showSDoc (gopt_set dflags Opt_SuppressUniques) - (ppr arg <+> ppr (idType arg) <+> file_msg) + (vcat + [ text "Arg:" <+> ppr arg + , text "Type:" <+> ppr arg_ty + , file_msg + ]) file_msg = case outputFile dflags of Nothing -> empty - Just f -> text "in output file " <+> quotes (text f) + Just f -> text "In output file " <+> quotes (text f) -- We need to suppress uniques here because otherwise they'd -- end up in the generated code as strings. This is bad for -- determinism, because with different uniques the strings ===================================== compiler/GHC/Core/Tidy.hs ===================================== @@ -21,7 +21,7 @@ import GHC.Core import GHC.Core.Seq ( seqUnfolding ) import GHC.Types.Id import GHC.Types.Id.Info -import GHC.Types.Demand ( zapUsageEnvSig ) +import GHC.Types.Demand ( zapDmdEnvSig ) import GHC.Core.Type ( tidyType, tidyVarBndr ) import GHC.Core.Coercion ( tidyCo ) import GHC.Types.Var @@ -206,7 +206,7 @@ tidyLetBndr rec_tidy_env env@(tidy_env, var_env) id new_info = vanillaIdInfo `setOccInfo` occInfo old_info `setArityInfo` arityInfo old_info - `setStrictnessInfo` zapUsageEnvSig (strictnessInfo old_info) + `setStrictnessInfo` zapDmdEnvSig (strictnessInfo old_info) `setDemandInfo` demandInfo old_info `setInlinePragInfo` inlinePragInfo old_info `setUnfoldingInfo` new_unf ===================================== compiler/GHC/Types/Demand.hs ===================================== @@ -34,7 +34,7 @@ module GHC.Types.Demand ( lazyApply1Dmd, lazyApply2Dmd, strictOnceApply1Dmd, strictManyApply1Dmd, -- ** Other @Demand@ operations oneifyCard, oneifyDmd, strictifyDmd, strictifyDictDmd, mkWorkerDemand, - peelCallDmd, peelManyCalls, mkCallDmd, mkCallDmds, + peelCallDmd, peelManyCalls, mkCalledOnceDmd, mkCalledOnceDmds, addCaseBndrDmd, -- ** Extracting one-shot information argOneShots, argsOneShots, saturatedByOneShots, @@ -73,7 +73,7 @@ module GHC.Types.Demand ( seqDemand, seqDemandList, seqDmdType, seqStrictSig, -- * Zapping usage information - zapUsageDemand, zapUsageEnvSig, zapUsedOnceDemand, zapUsedOnceSig + zapUsageDemand, zapDmdEnvSig, zapUsedOnceDemand, zapUsedOnceSig ) where #include "HsVersions.h" @@ -267,9 +267,11 @@ data SubDemand -- with the specified cardinality at every level. -- Expands to 'Call' via 'viewCall' and to 'Prod' via 'viewProd'. -- - -- @Poly n@ is semantically equivalent to @nP(n,n,...)@ or @Cn(Cn(..Cn(n)))@. - -- So @U === UP(U,U,...)@ and @U === CU(CU(..CU(U)))@, - -- @S === SP(S,S,...)@ and @S === CS(CS(..CS(S)))@, and so on. + -- @Poly n@ is semantically equivalent to @Prod [n :* Poly n, ...]@ or + -- @Call n (Poly n)@. 'mkCall' and 'mkProd' do these rewrites. + -- + -- In Note [Demand notation]: @U === P(U,U,...)@ and @U === CU(U)@, + -- @S === P(S,S,...)@ and @S === CS(S)@, and so on. -- -- We only really use 'Poly' with 'C_10' (bottom), 'C_00' (absent), -- 'C_0N' (top) and sometimes 'C_1N', but it's simpler to treat it uniformly @@ -278,7 +280,8 @@ data SubDemand -- ^ @Call n sd@ describes the evaluation context of @n@ function -- applications, where every individual result is evaluated according to @sd at . -- @sd@ is /relative/ to a single call, cf. Note [Call demands are relative]. - -- Used only for values of function type. + -- Used only for values of function type. Use the smart constructor 'mkCall' + -- whenever possible! | Prod ![Demand] -- ^ @Prod ds@ describes the evaluation context of a case scrutinisation -- on an expression of product type, where the product components are @@ -306,7 +309,7 @@ polyDmd C_1N = C_1N :* poly1N polyDmd C_10 = C_10 :* poly10 -- | A smart constructor for 'Prod', applying rewrite rules along the semantic --- equalities @Prod [polyDmd n, ...] === polyDmd n@, simplifying to 'Poly' +-- equality @Prod [polyDmd n, ...] === polyDmd n@, simplifying to 'Poly' -- 'SubDemand's when possible. Note that this degrades boxity information! E.g. a -- polymorphic demand will never unbox. mkProd :: [Demand] -> SubDemand @@ -335,6 +338,13 @@ viewProd _ _ = Nothing {-# INLINE viewProd #-} -- we want to fuse away the replicate and the allocation -- for Arity. Otherwise, #18304 bites us. +-- | A smart constructor for 'Call', applying rewrite rules along the semantic +-- equality @Call n (Poly n) === Poly n@, simplifying to 'Poly' 'SubDemand's +-- when possible. +mkCall :: Card -> SubDemand -> SubDemand +mkCall n cd@(Poly m) | n == m = cd +mkCall n cd = Call n cd + -- | @viewCall sd@ interprets @sd@ as a 'Call', expanding 'Poly' demands as -- necessary. viewCall :: SubDemand -> Maybe (Card, SubDemand) @@ -356,8 +366,9 @@ lubSubDmd (Prod ds1) (viewProd (length ds1) -> Just ds2) = -- Handle Call lubSubDmd (Call n1 d1) (viewCall -> Just (n2, d2)) -- See Note [Call demands are relative] - | isAbs n2 = Call (lubCard n1 n2) (lubSubDmd d1 botSubDmd) - | otherwise = Call (lubCard n1 n2) (lubSubDmd d1 d2) + | isAbs n1 = mkCall (lubCard n1 n2) (lubSubDmd botSubDmd d2) + | isAbs n2 = mkCall (lubCard n1 n2) (lubSubDmd d1 botSubDmd) + | otherwise = mkCall (lubCard n1 n2) (lubSubDmd d1 d2) -- Handle Poly lubSubDmd (Poly n1) (Poly n2) = Poly (lubCard n1 n2) -- Make use of reflexivity (so we'll match the Prod or Call cases again). @@ -367,7 +378,7 @@ lubSubDmd _ _ = topSubDmd -- | Denotes '∪' on 'Demand'. lubDmd :: Demand -> Demand -> Demand -lubDmd (n1 :* sd1) (n2 :* sd2) = lubCard n1 n2 :* lubSubDmd sd1 sd2 +lubDmd (n1 :* sd1) (n2 :* sd2) = lubCard n1 n2 :* lubSubDmd sd1 sd2 -- | Denotes '+' on 'SubDemand'. plusSubDmd :: SubDemand -> SubDemand -> SubDemand @@ -377,8 +388,9 @@ plusSubDmd (Prod ds1) (viewProd (length ds1) -> Just ds2) = -- Handle Call plusSubDmd (Call n1 d1) (viewCall -> Just (n2, d2)) -- See Note [Call demands are relative] - | isAbs n2 = Call (plusCard n1 n2) (lubSubDmd d1 botSubDmd) - | otherwise = Call (plusCard n1 n2) (lubSubDmd d1 d2) + | isAbs n1 = mkCall (plusCard n1 n2) (lubSubDmd botSubDmd d2) + | isAbs n2 = mkCall (plusCard n1 n2) (lubSubDmd d1 botSubDmd) + | otherwise = mkCall (plusCard n1 n2) (lubSubDmd d1 d2) -- Handle Poly plusSubDmd (Poly n1) (Poly n2) = Poly (plusCard n1 n2) -- Make use of reflexivity (so we'll match the Prod or Call cases again). @@ -407,7 +419,7 @@ multSubDmd :: Card -> SubDemand -> SubDemand multSubDmd n sd | Just sd' <- multTrivial n seqSubDmd sd = sd' multSubDmd n (Poly n') = Poly (multCard n n') -multSubDmd n (Call n' sd) = Call (multCard n n') sd -- See Note [Call demands are relative] +multSubDmd n (Call n' sd) = mkCall (multCard n n') sd -- See Note [Call demands are relative] multSubDmd n (Prod ds) = Prod (map (multDmd n) ds) multDmd :: Card -> Demand -> Demand @@ -457,22 +469,22 @@ evalDmd = C_1N :* topSubDmd -- | First argument of 'GHC.Exts.maskAsyncExceptions#': @SCS(U)@. -- Called exactly once. strictOnceApply1Dmd :: Demand -strictOnceApply1Dmd = C_11 :* Call C_11 topSubDmd +strictOnceApply1Dmd = C_11 :* mkCall C_11 topSubDmd -- | First argument of 'GHC.Exts.atomically#': @MCM(U)@. -- Called at least once, possibly many times. strictManyApply1Dmd :: Demand -strictManyApply1Dmd = C_1N :* Call C_1N topSubDmd +strictManyApply1Dmd = C_1N :* mkCall C_1N topSubDmd -- | First argument of catch#: @1C1(U)@. -- Evaluates its arg lazily, but then applies it exactly once to one argument. lazyApply1Dmd :: Demand -lazyApply1Dmd = C_01 :* Call C_01 topSubDmd +lazyApply1Dmd = C_01 :* mkCall C_01 topSubDmd -- | Second argument of catch#: @1C1(CS(U))@. -- Calls its arg lazily, but then applies it exactly once to an additional argument. lazyApply2Dmd :: Demand -lazyApply2Dmd = C_01 :* Call C_01 (Call C_11 topSubDmd) +lazyApply2Dmd = C_01 :* mkCall C_01 (mkCall C_11 topSubDmd) -- | Make a 'Demand' evaluated at-most-once. oneifyDmd :: Demand -> Demand @@ -512,12 +524,12 @@ strictifyDictDmd ty (n :* Prod ds) strictifyDictDmd _ dmd = dmd -- | Wraps the 'SubDemand' with a one-shot call demand: @d@ -> @CS(d)@. -mkCallDmd :: SubDemand -> SubDemand -mkCallDmd sd = Call C_11 sd +mkCalledOnceDmd :: SubDemand -> SubDemand +mkCalledOnceDmd sd = mkCall C_11 sd --- | @mkCallDmds n d@ returns @CS(CS...(CS d))@ where there are @n@ @CS@'s. -mkCallDmds :: Arity -> SubDemand -> SubDemand -mkCallDmds arity sd = iterate mkCallDmd sd !! arity +-- | @mkCalledOnceDmds n d@ returns @CS(CS...(CS d))@ where there are @n@ @CS@'s. +mkCalledOnceDmds :: Arity -> SubDemand -> SubDemand +mkCalledOnceDmds arity sd = iterate mkCalledOnceDmd sd !! arity -- | Peels one call level from the sub-demand, and also returns how many -- times we entered the lambda body. @@ -669,7 +681,7 @@ This is needed even for non-product types, in case the case-binder is used but the components of the case alternative are not. Note [Don't optimise UP(U,U,...) to U] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ These two SubDemands: UP(U,U) (@Prod [topDmd, topDmd]@) and U (@topSubDmd@) are semantically equivalent, but we do not turn the former into @@ -1571,9 +1583,9 @@ This is weird, so I'm not worried about whether this optimises brilliantly; but it should not fall over. -} -zapUsageEnvSig :: StrictSig -> StrictSig --- Remove the usage environment from the demand -zapUsageEnvSig (StrictSig (DmdType _ ds r)) = mkClosedStrictSig ds r +-- | Remove the demand environment from the signature. +zapDmdEnvSig :: StrictSig -> StrictSig +zapDmdEnvSig (StrictSig (DmdType _ ds r)) = mkClosedStrictSig ds r zapUsageDemand :: Demand -> Demand -- Remove the usage info, but not the strictness info, from the demand @@ -1615,8 +1627,8 @@ kill_usage kfs (n :* sd) = kill_usage_card kfs n :* kill_usage_sd kfs sd kill_usage_sd :: KillFlags -> SubDemand -> SubDemand kill_usage_sd kfs (Call n sd) - | kf_called_once kfs = Call (lubCard C_1N n) (kill_usage_sd kfs sd) - | otherwise = Call n (kill_usage_sd kfs sd) + | kf_called_once kfs = mkCall (lubCard C_1N n) (kill_usage_sd kfs sd) + | otherwise = mkCall n (kill_usage_sd kfs sd) kill_usage_sd kfs (Prod ds) = Prod (map (kill_usage kfs) ds) kill_usage_sd _ sd = sd @@ -1640,7 +1652,7 @@ trimToType (n :* sd) ts where go (Prod ds) (TsProd tss) | equalLength ds tss = Prod (zipWith trimToType ds tss) - go (Call n sd) (TsFun ts) = Call n (go sd ts) + go (Call n sd) (TsFun ts) = mkCall n (go sd ts) go sd at Poly{} _ = sd go _ _ = topSubDmd @@ -1804,7 +1816,7 @@ instance Binary SubDemand where h <- getByte bh case h of 0 -> Poly <$> get bh - 1 -> Call <$> get bh <*> get bh + 1 -> mkCall <$> get bh <*> get bh 2 -> Prod <$> get bh _ -> pprPanic "Binary:SubDemand" (ppr (fromIntegral h :: Int)) ===================================== compiler/GHC/Types/Id/Info.hs ===================================== @@ -650,7 +650,7 @@ zapUsageInfo info = Just (info {demandInfo = zapUsageDemand (demandInfo info)}) zapUsageEnvInfo :: IdInfo -> Maybe IdInfo zapUsageEnvInfo info | hasDemandEnvSig (strictnessInfo info) - = Just (info {strictnessInfo = zapUsageEnvSig (strictnessInfo info)}) + = Just (info {strictnessInfo = zapDmdEnvSig (strictnessInfo info)}) | otherwise = Nothing ===================================== distrib/mkDocs/mkDocs ===================================== @@ -31,7 +31,9 @@ cd .. tar -Jxf "$WINDOWS_BINDIST" mv ghc* windows cd inst/share/doc/ghc*/html/libraries -mv ../../../../../../windows/doc/html/libraries/Win32-* . +mv ../../../../../../windows/doc/html/libraries/Win32-* . || \ # make binary distribution + mv ../../../../../../windows/docs/html/libraries/Win32 . || \ # hadrian binary distribution + die "failed to find the Win32 package documentation" sh gen_contents_index cd .. for i in haddock libraries users_guide ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -12,6 +12,7 @@ import Settings import Settings.Program (programContext) import Target import Utilities +import qualified System.Directory.Extra as IO {- Note [Binary distributions] @@ -136,13 +137,20 @@ bindistRules = do copyDirectory (ghcBuildDir -/- "bin") bindistFilesDir copyDirectory (ghcBuildDir -/- "lib") bindistFilesDir copyDirectory (rtsIncludeDir) bindistFilesDir + unless cross $ need ["docs"] + -- TODO: we should only embed the docs that have been generated -- depending on the current settings (flavours' "ghcDocs" field and -- "--docs=.." command-line flag) -- Currently we embed the "docs" directory if it exists but it may -- contain outdated or even invalid data. - whenM (doesDirectoryExist (root -/- "docs")) $ do + + -- Use the IO version of doesDirectoryExist because the Shake Action + -- version should not be used for directories the build system can + -- create. Using the Action version caused documentation to not be + -- included in the bindist in the past (part of the problem in #18669). + whenM (liftIO (IO.doesDirectoryExist (root -/- "docs"))) $ do copyDirectory (root -/- "docs") bindistFilesDir when windowsHost $ do copyDirectory (root -/- "mingw") bindistFilesDir ===================================== testsuite/tests/arityanal/should_compile/Arity11.stderr ===================================== @@ -35,7 +35,7 @@ end Rec } -- RHS size: {terms: 52, types: 28, coercions: 0, joins: 0/5} F11.$wfib [InlPrag=[2]] :: forall {a} {p}. (a -> a -> Bool) -> (Num a, Num p) => a -> p -[GblId, Arity=4, Str=, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 150 60 0] 460 0}] +[GblId, Arity=4, Str=, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 150 60 0] 460 0}] F11.$wfib = \ (@a) (@p) (ww :: a -> a -> Bool) (w :: Num a) (w1 :: Num p) (w2 :: a) -> let { @@ -73,7 +73,7 @@ F11.$wfib fib [InlPrag=[2]] :: forall {a} {p}. (Eq a, Num a, Num p) => a -> p [GblId, Arity=4, - Str=, + Str=, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=4,unsat_ok=True,boring_ok=False) Tmpl= \ (@a) (@p) (w [Occ=Once1!] :: Eq a) (w1 [Occ=Once1] :: Num a) (w2 [Occ=Once1] :: Num p) (w3 [Occ=Once1] :: a) -> case w of { GHC.Classes.C:Eq ww1 [Occ=Once1] _ [Occ=Dead] -> F11.$wfib @a @p ww1 w1 w2 w3 }}] fib = \ (@a) (@p) (w :: Eq a) (w1 :: Num a) (w2 :: Num p) (w3 :: a) -> case w of { GHC.Classes.C:Eq ww1 ww2 -> F11.$wfib @a @p ww1 w1 w2 w3 } ===================================== testsuite/tests/arityanal/should_compile/Arity16.stderr ===================================== @@ -5,7 +5,7 @@ Result size of Tidy Core = {terms: 52, types: 87, coercions: 0, joins: 0/0} Rec { -- RHS size: {terms: 15, types: 17, coercions: 0, joins: 0/0} map2 [Occ=LoopBreaker] :: forall {t} {a}. (t -> a) -> [t] -> [a] -[GblId, Arity=2, Str=, Unf=OtherCon []] +[GblId, Arity=2, Str=, Unf=OtherCon []] map2 = \ (@t) (@a) (f :: t -> a) (ds :: [t]) -> case ds of { ===================================== testsuite/tests/stranal/should_compile/T18894.hs ===================================== @@ -0,0 +1,28 @@ +{-# OPTIONS_GHC -O2 -fforce-recomp #-} + +-- | The point of this test is that @g*@ get's a demand that says +-- "whenever @g*@ is called, the second component of the pair is evaluated strictly". +module T18894 (h1, h2) where + +g1 :: Int -> (Int,Int) +g1 1 = (15, 0) +g1 n = (2 * n, 2 `div` n) +{-# NOINLINE g1 #-} + +h1 :: Int -> Int +h1 1 = 0 +-- Sadly, the @g1 2@ subexpression will be floated to top-level, where we +-- don't see the specific demand placed on it by @snd at . Tracked in #19001. +h1 2 = snd (g1 2) +h1 m = uncurry (+) (g1 m) + +g2 :: Int -> Int -> (Int,Int) +g2 m 1 = (m, 0) +g2 m n = (2 * m, 2 `div` n) +{-# NOINLINE g2 #-} + +h2 :: Int -> Int +h2 1 = 0 +h2 m + | odd m = snd (g2 m 2) + | otherwise = uncurry (+) (g2 2 m) ===================================== testsuite/tests/stranal/should_compile/T18894.stderr ===================================== @@ -0,0 +1,404 @@ + +==================== Demand analysis ==================== +Result size of Demand analysis + = {terms: 177, types: 97, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 36, types: 16, coercions: 0, joins: 0/0} +g2 [InlPrag=NOINLINE, Dmd=UCU(CS(P(1P(U),SP(U))))] + :: Int -> Int -> (Int, Int) +[LclId, + Arity=2, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20 20] 161 20}] +g2 + = \ (m [Dmd=UP(U)] :: Int) (ds [Dmd=SP(SU)] :: Int) -> + case ds of { GHC.Types.I# ds [Dmd=SU] -> + case ds of ds [Dmd=1U] { + __DEFAULT -> + (case m of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.*# 2# y) }, + case ds of wild { + __DEFAULT -> + case GHC.Classes.divInt# 2# wild of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> GHC.Types.I# -2#; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + }); + 1# -> (m, lvl) + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 36, types: 19, coercions: 0, joins: 0/0} +h2 :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 162 10}] +h2 + = \ (ds [Dmd=SP(MU)] :: Int) -> + case ds of wild [Dmd=UP(U)] { GHC.Types.I# ds [Dmd=MU] -> + case ds of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> + case g2 wild lvl of { (ds1 [Dmd=A], y [Dmd=SU]) -> y }; + 0# -> + case g2 lvl wild of { (x [Dmd=SP(U)], ds [Dmd=SP(U)]) -> + case x of { GHC.Types.I# x -> + case ds of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + } + }; + 1# -> lvl + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 15# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +lvl :: (Int, Int) +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = (lvl, lvl) + +-- RHS size: {terms: 30, types: 11, coercions: 0, joins: 0/0} +g1 [InlPrag=NOINLINE, Dmd=UCU(P(UP(U),UP(U)))] :: Int -> (Int, Int) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 141 10}] +g1 + = \ (ds [Dmd=SP(SU)] :: Int) -> + case ds of { GHC.Types.I# ds [Dmd=SU] -> + case ds of ds { + __DEFAULT -> + (GHC.Types.I# (GHC.Prim.*# 2# ds), + case ds of wild { + __DEFAULT -> + case GHC.Classes.divInt# 2# wild of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> GHC.Types.I# -2#; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + }); + 1# -> lvl + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +lvl :: (Int, Int) +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=False, ConLike=False, + WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 30 0}] +lvl = g1 (GHC.Types.I# 2#) + +-- RHS size: {terms: 28, types: 18, coercions: 0, joins: 0/0} +h1 :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 111 10}] +h1 + = \ (ds [Dmd=SP(MU)] :: Int) -> + case ds of wild [Dmd=1P(1U)] { GHC.Types.I# ds [Dmd=MU] -> + case ds of { + __DEFAULT -> + case g1 wild of { (x [Dmd=SP(U)], ds [Dmd=SP(U)]) -> + case x of { GHC.Types.I# x -> + case ds of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + }; + 1# -> lvl; + 2# -> case lvl of { (ds1 [Dmd=A], y [Dmd=SU]) -> y } + } + } + + + + +==================== Demand analysis ==================== +Result size of Demand analysis + = {terms: 171, types: 120, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# -2# + +-- RHS size: {terms: 32, types: 18, coercions: 0, joins: 0/0} +$wg2 [InlPrag=NOINLINE, Dmd=UCU(CS(P(1P(U),SP(U))))] + :: Int -> GHC.Prim.Int# -> (# Int, Int #) +[LclId, + Arity=2, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20 30] 121 20}] +$wg2 + = \ (w [Dmd=UP(U)] :: Int) (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + (# case w of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.*# 2# y) }, + case ds of { + __DEFAULT -> + case GHC.Classes.divInt# 2# ds of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> lvl; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + } #); + 1# -> (# w, lvl #) + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 34, types: 21, coercions: 0, joins: 0/0} +$wh2 [InlPrag=[2]] :: GHC.Prim.Int# -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 162 10}] +$wh2 + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> + case $wg2 (GHC.Types.I# ds) 2# of + { (# ww [Dmd=A], ww [Dmd=SU] #) -> + ww + }; + 0# -> + case $wg2 lvl ds of { (# ww [Dmd=SP(U)], ww [Dmd=SP(U)] #) -> + case ww of { GHC.Types.I# x -> + case ww of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + } + }; + 1# -> lvl + } + +-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} +h2 [InlPrag=[2]] :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (w [Occ=Once1!] :: Int) -> + case w of { GHC.Types.I# ww [Occ=Once1, Dmd=MU] -> $wh2 ww }}] +h2 + = \ (w [Dmd=SP(SU)] :: Int) -> + case w of { GHC.Types.I# ww [Dmd=SU] -> $wh2 ww } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 15# + +-- RHS size: {terms: 28, types: 15, coercions: 0, joins: 0/0} +$wg1 [InlPrag=NOINLINE, Dmd=UCU(P(UP(U),UP(U)))] + :: GHC.Prim.Int# -> (# Int, Int #) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 111 20}] +$wg1 + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + (# GHC.Types.I# (GHC.Prim.*# 2# ds), + case ds of { + __DEFAULT -> + case GHC.Classes.divInt# 2# ds of ww4 { __DEFAULT -> + GHC.Types.I# ww4 + }; + -1# -> lvl; + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } + } #); + 1# -> (# lvl, lvl #) + } + +-- RHS size: {terms: 7, types: 9, coercions: 0, joins: 0/0} +lvl :: (Int, Int) +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=False, ConLike=False, + WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 40 10}] +lvl = case $wg1 2# of { (# ww, ww #) -> (ww, ww) } + +-- RHS size: {terms: 25, types: 18, coercions: 0, joins: 0/0} +$wh1 [InlPrag=[2]] :: GHC.Prim.Int# -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [50] 101 10}] +$wh1 + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds [Dmd=1U] { + __DEFAULT -> + case $wg1 ds of { (# ww [Dmd=SP(U)], ww [Dmd=SP(U)] #) -> + case ww of { GHC.Types.I# x -> + case ww of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } + } + }; + 1# -> lvl; + 2# -> case lvl of { (ds1 [Dmd=A], y [Dmd=SU]) -> y } + } + +-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} +h1 [InlPrag=[2]] :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (w [Occ=Once1!] :: Int) -> + case w of { GHC.Types.I# ww [Occ=Once1, Dmd=MU] -> $wh1 ww }}] +h1 + = \ (w [Dmd=SP(SU)] :: Int) -> + case w of { GHC.Types.I# ww [Dmd=SU] -> $wh1 ww } + + + ===================================== testsuite/tests/stranal/should_compile/T18894b.hs ===================================== @@ -0,0 +1,20 @@ +{-# OPTIONS_GHC -O -fno-call-arity -fforce-recomp #-} + +module T18894 (f) where + +expensive :: Int -> (Int, Int) +expensive n = (n+1, n+2) +{-# NOINLINE expensive #-} + +-- arity 1 by itself, but not exported, thus can be eta-expanded based on usage +eta :: Int -> Int -> Int +eta x = if fst (expensive x) == 13 + then \y -> x + y + else \y -> x * y +{-# NOINLINE eta #-} + +f :: Int -> Int +f 1 = 0 +f m + | odd m = eta m 2 + | otherwise = eta 2 m ===================================== testsuite/tests/stranal/should_compile/T18894b.stderr ===================================== @@ -0,0 +1,187 @@ + +==================== Demand analysis ==================== +Result size of Demand analysis = {terms: 83, types: 40, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 16, types: 7, coercions: 0, joins: 0/0} +expensive [InlPrag=NOINLINE, Dmd=UCU(P(SP(SU),A))] :: Int -> (Int, Int) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [40] 52 10}] +expensive + = \ (n [Dmd=UP(U)] :: Int) -> + (case n of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 1#) }, case n of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 2#) }) + +-- RHS size: {terms: 20, types: 11, coercions: 0, joins: 0/0} +eta [InlPrag=NOINLINE, Dmd=UCU(CS(U))] :: Int -> Int -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [0] 140 120}] +eta + = \ (x [Dmd=UP(U)] :: Int) -> + case expensive x of { (x [Dmd=SP(SU)], ds1 [Dmd=A]) -> + case x of { GHC.Types.I# x [Dmd=SU] -> + case x of { + __DEFAULT -> \ (y [Dmd=SP(U)] :: Int) -> GHC.Num.$fNumInt_$c* x y; + 13# -> \ (y [Dmd=SP(U)] :: Int) -> GHC.Num.$fNumInt_$c+ x y + } + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 21, types: 5, coercions: 0, joins: 0/0} +f :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 111 0}] +f = \ (ds [Dmd=SP(MU)] :: Int) -> + case ds of wild [Dmd=UP(U)] { GHC.Types.I# ds [Dmd=MU] -> + case ds of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> eta wild lvl; + 0# -> eta lvl wild + }; + 1# -> lvl + } + } + + + + +==================== Demand analysis ==================== +Result size of Demand analysis = {terms: 85, types: 47, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +$trModule = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Prim.Addr# +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +$trModule = "T18894"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule :: GHC.Types.TrName +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$trModule = GHC.Types.TrNameS $trModule + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18894.$trModule :: GHC.Types.Module +[LclIdX, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18894.$trModule = GHC.Types.Module $trModule $trModule + +-- RHS size: {terms: 16, types: 9, coercions: 0, joins: 0/0} +$wexpensive [InlPrag=NOINLINE, Dmd=UCU(P(SP(SU),A))] :: Int -> (# Int, Int #) +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [40] 42 10}] +$wexpensive + = \ (w [Dmd=UP(U)] :: Int) -> + (# case w of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 1#) }, + case w of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 2#) } #) + +-- RHS size: {terms: 19, types: 12, coercions: 0, joins: 0/0} +eta [InlPrag=NOINLINE, Dmd=UCU(CS(U))] :: Int -> Int -> Int +[LclId, + Arity=2, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [0 0] 120 0}] +eta + = \ (x [Dmd=MP(U)] :: Int) (eta [Dmd=SP(U), OS=OneShot] :: Int) -> + case $wexpensive x of { (# ww [Dmd=SP(SU)], ww [Dmd=A] #) -> + case ww of { GHC.Types.I# x [Dmd=SU] -> + case x of { + __DEFAULT -> GHC.Num.$fNumInt_$c* x eta; + 13# -> GHC.Num.$fNumInt_$c+ x eta + } + } + } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 20, types: 3, coercions: 0, joins: 0/0} +$wf [InlPrag=[2]] :: GHC.Prim.Int# -> Int +[LclId, + Arity=1, + Str=, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 121 0}] +$wf + = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> + case GHC.Prim.remInt# ds 2# of { + __DEFAULT -> eta (GHC.Types.I# ds) lvl; + 0# -> eta lvl (GHC.Types.I# ds) + }; + 1# -> lvl + } + +-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} +f [InlPrag=[2]] :: Int -> Int +[LclIdX, + Arity=1, + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (w [Occ=Once1!] :: Int) -> case w of { GHC.Types.I# ww [Occ=Once1, Dmd=MU] -> $wf ww }}] +f = \ (w [Dmd=SP(SU)] :: Int) -> case w of { GHC.Types.I# ww [Dmd=SU] -> $wf ww } + + + ===================================== testsuite/tests/stranal/should_compile/all.T ===================================== @@ -58,3 +58,7 @@ test('T18122', [ grep_errmsg(r'wfoo =') ], compile, ['-ddump-simpl']) # We care about the call demand on $wg test('T18903', [ grep_errmsg(r'Dmd=\S+C\S+') ], compile, ['-ddump-simpl -dsuppress-uniques']) +# We care about the call demand on $wg1 and $wg2 +test('T18894', [ grep_errmsg(r'Dmd=\S+C\S+') ], compile, ['-ddump-stranal -dsuppress-uniques']) +# We care about the Arity 2 on eta, as a result of the annotated Dmd +test('T18894b', [ grep_errmsg(r'Arity=2') ], compile, ['-ddump-stranal -dsuppress-uniques -fno-call-arity -dppr-cols=200']) ===================================== testsuite/tests/stranal/sigs/T5075.stderr ===================================== @@ -1,7 +1,7 @@ ==================== Strictness signatures ==================== T5075.$trModule: -T5075.loop: +T5075.loop: @@ -13,6 +13,6 @@ T5075.loop: ==================== Strictness signatures ==================== T5075.$trModule: -T5075.loop: +T5075.loop: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/05d4b26bcaaa34f5506440f00aee191292bc244a...9cc868bfd7ed77ffcc191028c5f57c97df634b79 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/05d4b26bcaaa34f5506440f00aee191292bc244a...9cc868bfd7ed77ffcc191028c5f57c97df634b79 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Dec 13 12:14:21 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sun, 13 Dec 2020 07:14:21 -0500 Subject: [Git][ghc/ghc][master] mkDocs: support hadrian bindists #18973 Message-ID: <5fd6059d8e8b2_6b21491119013028bc@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: e033dd05 by Adam Sandberg Ericsson at 2020-12-12T10:52:19+00:00 mkDocs: support hadrian bindists #18973 - - - - - 1 changed file: - distrib/mkDocs/mkDocs Changes: ===================================== distrib/mkDocs/mkDocs ===================================== @@ -31,7 +31,9 @@ cd .. tar -Jxf "$WINDOWS_BINDIST" mv ghc* windows cd inst/share/doc/ghc*/html/libraries -mv ../../../../../../windows/doc/html/libraries/Win32-* . +mv ../../../../../../windows/doc/html/libraries/Win32-* . || \ # make binary distribution + mv ../../../../../../windows/docs/html/libraries/Win32 . || \ # hadrian binary distribution + die "failed to find the Win32 package documentation" sh gen_contents_index cd .. for i in haddock libraries users_guide View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e033dd0512443140dcca5b3c90b84022d8caf942 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e033dd0512443140dcca5b3c90b84022d8caf942 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Dec 13 12:14:56 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sun, 13 Dec 2020 07:14:56 -0500 Subject: [Git][ghc/ghc][master] Remove old .travis.yml Message-ID: <5fd605c0eb57a_6b2174471c13059f1@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 78580ba3 by John Ericson at 2020-12-13T07:14:50-05:00 Remove old .travis.yml - - - - - 1 changed file: - − .travis.yml Changes: ===================================== .travis.yml deleted ===================================== @@ -1,61 +0,0 @@ -# The following enables container-based travis instances -sudo: false - -git: - submodules: false - -env: - - DEBUG_STAGE2=YES - - DEBUG_STAGE2=NO - -# TODO. Install llvm once llvm's APT repository is working again. -# See http://lists.llvm.org/pipermail/llvm-dev/2016-May/100303.html. -addons: - apt: - sources: - - hvr-ghc - #- llvm-toolchain-precise-3.7 - - ubuntu-toolchain-r-test - packages: - - cabal-install-2.2 - - ghc-8.4.3 - - alex-3.1.7 - - happy-1.19.5 - - python3 - #- llvm-3.7 - -before_install: - - export PATH=/opt/ghc/8.4.3/bin:/opt/cabal/2.2/bin:/opt/alex/3.1.7/bin:/opt/happy/1.19.5/bin:/usr/lib/llvm-3.7/bin:$PATH - -# Be explicit about which protocol to use, such that we don't have to repeat the rewrite command for each. - - git config remote.origin.url git://github.com/${TRAVIS_REPO_SLUG}.git - - git config --global url."git://github.com/${TRAVIS_REPO_SLUG%/*}/packages-".insteadOf "git://github.com/${TRAVIS_REPO_SLUG%/*}/packages/" - - git submodule --quiet init # Be quiet about these urls, as we may override them later. - -# Check if submodule repositories exist. - - git config --get-regexp submodule.*.url | while read entry url; do git ls-remote "$url" dummyref 2>/dev/null && echo "$entry = $url" || git config --unset-all "$entry" ; done - -# Use github.com/ghc for those submodule repositories we couldn't connect to. - - git config remote.origin.url git://github.com/ghc/ghc.git - - git config --global url."git://github.com/ghc/packages-".insteadOf git://github.com/ghc/packages/ - - git submodule init # Don't be quiet, we want to show these urls. - - git submodule --quiet update --recursive # Now we can be quiet again. - -script: - # do not build docs - - echo 'HADDOCK_DOCS = NO' >> mk/validate.mk - - echo 'BUILD_SPHINX_HTML = NO' >> mk/validate.mk - - echo 'BUILD_SPHINX_PDF = NO' >> mk/validate.mk - # do not build dynamic libraries - - echo 'DYNAMIC_GHC_PROGRAMS = NO' >> mk/validate.mk - - echo 'GhcLibWays = v' >> mk/validate.mk - - if [ "$DEBUG_STAGE2" = "YES" ]; then echo 'GhcStage2HcOpts += -DDEBUG' >> mk/validate.mk; fi - # * Use --quiet, otherwise the build log might exceed the limit of 4 - # megabytes, causing Travis to kill our job. - # * But use VERBOSE=2 (the default, but not when using --quiet) otherwise - # the testsuite might not print output for over 10 minutes (more likely so - # when DEBUG_STAGE2=NO), causing Travis to again kill our job. - # * Use --fast, to stay within the time limits set by Travis. - # See Note [validate and testsuite speed] in toplevel Makefile. - # Actually, do not run test suite. Takes too long. - - THREADS=3 SKIP_PERF_TESTS=YES VERBOSE=2 ./validate --fast --quiet --build-only View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/78580ba3f99565b0aecb25c4206718d4c8a52317 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/78580ba3f99565b0aecb25c4206718d4c8a52317 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Dec 13 14:56:19 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sun, 13 Dec 2020 09:56:19 -0500 Subject: [Git][ghc/ghc] Pushed new tag ghc-9.1-start Message-ID: <5fd62b93482fb_6b215b9af781310123@gitlab.mail> Ben Gamari pushed new tag ghc-9.1-start at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/ghc-9.1-start You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Dec 13 18:44:20 2020 From: gitlab at gitlab.haskell.org (Alan Zimmerman) Date: Sun, 13 Dec 2020 13:44:20 -0500 Subject: [Git][ghc/ghc][wip/az/exactprint] WIP on delta printing. Message-ID: <5fd66104b84a4_6b2149111901315296@gitlab.mail> Alan Zimmerman pushed to branch wip/az/exactprint at Glasgow Haskell Compiler / GHC Commits: 579d487b by Alan Zimmerman at 2020-12-13T18:43:46+00:00 WIP on delta printing. Making progress - - - - - 30 changed files: - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/ThToHs.hs - libraries/Cabal - libraries/directory - libraries/hpc - libraries/time - libraries/unix - testsuite/tests/ghc-api/annotations/InTreeAnnotations1.stderr - testsuite/tests/parser/should_compile/DumpParsedAst.stderr - testsuite/tests/parser/should_compile/DumpRenamedAst.stderr - testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr - testsuite/tests/parser/should_compile/KindSigs.stderr - testsuite/tests/printer/Ppr001.hs - testsuite/tests/printer/Ppr004.hs - testsuite/tests/printer/Ppr024.hs - testsuite/tests/printer/Ppr025.hs - utils/check-exact/Main.hs - utils/check-exact/Test.hs - + utils/check-exact/cases/LayoutIn1.hs - + utils/check-exact/cases/LayoutIn3.expected.hs - + utils/check-exact/cases/LayoutIn3.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/579d487b4b2e82b748fe58b540b6874b89e1a8d0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/579d487b4b2e82b748fe58b540b6874b89e1a8d0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Dec 13 22:07:16 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sun, 13 Dec 2020 17:07:16 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/T19057 Message-ID: <5fd69094c6e92_6b2174471c134515b@gitlab.mail> Ben Gamari pushed new branch wip/T19057 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T19057 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Dec 13 22:08:58 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sun, 13 Dec 2020 17:08:58 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/backports-8.10 Message-ID: <5fd690fa82456_6b215c5fa6c135087c@gitlab.mail> Ben Gamari pushed new branch wip/backports-8.10 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/backports-8.10 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Dec 13 22:11:26 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sun, 13 Dec 2020 17:11:26 -0500 Subject: [Git][ghc/ghc][wip/backports-8.10] Bump bytestring submodule to 0.10.12.0 Message-ID: <5fd6918e2bbce_6b213272ce0135421b@gitlab.mail> Ben Gamari pushed to branch wip/backports-8.10 at Glasgow Haskell Compiler / GHC Commits: acb022e6 by Ben Gamari at 2020-12-13T17:10:53-05:00 Bump bytestring submodule to 0.10.12.0 Fixes #18233. - - - - - 1 changed file: - libraries/bytestring Changes: ===================================== libraries/bytestring ===================================== @@ -1 +1 @@ -Subproject commit 95fe6bdf13c9cc86c1c880164f7844d61d989574 +Subproject commit e043aacfc4202a59ccae8b8c8cf0e1ad83a3f209 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/acb022e61d2d79616005ef487818af8267dc4414 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/acb022e61d2d79616005ef487818af8267dc4414 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Dec 13 22:23:55 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sun, 13 Dec 2020 17:23:55 -0500 Subject: [Git][ghc/ghc][wip/backports-8.10] 22 commits: rts/Sanity: Avoid nasty race in weak pointer sanity-checking Message-ID: <5fd6947b4824e_6b215ab2cc813777d8@gitlab.mail> Ben Gamari pushed to branch wip/backports-8.10 at Glasgow Haskell Compiler / GHC Commits: d7e4813c by Ben Gamari at 2020-12-07T15:10:41+00:00 rts/Sanity: Avoid nasty race in weak pointer sanity-checking See Note [Racing weak pointer evacuation] for all of the gory details. - - - - - ef241371 by GHC GitLab CI at 2020-12-07T15:11:57+00:00 nonmoving: Fix regression from TSAN work The TSAN rework (specifically aad1f803) introduced a subtle regression in GC.c, swapping `g0` in place of `gen`. Whoops! Fixes #18997. (cherry picked from commit 21c807df67afe1aee7bf4a964a00cc78ef19e00f) - - - - - 38f2f627 by GHC GitLab CI at 2020-12-07T15:12:10+00:00 rts/Messages: Add missing write barrier in THROWTO message update After a THROWTO message has been handle the message closure is overwritten by a NULL message. We must ensure that the original closure's pointers continue to be visible to the nonmoving GC. (cherry picked from commit 6c2faf158fd26fc06b03c9bd11b6d2cf8e8db572) - - - - - 813c5219 by GHC GitLab CI at 2020-12-07T15:12:51+00:00 nonmoving: Add missing write barrier in shrinkSmallByteArray (cherry picked from commit 35c22991ae5c22b10ca1a81f0aa888d1939f0b3f) - - - - - de7f2203 by GHC GitLab CI at 2020-12-07T15:13:01+00:00 Updates: Don't zero slop until closure has been pushed Ensure that the the free variables have been pushed to the update remembered set before we zero the slop. (cherry picked from commit 134f759926bb4163d7ab97e72ce7209ed42f98b9) - - - - - 2ba6b268 by GHC GitLab CI at 2020-12-07T15:13:15+00:00 OSThreads: Fix error code checking pthread_join returns its error code and apparently doesn't set errno. (cherry picked from commit c488ac737e8ca3813fe6db069cbeb7abba00cfb9) - - - - - 7122ff03 by GHC GitLab CI at 2020-12-07T15:13:31+00:00 nonmoving: Don't join to mark_thread on shutdown The mark thread is not joinable as we detach from it on creation. (cherry picked from commit ca1ef0e758a3fb787691529a0f8149e9d10b1d00) - - - - - ada68f55 by Ben Gamari at 2020-12-07T15:13:46+00:00 nonmoving: Add reference to Ueno 2016 (cherry picked from commit a3b8375eeb2ce9d2e30f8269f5b489c5bcacc69f) - - - - - 4f01c8b4 by GHC GitLab CI at 2020-12-07T15:14:20+00:00 nonmoving: Ensure that evacuated large objects are marked See Note [Non-moving GC: Marking evacuated objects]. (cherry picked from commit b416189e4004506b89f06f147be37e76f4cd507f) - - - - - 658b7fc9 by Ben Gamari at 2020-12-07T15:14:40+00:00 rts/linker: Align bssSize to page size when mapping symbol extras We place symbol_extras right after bss. We also need to ensure that symbol_extras can be mprotect'd independently from the rest of the image. To ensure this we round up the size of bss to a page boundary, thus ensuring that symbol_extras is also page-aligned. (cherry picked from commit 9f40cf6ca9fb24dbc55f7eae43e2b89aa12bf251) (cherry picked from commit 4b83b6a8f8ac08e81b6e75c47f133e3ed6bdea95) - - - - - abab9157 by Ben Gamari at 2020-12-07T15:15:20+00:00 rts: Allocate MBlocks with MAP_TOP_DOWN on Windows As noted in #18991, we would previously allocate heap in low memory. Due to this the linker, which typically *needs* low memory, would end up competing with the heap. In longer builds we end up running out of low memory entirely, leading to linking failures. (cherry picked from commit a1a75aa9be2c133dd1372a08eeb6a92c31688df7) - - - - - b160abf5 by Ben Gamari at 2020-12-07T15:16:23+00:00 rts/linker: Ensure that .rodata is aligned to 16 bytes Pulled out of !4310. (cherry picked from commit be408b86c9125dedd2f83e9701ea9f2e499c8dd4) - - - - - e7dbdbfa by GHC GitLab CI at 2020-12-07T15:19:45+00:00 Bump text submodule to 1.2.4.1-rc1 Per request of @phadej. - - - - - 1abaf38a by Ben Gamari at 2020-12-10T04:29:23+00:00 nonmoving: Fix small CPP bug Previously an incorrect semicolon meant that we would fail to call busy_wait_nop when spinning. - - - - - 4123b929 by GHC GitLab CI at 2020-12-10T04:29:25+00:00 nonmoving: Assert deadlock-gc promotion invariant When performing a deadlock-detection GC we must ensure that all objects end up in the non-moving generation. Assert this in scavenge. - - - - - 13b6696b by GHC GitLab CI at 2020-12-10T04:29:25+00:00 nonmoving: Ensure deadlock detection promotion works Previously the deadlock-detection promotion logic in alloc_for_copy was just plain wrong: it failed to fire when gct->evac_gen_no != oldest_gen->gen_no. The fix is simple: move the - - - - - 0c7f20e2 by GHC GitLab CI at 2020-12-10T04:30:10+00:00 nonmoving: Refactor alloc_for_copy Pull the cold non-moving allocation path out of alloc_for_copy. - - - - - b1b55be1 by Ben Gamari at 2020-12-10T04:30:34+00:00 nonmoving: Don't push objects during deadlock detect GC Previously we would push large objects and compact regions to the mark queue during the deadlock detect GC, resulting in failure to detect deadlocks. - - - - - b0ad86fb by GHC GitLab CI at 2020-12-10T04:31:18+00:00 nonmoving: Add comments to nonmovingResurrectThreads - - - - - e89a5563 by Takenobu Tani at 2020-12-13T17:11:57-05:00 Limit upper version of Happy for ghc-9.0 and earlier (#18620) This patch adds the upper bound of a happy version for ghc-9.0 and earlier. Currently, we can't use happy-1.20.0 for ghc-9.0. See #18620. (cherry picked from commit 74a7fbff5a8f244cd44345bf987e26413bb1989e) - - - - - d9064a7c by Ben Gamari at 2020-12-13T17:11:57-05:00 Bump bytestring submodule to 0.10.12.0 Fixes #18233. - - - - - 4b9b7df6 by Shayne Fletcher at 2020-12-13T17:22:57-05:00 Fix bad span calculations of post qualified imports (cherry picked from commit 57f3fdb1fbeb82b5b19bc5e2970d8857c2514fcc) - - - - - 22 changed files: - aclocal.m4 - compiler/parser/Parser.y - hadrian/hadrian.cabal - libraries/bytestring - rts/LinkerInternals.h - rts/Messages.c - rts/Messages.h - rts/PrimOps.cmm - rts/RaiseAsync.c - rts/Updates.h - rts/linker/SymbolExtras.c - rts/posix/OSThreads.c - rts/sm/Evac.c - rts/sm/GC.c - rts/sm/NonMoving.c - rts/sm/NonMovingMark.c - rts/sm/Sanity.c - rts/sm/Scav.c - rts/win32/OSMem.c - testsuite/tests/module/all.T - + testsuite/tests/module/mod185.hs - + testsuite/tests/module/mod185.stderr Changes: ===================================== aclocal.m4 ===================================== @@ -1036,6 +1036,8 @@ if test ! -f compiler/parser/Parser.hs || test ! -f compiler/cmm/CmmParse.hs then FP_COMPARE_VERSIONS([$fptools_cv_happy_version],[-lt],[1.19.10], [AC_MSG_ERROR([Happy version 1.19.10 or later is required to compile GHC.])])[] + FP_COMPARE_VERSIONS([$fptools_cv_happy_version],[-ge],[1.20.0], + [AC_MSG_ERROR([Happy version 1.19 is required to compile GHC.])])[] fi HappyVersion=$fptools_cv_happy_version; AC_SUBST(HappyVersion) ===================================== compiler/parser/Parser.y ===================================== @@ -973,18 +973,20 @@ importdecls_semi importdecl :: { LImportDecl GhcPs } : 'import' maybe_src maybe_safe optqualified maybe_pkg modid optqualified maybeas maybeimpspec {% do { - ; checkImportDecl $4 $7 - ; ams (cL (comb4 $1 $6 (snd $8) $9) $ + ; let { ; mPreQual = unLoc $4 + ; mPostQual = unLoc $7 } + ; checkImportDecl mPreQual mPostQual + ; ams (cL (comb5 $1 $6 $7 (snd $8) $9) $ ImportDecl { ideclExt = noExtField , ideclSourceSrc = snd $ fst $2 , ideclName = $6, ideclPkgQual = snd $5 , ideclSource = snd $2, ideclSafe = snd $3 - , ideclQualified = importDeclQualifiedStyle $4 $7 + , ideclQualified = importDeclQualifiedStyle mPreQual mPostQual , ideclImplicit = False , ideclAs = unLoc (snd $8) , ideclHiding = unLoc $9 }) - (mj AnnImport $1 : fst (fst $2) ++ fst $3 ++ fmap (mj AnnQualified) (maybeToList $4) - ++ fst $5 ++ fmap (mj AnnQualified) (maybeToList $7) ++ fst $8) + (mj AnnImport $1 : fst (fst $2) ++ fst $3 ++ fmap (mj AnnQualified) (maybeToList mPreQual) + ++ fst $5 ++ fmap (mj AnnQualified) (maybeToList mPostQual) ++ fst $8) } } ===================================== hadrian/hadrian.cabal ===================================== @@ -147,7 +147,7 @@ executable hadrian , transformers >= 0.4 && < 0.6 , unordered-containers >= 0.2.1 && < 0.3 build-tools: alex >= 3.1 - , happy >= 1.19.10 + , happy >= 1.19.10 && < 1.20 ghc-options: -Wall -Wincomplete-record-updates -Wredundant-constraints ===================================== libraries/bytestring ===================================== @@ -1 +1 @@ -Subproject commit 95fe6bdf13c9cc86c1c880164f7844d61d989574 +Subproject commit e043aacfc4202a59ccae8b8c8cf0e1ad83a3f209 ===================================== rts/LinkerInternals.h ===================================== @@ -135,7 +135,7 @@ typedef struct _Segment { int n_sections; } Segment; -#if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH) +#if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH) || defined(aarch64_HOST_ARCH) #define NEED_SYMBOL_EXTRAS 1 #endif ===================================== rts/Messages.c ===================================== @@ -100,7 +100,7 @@ loop: case THROWTO_SUCCESS: { // this message is done StgTSO *source = t->source; - doneWithMsgThrowTo(t); + doneWithMsgThrowTo(cap, t); tryWakeupThread(cap, source); break; } ===================================== rts/Messages.h ===================================== @@ -23,8 +23,16 @@ void sendMessage (Capability *from_cap, Capability *to_cap, Message *msg); #include "SMPClosureOps.h" INLINE_HEADER void -doneWithMsgThrowTo (MessageThrowTo *m) +doneWithMsgThrowTo (Capability *cap, MessageThrowTo *m) { + // The message better be locked + ASSERT(m->header.info == &stg_WHITEHOLE_info); + IF_NONMOVING_WRITE_BARRIER_ENABLED { + updateRemembSetPushClosure(cap, (StgClosure *) m->link); + updateRemembSetPushClosure(cap, (StgClosure *) m->source); + updateRemembSetPushClosure(cap, (StgClosure *) m->target); + updateRemembSetPushClosure(cap, (StgClosure *) m->exception); + } OVERWRITING_CLOSURE((StgClosure*)m); unlockClosure((StgClosure*)m, &stg_MSG_NULL_info); LDV_RECORD_CREATE(m); ===================================== rts/PrimOps.cmm ===================================== @@ -233,6 +233,22 @@ stg_shrinkSmallMutableArrayzh ( gcptr mba, W_ new_size ) OVERWRITING_CLOSURE_OFS(mba, (BYTES_TO_WDS(SIZEOF_StgSmallMutArrPtrs) + new_size)); + + IF_NONMOVING_WRITE_BARRIER_ENABLED { + // Ensure that the elements we are about to shrink out of existence + // remain visible to the non-moving collector. + W_ p, end; + p = mba + SIZEOF_StgSmallMutArrPtrs + WDS(new_size); + end = mba + SIZEOF_StgSmallMutArrPtrs + WDS(StgSmallMutArrPtrs_ptrs(mba)); +again: + ccall updateRemembSetPushClosure_(BaseReg "ptr", + W_[p] "ptr"); + if (p < end) { + p = p + SIZEOF_W; + goto again; + } + } + StgSmallMutArrPtrs_ptrs(mba) = new_size; // See the comments in overwritingClosureOfs for an explanation // of the interaction with LDV profiling. ===================================== rts/RaiseAsync.c ===================================== @@ -336,7 +336,7 @@ check_target: } // nobody else can wake up this TSO after we claim the message - doneWithMsgThrowTo(m); + doneWithMsgThrowTo(cap, m); raiseAsync(cap, target, msg->exception, false, NULL); return THROWTO_SUCCESS; @@ -577,7 +577,7 @@ maybePerformBlockedException (Capability *cap, StgTSO *tso) throwToSingleThreaded(cap, msg->target, msg->exception); source = msg->source; - doneWithMsgThrowTo(msg); + doneWithMsgThrowTo(cap, msg); tryWakeupThread(cap, source); return 1; } @@ -599,7 +599,7 @@ awakenBlockedExceptionQueue (Capability *cap, StgTSO *tso) i = lockClosure((StgClosure *)msg); if (i != &stg_MSG_NULL_info) { source = msg->source; - doneWithMsgThrowTo(msg); + doneWithMsgThrowTo(cap, msg); tryWakeupThread(cap, source); } else { unlockClosure((StgClosure *)msg,i); @@ -696,7 +696,7 @@ removeFromQueues(Capability *cap, StgTSO *tso) // ASSERT(m->header.info == &stg_WHITEHOLE_info); // unlock and revoke it at the same time - doneWithMsgThrowTo(m); + doneWithMsgThrowTo(cap, m); break; } ===================================== rts/Updates.h ===================================== @@ -49,7 +49,6 @@ W_ bd; \ \ prim_write_barrier; \ - OVERWRITING_CLOSURE(p1); \ bd = Bdescr(p1); \ if (bdescr_gen_no(bd) != 0 :: bits16) { \ IF_NONMOVING_WRITE_BARRIER_ENABLED { \ @@ -60,6 +59,7 @@ } else { \ TICK_UPD_NEW_IND(); \ } \ + OVERWRITING_CLOSURE(p1); \ StgInd_indirectee(p1) = p2; \ prim_write_barrier; \ SET_INFO(p1, stg_BLACKHOLE_info); \ ===================================== rts/linker/SymbolExtras.c ===================================== @@ -77,7 +77,9 @@ int ocAllocateExtras(ObjectCode* oc, int count, int first, int bssSize) /* N.B. We currently can't mark symbol extras as non-executable in this * case. */ size_t n = roundUpToPage(oc->fileSize); - bssSize = roundUpToAlign(bssSize, 8); + // round bssSize up to the nearest page size since we need to ensure that + // symbol_extras is aligned to a page boundary so it can be mprotect'd. + bssSize = roundUpToPage(bssSize); size_t allocated_size = n + bssSize + extras_size; void *new = mmapForLinker(allocated_size, PROT_READ | PROT_WRITE, MAP_ANONYMOUS, -1, 0); if (new) { ===================================== rts/posix/OSThreads.c ===================================== @@ -380,8 +380,9 @@ interruptOSThread (OSThreadId id) void joinOSThread (OSThreadId id) { - if (pthread_join(id, NULL) != 0) { - sysErrorBelch("joinOSThread: error %d", errno); + int ret = pthread_join(id, NULL); + if (ret != 0) { + sysErrorBelch("joinOSThread: error %d", ret); } } ===================================== rts/sm/Evac.c ===================================== @@ -64,14 +64,92 @@ STATIC_INLINE void evacuate_large(StgPtr p); Allocate some space in which to copy an object. -------------------------------------------------------------------------- */ +static StgPtr +alloc_in_nonmoving_heap (uint32_t size) +{ + gct->copied += size; + StgPtr to = nonmovingAllocate(gct->cap, size); + + // Add segment to the todo list unless it's already there + // current->todo_link == NULL means not in todo list + struct NonmovingSegment *seg = nonmovingGetSegment(to); + if (!seg->todo_link) { + gen_workspace *ws = &gct->gens[oldest_gen->no]; + seg->todo_link = ws->todo_seg; + ws->todo_seg = seg; + } + + // The object which refers to this closure may have been aged (i.e. + // retained in a younger generation). Consequently, we must add the + // closure to the mark queue to ensure that it will be marked. + // + // However, if we are in a deadlock detection GC then we disable aging + // so there is no need. + // + // See Note [Non-moving GC: Marking evacuated objects]. + if (major_gc && !deadlock_detect_gc) { + markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, (StgClosure *) to); + } + return to; +} + +/* Inlined helper shared between alloc_for_copy_nonmoving and alloc_for_copy. */ +STATIC_INLINE StgPtr +alloc_in_moving_heap (uint32_t size, uint32_t gen_no) +{ + gen_workspace *ws = &gct->gens[gen_no]; // zero memory references here + + /* chain a new block onto the to-space for the destination gen if + * necessary. + */ + StgPtr to = ws->todo_free; + ws->todo_free += size; + if (ws->todo_free > ws->todo_lim) { + to = todo_block_full(size, ws); + } + ASSERT(ws->todo_free >= ws->todo_bd->free && ws->todo_free <= ws->todo_lim); + + return to; +} + +/* + * N.B. We duplicate much of alloc_for_copy here to minimize the number of + * branches introduced in the moving GC path of alloc_for_copy while minimizing + * repeated work. + */ +static StgPtr +alloc_for_copy_nonmoving (uint32_t size, uint32_t gen_no) +{ + /* See Note [Deadlock detection under nonmoving collector]. */ + if (deadlock_detect_gc) { + return alloc_in_nonmoving_heap(size); + } + + /* Should match logic from alloc_for_copy */ + if (gen_no < gct->evac_gen_no) { + if (gct->eager_promotion) { + gen_no = gct->evac_gen_no; + } else { + gct->failed_to_evac = true; + } + } + + if (gen_no == oldest_gen->no) { + return alloc_in_nonmoving_heap(size); + } else { + return alloc_in_moving_heap(size, gen_no); + } +} + /* size is in words */ STATIC_INLINE StgPtr alloc_for_copy (uint32_t size, uint32_t gen_no) { ASSERT(gen_no < RtsFlags.GcFlags.generations); - StgPtr to; - gen_workspace *ws; + if (RTS_UNLIKELY(RtsFlags.GcFlags.useNonmoving)) { + return alloc_for_copy_nonmoving(size, gen_no); + } /* Find out where we're going, using the handy "to" pointer in * the gen of the source object. If it turns out we need to @@ -81,60 +159,70 @@ alloc_for_copy (uint32_t size, uint32_t gen_no) if (gen_no < gct->evac_gen_no) { if (gct->eager_promotion) { gen_no = gct->evac_gen_no; - } else if (RTS_UNLIKELY(RtsFlags.GcFlags.useNonmoving) && deadlock_detect_gc) { - /* See Note [Deadlock detection under nonmoving collector]. */ - gen_no = oldest_gen->no; } else { gct->failed_to_evac = true; } } - if (RTS_UNLIKELY(RtsFlags.GcFlags.useNonmoving)) { - if (gen_no == oldest_gen->no) { - gct->copied += size; - to = nonmovingAllocate(gct->cap, size); - - // Add segment to the todo list unless it's already there - // current->todo_link == NULL means not in todo list - struct NonmovingSegment *seg = nonmovingGetSegment(to); - if (!seg->todo_link) { - gen_workspace *ws = &gct->gens[oldest_gen->no]; - seg->todo_link = ws->todo_seg; - ws->todo_seg = seg; - } - - // The object which refers to this closure may have been aged (i.e. - // retained in a younger generation). Consequently, we must add the - // closure to the mark queue to ensure that it will be marked. - // - // However, if we are in a deadlock detection GC then we disable aging - // so there is no need. - if (major_gc && !deadlock_detect_gc) - markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, (StgClosure *) to); - return to; - } - } - - ws = &gct->gens[gen_no]; // zero memory references here - - /* chain a new block onto the to-space for the destination gen if - * necessary. - */ - to = ws->todo_free; - ws->todo_free += size; - if (ws->todo_free > ws->todo_lim) { - to = todo_block_full(size, ws); - } - ASSERT(ws->todo_free >= ws->todo_bd->free && ws->todo_free <= ws->todo_lim); - - return to; + return alloc_in_moving_heap(size, gen_no); } /* ----------------------------------------------------------------------------- The evacuate() code -------------------------------------------------------------------------- */ -/* size is in words */ +/* + * Note [Non-moving GC: Marking evacuated objects] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * + * When the non-moving collector is in use we must be careful to ensure that any + * references to objects in the non-moving generation from younger generations + * are pushed to the mark queue. + * + * In particular we need to ensure that we handle newly-promoted objects are + * correctly marked. For instance, consider this case: + * + * generation 0 generation 1 + * ────────────── ────────────── + * + * ┌───────┐ + * ┌───────┐ │ A │ + * │ B │ ◁────────────────────────── │ │ + * │ │ ──┬─────────────────┐ └───────┘ + * └───────┘ ┆ after GC │ + * ┆ │ + * ┌───────┐ ┆ before GC │ ┌───────┐ + * │ C │ ◁┄┘ └─────▷ │ C' │ + * │ │ │ │ + * └───────┘ └───────┘ + * + * + * In this case object C started off in generation 0 and was evacuated into + * generation 1 during the preparatory GC. However, the only reference to C' + * is from B, which lives in the generation 0 (via aging); this reference will + * not be visible to the concurrent non-moving collector (which can only + * traverse the generation 1 heap). Consequently, upon evacuating C we need to + * ensure that C' is added to the update remembered set as we know that it will + * continue to be reachable via B (which is assumed to be reachable as it lives + * in a younger generation). + * + * Where this happens depends upon the type of the object (e.g. C'): + * + * - In the case of "normal" small heap-allocated objects this happens in + * alloc_for_copy. + * - In the case of compact region this happens in evacuate_compact. + * - In the case of large objects this happens in evacuate_large. + * + * See also Note [Aging under the non-moving collector] in NonMoving.c. + * + */ + +/* size is in words + + We want to *always* inline this as often the size of the closure is static, + which allows unrolling of the copy loop. + + */ STATIC_INLINE GNUC_ATTR_HOT void copy_tag(StgClosure **p, const StgInfoTable *info, StgClosure *src, uint32_t size, uint32_t gen_no, StgWord tag) @@ -351,6 +439,11 @@ evacuate_large(StgPtr p) __atomic_fetch_or(&bd->flags, BF_EVACUATED, __ATOMIC_ACQ_REL); if (RTS_UNLIKELY(RtsFlags.GcFlags.useNonmoving && new_gen == oldest_gen)) { __atomic_fetch_or(&bd->flags, BF_NONMOVING, __ATOMIC_ACQ_REL); + + // See Note [Non-moving GC: Marking evacuated objects]. + if (major_gc && !deadlock_detect_gc) { + markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, (StgClosure *) p); + } } initBdescr(bd, new_gen, new_gen->to); @@ -505,6 +598,11 @@ evacuate_compact (StgPtr p) bd->flags |= BF_EVACUATED; if (RTS_UNLIKELY(RtsFlags.GcFlags.useNonmoving && new_gen == oldest_gen)) { __atomic_fetch_or(&bd->flags, BF_NONMOVING, __ATOMIC_RELAXED); + + // See Note [Non-moving GC: Marking evacuated objects]. + if (major_gc && !deadlock_detect_gc) { + markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, (StgClosure *) str); + } } initBdescr(bd, new_gen, new_gen->to); @@ -690,13 +788,6 @@ loop: */ if (flags & BF_LARGE) { evacuate_large((P_)q); - - // We may have evacuated the block to the nonmoving generation. If so - // we need to make sure it is added to the mark queue since the only - // reference to it may be from the moving heap. - if (major_gc && flags & BF_NONMOVING && !deadlock_detect_gc) { - markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, q); - } return; } ===================================== rts/sm/GC.c ===================================== @@ -1689,13 +1689,8 @@ collect_gct_blocks (void) static void collect_pinned_object_blocks (void) { - generation *gen; const bool use_nonmoving = RtsFlags.GcFlags.useNonmoving; - if (use_nonmoving && major_gc) { - gen = oldest_gen; - } else { - gen = g0; - } + generation *const gen = (use_nonmoving && major_gc) ? oldest_gen : g0; for (uint32_t n = 0; n < n_capabilities; n++) { bdescr *last = NULL; @@ -1720,7 +1715,7 @@ collect_pinned_object_blocks (void) if (gen->large_objects != NULL) { gen->large_objects->u.back = last; } - g0->large_objects = RELAXED_LOAD(&capabilities[n]->pinned_object_blocks); + gen->large_objects = RELAXED_LOAD(&capabilities[n]->pinned_object_blocks); RELAXED_STORE(&capabilities[n]->pinned_object_blocks, NULL); } } ===================================== rts/sm/NonMoving.c ===================================== @@ -191,8 +191,8 @@ Mutex concurrent_coll_finished_lock; * === Other references === * * Apart from the design document in docs/storage/nonmoving-gc and the Ueno - * 2016 paper (TODO citation) from which it drew inspiration, there are a - * variety of other relevant Notes scattered throughout the tree: + * 2016 paper [ueno 2016] from which it drew inspiration, there are a variety + * of other relevant Notes scattered throughout the tree: * * - Note [Concurrent non-moving collection] (NonMoving.c) describes * concurrency control of the nonmoving collector @@ -204,6 +204,10 @@ Mutex concurrent_coll_finished_lock; * - Note [Aging under the non-moving collector] (NonMoving.c) describes how * we accomodate aging * + * - Note [Non-moving GC: Marking evacuated objects] (Evac.c) describes how + * non-moving objects reached by evacuate() are marked, which is necessary + * due to aging. + * * - Note [Large objects in the non-moving collector] (NonMovingMark.c) * describes how we track large objects. * @@ -232,6 +236,11 @@ Mutex concurrent_coll_finished_lock; * how we use the DIRTY flags associated with MUT_VARs and TVARs to improve * barrier efficiency. * + * [ueno 2016]: + * Katsuhiro Ueno and Atsushi Ohori. 2016. A fully concurrent garbage + * collector for functional programs on multicore processors. SIGPLAN Not. 51, + * 9 (September 2016), 421–433. DOI:https://doi.org/10.1145/3022670.2951944 + * * * Note [Concurrent non-moving collection] * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -312,6 +321,8 @@ Mutex concurrent_coll_finished_lock; * * The non-moving collector will come to C in the mark queue and mark it. * + * The implementation details of this are described in Note [Non-moving GC: + * Marking evacuated objects] in Evac.c. * * Note [Deadlock detection under the non-moving collector] * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -726,7 +737,6 @@ void nonmovingStop(void) "waiting for nonmoving collector thread to terminate"); ACQUIRE_LOCK(&concurrent_coll_finished_lock); waitCondition(&concurrent_coll_finished, &concurrent_coll_finished_lock); - joinOSThread(mark_thread); } #endif } ===================================== rts/sm/NonMovingMark.c ===================================== @@ -737,9 +737,11 @@ void updateRemembSetPushStack(Capability *cap, StgStack *stack) // The concurrent GC has claimed the right to mark the stack. // Wait until it finishes marking before proceeding with // mutation. - while (needs_upd_rem_set_mark((StgClosure *) stack)); + while (needs_upd_rem_set_mark((StgClosure *) stack)) #if defined(PARALLEL_GC) busy_wait_nop(); // TODO: Spinning here is unfortunate +#else + ; #endif return; } @@ -1927,6 +1929,8 @@ void nonmovingTidyThreads () } } +// Mark threads which appear to be dead but still need to be properly torn down +// by resurrectThreads. void nonmovingResurrectThreads (struct MarkQueue_ *queue, StgTSO **resurrected_threads) { StgTSO *next; @@ -1938,6 +1942,9 @@ void nonmovingResurrectThreads (struct MarkQueue_ *queue, StgTSO **resurrected_t case ThreadComplete: continue; default: + // The thread may be, e.g., deadlocked in which case we must ensure + // it isn't swept since resurrectThreads will need to throw it an + // exception. markQueuePushClosure_(queue, (StgClosure*)t); t->global_link = *resurrected_threads; *resurrected_threads = t; ===================================== rts/sm/Sanity.c ===================================== @@ -224,6 +224,111 @@ checkClosureProfSanity(const StgClosure *p) } #endif +/* Note [Racing weak pointer evacuation] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * While debugging a GC crash (#18919) I noticed a spurious crash due to the + * end-of-GC sanity check stumbling across a weak pointer with unevacuated key. + * This can happen when two GC threads race to evacuate a weak pointer. + * Specifically, we start out with a heap with a weak pointer reachable + * from both a generation's weak pointer list and some other root-reachable + * closure (e.g. a Just constructor): + * + * O W + * ┌──────────┐ ┌──────────┐ + * Root ────→ │ Just │ ╭───→ │ Weak# │ ←─────── weak_ptr_list + * Set ├──────────┤ │ ├──────────┤ + * │ │ ────╯ │ value │ ─→ ... + * └──────────┘ │ key │ ───╮ K + * │ ... │ │ ┌──────────┐ + * └──────────┘ ╰──→ │ ... │ + * ├──────────┤ + * + * The situation proceeds as follows: + * + * 1. Thread A initiates a GC, wakes up the GC worker threads, and starts + * evacuating roots. + * 2. Thread A evacuates a weak pointer object O to location O'. + * 3. Thread A fills the block where O' lives and pushes it to its + * work-stealing queue. + * 4. Thread B steals the O' block and starts scavenging it. + * 5. Thread A enters markWeakPtrList. + * 6. Thread A starts evacuating W, resulting in Wb'. + * 7. Thread B scavenges O', evacuating W', resulting in Wa'. + * 8. Thread A and B are now racing to evacuate W. Only one will win the race + * (due to the CAS in copy_tag). Let the winning copy be called W'. + * 9. W will be replaced by a forwarding pointer to the winning copy, W'. + * 10. Whichever thread loses the race will retry evacuation, see + * that W has already been evacuated, and proceed as usual. + * 10. W' will get added to weak_ptr_list by markWeakPtrList. + * 11. Eventually W' will be scavenged. + * 12. traverseWeakPtrList will see that W' has been scavenged and evacuate the + * its key. + * 13. However, the copy that lost the race is not on `weak_ptr_list` + * and will therefore never get its `key` field scavenged (since + * `traverseWeakPtrList` will never see it). + * + * Now the heap looks like: + * + * O' W (from-space) + * ┌──────────┐ ┌──────────┐ + * Root ────→ │ Just │ │ Fwd-ptr │ ───────────╮ + * Set ├──────────┤ ├──────────┤ │ + * │ │ ────╮ │ value │ ─→ ... │ + * └──────────┘ │ │ key │ ────────────────────────╮ + * │ │ ... │ │ │ + * │ └──────────┘ │ │ + * │ │ │ + * │ Wa' │ │ + * │ ┌──────────┐ ╭────╯ │ + * ╰───→ │ Weak# │ ←─────┤ │ + * ├──────────┤ ╰─ weak_ptr_list │ + * │ value │ ─→ ... │ + * │ key │ ───╮ K' │ + * │ ... │ │ ┌──────────┐ │ + * └──────────┘ ╰──→ │ ... │ │ + * ├──────────┤ │ + * Wb' │ + * ┌──────────┐ │ + * │ Weak# │ │ + * ├──────────┤ │ + * │ value │ ─→ ... │ + * │ key │ ───╮ K (from-space) │ + * │ ... │ │ ┌──────────┐ │ + * └──────────┘ ╰──→ │ 0xaaaaa │ ←──╯ + * ├──────────┤ + * + * + * Without sanity checking this is fine; we have introduced a spurious copy of + * W, Wb' into the heap but it is unreachable and therefore won't cause any + * trouble. However, with sanity checking we may encounter this spurious copy + * when walking the heap. Moreover, this copy was never added to weak_ptr_list, + * meaning that its key field (along with the other fields mark as + * non-pointers) will not get scavenged and will therefore point into + * from-space. + * + * To avoid this checkClosure skips over the key field when it sees a weak + * pointer. Note that all fields of Wb' *other* than the key field should be + * valid, so we don't skip the closure entirely. + * + * We then do additional checking of all closures on the weak_ptr_lists, where + * we *do* check `key`. + */ + +// Check validity of objects on weak_ptr_list. +// See Note [Racing weak pointer evacuation]. +static void +checkGenWeakPtrList( uint32_t g ) +{ + for (StgWeak *w = generations[g].weak_ptr_list; w != NULL; w = w->link) { + ASSERT(LOOKS_LIKE_CLOSURE_PTR(w)); + ASSERT(w->header.info == &stg_WEAK_info); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(w->key)); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(w->value)); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(w->finalizer)); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(w->cfinalizers)); + } +} + // Returns closure size in words StgOffset checkClosure( const StgClosure* p ) @@ -343,12 +448,9 @@ checkClosure( const StgClosure* p ) * representative of the actual layout. */ { StgWeak *w = (StgWeak *)p; - ASSERT(LOOKS_LIKE_CLOSURE_PTR(w->key)); - ASSERT(LOOKS_LIKE_CLOSURE_PTR(w->value)); - ASSERT(LOOKS_LIKE_CLOSURE_PTR(w->finalizer)); - if (w->link) { - ASSERT(LOOKS_LIKE_CLOSURE_PTR(w->link)); - } + // N.B. Checking most of the fields here is not safe. + // See Note [Racing weak pointer evacuation] for why. + ASSERT(LOOKS_LIKE_CLOSURE_PTR(w->cfinalizers)); return sizeW_fromITBL(info); } @@ -851,6 +953,12 @@ static void checkGeneration (generation *gen, checkHeapChain(ws->scavd_list); } + // Check weak pointer lists + // See Note [Racing weak pointer evacuation]. + for (uint32_t g = 0; g < RtsFlags.GcFlags.generations; g++) { + checkGenWeakPtrList(g); + } + checkLargeObjects(gen->large_objects); checkCompactObjects(gen->compact_objects); } ===================================== rts/sm/Scav.c ===================================== @@ -440,6 +440,14 @@ scavenge_block (bdescr *bd) p = bd->u.scan; + // Sanity check: See Note [Deadlock detection under nonmoving collector]. +#if defined(DEBUG) + if (RtsFlags.GcFlags.useNonmoving && deadlock_detect_gc) { + ASSERT(bd->gen == oldest_gen); + } +#endif + + // we might be evacuating into the very object that we're // scavenging, so we have to check the real bd->free pointer each // time around the loop. ===================================== rts/win32/OSMem.c ===================================== @@ -67,8 +67,11 @@ allocNew(uint32_t n) { alloc_rec* rec; rec = (alloc_rec*)stgMallocBytes(sizeof(alloc_rec),"getMBlocks: allocNew"); rec->size = ((W_)n+1)*MBLOCK_SIZE; + // N.B. We use MEM_TOP_DOWN here to ensure that we leave the bottom of the + // address space available for the linker and libraries, which in general + // want to live in low memory. See #18991. rec->base = - VirtualAlloc(NULL, rec->size, MEM_RESERVE, PAGE_READWRITE); + VirtualAlloc(NULL, rec->size, MEM_RESERVE | MEM_TOP_DOWN, PAGE_READWRITE); if(rec->base==0) { stgFree((void*)rec); rec=0; ===================================== testsuite/tests/module/all.T ===================================== @@ -268,6 +268,7 @@ test('mod181', normal, compile, ['']) test('mod182', normal, compile_fail, ['']) test('mod183', normal, compile_fail, ['']) test('mod184', normal, compile, ['-Wprepositive-qualified-module']) +test('mod185', normal, compile, ['-ddump-parsed-ast']) test('T1148', normal, compile, ['']) test('T1074', normal, compile, ['']) ===================================== testsuite/tests/module/mod185.hs ===================================== @@ -0,0 +1,5 @@ +{-# LANGUAGE ImportQualifiedPost #-} +-- The span of the import decl should include the 'qualified' keyword. +import Prelude qualified + +main = Prelude.undefined ===================================== testsuite/tests/module/mod185.stderr ===================================== @@ -0,0 +1,62 @@ +==================== Parser AST ==================== + +({ mod185.hs:1:1 } + (HsModule + (VirtualBraces + (1)) + (Nothing) + (Nothing) + [({ mod185.hs:3:1-24 } + (ImportDecl + (NoExtField) + (NoSourceText) + ({ mod185.hs:3:8-14 } + {ModuleName: Prelude}) + (Nothing) + (NotBoot) + (False) + (QualifiedPost) + (False) + (Nothing) + (Nothing)))] + [({ mod185.hs:5:1-24 } + (ValD + (NoExtField) + (FunBind + (NoExtField) + ({ mod185.hs:5:1-4 } + (Unqual + {OccName: main})) + (MG + (NoExtField) + ({ mod185.hs:5:1-24 } + [({ mod185.hs:5:1-24 } + (Match + (NoExtField) + (FunRhs + ({ mod185.hs:5:1-4 } + (Unqual + {OccName: main})) + (Prefix) + (NoSrcStrict)) + [] + (GRHSs + (NoExtField) + [({ mod185.hs:5:6-24 } + (GRHS + (NoExtField) + [] + ({ mod185.hs:5:8-24 } + (HsVar + (NoExtField) + ({ mod185.hs:5:8-24 } + (Qual + {ModuleName: Prelude} + {OccName: undefined}))))))] + ({ } + (EmptyLocalBinds + (NoExtField))))))]) + (FromSource)) + [])))] + (Nothing) + (Nothing))) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/acb022e61d2d79616005ef487818af8267dc4414...4b9b7df66967fff0f51e6805dcbb645ef9904783 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/acb022e61d2d79616005ef487818af8267dc4414...4b9b7df66967fff0f51e6805dcbb645ef9904783 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Dec 13 22:26:00 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sun, 13 Dec 2020 17:26:00 -0500 Subject: [Git][ghc/ghc][wip/backports-8.10] gitlab-ci: Rename RELEASE variable to RELEASE_JOB Message-ID: <5fd694f877b07_6b215ab2cc813803b7@gitlab.mail> Ben Gamari pushed to branch wip/backports-8.10 at Glasgow Haskell Compiler / GHC Commits: 5ccb0792 by Ben Gamari at 2020-12-13T17:25:24-05:00 gitlab-ci: Rename RELEASE variable to RELEASE_JOB This interfered with the autoconf variable of the same name, breaking pre-release builds. (cherry picked from commit 15dca84793d5ec4ff922726477923e40caa075eb) (cherry picked from commit 3e55edd97c8eba271f5cb64b9362796791e0e887) - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -52,7 +52,7 @@ stages: expire_in: 1 year only: variables: - - $RELEASE == "yes" + - $RELEASE_JOB == "yes" ############################################################ # Runner Tags View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5ccb07925beec746c333c433227535e2bede77d5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5ccb07925beec746c333c433227535e2bede77d5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Dec 13 22:27:33 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sun, 13 Dec 2020 17:27:33 -0500 Subject: [Git][ghc/ghc][wip/backports-8.10] configure: Release 8.10.3 Message-ID: <5fd6955591c85_6b2174471c13809dd@gitlab.mail> Ben Gamari pushed to branch wip/backports-8.10 at Glasgow Haskell Compiler / GHC Commits: dbb0d690 by Ben Gamari at 2020-12-13T17:26:54-05:00 configure: Release 8.10.3 - - - - - 1 changed file: - configure.ac Changes: ===================================== configure.ac ===================================== @@ -13,10 +13,10 @@ dnl # see what flags are available. (Better yet, read the documentation!) # -AC_INIT([The Glorious Glasgow Haskell Compilation System], [8.10.2], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) +AC_INIT([The Glorious Glasgow Haskell Compilation System], [8.10.3], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) # Set this to YES for a released version, otherwise NO -: ${RELEASE=NO} +: ${RELEASE=YES} # The primary version (e.g. 7.5, 7.4.1) is set in the AC_INIT line # above. If this is not a released version, then we will append the View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dbb0d6909e3887dde04c7d6fbb97ca00db9f14a0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dbb0d6909e3887dde04c7d6fbb97ca00db9f14a0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Dec 13 22:38:04 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sun, 13 Dec 2020 17:38:04 -0500 Subject: [Git][ghc/ghc][wip/backports-9.0] 3 commits: Bump Cabal submodule to 3.4.0.0-rc5 Message-ID: <5fd697ccbad54_6b21628164813833c6@gitlab.mail> Ben Gamari pushed to branch wip/backports-9.0 at Glasgow Haskell Compiler / GHC Commits: 1144a1e8 by Ben Gamari at 2020-12-13T17:32:11-05:00 Bump Cabal submodule to 3.4.0.0-rc5 - - - - - d573827f by Andreas Klebinger at 2020-12-13T17:36:42-05:00 RegAlloc: Add missing raPlatformfield to RegAllocStatsSpill Fixes #18994 Co-Author: Benjamin Maurer <maurer.benjamin at gmail.com> (cherry picked from commit 3e3555cc9c2a9f5246895f151259fd2a81621f38) - - - - - 9ca9e1fd by Shayne Fletcher at 2020-12-13T17:37:20-05:00 Fix bad span calculations of post qualified imports (cherry picked from commit 4a437bc19d2026845948356a932b2cac2417eb12) - - - - - 7 changed files: - compiler/GHC/CmmToAsm/Reg/Graph.hs - compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs - compiler/GHC/Parser.y - libraries/Cabal - testsuite/tests/module/all.T - + testsuite/tests/module/mod185.hs - + testsuite/tests/module/mod185.stderr Changes: ===================================== compiler/GHC/CmmToAsm/Reg/Graph.hs ===================================== @@ -278,7 +278,8 @@ regAlloc_spin config spinCount triv regsFree slotsFree slotsCount debug_codeGrap , raCoalesced = rmCoalesce , raSpillStats = spillStats , raSpillCosts = spillCosts - , raSpilled = code_spilled } + , raSpilled = code_spilled + , raPlatform = platform } -- Bundle up all the register allocator statistics. -- .. but make sure to drop them on the floor if they're not ===================================== compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs ===================================== @@ -73,7 +73,11 @@ data RegAllocStats statics instr , raSpillCosts :: SpillCostInfo -- | Code with spill instructions added. - , raSpilled :: [LiveCmmDecl statics instr] } + , raSpilled :: [LiveCmmDecl statics instr] + + -- | Target platform + , raPlatform :: !Platform + } -- a successful coloring ===================================== compiler/GHC/Parser.y ===================================== @@ -967,18 +967,20 @@ importdecls_semi importdecl :: { LImportDecl GhcPs } : 'import' maybe_src maybe_safe optqualified maybe_pkg modid optqualified maybeas maybeimpspec {% do { - ; checkImportDecl $4 $7 - ; ams (L (comb4 $1 $6 (snd $8) $9) $ + ; let { ; mPreQual = unLoc $4 + ; mPostQual = unLoc $7 } + ; checkImportDecl mPreQual mPostQual + ; ams (L (comb5 $1 $6 $7 (snd $8) $9) $ ImportDecl { ideclExt = noExtField , ideclSourceSrc = snd $ fst $2 , ideclName = $6, ideclPkgQual = snd $5 , ideclSource = snd $2, ideclSafe = snd $3 - , ideclQualified = importDeclQualifiedStyle $4 $7 + , ideclQualified = importDeclQualifiedStyle mPreQual mPostQual , ideclImplicit = False , ideclAs = unLoc (snd $8) , ideclHiding = unLoc $9 }) - (mj AnnImport $1 : fst (fst $2) ++ fst $3 ++ fmap (mj AnnQualified) (maybeToList $4) - ++ fst $5 ++ fmap (mj AnnQualified) (maybeToList $7) ++ fst $8) + (mj AnnImport $1 : fst (fst $2) ++ fst $3 ++ fmap (mj AnnQualified) (maybeToList mPreQual) + ++ fst $5 ++ fmap (mj AnnQualified) (maybeToList mPostQual) ++ fst $8) } } @@ -1002,9 +1004,9 @@ maybe_pkg :: { ([AddAnn],Maybe StringLiteral) } ; return ([mj AnnPackageName $1], Just (StringLiteral (getSTRINGs $1) pkgFS)) } } | {- empty -} { ([],Nothing) } -optqualified :: { Maybe (Located Token) } - : 'qualified' { Just $1 } - | {- empty -} { Nothing } +optqualified :: { Located (Maybe (Located Token)) } + : 'qualified' { sL1 $1 (Just $1) } + | {- empty -} { noLoc Nothing } maybeas :: { ([AddAnn],Located (Maybe (Located ModuleName))) } : 'as' modid { ([mj AnnAs $1] @@ -3754,6 +3756,11 @@ comb4 a b c d = a `seq` b `seq` c `seq` d `seq` (combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $ combineSrcSpans (getLoc c) (getLoc d)) +comb5 :: Located a -> Located b -> Located c -> Located d -> Located e -> SrcSpan +comb5 a b c d e = a `seq` b `seq` c `seq` d `seq` e `seq` + (combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $ + combineSrcSpans (getLoc c) $ combineSrcSpans (getLoc d) (getLoc e)) + -- strict constructor version: {-# INLINE sL #-} sL :: SrcSpan -> a -> Located a ===================================== libraries/Cabal ===================================== @@ -1 +1 @@ -Subproject commit 5aea8a4b8463e1ae95272e190a1022764164294f +Subproject commit 7907a676ada3a5944cfa3b45e23deda7496767cf ===================================== testsuite/tests/module/all.T ===================================== @@ -268,6 +268,7 @@ test('mod181', normal, compile, ['']) test('mod182', normal, compile_fail, ['']) test('mod183', normal, compile_fail, ['']) test('mod184', normal, compile, ['-Wprepositive-qualified-module']) +test('mod185', normal, compile, ['-ddump-parsed-ast']) test('T1148', normal, compile, ['']) test('T1074', normal, compile, ['']) ===================================== testsuite/tests/module/mod185.hs ===================================== @@ -0,0 +1,5 @@ +{-# LANGUAGE ImportQualifiedPost #-} +-- The span of the import decl should include the 'qualified' keyword. +import Prelude qualified + +main = Prelude.undefined ===================================== testsuite/tests/module/mod185.stderr ===================================== @@ -0,0 +1,62 @@ +==================== Parser AST ==================== + +({ mod185.hs:1:1 } + (HsModule + (VirtualBraces + (1)) + (Nothing) + (Nothing) + [({ mod185.hs:3:1-24 } + (ImportDecl + (NoExtField) + (NoSourceText) + ({ mod185.hs:3:8-14 } + {ModuleName: Prelude}) + (Nothing) + (NotBoot) + (False) + (QualifiedPost) + (False) + (Nothing) + (Nothing)))] + [({ mod185.hs:5:1-24 } + (ValD + (NoExtField) + (FunBind + (NoExtField) + ({ mod185.hs:5:1-4 } + (Unqual + {OccName: main})) + (MG + (NoExtField) + ({ mod185.hs:5:1-24 } + [({ mod185.hs:5:1-24 } + (Match + (NoExtField) + (FunRhs + ({ mod185.hs:5:1-4 } + (Unqual + {OccName: main})) + (Prefix) + (NoSrcStrict)) + [] + (GRHSs + (NoExtField) + [({ mod185.hs:5:6-24 } + (GRHS + (NoExtField) + [] + ({ mod185.hs:5:8-24 } + (HsVar + (NoExtField) + ({ mod185.hs:5:8-24 } + (Qual + {ModuleName: Prelude} + {OccName: undefined}))))))] + ({ } + (EmptyLocalBinds + (NoExtField))))))]) + (FromSource)) + [])))] + (Nothing) + (Nothing))) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/794616b6c4ab6537304777cfb5616cd5fc031a2f...9ca9e1fd2197a57291824ed4e4266182b8d909a1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/794616b6c4ab6537304777cfb5616cd5fc031a2f...9ca9e1fd2197a57291824ed4e4266182b8d909a1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Dec 13 22:46:57 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sun, 13 Dec 2020 17:46:57 -0500 Subject: [Git][ghc/ghc][wip/backports-8.10] parser: Backport comb5 combinator Message-ID: <5fd699e1f11be_6b214a47f7813877d2@gitlab.mail> Ben Gamari pushed to branch wip/backports-8.10 at Glasgow Haskell Compiler / GHC Commits: 035e9e43 by Ben Gamari at 2020-12-13T17:46:16-05:00 parser: Backport comb5 combinator - - - - - 1 changed file: - compiler/parser/Parser.y Changes: ===================================== compiler/parser/Parser.y ===================================== @@ -3898,6 +3898,11 @@ comb4 a b c d = a `seq` b `seq` c `seq` d `seq` (combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $ combineSrcSpans (getLoc c) (getLoc d)) +comb5 :: Located a -> Located b -> Located c -> Located d -> Located e -> SrcSpan +comb5 a b c d e = a `seq` b `seq` c `seq` d `seq` e `seq` + (combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $ + combineSrcSpans (getLoc c) $ combineSrcSpans (getLoc d) (getLoc e)) + -- strict constructor version: {-# INLINE sL #-} sL :: HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/035e9e43be763626b563a08c138e10df0538aa54 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/035e9e43be763626b563a08c138e10df0538aa54 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Dec 13 23:14:00 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sun, 13 Dec 2020 18:14:00 -0500 Subject: [Git][ghc/ghc][wip/backports-8.10] 3 commits: Fix bad span calculations of post qualified imports Message-ID: <5fd6a0386df21_6b2131d5c3813885f9@gitlab.mail> Ben Gamari pushed to branch wip/backports-8.10 at Glasgow Haskell Compiler / GHC Commits: 4ad5c728 by Shayne Fletcher at 2020-12-13T18:13:10-05:00 Fix bad span calculations of post qualified imports (cherry picked from commit 57f3fdb1fbeb82b5b19bc5e2970d8857c2514fcc) - - - - - e973ab87 by Ben Gamari at 2020-12-13T18:13:10-05:00 gitlab-ci: Rename RELEASE variable to RELEASE_JOB This interfered with the autoconf variable of the same name, breaking pre-release builds. (cherry picked from commit 15dca84793d5ec4ff922726477923e40caa075eb) (cherry picked from commit 3e55edd97c8eba271f5cb64b9362796791e0e887) - - - - - 8bc3842e by Ben Gamari at 2020-12-13T18:13:10-05:00 configure: Release 8.10.3 - - - - - 7 changed files: - .gitlab-ci.yml - compiler/parser/Parser.y - configure.ac - libraries/text - testsuite/tests/module/all.T - + testsuite/tests/module/mod185.hs - + testsuite/tests/module/mod185.stderr Changes: ===================================== .gitlab-ci.yml ===================================== @@ -52,7 +52,7 @@ stages: expire_in: 1 year only: variables: - - $RELEASE == "yes" + - $RELEASE_JOB == "yes" ############################################################ # Runner Tags ===================================== compiler/parser/Parser.y ===================================== @@ -973,18 +973,20 @@ importdecls_semi importdecl :: { LImportDecl GhcPs } : 'import' maybe_src maybe_safe optqualified maybe_pkg modid optqualified maybeas maybeimpspec {% do { - ; checkImportDecl $4 $7 - ; ams (cL (comb4 $1 $6 (snd $8) $9) $ + ; let { ; mPreQual = unLoc $4 + ; mPostQual = unLoc $7 } + ; checkImportDecl mPreQual mPostQual + ; ams (cL (comb5 $1 $6 $7 (snd $8) $9) $ ImportDecl { ideclExt = noExtField , ideclSourceSrc = snd $ fst $2 , ideclName = $6, ideclPkgQual = snd $5 , ideclSource = snd $2, ideclSafe = snd $3 - , ideclQualified = importDeclQualifiedStyle $4 $7 + , ideclQualified = importDeclQualifiedStyle mPreQual mPostQual , ideclImplicit = False , ideclAs = unLoc (snd $8) , ideclHiding = unLoc $9 }) - (mj AnnImport $1 : fst (fst $2) ++ fst $3 ++ fmap (mj AnnQualified) (maybeToList $4) - ++ fst $5 ++ fmap (mj AnnQualified) (maybeToList $7) ++ fst $8) + (mj AnnImport $1 : fst (fst $2) ++ fst $3 ++ fmap (mj AnnQualified) (maybeToList mPreQual) + ++ fst $5 ++ fmap (mj AnnQualified) (maybeToList mPostQual) ++ fst $8) } } @@ -1008,9 +1010,9 @@ maybe_pkg :: { ([AddAnn],Maybe StringLiteral) } ; return ([mj AnnPackageName $1], Just (StringLiteral (getSTRINGs $1) pkgFS)) } } | {- empty -} { ([],Nothing) } -optqualified :: { Maybe (Located Token) } - : 'qualified' { Just $1 } - | {- empty -} { Nothing } +optqualified :: { Located (Maybe (Located Token)) } + : 'qualified' { sL1 $1 (Just $1) } + | {- empty -} { noLoc Nothing } maybeas :: { ([AddAnn],Located (Maybe (Located ModuleName))) } : 'as' modid { ([mj AnnAs $1] @@ -3896,6 +3898,11 @@ comb4 a b c d = a `seq` b `seq` c `seq` d `seq` (combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $ combineSrcSpans (getLoc c) (getLoc d)) +comb5 :: Located a -> Located b -> Located c -> Located d -> Located e -> SrcSpan +comb5 a b c d e = a `seq` b `seq` c `seq` d `seq` e `seq` + (combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $ + combineSrcSpans (getLoc c) $ combineSrcSpans (getLoc d) (getLoc e)) + -- strict constructor version: {-# INLINE sL #-} sL :: HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a ===================================== configure.ac ===================================== @@ -13,10 +13,10 @@ dnl # see what flags are available. (Better yet, read the documentation!) # -AC_INIT([The Glorious Glasgow Haskell Compilation System], [8.10.2], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) +AC_INIT([The Glorious Glasgow Haskell Compilation System], [8.10.3], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) # Set this to YES for a released version, otherwise NO -: ${RELEASE=NO} +: ${RELEASE=YES} # The primary version (e.g. 7.5, 7.4.1) is set in the AC_INIT line # above. If this is not a released version, then we will append the ===================================== libraries/text ===================================== @@ -1 +1 @@ -Subproject commit be54b46175db603aafea3e3f19a6a75e87a29828 +Subproject commit e07c14940c25f33fe5b282912d745d3a79dd4ade ===================================== testsuite/tests/module/all.T ===================================== @@ -268,6 +268,7 @@ test('mod181', normal, compile, ['']) test('mod182', normal, compile_fail, ['']) test('mod183', normal, compile_fail, ['']) test('mod184', normal, compile, ['-Wprepositive-qualified-module']) +test('mod185', normal, compile, ['-ddump-parsed-ast']) test('T1148', normal, compile, ['']) test('T1074', normal, compile, ['']) ===================================== testsuite/tests/module/mod185.hs ===================================== @@ -0,0 +1,5 @@ +{-# LANGUAGE ImportQualifiedPost #-} +-- The span of the import decl should include the 'qualified' keyword. +import Prelude qualified + +main = Prelude.undefined ===================================== testsuite/tests/module/mod185.stderr ===================================== @@ -0,0 +1,62 @@ +==================== Parser AST ==================== + +({ mod185.hs:1:1 } + (HsModule + (VirtualBraces + (1)) + (Nothing) + (Nothing) + [({ mod185.hs:3:1-24 } + (ImportDecl + (NoExtField) + (NoSourceText) + ({ mod185.hs:3:8-14 } + {ModuleName: Prelude}) + (Nothing) + (NotBoot) + (False) + (QualifiedPost) + (False) + (Nothing) + (Nothing)))] + [({ mod185.hs:5:1-24 } + (ValD + (NoExtField) + (FunBind + (NoExtField) + ({ mod185.hs:5:1-4 } + (Unqual + {OccName: main})) + (MG + (NoExtField) + ({ mod185.hs:5:1-24 } + [({ mod185.hs:5:1-24 } + (Match + (NoExtField) + (FunRhs + ({ mod185.hs:5:1-4 } + (Unqual + {OccName: main})) + (Prefix) + (NoSrcStrict)) + [] + (GRHSs + (NoExtField) + [({ mod185.hs:5:6-24 } + (GRHS + (NoExtField) + [] + ({ mod185.hs:5:8-24 } + (HsVar + (NoExtField) + ({ mod185.hs:5:8-24 } + (Qual + {ModuleName: Prelude} + {OccName: undefined}))))))] + ({ } + (EmptyLocalBinds + (NoExtField))))))]) + (FromSource)) + [])))] + (Nothing) + (Nothing))) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/035e9e43be763626b563a08c138e10df0538aa54...8bc3842ea66cd69555bec2679b731599a96aa2f0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/035e9e43be763626b563a08c138e10df0538aa54...8bc3842ea66cd69555bec2679b731599a96aa2f0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Dec 14 01:13:55 2020 From: gitlab at gitlab.haskell.org (Shayne Fletcher) Date: Sun, 13 Dec 2020 20:13:55 -0500 Subject: [Git][ghc/ghc][wip/T18599] GetField desugar on typecheck Message-ID: <5fd6bc53deabf_6b2174471c1392364@gitlab.mail> Shayne Fletcher pushed to branch wip/T18599 at Glasgow Haskell Compiler / GHC Commits: 3015d6d7 by Shayne Fletcher at 2020-12-13T20:13:40-05:00 GetField desugar on typecheck - - - - - 6 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Types/Origin.hs - testsuite/tests/parser/should_run/RecordDotSyntax.hs Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -495,7 +495,6 @@ data HsExpr p , gf_expr :: LHsExpr p , gf_field :: Located FastString , gf_get_field :: Maybe (IdP p) - , gf_getField :: LHsExpr p -- Desugared equivalent 'getField' term. } -- ^ @Just id@ means @RebindableSyntax@ is in use and gives the id -- of the in-scope 'getField'. ===================================== compiler/GHC/Parser/PostProcess.hs ===================================== @@ -2763,7 +2763,6 @@ mkGetField loc arg field = , gf_expr = arg , gf_field = field , gf_get_field = Nothing - , gf_getField = mkGet arg field } mkProjection :: SrcSpan -> [Located FastString] -> LHsExpr GhcPs ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -212,22 +212,41 @@ rnExpr (NegApp _ e _) ------------------------------------------ -- Record dot syntax -rnExpr (GetField x e f _ g) - = do { (e', _) <- rnLExpr e - ; (g', fv) <- rnLExpr g - ; return (GetField x e' f Nothing g', fv) + +rnExpr (GetField x e f _) + = do { rebindable_on <- xoptM LangExt.RebindableSyntax + ; (e', fvs) <- rnLExpr e + ; if rebindable_on + then do { + getField <- lookupOccRn (mkVarUnqual (fsLit "getField")) + ; return (GetField x e' f (Just getField), fvs `plusFV` unitFV getField) + } + else return (GetField x e' f Nothing, fvs) } rnExpr (Projection x fs _ p) - = do { (p', fv) <- rnLExpr p - ; return (Projection x fs Nothing p', fv) + = do { rebindable_on <- xoptM LangExt.RebindableSyntax + ; (p', fv) <- rnLExpr p + ; if rebindable_on + then do { + getField <- lookupOccRn (mkVarUnqual (fsLit "getField")) + ; return (Projection x fs (Just getField) p', fv) + } + else return (Projection x fs Nothing p', fv) } rnExpr (RecordDotUpd x e us _ f) - = do { (e', _) <- rnLExpr e + = do { rebindable_on <- xoptM LangExt.RebindableSyntax + ; (e', _) <- rnLExpr e ; us' <- map fst <$> mapM rnRecUpdProj us ; (f', fv) <- rnLExpr f - ; return (RecordDotUpd x e' us' Nothing f', fv) + ; if rebindable_on + then do { + getField <- lookupOccRn (mkVarUnqual (fsLit "getField")) + ; setField <- lookupOccRn (mkVarUnqual (fsLit "setField")) + ; return (RecordDotUpd x e' us'(Just (getField, setField)) f', fv) + } + else return (RecordDotUpd x e' us' Nothing f', fv) } where rnRecUpdProj :: LHsRecUpdProj GhcPs -> RnM (LHsRecUpdProj GhcRn, FreeVars) ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -86,6 +86,8 @@ import qualified GHC.LanguageExtensions as LangExt import Data.Function import Data.List (partition, sortBy, groupBy, intersect) +import GHC.Types.Fixity + {- ************************************************************************ * * @@ -934,7 +936,14 @@ tcExpr (ArithSeq _ witness seq) res_ty * * ************************************************************************ -} -tcExpr (GetField _ _ _ _ (L _ g)) res_ty = tcExpr g res_ty + +tcExpr (GetField _ arg field mb_getField) res_ty + = do { -- See Note [Type-checking record dot syntax] (not written yet) + loc <- getSrcSpanM + ; case mb_getField of + Just getField -> tcExpr (mkGet loc getField arg field) res_ty + Nothing -> panic "tcExpr: GetField: Not implemented" + } tcExpr (Projection _ _ _ (L _ p)) res_ty = tcExpr p res_ty tcExpr (RecordDotUpd _ _ _ _ (L _ s)) res_ty = tcExpr s res_ty @@ -1830,3 +1839,34 @@ checkClosedInStaticForm name = do -- When @n@ is not closed, we traverse the graph reachable from @n@ to build -- the reason. -- + +----------------------------------------- +-- Bits and pieces for RecordDotSyntax. + +mkParen :: SrcSpan -> LHsExpr GhcRn -> LHsExpr GhcRn +mkParen loc = L loc . HsPar noExtField + +mkApp :: SrcSpan -> LHsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn +mkApp loc x = L loc . HsApp noExtField x + +_mkOpApp :: LHsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn +_mkOpApp x op = noLoc . OpApp (Fixity NoSourceText minPrecedence InfixL) x op + +mkAppType :: SrcSpan -> LHsExpr GhcRn -> GenLocated SrcSpan (HsType (NoGhcTc GhcRn)) -> LHsExpr GhcRn +mkAppType loc expr = L loc . HsAppType noExtField expr . mkEmptyWildCardBndrs + +mkSelector :: SrcSpan -> FastString -> LHsType GhcRn +mkSelector loc = L loc . HsTyLit noExtField . HsStrTy NoSourceText + +-- mkGet arg field calcuates a get_field @field arg expression. +-- e.g. z.x = mkGet z x = get_field @x z +mkGet :: SrcSpan -> Name -> LHsExpr GhcRn -> Located FastString -> HsExpr GhcRn +mkGet loc get_field arg field = unLoc (head $ mkGet' loc get_field [arg] field) + +mkGet' :: SrcSpan -> Name -> [LHsExpr GhcRn] -> Located FastString -> [LHsExpr GhcRn] +mkGet' loc get_field l@(r : _) (L _ field) = + mkApp loc (mkAppType loc (L loc (HsVar noExtField (L loc get_field))) + (mkSelector loc field)) (mkParen loc r) + : l + +mkGet' _ _ [] _ = panic "mkGet' : The impossible has happened!" ===================================== compiler/GHC/Tc/Types/Origin.hs ===================================== @@ -493,7 +493,7 @@ exprCtOrigin (HsAppType _ e1 _) = lexprCtOrigin e1 exprCtOrigin (OpApp _ _ op _) = lexprCtOrigin op exprCtOrigin (NegApp _ e _) = lexprCtOrigin e exprCtOrigin (HsPar _ e) = lexprCtOrigin e -exprCtOrigin (GetField _ e _ _ _) = lexprCtOrigin e +exprCtOrigin (GetField _ e _ _ ) = lexprCtOrigin e exprCtOrigin (Projection _ _ _ _) = SectionOrigin exprCtOrigin (SectionL _ _ _) = SectionOrigin exprCtOrigin (SectionR _ _ _) = SectionOrigin ===================================== testsuite/tests/parser/should_run/RecordDotSyntax.hs ===================================== @@ -7,6 +7,9 @@ {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE RebindableSyntax #-} +import Prelude + -- Choice (C2a). import Data.Function -- for & View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3015d6d7a93f2a9ff25aef98042757bb431bc0f7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3015d6d7a93f2a9ff25aef98042757bb431bc0f7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Dec 14 02:58:31 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sun, 13 Dec 2020 21:58:31 -0500 Subject: [Git][ghc/ghc][wip/backports-8.10] Disable deprecation warnings in Cabal build Message-ID: <5fd6d4d7842bf_6b21501685013958bb@gitlab.mail> Ben Gamari pushed to branch wip/backports-8.10 at Glasgow Haskell Compiler / GHC Commits: 46d078b5 by Ben Gamari at 2020-12-13T21:58:00-05:00 Disable deprecation warnings in Cabal build - - - - - 2 changed files: - hadrian/src/Settings/Warnings.hs - mk/warnings.mk Changes: ===================================== hadrian/src/Settings/Warnings.hs ===================================== @@ -29,6 +29,7 @@ ghcWarningsArgs = do , package base ? pure [ "-Wno-trustworthy-safe" ] , package binary ? pure [ "-Wno-deprecations" ] , package bytestring ? pure [ "-Wno-inline-rule-shadowing" ] + , package cabal ? pure [ "-Wno-error=deprecations" ] , package compiler ? pure [ "-Wcpp-undef" ] , package directory ? pure [ "-Wno-unused-imports" ] , package ghc ? pure [ "-Wcpp-undef" ] ===================================== mk/warnings.mk ===================================== @@ -80,6 +80,8 @@ libraries/haskeline_dist-install_EXTRA_HC_OPTS += -Wno-unused-imports libraries/haskeline_dist-install_EXTRA_HC_OPTS += -Wno-redundant-constraints libraries/haskeline_dist-install_EXTRA_HC_OPTS += -Wno-simplifiable-class-constraints +# Due to deprecation warning +libraries/Cabal_dist-install_EXTRA_HC_OPTS += -Wno-error=deprecations # temporarily turn off unused-imports warnings for pretty libraries/pretty_dist-install_EXTRA_HC_OPTS += -Wno-unused-imports View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/46d078b5e8c15ac8433b718dc787d4a48b492242 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/46d078b5e8c15ac8433b718dc787d4a48b492242 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Dec 14 04:29:17 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sun, 13 Dec 2020 23:29:17 -0500 Subject: [Git][ghc/ghc][wip/backports-8.10] Disable deprecation warnings in Cabal build Message-ID: <5fd6ea1d80a80_6b215c5fa6c1397210@gitlab.mail> Ben Gamari pushed to branch wip/backports-8.10 at Glasgow Haskell Compiler / GHC Commits: cd3806ae by Ben Gamari at 2020-12-13T23:28:54-05:00 Disable deprecation warnings in Cabal build - - - - - 2 changed files: - hadrian/src/Settings/Warnings.hs - mk/warnings.mk Changes: ===================================== hadrian/src/Settings/Warnings.hs ===================================== @@ -51,4 +51,7 @@ ghcWarningsArgs = do , "-Wno-redundant-constraints" , "-Wno-orphans" ] , package win32 ? pure [ "-Wno-trustworthy-safe" ] - , package xhtml ? pure [ "-Wno-unused-imports" ] ] ] + , package xhtml ? pure [ "-Wno-unused-imports" ] ] + , mconcat + [ package cabal ? pure [ "-Wno-error=deprecations" ] ] + ] ===================================== mk/warnings.mk ===================================== @@ -80,6 +80,8 @@ libraries/haskeline_dist-install_EXTRA_HC_OPTS += -Wno-unused-imports libraries/haskeline_dist-install_EXTRA_HC_OPTS += -Wno-redundant-constraints libraries/haskeline_dist-install_EXTRA_HC_OPTS += -Wno-simplifiable-class-constraints +# Due to deprecation warning +libraries/Cabal_dist-install_EXTRA_HC_OPTS += -Wno-error=deprecations # temporarily turn off unused-imports warnings for pretty libraries/pretty_dist-install_EXTRA_HC_OPTS += -Wno-unused-imports View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cd3806aea179f93b06aa8e3154135e4939032330 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cd3806aea179f93b06aa8e3154135e4939032330 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Dec 14 07:32:52 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Mon, 14 Dec 2020 02:32:52 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/T19053 Message-ID: <5fd7152472f40_6b213272ce01399073@gitlab.mail> Sebastian Graf pushed new branch wip/T19053 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T19053 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Dec 14 13:25:34 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 14 Dec 2020 08:25:34 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: Remove old .travis.yml Message-ID: <5fd767ce43db5_6b213272ce01428689@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 78580ba3 by John Ericson at 2020-12-13T07:14:50-05:00 Remove old .travis.yml - - - - - 1bce2f01 by Cale Gibbard at 2020-12-14T08:25:25-05:00 Implement type applications in patterns The haddock submodule is also updated so that it understands the changes to patterns. - - - - - e990a9ac by Sebastian Graf at 2020-12-14T08:25:25-05:00 Add regression test for #19053 - - - - - 30 changed files: - − .travis.yml - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Errors.hs - compiler/GHC/Parser/Errors/Ppr.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Parser/PostProcess/Haddock.hs - compiler/GHC/Parser/Types.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Gen/Rule.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/PatSyn.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9cc868bfd7ed77ffcc191028c5f57c97df634b79...e990a9aceb129ac0dc406a41e92633e23ec9753f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9cc868bfd7ed77ffcc191028c5f57c97df634b79...e990a9aceb129ac0dc406a41e92633e23ec9753f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Dec 14 13:45:11 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Mon, 14 Dec 2020 08:45:11 -0500 Subject: [Git][ghc/ghc][wip/T17656] 26 commits: doc: Clarify the default for -fomit-yields Message-ID: <5fd76c67bc3e9_6b215c5fa6c14307a5@gitlab.mail> Simon Peyton Jones pushed to branch wip/T17656 at Glasgow Haskell Compiler / GHC Commits: 35e7b0c6 by Kirill Elagin at 2020-12-10T01:45:54-05:00 doc: Clarify the default for -fomit-yields “Yield points enabled” is confusing (and probably wrong? I am not 100% sure what it means). Change it to a simple “on”. Undo this change from 2c23fff2e03e77187dc4d01f325f5f43a0e7cad2. - - - - - 3551c554 by Kirill Elagin at 2020-12-10T01:45:54-05:00 doc: Extra-clarify -fomit-yields Be more clear on what this optimisation being on by default means in terms of yields. - - - - - 6484f0d7 by Sergei Trofimovich at 2020-12-10T01:46:33-05:00 rts/linker/Elf.c: add missing <dlfcn.h> include (musl support) The change fixes build failure on musl: ``` rts/linker/Elf.c:2031:3: error: warning: implicit declaration of function 'dlclose'; did you mean 'close'? [-Wimplicit-function-declaration] 2031 | dlclose(nc->dlopen_handle); | ^~~~~~~ | close ``` Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - ab24ed9b by Ben Gamari at 2020-12-11T03:55:51-05:00 users guide: Fix syntax errors Fixes errors introduced by 3a55b3a2574f913d046f3a6f82db48d7f6df32e3. - - - - - d3a24d31 by Ben Gamari at 2020-12-11T03:55:51-05:00 users guide: Describe GC lifecycle events Every time I am asked about how to interpret these events I need to figure it out from scratch. It's well past time that the users guide properly documents these. - - - - - 741309b9 by Ben Gamari at 2020-12-11T03:56:27-05:00 gitlab-ci: Fix incorrect Docker image for nightly cross job Also refactor the job definition to eliminate the bug by construction. - - - - - 19703bc8 by Ben Gamari at 2020-12-11T03:56:27-05:00 gitlab-ci: Fix name of flavour in ThreadSanitizer job It looks like I neglected to update this after introduce flavour transformers. - - - - - 381eb660 by Sylvain Henry at 2020-12-11T12:57:35-05:00 Display FFI labels (fix #18539) - - - - - 4548d1f8 by Aaron Allen at 2020-12-11T12:58:14-05:00 Elide extraneous messages for :doc command (#15784) Do not print `<has no documentation>` alongside a valid doc. Additionally, if two matching symbols lack documentation then the message will only be printed once. Hence, `<has no documentation>` will be printed at most once and only if all matching symbols are lacking docs. - - - - - 5eba91b6 by Aaron Allen at 2020-12-11T12:58:14-05:00 Add :doc test case for duplicate record fields Tests that the output of the `:doc` command is correct for duplicate record fields defined using -XDuplicateRecordFields. - - - - - 5feb9b2d by Ryan Scott at 2020-12-11T22:39:29-05:00 Delete outdated Note [Kind-checking tyvar binders for associated types] This Note has severely bitrotted, as it has no references anywhere in the codebase, and none of the functions that it mentions exist anymore. Let's just delete this. While I was in town, I deleted some outdated comments from `checkFamPatBinders` of a similar caliber. Fixes #19008. [ci skip] - - - - - f9f9f030 by Sylvain Henry at 2020-12-11T22:40:08-05:00 Arrows: correctly query arrow methods (#17423) Consider the following code: proc (C x y) -> ... Before this patch, the evidence binding for the Arrow dictionary was attached to the C pattern: proc (C x y) { $dArrow = ... } -> ... But then when we desugar this, we use arrow operations ("arr", ">>>"...) specialised for this arrow: let arr_xy = arr $dArrow -- <-- Not in scope! ... in arr_xy (\(C x y) { $dArrow = ... } -> ...) This patch allows arrow operations to be type-checked before the proc itself, avoiding this issue. Fix #17423 - - - - - aaa8f00f by Sylvain Henry at 2020-12-11T22:40:48-05:00 Validate script: fix configure command when using stack - - - - - b4a929a1 by Sylvain Henry at 2020-12-11T22:41:30-05:00 Hadrian: fix libffi tarball parsing Fix parsing of "libffi-3.3.tar.gz". NB: switch to a newer libffi isn't done in this patch - - - - - 690c8946 by Sylvain Henry at 2020-12-11T22:42:09-05:00 Parser: move parser utils into their own module Move code unrelated to runtime evaluation out of GHC.Runtime.Eval - - - - - 76be0e32 by Sylvain Henry at 2020-12-11T22:42:48-05:00 Move SizedSeq into ghc-boot - - - - - 3a16d764 by Sylvain Henry at 2020-12-11T22:42:48-05:00 ghci: don't compile unneeded modules - - - - - 2895fa60 by Sylvain Henry at 2020-12-11T22:42:48-05:00 ghci: reuse Arch from ghc-boot - - - - - 480a38d4 by Sylvain Henry at 2020-12-11T22:43:30-05:00 rts: don't use siginterrupt (#19019) - - - - - 4af6126d by Sylvain Henry at 2020-12-11T22:44:11-05:00 Use static array in zeroCount - - - - - 5bd71bfd by Sebastian Graf at 2020-12-12T04:45:09-05:00 DmdAnal: Annotate top-level function bindings with demands (#18894) It's useful to annotate a non-exported top-level function like `g` in ```hs module Lib (h) where g :: Int -> Int -> (Int,Int) g m 1 = (m, 0) g m n = (2 * m, 2 `div` n) {-# NOINLINE g #-} h :: Int -> Int h 1 = 0 h m | odd m = snd (g m 2) | otherwise = uncurry (+) (g 2 m) ``` with its demand `UCU(CS(P(1P(U),SP(U))`, which tells us that whenever `g` was called, the second component of the returned pair was evaluated strictly. Since #18903 we do so for local functions, where we can see all calls. For top-level functions, we can assume that all *exported* functions are demanded according to `topDmd` and thus get sound demands for non-exported top-level functions. The demand on `g` is crucial information for Nested CPR, which may the go on and unbox `g` for the second pair component. That is true even if that pair component may diverge, as is the case for the call site `g 13 0`, which throws a div-by-zero exception. In `T18894b`, you can even see the new demand annotation enabling us to eta-expand a function that we wouldn't be able to eta-expand without Call Arity. We only track bindings of function type in order not to risk huge compile-time regressions, see `isInterestingTopLevelFn`. There was a CoreLint check that rejected strict demand annotations on recursive or top-level bindings, which seems completely unjustified. All the cases I investigated were fine, so I removed it. Fixes #18894. - - - - - 3aae036e by Sebastian Graf at 2020-12-12T04:45:09-05:00 Demand: Simplify `CU(U)` to `U` (#19005) Both sub-demands encode the same information. This is a trivial change and already affects a few regression tests (e.g. `T5075`), so no separate regression test is necessary. - - - - - c6477639 by Adam Sandberg Ericsson at 2020-12-12T04:45:48-05:00 hadrian: correctly copy the docs dir into the bindist #18669 - - - - - e033dd05 by Adam Sandberg Ericsson at 2020-12-12T10:52:19+00:00 mkDocs: support hadrian bindists #18973 - - - - - 78580ba3 by John Ericson at 2020-12-13T07:14:50-05:00 Remove old .travis.yml - - - - - c11fc475 by Simon Peyton Jones at 2020-12-14T13:44:40+00:00 Kill floatEqualities completely This patch delivers on #17656, by entirel killing off the complex floatEqualities mechanism. Previously, floatEqualities would float an equality out of an implication, so that it could be solved at an outer level. But now we simply do unification in-place, without floating the constraint, relying on level numbers to determine untouchability. There are a number of important new Notes: * GHC.Tc.Utils.Unify Note [Unification preconditions] describes the preconditions for unification, including both skolem-escape and touchability. * GHC.Tc.Solver.Interact Note [Solve by unification] describes what we do when we do unify * GHC.Tc.Solver.Monad Note [The Unification Level Flag] describes how we control solver iteration under this new scheme * GHC.Tc.Solver.Monad Note [Tracking Given equalities] describes how we track when we have Given equalities * GHC.Tc.Types.Constraint Note [HasGivenEqs] is a new explanation of the ic_given_eqs field of an implication A big raft of subtle Notes in Solver, concerning floatEqualities, disappears. Main code changes: * GHC.Tc.Solver.floatEqualities disappears entirely * GHC.Tc.Solver.Monad: new fields in InertCans, inert_given_eq_lvl and inert_given_eq, updated by updateGivenEqs See Note [Tracking Given equalities]. * In exchange for updateGivenEqa, GHC.Tc.Solver.Monad.getHasGivenEqs is much simpler and more efficient * I found I could kill of metaTyVarUpdateOK entirely - - - - - 30 changed files: - .gitlab-ci.yml - − .travis.yml - compiler/GHC.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Tidy.hs - + compiler/GHC/Parser/Utils.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/Runtime/Heap/Inspect.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Arrow.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Interact.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Utils/Unify.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Demand.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/038ea2025161516387d06274f23a27ec336a9a8c...c11fc47596b435328d278eef48942e3755f94015 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/038ea2025161516387d06274f23a27ec336a9a8c...c11fc47596b435328d278eef48942e3755f94015 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Dec 14 15:13:38 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 14 Dec 2020 10:13:38 -0500 Subject: [Git][ghc/ghc][wip/backports-8.10] 2 commits: hadrian: Reindent Settings.Warnings Message-ID: <5fd78122b6228_6b2162825c01450781@gitlab.mail> Ben Gamari pushed to branch wip/backports-8.10 at Glasgow Haskell Compiler / GHC Commits: 63e10d71 by Ben Gamari at 2020-12-14T10:10:38-05:00 hadrian: Reindent Settings.Warnings The previous state was quite illegible. - - - - - eb9c45a0 by Ben Gamari at 2020-12-14T10:12:26-05:00 hadrian: Pass -Werror before other arguments Previously we would append -Werror to the argument list. However, this ended up overriding the -Wno-error=... flags in Settings.Warnings. - - - - - 2 changed files: - hadrian/src/Flavour.hs - hadrian/src/Settings/Warnings.hs Changes: ===================================== hadrian/src/Flavour.hs ===================================== @@ -2,7 +2,7 @@ module Flavour ( Flavour (..), werror , DocTargets, DocTarget(..) -- * Flavour transformers - , addArgs + , addArgs, addArgsBefore , splitSections, splitSectionsIf , enableThreadSanitizer , enableDebugInfo, enableTickyGhc @@ -71,10 +71,15 @@ data DocTarget = Haddocks | SphinxHTML | SphinxPDFs | SphinxMan | SphinxInfo addArgs :: Args -> Flavour -> Flavour addArgs args' fl = fl { args = args fl <> args' } +addArgsBefore :: Args -> Flavour -> Flavour +addArgsBefore args' fl = fl { args = args' <> args fl } + -- | Turn on -Werror for packages built with the stage1 compiler. -- It mimics the CI settings so is useful to turn on when developing. werror :: Flavour -> Flavour -werror = addArgs (builder Ghc ? notStage0 ? arg "-Werror") +werror = addArgsBefore (builder Ghc ? notStage0 ? arg "-Werror") + -- N.B. We add this flag *before* the others to ensure that we don't override + -- the -Wno-error flags defined in "Settings.Warnings". -- | Build C and Haskell objects with debugging information. enableDebugInfo :: Flavour -> Flavour ===================================== hadrian/src/Settings/Warnings.hs ===================================== @@ -20,38 +20,39 @@ ghcWarningsArgs = do isIntegerSimple <- (== integerSimple) <$> getIntegerPackage mconcat [ stage0 ? mconcat - [ libraryPackage ? pure [ "-fno-warn-deprecated-flags" ] - , package terminfo ? pure [ "-fno-warn-unused-imports" ] - , package transformers ? pure [ "-fno-warn-unused-matches" - , "-fno-warn-unused-imports" ] ] + [ libraryPackage ? pure [ "-fno-warn-deprecated-flags" ] + , package terminfo ? pure [ "-fno-warn-unused-imports" ] + , package transformers ? pure [ "-fno-warn-unused-matches" + , "-fno-warn-unused-imports" ] ] , notStage0 ? mconcat - [ libraryPackage ? pure [ "-Wno-deprecated-flags" ] - , package base ? pure [ "-Wno-trustworthy-safe" ] - , package binary ? pure [ "-Wno-deprecations" ] - , package bytestring ? pure [ "-Wno-inline-rule-shadowing" ] - , package compiler ? pure [ "-Wcpp-undef" ] - , package directory ? pure [ "-Wno-unused-imports" ] - , package ghc ? pure [ "-Wcpp-undef" ] - , package ghcPrim ? pure [ "-Wno-trustworthy-safe" ] - , package haddock ? pure [ "-Wno-unused-imports" - , "-Wno-deprecations" ] - , package haskeline ? pure [ "-Wno-deprecations" - , "-Wno-unused-imports" - , "-Wno-redundant-constraints" - , "-Wno-simplifiable-class-constraints" ] - , package pretty ? pure [ "-Wno-unused-imports" ] - , package primitive ? pure [ "-Wno-unused-imports" - , "-Wno-deprecations" ] - , package rts ? pure [ "-Wcpp-undef" ] - , package terminfo ? pure [ "-Wno-unused-imports" ] - , isIntegerSimple ? - package text ? pure [ "-Wno-unused-imports" ] - , package transformers ? pure [ "-Wno-unused-matches" - , "-Wno-unused-imports" - , "-Wno-redundant-constraints" - , "-Wno-orphans" ] - , package win32 ? pure [ "-Wno-trustworthy-safe" ] - , package xhtml ? pure [ "-Wno-unused-imports" ] ] + [ libraryPackage ? pure [ "-Wno-deprecated-flags" ] + , package base ? pure [ "-Wno-trustworthy-safe" ] + , package binary ? pure [ "-Wno-deprecations" ] + , package bytestring ? pure [ "-Wno-inline-rule-shadowing" ] + , package compiler ? pure [ "-Wcpp-undef" ] + , package directory ? pure [ "-Wno-unused-imports" ] + , package ghc ? pure [ "-Wcpp-undef" ] + , package ghcPrim ? pure [ "-Wno-trustworthy-safe" ] + , package haddock ? pure [ "-Wno-unused-imports" + , "-Wno-deprecations" ] + , package haskeline ? pure [ "-Wno-deprecations" + , "-Wno-unused-imports" + , "-Wno-redundant-constraints" + , "-Wno-simplifiable-class-constraints" ] + , package pretty ? pure [ "-Wno-unused-imports" ] + , package primitive ? pure [ "-Wno-unused-imports" + , "-Wno-deprecations" ] + , package rts ? pure [ "-Wcpp-undef" ] + , package terminfo ? pure [ "-Wno-unused-imports" ] + , isIntegerSimple ? + package text ? pure [ "-Wno-unused-imports" ] + , package transformers ? pure [ "-Wno-unused-matches" + , "-Wno-unused-imports" + , "-Wno-redundant-constraints" + , "-Wno-orphans" ] + , package win32 ? pure [ "-Wno-trustworthy-safe" ] + , package xhtml ? pure [ "-Wno-unused-imports" ] + ] , mconcat - [ package cabal ? pure [ "-Wno-error=deprecations" ] ] + [ package cabal ? pure [ "-Wno-error=deprecations" ] ] ] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cd3806aea179f93b06aa8e3154135e4939032330...eb9c45a0d612f8e16a0b0abd686534fedfdbac78 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cd3806aea179f93b06aa8e3154135e4939032330...eb9c45a0d612f8e16a0b0abd686534fedfdbac78 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Dec 14 15:20:28 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 14 Dec 2020 10:20:28 -0500 Subject: [Git][ghc/ghc][wip/T7275] 18 commits: CodeGen: Make folds User/DefinerOfRegs INLINEABLE. Message-ID: <5fd782bc963c8_6b2162816481454320@gitlab.mail> Ben Gamari pushed to branch wip/T7275 at Glasgow Haskell Compiler / GHC Commits: 51e3bb6d by Andreas Klebinger at 2020-12-08T22:43:21-05:00 CodeGen: Make folds User/DefinerOfRegs INLINEABLE. Reduces allocation for the test case I was looking at by about 1.2%. Mostly from avoiding allocation of some folding functions which turn into let-no-escape bindings which just reuse their environment instead. We also force inlining in a few key places in CmmSink which helps a bit more. - - - - - 69ae10c3 by Andreas Klebinger at 2020-12-08T22:43:21-05:00 CmmSink: Force inlining of foldRegsDefd Helps avoid allocating the folding function. Improves perf for T3294 by about 1%. - - - - - 6e3da800 by Andreas Klebinger at 2020-12-08T22:43:21-05:00 Cmm: Make a few types and utility function slightly stricter. About 0.6% reduction in allocations for the code I was looking at. Not a huge difference but no need to throw away performance. - - - - - aef44d7f by Andreas Klebinger at 2020-12-08T22:43:21-05:00 Cmm.Sink: Optimize retaining of assignments, live sets. Sinking requires us to track live local regs after each cmm statement. We used to do this via "Set LocalReg". However we can replace this with a solution based on IntSet which is overall more efficient without losing much. The thing we lose is width of the variables, which isn't used by the sinking pass anyway. I also reworked how we keep assignments to regs mentioned in skipped assignments. I put the details into Note [Keeping assignemnts mentioned in skipped RHSs]. The gist of it is instead of keeping track of it via the use count which is a `IntMap Int` we now use the live regs set (IntSet) which is quite a bit faster. I think it also matches the semantics a lot better. The skipped (not discarded) assignment does in fact keep the regs on it's rhs alive so keeping track of this in the live set seems like the clearer solution as well. Improves allocations for T3294 by yet another 1%. - - - - - 59f2249b by Andreas Klebinger at 2020-12-08T22:43:21-05:00 GHC.Cmm.Opt: Be stricter in results. Optimization either returns Nothing if nothing is to be done or `Just <cmmExpr>` otherwise. There is no point in being lazy in `cmmExpr`. We usually inspect this element so the thunk gets forced not long after. We might eliminate it as dead code once in a blue moon but that's not a case worth optimizing for. Overall the impact of this is rather low. As Cmm.Opt doesn't allocate much (compared to the rest of GHC) to begin with. - - - - - 54b88eac by Andreas Klebinger at 2020-12-08T22:43:57-05:00 Bump time submodule. This should fix #19002. - - - - - 35e7b0c6 by Kirill Elagin at 2020-12-10T01:45:54-05:00 doc: Clarify the default for -fomit-yields “Yield points enabled” is confusing (and probably wrong? I am not 100% sure what it means). Change it to a simple “on”. Undo this change from 2c23fff2e03e77187dc4d01f325f5f43a0e7cad2. - - - - - 3551c554 by Kirill Elagin at 2020-12-10T01:45:54-05:00 doc: Extra-clarify -fomit-yields Be more clear on what this optimisation being on by default means in terms of yields. - - - - - 6484f0d7 by Sergei Trofimovich at 2020-12-10T01:46:33-05:00 rts/linker/Elf.c: add missing <dlfcn.h> include (musl support) The change fixes build failure on musl: ``` rts/linker/Elf.c:2031:3: error: warning: implicit declaration of function 'dlclose'; did you mean 'close'? [-Wimplicit-function-declaration] 2031 | dlclose(nc->dlopen_handle); | ^~~~~~~ | close ``` Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - ab24ed9b by Ben Gamari at 2020-12-11T03:55:51-05:00 users guide: Fix syntax errors Fixes errors introduced by 3a55b3a2574f913d046f3a6f82db48d7f6df32e3. - - - - - d3a24d31 by Ben Gamari at 2020-12-11T03:55:51-05:00 users guide: Describe GC lifecycle events Every time I am asked about how to interpret these events I need to figure it out from scratch. It's well past time that the users guide properly documents these. - - - - - 741309b9 by Ben Gamari at 2020-12-11T03:56:27-05:00 gitlab-ci: Fix incorrect Docker image for nightly cross job Also refactor the job definition to eliminate the bug by construction. - - - - - 19703bc8 by Ben Gamari at 2020-12-11T03:56:27-05:00 gitlab-ci: Fix name of flavour in ThreadSanitizer job It looks like I neglected to update this after introduce flavour transformers. - - - - - ed82de5e by Ben Gamari at 2020-12-14T10:20:06-05:00 rts: Break up census logic Move the logic for taking censuses of "normal" and pinned blocks to their own functions. - - - - - c7f8e22c by Ben Gamari at 2020-12-14T10:20:06-05:00 rts: Implement heap census support for pinned objects It turns out that this was fairly straightforward to implement since we are now pretty careful about zeroing slop. - - - - - 2c1f2e49 by Ben Gamari at 2020-12-14T10:20:06-05:00 Storage: Unconditionally enable zeroing of alignment slop This is necessary since the user may enable `+RTS -hT` at any time. - - - - - 370c9f41 by Ben Gamari at 2020-12-14T10:20:06-05:00 rts: Zero shrunk array slop in vanilla RTS But only when profiling or DEBUG are enabled. Fixes #17572. - - - - - ff664f40 by Ben Gamari at 2020-12-14T10:20:06-05:00 rts: Enforce that mark-region isn't used with -h As noted in #9666, the mark-region GC is not compatible with heap profiling. Also add documentation for this flag. Closes #9666. - - - - - 21 changed files: - .gitlab-ci.yml - compiler/GHC/Cmm/Expr.hs - + compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Liveness.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/Utils/Outputable.hs - compiler/ghc.cabal.in - docs/users_guide/eventlog-formats.rst - docs/users_guide/runtime_control.rst - docs/users_guide/using-optimisation.rst - includes/Cmm.h - libraries/time - rts/ProfHeap.c - rts/RtsFlags.c - rts/Stats.c - rts/linker/Elf.c - rts/sm/Storage.c - utils/deriveConstants/Main.hs Changes: ===================================== .gitlab-ci.yml ===================================== @@ -257,27 +257,24 @@ validate-x86_64-linux-deb9-unreg-hadrian: CONFIGURE_ARGS: --enable-unregisterised TEST_ENV: "x86_64-linux-deb9-unreg-hadrian" -validate-x86_64-linux-deb10-hadrian-cross-aarch64: - <<: *nightly +.build-x86_64-linux-deb10-hadrian-cross-aarch64: extends: .validate-linux-hadrian - stage: full-build image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV" variables: BIN_DIST_NAME: "ghc-x86_64-deb9-linux" - rules: - - if: '$CI_MERGE_REQUEST_LABELS =~ /.*cross-compilation.*/' - variables: CONFIGURE_ARGS: --with-intree-gmp CROSS_TARGET: "aarch64-linux-gnu" +validate-x86_64-linux-deb10-hadrian-cross-aarch64: + extends: .build-x86_64-linux-deb10-hadrian-cross-aarch64 + stage: full-build + rules: + - if: '$CI_MERGE_REQUEST_LABELS =~ /.*cross-compilation.*/' + nightly-x86_64-linux-deb10-hadrian-cross-aarch64: <<: *nightly - extends: .validate-linux-hadrian + extends: .build-x86_64-linux-deb10-hadrian-cross-aarch64 stage: full-build - variables: - CONFIGURE_ARGS: --with-intree-gmp - CROSS_TARGET: "aarch64-linux-gnu" - ############################################################ @@ -712,7 +709,7 @@ nightly-x86_64-linux-deb9-integer-simple: stage: full-build variables: TEST_ENV: "x86_64-linux-deb9-tsan" - BUILD_FLAVOUR: "thread-sanitizer" + BUILD_FLAVOUR: "default+thread_sanitizer" TSAN_OPTIONS: "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions" # Haddock is large enough to make TSAN choke without massive quantities of # memory. ===================================== compiler/GHC/Cmm/Expr.hs ===================================== @@ -53,14 +53,14 @@ import GHC.Types.Basic (Alignment, mkAlignment, alignmentOf) ----------------------------------------------------------------------------- data CmmExpr - = CmmLit CmmLit -- Literal + = CmmLit !CmmLit -- Literal | CmmLoad !CmmExpr !CmmType -- Read memory location | CmmReg !CmmReg -- Contents of register | CmmMachOp MachOp [CmmExpr] -- Machine operation (+, -, *, etc.) | CmmStackSlot Area {-# UNPACK #-} !Int -- addressing expression of a stack slot -- See Note [CmmStackSlot aliasing] - | CmmRegOff !CmmReg Int + | CmmRegOff !CmmReg !Int -- CmmRegOff reg i -- ** is shorthand only, meaning ** -- CmmMachOp (MO_Add rep) [x, CmmLit (CmmInt (fromIntegral i) rep)] @@ -173,16 +173,16 @@ Now, the assignments of y go away, -} data CmmLit - = CmmInt !Integer Width + = CmmInt !Integer !Width -- Interpretation: the 2's complement representation of the value -- is truncated to the specified size. This is easier than trying -- to keep the value within range, because we don't know whether -- it will be used as a signed or unsigned value (the CmmType doesn't -- distinguish between signed & unsigned). - | CmmFloat Rational Width + | CmmFloat Rational !Width | CmmVec [CmmLit] -- Vector literal | CmmLabel CLabel -- Address of label - | CmmLabelOff CLabel Int -- Address of label + byte offset + | CmmLabelOff CLabel !Int -- Address of label + byte offset -- Due to limitations in the C backend, the following -- MUST ONLY be used inside the info table indicated by label2 @@ -191,7 +191,7 @@ data CmmLit -- Don't use it at all unless tablesNextToCode. -- It is also used inside the NCG during when generating -- position-independent code. - | CmmLabelDiffOff CLabel CLabel Int Width -- label1 - label2 + offset + | CmmLabelDiffOff CLabel CLabel !Int !Width -- label1 - label2 + offset -- In an expression, the width just has the effect of MO_SS_Conv -- from wordWidth to the desired width. -- @@ -363,6 +363,7 @@ instance DefinerOfRegs LocalReg CmmReg where foldRegsDefd _ _ z (CmmGlobal _) = z instance UserOfRegs GlobalReg CmmReg where + {-# INLINEABLE foldRegsUsed #-} foldRegsUsed _ _ z (CmmLocal _) = z foldRegsUsed _ f z (CmmGlobal reg) = f z reg @@ -379,6 +380,7 @@ instance Ord r => DefinerOfRegs r r where instance (Ord r, UserOfRegs r CmmReg) => UserOfRegs r CmmExpr where -- The (Ord r) in the context is necessary here -- See Note [Recursive superclasses] in GHC.Tc.TyCl.Instance + {-# INLINEABLE foldRegsUsed #-} foldRegsUsed platform f !z e = expr z e where expr z (CmmLit _) = z expr z (CmmLoad addr _) = foldRegsUsed platform f z addr ===================================== compiler/GHC/Cmm/LRegSet.hs ===================================== @@ -0,0 +1,53 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module GHC.Cmm.LRegSet ( + LRegSet, + LRegKey, + + emptyLRegSet, + nullLRegSet, + insertLRegSet, + elemLRegSet, + + deleteFromLRegSet, + sizeLRegSet, + + plusLRegSet, + elemsLRegSet + ) where + +import GHC.Prelude +import GHC.Types.Unique +import GHC.Cmm.Expr + +import Data.IntSet as IntSet + +-- Compact sets for membership tests of local variables. + +type LRegSet = IntSet.IntSet +type LRegKey = Int + +emptyLRegSet :: LRegSet +emptyLRegSet = IntSet.empty + +nullLRegSet :: LRegSet -> Bool +nullLRegSet = IntSet.null + +insertLRegSet :: LocalReg -> LRegSet -> LRegSet +insertLRegSet l = IntSet.insert (getKey (getUnique l)) + +elemLRegSet :: LocalReg -> LRegSet -> Bool +elemLRegSet l = IntSet.member (getKey (getUnique l)) + +deleteFromLRegSet :: LRegSet -> LocalReg -> LRegSet +deleteFromLRegSet set reg = IntSet.delete (getKey . getUnique $ reg) set + +sizeLRegSet :: IntSet -> Int +sizeLRegSet = IntSet.size + +plusLRegSet :: IntSet -> IntSet -> IntSet +plusLRegSet = IntSet.union + +elemsLRegSet :: IntSet -> [Int] +elemsLRegSet = IntSet.toList ===================================== compiler/GHC/Cmm/Liveness.hs ===================================== @@ -6,9 +6,12 @@ module GHC.Cmm.Liveness ( CmmLocalLive , cmmLocalLiveness + , cmmLocalLivenessL , cmmGlobalLiveness , liveLattice + , liveLatticeL , gen_kill + , gen_killL ) where @@ -22,11 +25,14 @@ import GHC.Cmm.Dataflow.Block import GHC.Cmm.Dataflow.Collections import GHC.Cmm.Dataflow import GHC.Cmm.Dataflow.Label +import GHC.Cmm.LRegSet import GHC.Data.Maybe import GHC.Utils.Outputable import GHC.Utils.Panic +import GHC.Types.Unique + ----------------------------------------------------------------------------- -- Calculating what variables are live on entry to a basic block ----------------------------------------------------------------------------- @@ -92,3 +98,66 @@ xferLive platform (BlockCC eNode middle xNode) fBase = in mapSingleton (entryLabel eNode) result {-# SPECIALIZE xferLive :: Platform -> TransferFun (CmmLive LocalReg) #-} {-# SPECIALIZE xferLive :: Platform -> TransferFun (CmmLive GlobalReg) #-} + +----------------------------------------------------------------------------- +-- | Specialization that only retains the keys for local variables. +-- +-- Local variablas are mostly glorified Ints, and some parts of the compiler +-- really don't care about anything but the Int part. So we can avoid some +-- overhead by computing a IntSet instead of a Set LocalReg which (unsurprisingly) +-- is quite a bit faster. +----------------------------------------------------------------------------- + +type BlockEntryLivenessL = LabelMap LRegSet + +-- | The dataflow lattice +liveLatticeL :: DataflowLattice LRegSet +liveLatticeL = DataflowLattice emptyLRegSet add + where + add (OldFact old) (NewFact new) = + let !join = plusLRegSet old new + in changedIf (sizeLRegSet join > sizeLRegSet old) join + + +cmmLocalLivenessL :: Platform -> CmmGraph -> BlockEntryLivenessL +cmmLocalLivenessL platform graph = + check $ analyzeCmmBwd liveLatticeL (xferLiveL platform) graph mapEmpty + where + entry = g_entry graph + check facts = + noLiveOnEntryL entry (expectJust "check" $ mapLookup entry facts) facts + +-- | On entry to the procedure, there had better not be any LocalReg's live-in. +noLiveOnEntryL :: BlockId -> LRegSet -> a -> a +noLiveOnEntryL bid in_fact x = + if nullLRegSet in_fact then x + else pprPanic "LocalReg's live-in to graph" (ppr bid <+> ppr reg_uniques) + where + -- We convert the int's to uniques so that the printing matches that + -- of registers. + reg_uniques = map mkUniqueGrimily $ elemsLRegSet in_fact + + + + +gen_killL + :: (DefinerOfRegs LocalReg n, UserOfRegs LocalReg n) + => Platform -> n -> LRegSet -> LRegSet +gen_killL platform node set = + let !afterKill = foldRegsDefd platform deleteFromLRegSet set node + in foldRegsUsed platform (flip insertLRegSet) afterKill node +{-# INLINE gen_killL #-} + +xferLiveL + :: ( UserOfRegs LocalReg (CmmNode O O) + , DefinerOfRegs LocalReg (CmmNode O O) + , UserOfRegs LocalReg (CmmNode O C) + , DefinerOfRegs LocalReg (CmmNode O C) + ) + => Platform -> TransferFun LRegSet +xferLiveL platform (BlockCC eNode middle xNode) fBase = + let joined = gen_killL platform xNode $! joinOutFacts liveLatticeL xNode fBase + !result = foldNodesBwdOO (gen_killL platform) middle joined + in mapSingleton (entryLabel eNode) result + + ===================================== compiler/GHC/Cmm/Node.hs ===================================== @@ -318,6 +318,7 @@ foreignTargetHints target -- Instances of register and slot users / definers instance UserOfRegs LocalReg (CmmNode e x) where + {-# INLINEABLE foldRegsUsed #-} foldRegsUsed platform f !z n = case n of CmmAssign _ expr -> fold f z expr CmmStore addr rval -> fold f (fold f z addr) rval @@ -332,6 +333,7 @@ instance UserOfRegs LocalReg (CmmNode e x) where fold f z n = foldRegsUsed platform f z n instance UserOfRegs GlobalReg (CmmNode e x) where + {-# INLINEABLE foldRegsUsed #-} foldRegsUsed platform f !z n = case n of CmmAssign _ expr -> fold f z expr CmmStore addr rval -> fold f (fold f z addr) rval @@ -348,10 +350,12 @@ instance UserOfRegs GlobalReg (CmmNode e x) where instance (Ord r, UserOfRegs r CmmReg) => UserOfRegs r ForeignTarget where -- The (Ord r) in the context is necessary here -- See Note [Recursive superclasses] in GHC.Tc.TyCl.Instance + {-# INLINEABLE foldRegsUsed #-} foldRegsUsed _ _ !z (PrimTarget _) = z foldRegsUsed platform f !z (ForeignTarget e _) = foldRegsUsed platform f z e instance DefinerOfRegs LocalReg (CmmNode e x) where + {-# INLINEABLE foldRegsDefd #-} foldRegsDefd platform f !z n = case n of CmmAssign lhs _ -> fold f z lhs CmmUnsafeForeignCall _ fs _ -> fold f z fs @@ -362,6 +366,7 @@ instance DefinerOfRegs LocalReg (CmmNode e x) where fold f z n = foldRegsDefd platform f z n instance DefinerOfRegs GlobalReg (CmmNode e x) where + {-# INLINEABLE foldRegsDefd #-} foldRegsDefd platform f !z n = case n of CmmAssign lhs _ -> fold f z lhs CmmUnsafeForeignCall tgt _ _ -> fold f z (foreignTargetRegs tgt) ===================================== compiler/GHC/Cmm/Opt.hs ===================================== @@ -58,7 +58,7 @@ cmmMachOpFoldM -> Maybe CmmExpr cmmMachOpFoldM _ op [CmmLit (CmmInt x rep)] - = Just $ case op of + = Just $! case op of MO_S_Neg _ -> CmmLit (CmmInt (-x) rep) MO_Not _ -> CmmLit (CmmInt (complement x) rep) @@ -90,13 +90,13 @@ cmmMachOpFoldM platform conv_outer [CmmMachOp conv_inner [x]] -- but remember to use the signedness from the widening, just in case -- the final conversion is a widen. | rep1 < rep2 && rep2 > rep3 -> - Just $ cmmMachOpFold platform (intconv signed1 rep1 rep3) [x] + Just $! cmmMachOpFold platform (intconv signed1 rep1 rep3) [x] -- Nested widenings: collapse if the signedness is the same | rep1 < rep2 && rep2 < rep3 && signed1 == signed2 -> - Just $ cmmMachOpFold platform (intconv signed1 rep1 rep3) [x] + Just $! cmmMachOpFold platform (intconv signed1 rep1 rep3) [x] -- Nested narrowings: collapse | rep1 > rep2 && rep2 > rep3 -> - Just $ cmmMachOpFold platform (MO_UU_Conv rep1 rep3) [x] + Just $! cmmMachOpFold platform (MO_UU_Conv rep1 rep3) [x] | otherwise -> Nothing where @@ -117,34 +117,34 @@ cmmMachOpFoldM platform mop [CmmLit (CmmInt x xrep), CmmLit (CmmInt y _)] = case mop of -- for comparisons: don't forget to narrow the arguments before -- comparing, since they might be out of range. - MO_Eq _ -> Just $ CmmLit (CmmInt (if x_u == y_u then 1 else 0) (wordWidth platform)) - MO_Ne _ -> Just $ CmmLit (CmmInt (if x_u /= y_u then 1 else 0) (wordWidth platform)) - - MO_U_Gt _ -> Just $ CmmLit (CmmInt (if x_u > y_u then 1 else 0) (wordWidth platform)) - MO_U_Ge _ -> Just $ CmmLit (CmmInt (if x_u >= y_u then 1 else 0) (wordWidth platform)) - MO_U_Lt _ -> Just $ CmmLit (CmmInt (if x_u < y_u then 1 else 0) (wordWidth platform)) - MO_U_Le _ -> Just $ CmmLit (CmmInt (if x_u <= y_u then 1 else 0) (wordWidth platform)) - - MO_S_Gt _ -> Just $ CmmLit (CmmInt (if x_s > y_s then 1 else 0) (wordWidth platform)) - MO_S_Ge _ -> Just $ CmmLit (CmmInt (if x_s >= y_s then 1 else 0) (wordWidth platform)) - MO_S_Lt _ -> Just $ CmmLit (CmmInt (if x_s < y_s then 1 else 0) (wordWidth platform)) - MO_S_Le _ -> Just $ CmmLit (CmmInt (if x_s <= y_s then 1 else 0) (wordWidth platform)) - - MO_Add r -> Just $ CmmLit (CmmInt (x + y) r) - MO_Sub r -> Just $ CmmLit (CmmInt (x - y) r) - MO_Mul r -> Just $ CmmLit (CmmInt (x * y) r) - MO_U_Quot r | y /= 0 -> Just $ CmmLit (CmmInt (x_u `quot` y_u) r) - MO_U_Rem r | y /= 0 -> Just $ CmmLit (CmmInt (x_u `rem` y_u) r) - MO_S_Quot r | y /= 0 -> Just $ CmmLit (CmmInt (x `quot` y) r) - MO_S_Rem r | y /= 0 -> Just $ CmmLit (CmmInt (x `rem` y) r) - - MO_And r -> Just $ CmmLit (CmmInt (x .&. y) r) - MO_Or r -> Just $ CmmLit (CmmInt (x .|. y) r) - MO_Xor r -> Just $ CmmLit (CmmInt (x `xor` y) r) - - MO_Shl r -> Just $ CmmLit (CmmInt (x `shiftL` fromIntegral y) r) - MO_U_Shr r -> Just $ CmmLit (CmmInt (x_u `shiftR` fromIntegral y) r) - MO_S_Shr r -> Just $ CmmLit (CmmInt (x `shiftR` fromIntegral y) r) + MO_Eq _ -> Just $! CmmLit (CmmInt (if x_u == y_u then 1 else 0) (wordWidth platform)) + MO_Ne _ -> Just $! CmmLit (CmmInt (if x_u /= y_u then 1 else 0) (wordWidth platform)) + + MO_U_Gt _ -> Just $! CmmLit (CmmInt (if x_u > y_u then 1 else 0) (wordWidth platform)) + MO_U_Ge _ -> Just $! CmmLit (CmmInt (if x_u >= y_u then 1 else 0) (wordWidth platform)) + MO_U_Lt _ -> Just $! CmmLit (CmmInt (if x_u < y_u then 1 else 0) (wordWidth platform)) + MO_U_Le _ -> Just $! CmmLit (CmmInt (if x_u <= y_u then 1 else 0) (wordWidth platform)) + + MO_S_Gt _ -> Just $! CmmLit (CmmInt (if x_s > y_s then 1 else 0) (wordWidth platform)) + MO_S_Ge _ -> Just $! CmmLit (CmmInt (if x_s >= y_s then 1 else 0) (wordWidth platform)) + MO_S_Lt _ -> Just $! CmmLit (CmmInt (if x_s < y_s then 1 else 0) (wordWidth platform)) + MO_S_Le _ -> Just $! CmmLit (CmmInt (if x_s <= y_s then 1 else 0) (wordWidth platform)) + + MO_Add r -> Just $! CmmLit (CmmInt (x + y) r) + MO_Sub r -> Just $! CmmLit (CmmInt (x - y) r) + MO_Mul r -> Just $! CmmLit (CmmInt (x * y) r) + MO_U_Quot r | y /= 0 -> Just $! CmmLit (CmmInt (x_u `quot` y_u) r) + MO_U_Rem r | y /= 0 -> Just $! CmmLit (CmmInt (x_u `rem` y_u) r) + MO_S_Quot r | y /= 0 -> Just $! CmmLit (CmmInt (x `quot` y) r) + MO_S_Rem r | y /= 0 -> Just $! CmmLit (CmmInt (x `rem` y) r) + + MO_And r -> Just $! CmmLit (CmmInt (x .&. y) r) + MO_Or r -> Just $! CmmLit (CmmInt (x .|. y) r) + MO_Xor r -> Just $! CmmLit (CmmInt (x `xor` y) r) + + MO_Shl r -> Just $! CmmLit (CmmInt (x `shiftL` fromIntegral y) r) + MO_U_Shr r -> Just $! CmmLit (CmmInt (x_u `shiftR` fromIntegral y) r) + MO_S_Shr r -> Just $! CmmLit (CmmInt (x `shiftR` fromIntegral y) r) _ -> Nothing @@ -162,7 +162,7 @@ cmmMachOpFoldM platform mop [CmmLit (CmmInt x xrep), CmmLit (CmmInt y _)] cmmMachOpFoldM platform op [x@(CmmLit _), y] | not (isLit y) && isCommutableMachOp op - = Just (cmmMachOpFold platform op [y, x]) + = Just $! (cmmMachOpFold platform op [y, x]) -- Turn (a+b)+c into a+(b+c) where possible. Because literals are -- moved to the right, it is more likely that we will find @@ -183,7 +183,7 @@ cmmMachOpFoldM platform op [x@(CmmLit _), y] cmmMachOpFoldM platform mop1 [CmmMachOp mop2 [arg1,arg2], arg3] | mop2 `associates_with` mop1 && not (isLit arg1) && not (isPicReg arg1) - = Just (cmmMachOpFold platform mop2 [arg1, cmmMachOpFold platform mop1 [arg2,arg3]]) + = Just $! (cmmMachOpFold platform mop2 [arg1, cmmMachOpFold platform mop1 [arg2,arg3]]) where MO_Add{} `associates_with` MO_Sub{} = True mop1 `associates_with` mop2 = @@ -192,7 +192,7 @@ cmmMachOpFoldM platform mop1 [CmmMachOp mop2 [arg1,arg2], arg3] -- special case: (a - b) + c ==> a + (c - b) cmmMachOpFoldM platform mop1@(MO_Add{}) [CmmMachOp mop2@(MO_Sub{}) [arg1,arg2], arg3] | not (isLit arg1) && not (isPicReg arg1) - = Just (cmmMachOpFold platform mop1 [arg1, cmmMachOpFold platform mop2 [arg3,arg2]]) + = Just $! (cmmMachOpFold platform mop1 [arg1, cmmMachOpFold platform mop2 [arg3,arg2]]) -- special case: (PicBaseReg + lit) + N ==> PicBaseReg + (lit+N) -- @@ -205,27 +205,27 @@ cmmMachOpFoldM platform mop1@(MO_Add{}) [CmmMachOp mop2@(MO_Sub{}) [arg1,arg2], cmmMachOpFoldM _ MO_Add{} [ CmmMachOp op at MO_Add{} [pic, CmmLit lit] , CmmLit (CmmInt n rep) ] | isPicReg pic - = Just $ CmmMachOp op [pic, CmmLit $ cmmOffsetLit lit off ] + = Just $! CmmMachOp op [pic, CmmLit $ cmmOffsetLit lit off ] where off = fromIntegral (narrowS rep n) -- Make a RegOff if we can cmmMachOpFoldM _ (MO_Add _) [CmmReg reg, CmmLit (CmmInt n rep)] - = Just $ cmmRegOff reg (fromIntegral (narrowS rep n)) + = Just $! cmmRegOff reg (fromIntegral (narrowS rep n)) cmmMachOpFoldM _ (MO_Add _) [CmmRegOff reg off, CmmLit (CmmInt n rep)] - = Just $ cmmRegOff reg (off + fromIntegral (narrowS rep n)) + = Just $! cmmRegOff reg (off + fromIntegral (narrowS rep n)) cmmMachOpFoldM _ (MO_Sub _) [CmmReg reg, CmmLit (CmmInt n rep)] - = Just $ cmmRegOff reg (- fromIntegral (narrowS rep n)) + = Just $! cmmRegOff reg (- fromIntegral (narrowS rep n)) cmmMachOpFoldM _ (MO_Sub _) [CmmRegOff reg off, CmmLit (CmmInt n rep)] - = Just $ cmmRegOff reg (off - fromIntegral (narrowS rep n)) + = Just $! cmmRegOff reg (off - fromIntegral (narrowS rep n)) -- Fold label(+/-)offset into a CmmLit where possible cmmMachOpFoldM _ (MO_Add _) [CmmLit lit, CmmLit (CmmInt i rep)] - = Just $ CmmLit (cmmOffsetLit lit (fromIntegral (narrowU rep i))) + = Just $! CmmLit (cmmOffsetLit lit (fromIntegral (narrowU rep i))) cmmMachOpFoldM _ (MO_Add _) [CmmLit (CmmInt i rep), CmmLit lit] - = Just $ CmmLit (cmmOffsetLit lit (fromIntegral (narrowU rep i))) + = Just $! CmmLit (cmmOffsetLit lit (fromIntegral (narrowU rep i))) cmmMachOpFoldM _ (MO_Sub _) [CmmLit lit, CmmLit (CmmInt i rep)] - = Just $ CmmLit (cmmOffsetLit lit (fromIntegral (negate (narrowU rep i)))) + = Just $! CmmLit (cmmOffsetLit lit (fromIntegral (negate (narrowU rep i)))) -- Comparison of literal with widened operand: perform the comparison @@ -245,7 +245,7 @@ cmmMachOpFoldM platform cmp [CmmMachOp conv [x], CmmLit (CmmInt i _)] -- and the literal fits in the smaller size: i == narrow_fn rep i -- then we can do the comparison at the smaller size - = Just (cmmMachOpFold platform narrow_cmp [x, CmmLit (CmmInt i rep)]) + = Just $! (cmmMachOpFold platform narrow_cmp [x, CmmLit (CmmInt i rep)]) where maybe_conversion (MO_UU_Conv from to) | to > from @@ -320,8 +320,8 @@ cmmMachOpFoldM platform mop [x, (CmmLit (CmmInt 1 rep))] MO_Mul _ -> Just x MO_S_Quot _ -> Just x MO_U_Quot _ -> Just x - MO_S_Rem _ -> Just $ CmmLit (CmmInt 0 rep) - MO_U_Rem _ -> Just $ CmmLit (CmmInt 0 rep) + MO_S_Rem _ -> Just $! CmmLit (CmmInt 0 rep) + MO_U_Rem _ -> Just $! CmmLit (CmmInt 0 rep) -- Comparisons; trickier -- See Note [Comparison operators] @@ -346,18 +346,18 @@ cmmMachOpFoldM platform mop [x, (CmmLit (CmmInt n _))] = case mop of MO_Mul rep | Just p <- exactLog2 n -> - Just (cmmMachOpFold platform (MO_Shl rep) [x, CmmLit (CmmInt p rep)]) + Just $! (cmmMachOpFold platform (MO_Shl rep) [x, CmmLit (CmmInt p rep)]) MO_U_Quot rep | Just p <- exactLog2 n -> - Just (cmmMachOpFold platform (MO_U_Shr rep) [x, CmmLit (CmmInt p rep)]) + Just $! (cmmMachOpFold platform (MO_U_Shr rep) [x, CmmLit (CmmInt p rep)]) MO_U_Rem rep | Just _ <- exactLog2 n -> - Just (cmmMachOpFold platform (MO_And rep) [x, CmmLit (CmmInt (n - 1) rep)]) + Just $! (cmmMachOpFold platform (MO_And rep) [x, CmmLit (CmmInt (n - 1) rep)]) MO_S_Quot rep | Just p <- exactLog2 n, CmmReg _ <- x -> -- We duplicate x in signedQuotRemHelper, hence require -- it is a reg. FIXME: remove this restriction. - Just (cmmMachOpFold platform (MO_S_Shr rep) + Just $! (cmmMachOpFold platform (MO_S_Shr rep) [signedQuotRemHelper rep p, CmmLit (CmmInt p rep)]) MO_S_Rem rep | Just p <- exactLog2 n, @@ -366,7 +366,7 @@ cmmMachOpFoldM platform mop [x, (CmmLit (CmmInt n _))] -- We replace (x `rem` 2^p) by (x - (x `quot` 2^p) * 2^p). -- Moreover, we fuse MO_S_Shr (last operation of MO_S_Quot) -- and MO_S_Shl (multiplication by 2^p) into a single MO_And operation. - Just (cmmMachOpFold platform (MO_Sub rep) + Just $! (cmmMachOpFold platform (MO_Sub rep) [x, cmmMachOpFold platform (MO_And rep) [signedQuotRemHelper rep p, CmmLit (CmmInt (- n) rep)]]) _ -> Nothing ===================================== compiler/GHC/Cmm/Sink.hs ===================================== @@ -1,4 +1,6 @@ {-# LANGUAGE GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} + module GHC.Cmm.Sink ( cmmSink ) where @@ -8,6 +10,7 @@ import GHC.Prelude import GHC.Cmm import GHC.Cmm.Opt import GHC.Cmm.Liveness +import GHC.Cmm.LRegSet import GHC.Cmm.Utils import GHC.Cmm.Dataflow.Block import GHC.Cmm.Dataflow.Label @@ -16,29 +19,13 @@ import GHC.Cmm.Dataflow.Graph import GHC.Platform.Regs import GHC.Platform -import GHC.Types.Unique import GHC.Types.Unique.FM import qualified Data.IntSet as IntSet import Data.List (partition) -import qualified Data.Set as Set import Data.Maybe --- Compact sets for membership tests of local variables. - -type LRegSet = IntSet.IntSet - -emptyLRegSet :: LRegSet -emptyLRegSet = IntSet.empty - -nullLRegSet :: LRegSet -> Bool -nullLRegSet = IntSet.null - -insertLRegSet :: LocalReg -> LRegSet -> LRegSet -insertLRegSet l = IntSet.insert (getKey (getUnique l)) - -elemLRegSet :: LocalReg -> LRegSet -> Bool -elemLRegSet l = IntSet.member (getKey (getUnique l)) +import GHC.Exts (inline) -- ----------------------------------------------------------------------------- -- Sinking and inlining @@ -167,8 +154,8 @@ type Assignments = [Assignment] cmmSink :: Platform -> CmmGraph -> CmmGraph cmmSink platform graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks where - liveness = cmmLocalLiveness platform graph - getLive l = mapFindWithDefault Set.empty l liveness + liveness = cmmLocalLivenessL platform graph + getLive l = mapFindWithDefault emptyLRegSet l liveness blocks = revPostorder graph @@ -188,8 +175,8 @@ cmmSink platform graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks -- Annotate the middle nodes with the registers live *after* -- the node. This will help us decide whether we can inline -- an assignment in the current node or not. - live = Set.unions (map getLive succs) - live_middle = gen_kill platform last live + live = IntSet.unions (map getLive succs) + live_middle = gen_killL platform last live ann_middles = annotate platform live_middle (blockToList middle) -- Now sink and inline in this block @@ -201,7 +188,7 @@ cmmSink platform graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks -- one predecessor), so identify the join points and the set -- of registers live in them. (joins, nonjoins) = partition (`mapMember` join_pts) succs - live_in_joins = Set.unions (map getLive joins) + live_in_joins = IntSet.unions (map getLive joins) -- We do not want to sink an assignment into multiple branches, -- so identify the set of registers live in multiple successors. @@ -210,26 +197,28 @@ cmmSink platform graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks -- now live in multiple branches. init_live_sets = map getLive nonjoins live_in_multi live_sets r = - case filter (Set.member r) live_sets of + case filter (elemLRegSet r) live_sets of (_one:_two:_) -> True _ -> False -- Now, drop any assignments that we will not sink any further. (dropped_last, assigs'') = dropAssignments platform drop_if init_live_sets assigs' + drop_if :: (LocalReg, CmmExpr, AbsMem) + -> [LRegSet] -> (Bool, [LRegSet]) drop_if a@(r,rhs,_) live_sets = (should_drop, live_sets') where should_drop = conflicts platform a final_last || not (isTrivial platform rhs) && live_in_multi live_sets r - || r `Set.member` live_in_joins + || r `elemLRegSet` live_in_joins live_sets' | should_drop = live_sets | otherwise = map upd live_sets - upd set | r `Set.member` set = set `Set.union` live_rhs + upd set | r `elemLRegSet` set = set `IntSet.union` live_rhs | otherwise = set - live_rhs = foldRegsUsed platform extendRegSet emptyRegSet rhs + live_rhs = foldRegsUsed platform (flip insertLRegSet) emptyLRegSet rhs final_middle = foldl' blockSnoc middle' dropped_last @@ -266,9 +255,9 @@ isTrivial _ _ = False -- -- annotate each node with the set of registers live *after* the node -- -annotate :: Platform -> LocalRegSet -> [CmmNode O O] -> [(LocalRegSet, CmmNode O O)] +annotate :: Platform -> LRegSet -> [CmmNode O O] -> [(LRegSet, CmmNode O O)] annotate platform live nodes = snd $ foldr ann (live,[]) nodes - where ann n (live,nodes) = (gen_kill platform n live, (live,n) : nodes) + where ann n (live,nodes) = (gen_killL platform n live, (live,n) : nodes) -- -- Find the blocks that have multiple successors (join points) @@ -285,13 +274,13 @@ findJoinPoints blocks = mapFilter (>1) succ_counts -- filter the list of assignments to remove any assignments that -- are not live in a continuation. -- -filterAssignments :: Platform -> LocalRegSet -> Assignments -> Assignments +filterAssignments :: Platform -> LRegSet -> Assignments -> Assignments filterAssignments platform live assigs = reverse (go assigs []) where go [] kept = kept go (a@(r,_,_):as) kept | needed = go as (a:kept) | otherwise = go as kept where - needed = r `Set.member` live + needed = r `elemLRegSet` live || any (conflicts platform a) (map toNode kept) -- Note that we must keep assignments that are -- referred to by other assignments we have @@ -312,7 +301,7 @@ filterAssignments platform live assigs = reverse (go assigs []) -- walk :: Platform - -> [(LocalRegSet, CmmNode O O)] -- nodes of the block, annotated with + -> [(LRegSet, CmmNode O O)] -- nodes of the block, annotated with -- the set of registers live *after* -- this node. @@ -366,11 +355,11 @@ shouldSink _ _other = Nothing -- out of inlining, but the inliner will see that r is live -- after the instruction and choose not to inline r in the rhs. -- -shouldDiscard :: CmmNode e x -> LocalRegSet -> Bool +shouldDiscard :: CmmNode e x -> LRegSet -> Bool shouldDiscard node live = case node of CmmAssign r (CmmReg r') | r == r' -> True - CmmAssign (CmmLocal r) _ -> not (r `Set.member` live) + CmmAssign (CmmLocal r) _ -> not (r `elemLRegSet` live) _otherwise -> False @@ -403,8 +392,9 @@ dropAssignments platform should_drop state assigs -- inlining opens up opportunities for doing so. tryToInline - :: Platform - -> LocalRegSet -- set of registers live after this + :: forall x. Platform + -> LRegSet -- set of registers live after this + -- -> LocalRegSet -- set of registers live after this -- node. We cannot inline anything -- that is live after the node, unless -- it is small enough to duplicate. @@ -415,35 +405,42 @@ tryToInline , Assignments -- Remaining assignments ) -tryToInline platform live node assigs = go usages node emptyLRegSet assigs +tryToInline platform liveAfter node assigs = + -- pprTrace "tryToInline assig length:" (ppr $ length assigs) $ + go usages liveAfter node emptyLRegSet assigs where usages :: UniqFM LocalReg Int -- Maps each LocalReg to a count of how often it is used usages = foldLocalRegsUsed platform addUsage emptyUFM node - go _usages node _skipped [] = (node, []) + go :: UniqFM LocalReg Int -> LRegSet -> CmmNode O x -> LRegSet -> Assignments + -> (CmmNode O x, Assignments) + go _usages _live node _skipped [] = (node, []) - go usages node skipped (a@(l,rhs,_) : rest) - | cannot_inline = dont_inline - | occurs_none = discard -- Note [discard during inlining] - | occurs_once = inline_and_discard - | isTrivial platform rhs = inline_and_keep - | otherwise = dont_inline + go usages live node skipped (a@(l,rhs,_) : rest) + | cannot_inline = dont_inline + | occurs_none = discard -- Note [discard during inlining] + | occurs_once = inline_and_discard + | isTrivial platform rhs = inline_and_keep + | otherwise = dont_inline where - inline_and_discard = go usages' inl_node skipped rest + inline_and_discard = go usages' live inl_node skipped rest where usages' = foldLocalRegsUsed platform addUsage usages rhs - discard = go usages node skipped rest + discard = go usages live node skipped rest dont_inline = keep node -- don't inline the assignment, keep it inline_and_keep = keep inl_node -- inline the assignment, keep it + keep :: CmmNode O x -> (CmmNode O x, Assignments) keep node' = (final_node, a : rest') - where (final_node, rest') = go usages' node' (insertLRegSet l skipped) rest - usages' = foldLocalRegsUsed platform (\m r -> addToUFM m r 2) - usages rhs - -- we must not inline anything that is mentioned in the RHS - -- of a binding that we have already skipped, so we set the - -- usages of the regs on the RHS to 2. + where (final_node, rest') = go usages live' node' (insertLRegSet l skipped) rest + + -- Avoid discarding of assignments to vars on the rhs. + -- See Note [Keeping assignemnts mentioned in skipped RHSs] + -- usages' = foldLocalRegsUsed platform (\m r -> addToUFM m r 2) + -- usages rhs + live' = inline foldLocalRegsUsed platform (\m r -> insertLRegSet r m) + live rhs cannot_inline = skipped `regsUsedIn` rhs -- Note [dependent assignments] || l `elemLRegSet` skipped @@ -451,7 +448,7 @@ tryToInline platform live node assigs = go usages node emptyLRegSet assigs -- How often is l used in the current node. l_usages = lookupUFM usages l - l_live = l `elemRegSet` live + l_live = l `elemLRegSet` live occurs_once = not l_live && l_usages == Just 1 occurs_none = not l_live && l_usages == Nothing @@ -467,6 +464,27 @@ tryToInline platform live node assigs = go usages node emptyLRegSet assigs inl_exp (CmmMachOp op args) = cmmMachOpFold platform op args inl_exp other = other +{- Note [Keeping assignemnts mentioned in skipped RHSs] + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + If we have to assignments: [z = y, y = e1] and we skip + z we *must* retain the assignment y = e1. This is because + we might inline "z = y" into another node later on so we + must ensure y is still defined at this point. + + If we dropped the assignment of "y = e1" then we would end up + referencing a variable which hasn't been mentioned after + inlining. + + We use a hack to do this. + + We pretend the regs from the rhs are live after the current + node. Since we only discard assignments to variables + which are dead after the current block this prevents discarding of the + assignment. It still allows inlining should e1 be a trivial rhs + however. + +-} {- Note [improveConditional] @@ -610,18 +628,34 @@ conflicts platform (r, rhs, addr) node -- (7) otherwise, no conflict | otherwise = False +{- Note [Inlining foldRegsDefd] + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + foldRegsDefd is, after optimization, *not* a small function so + it's only marked INLINEABLE, but not INLINE. + + However in some specific cases we call it *very* often making it + important to avoid the overhead of allocating the folding function. + + So we simply force inlining via the magic inline function. + For T3294 this improves allocation with -O by ~1%. + +-} + -- Returns True if node defines any global registers that are used in the -- Cmm expression globalRegistersConflict :: Platform -> CmmExpr -> CmmNode e x -> Bool globalRegistersConflict platform expr node = - foldRegsDefd platform (\b r -> b || regUsedIn platform (CmmGlobal r) expr) + -- See Note [Inlining foldRegsDefd] + inline foldRegsDefd platform (\b r -> b || regUsedIn platform (CmmGlobal r) expr) False node -- Returns True if node defines any local registers that are used in the -- Cmm expression localRegistersConflict :: Platform -> CmmExpr -> CmmNode e x -> Bool localRegistersConflict platform expr node = - foldRegsDefd platform (\b r -> b || regUsedIn platform (CmmLocal r) expr) + -- See Note [Inlining foldRegsDefd] + inline foldRegsDefd platform (\b r -> b || regUsedIn platform (CmmLocal r) expr) False node -- Note [Sinking and calls] ===================================== compiler/GHC/Cmm/Utils.hs ===================================== @@ -264,9 +264,11 @@ cmmOffset platform e byte_off = case e of CmmStackSlot area off -> CmmStackSlot area (off - byte_off) -- note stack area offsets increase towards lower addresses CmmMachOp (MO_Add rep) [expr, CmmLit (CmmInt byte_off1 _rep)] - -> CmmMachOp (MO_Add rep) [expr, CmmLit (CmmInt (byte_off1 + toInteger byte_off) rep)] - _ -> CmmMachOp (MO_Add width) [e, CmmLit (CmmInt (toInteger byte_off) width)] - where width = cmmExprWidth platform e + -> let !lit_off = (byte_off1 + toInteger byte_off) + in CmmMachOp (MO_Add rep) [expr, CmmLit (CmmInt lit_off rep)] + _ -> let !width = cmmExprWidth platform e + in + CmmMachOp (MO_Add width) [e, CmmLit (CmmInt (toInteger byte_off) width)] -- Smart constructor for CmmRegOff. Same caveats as cmmOffset above. cmmRegOff :: CmmReg -> Int -> CmmExpr ===================================== compiler/GHC/Utils/Outputable.hs ===================================== @@ -115,6 +115,7 @@ import Data.Int import qualified Data.IntMap as IM import Data.Set (Set) import qualified Data.Set as Set +import qualified Data.IntSet as IntSet import Data.String import Data.Word import System.IO ( Handle ) @@ -863,6 +864,9 @@ instance (Outputable a) => Outputable (NonEmpty a) where instance (Outputable a) => Outputable (Set a) where ppr s = braces (fsep (punctuate comma (map ppr (Set.toList s)))) +instance Outputable IntSet.IntSet where + ppr s = braces (fsep (punctuate comma (map ppr (IntSet.toList s)))) + instance (Outputable a, Outputable b) => Outputable (a, b) where ppr (x,y) = parens (sep [ppr x <> comma, ppr y]) ===================================== compiler/ghc.cabal.in ===================================== @@ -205,6 +205,7 @@ Library GHC.Cmm.Switch GHC.Cmm.Switch.Implement GHC.CmmToAsm + GHC.Cmm.LRegSet GHC.CmmToAsm.BlockLayout GHC.CmmToAsm.CFG GHC.CmmToAsm.CFG.Dominators ===================================== docs/users_guide/eventlog-formats.rst ===================================== @@ -207,9 +207,61 @@ Thread and scheduling events :base-ref:`Control.Concurrent.setThreadLabel`). +.. _gc-events: + Garbage collector events ~~~~~~~~~~~~~~~~~~~~~~~~ +The following events mark various points of the lifecycle of a moving garbage +collection. + +A typical garbage collection will look something like the following: + +1. A capability realizes that it needs a garbage collection (e.g. as a result + of running out of nursery) and requests a garbage collection. This is + marked by :event-type:`REQUEST_SEQ_GC` or :event-type:`REQUEST_PAR_GC`. + +2. As other capabilities reach yield points and suspend execution they emit + :event-type:`STOP_THREAD` events. + +3. When all capabilities have suspended execution, collection will begin, + marked by a :event-type:`GC_START` event. + +4. As individual parallel GC threads commence with scavenging they will emit + :event-type:`GC_WORK` events. + +5. If a parallel GC thread runs out of work it will emit a + :event-type:`GC_IDLE` event. If it is later handed more work it will emit + another :event-type:`GC_WORK` event. + +6. Eventually when scavenging has finished a :event-type:`GC_DONE` event + will be emitted by each GC thread. + +7. A bit of book-keeping is performed. + +8. A :event-type:`GC_END` event will be emitted marking the end of the GC cycle. + +9. A :event-type:`HEAP_SIZE` event will be emitted giving the + cumulative heap allocations of the program until now. + +10. A :event-type:`GC_STATS_GHC` event will be emitted + containing various details of the collection and heap state. + +11. In the case of a major collection, a + :event-type:`HEAP_LIVE` event will be emitted describing + the current size of the live on-heap data. + +12. In the case of the :ghc-flag:`-threaded` RTS, a + :event-type:`SPARK_COUNTERS` event will be emitted giving + details on how many sparks have been created, evaluated, and GC'd. + +13. As mutator threads resume execution they will emit :event-type:`RUN_THREAD` + events. + +Note that in the case of the concurrent non-moving collector additional events +will be emitted during the concurrent phase of collection. These are described +in :ref:`nonmoving-gc-events`. + .. event-type:: GC_START :tag: 9 @@ -685,6 +737,46 @@ These events mark various stages of the :rts-flag:`non-moving collection <--nonmoving-gc>` lifecycle. These are enabled with the ``+RTS -lg`` event-set. +A typical non-moving collection cycle will look something like the following: + +1. The preparatory phase of collection will emit the usual events associated + with a moving collection. See :ref:`gc-events` for details. + +2. The concurrent write barrier is enabled and the concurrent mark thread is + started. From this point forward mutator threads may emit + :event-type:`CONC_UPD_REM_SET_FLUSH` events, indicating that they have + flushed their capability-local update remembered sets. + +3. Concurrent marking begins, denoted by a :event-type:`CONC_MARK_BEGIN` event. + +4. When the mark queue is depleted a :event-type:`CONC_MARK_END` is emitted. + +5. If necessary (e.g. due to weak pointer marking), the marking process will + continue, returning to step (3) above. + +6. When the collector has done as much concurrent marking as it can it will + enter the post-mark synchronization phase of collection, denoted by a + :event-type:`CONC_SYNC_BEGIN` event. + +7. Mutator threads will suspend execution and, if necessary, flush their update + remembered sets (indicated by :event-type:`CONC_UPD_REM_SET_FLUSH` events). + +8. The collector will do any final marking necessary (indicated by + :event-type:`CONC_MARK_BEGIN` and :event-type:`CONC_MARK_END` events). + +9. The collector will do a small amount of sweeping, disable the write barrier, + emit a :event-type:`CONC_SYNC_END` event, and allow mutators to resume + +10. The collector will begin the concurrent sweep phase, indicated by a + :event-type:`CONC_SWEEP_BEGIN` event. + +11. Once sweeping has concluded a :event-type:`CONC_SWEEP_END` event will be + emitted and the concurrent collector thread will terminate. + +12. A :event-type:`NONMOVING_HEAP_CENSUS` event will be emitted describing the + fragmentation state of the non-moving heap. + + .. event-type:: CONC_MARK_BEGIN :tag: 200 @@ -742,8 +834,9 @@ with the ``+RTS -lg`` event-set. Non-moving heap census ~~~~~~~~~~~~~~~~~~~~~~ -The non-moving heap census events (enabled with the ``+RTS -ln`` event-set) are -intended to provide insight into fragmentation of the non-moving heap. +The non-moving heap census events (enabled with the :rts-flag:`+RTS -ln <-l ⟨flags⟩>` +event-set) are intended to provide insight into fragmentation of the non-moving +heap. .. event-type:: NONMOVING_HEAP_CENSUS @@ -760,8 +853,8 @@ Ticky counters ~~~~~~~~~~~~~~ Programs compiled with :ghc-flag:`-ticky` and :ghc-flag:`-eventlog` and invoked -with ``+RTS -lT`` will emit periodic samples of the ticky entry counters to the -eventlog. +with :rts-flag:`+RTS -lT <-l ⟨flags⟩>` will emit periodic samples of the ticky +entry counters to the eventlog. .. event-type:: TICKY_COUNTER_DEF ===================================== docs/users_guide/runtime_control.rst ===================================== @@ -411,6 +411,17 @@ performance. Note that :rts-flag:`--nonmoving-gc` cannot be used with ``-G1``, :rts-flag:`profiling <-hc>` nor :rts-flag:`-c`. +.. rts-flag:: -w + + :default: off + :since: a long time ago + :reverse: none + + Uses a mark-region garbage collection strategy for the oldest-generation heap. + Note that this cannot be used in conjunction with heap profiling + (:rts-flag:`-hT`) unless linked against the profiling runtime system with + :ghc-flag:`-prof`. + .. rts-flag:: -xn :default: off @@ -1194,6 +1205,9 @@ When the program is linked with the :ghc-flag:`-eventlog` option - ``f`` — parallel sparks (fully accurate). Disabled by default. + - ``T`` — :ghc-flag:`ticky-ticky profiler <-ticky>` events. Disabled by + default. + - ``u`` — user events. These are events emitted from Haskell code using functions such as ``Debug.Trace.traceEvent``. Enabled by default. ===================================== docs/users_guide/using-optimisation.rst ===================================== @@ -720,7 +720,7 @@ by saying ``-fno-wombat``. :reverse: -fno-omit-yields :category: - :default: yield points enabled + :default: on (yields are *not* inserted) Tells GHC to omit heap checks when no allocation is being performed. While this improves binary sizes by about 5%, it @@ -1197,16 +1197,16 @@ by saying ``-fno-wombat``. This is the full syntax for cardinalities, demands and sub-demands in BNF: - .. code-block:: + .. code-block:: none - card ::= B | A | 1 | U | S | M semantics as in the table above + card ::= B | A | 1 | U | S | M semantics as in the table above - d ::= card sd card = how often, sd = how deep - | card abbreviation: Same as "card card" + d ::= card sd card = how often, sd = how deep + | card abbreviation: Same as "card card" - sd ::= card polymorphic sub-demand, card at every level - | P(d,d,..) product sub-demand - | Ccard(sd) call sub-demand + sd ::= card polymorphic sub-demand, card at every level + | P(d,d,..) product sub-demand + | Ccard(sd) call sub-demand For example, ``fst`` is strict in its argument, and also in the first component of the argument. It will not evaluate the argument's second @@ -1234,17 +1234,17 @@ by saying ``-fno-wombat``. We summarise a function's demand properties in its *demand signature*. This is the general syntax: - .. code-block:: + .. code-block:: none - {x->dx,y->dy,z->dz...}...div - ^ ^ ^ ^ ^ ^ - | | | | | | - | \---+---+------/ | - | | | - demand on free demand on divergence - variables arguments information - (omitted if empty) (omitted if - no information) + {x->dx,y->dy,z->dz...}...div + ^ ^ ^ ^ ^ ^ + | | | | | | + | \---+---+------/ | + | | | + demand on free demand on divergence + variables arguments information + (omitted if empty) (omitted if + no information) We summarise ``fst``'s demand properties in its *demand signature* ````, which just says "If ``fst`` is applied to one argument, @@ -1260,13 +1260,11 @@ by saying ``-fno-wombat``. **Call sub-demands** - Consider ``maybe``: + Consider ``maybe``: :: - .. code-block:: - - maybe :: b -> (a -> b) -> Maybe a -> b - maybe n _ Nothing = n - maybe _ s (Just a) = s a + maybe :: b -> (a -> b) -> Maybe a -> b + maybe n _ Nothing = n + maybe _ s (Just a) = s a We give it demand signature ``<1C1(U)>``. The ``C1(U)`` is a *call sub-demand* that says "Called at most once, where the result is used ===================================== includes/Cmm.h ===================================== @@ -630,7 +630,11 @@ #else #define OVERWRITING_CLOSURE_SIZE(c, size) /* nothing */ #define OVERWRITING_CLOSURE(c) /* nothing */ -#define OVERWRITING_CLOSURE_MUTABLE(c, off) /* nothing */ +/* This is used to zero slop after shrunk arrays. It is important that we do + * this whenever profiling is enabled as described in Note [slop on the heap] + * in Storage.c. */ +#define OVERWRITING_CLOSURE_MUTABLE(c, off) \ + if (TO_W_(RtsFlags_ProfFlags_doHeapProfile(RtsFlags)) != 0) { foreign "C" overwritingMutableClosureOfs(c "ptr", off); } #endif // Memory barriers. ===================================== libraries/time ===================================== @@ -1 +1 @@ -Subproject commit c25d6a76702b454426e149fb590da5cb69f3bd0a +Subproject commit df292e1a74c6a87c2c1c889679074dd46ad39461 ===================================== rts/ProfHeap.c ===================================== @@ -1103,214 +1103,217 @@ heapCensusCompactList(Census *census, bdescr *bd) } } -/* ----------------------------------------------------------------------------- - * Code to perform a heap census. - * -------------------------------------------------------------------------- */ +/* + * Take a census of the contents of a "normal" (e.g. not large, not compact) + * heap block. This can, however, handle PINNED blocks. + */ static void -heapCensusChain( Census *census, bdescr *bd ) +heapCensusBlock(Census *census, bdescr *bd) { - StgPtr p; - const StgInfoTable *info; - size_t size; - bool prim; - - for (; bd != NULL; bd = bd->link) { - - // HACK: pretend a pinned block is just one big ARR_WORDS - // owned by CCS_PINNED. These blocks can be full of holes due - // to alignment constraints so we can't traverse the memory - // and do a proper census. - if (bd->flags & BF_PINNED) { - StgClosure arr; - SET_HDR(&arr, &stg_ARR_WORDS_info, CCS_PINNED); - heapProfObject(census, &arr, bd->blocks * BLOCK_SIZE_W, true); - continue; - } - - p = bd->start; - - // When we shrink a large ARR_WORDS, we do not adjust the free pointer - // of the associated block descriptor, thus introducing slop at the end - // of the object. This slop remains after GC, violating the assumption - // of the loop below that all slop has been eliminated (#11627). - // The slop isn't always zeroed (e.g. in non-profiling mode, cf - // OVERWRITING_CLOSURE_OFS). - // Consequently, we handle large ARR_WORDS objects as a special case. - if (bd->flags & BF_LARGE - && get_itbl((StgClosure *)p)->type == ARR_WORDS) { - size = arr_words_sizeW((StgArrBytes *)p); - prim = true; - heapProfObject(census, (StgClosure *)p, size, prim); - continue; - } + StgPtr p = bd->start; + // In the case of PINNED blocks there can be (zeroed) slop at the beginning + // due to object alignment. + if (bd->flags & BF_PINNED) { + while (p < bd->free && !*p) p++; + } - while (p < bd->free) { - info = get_itbl((const StgClosure *)p); - prim = false; + while (p < bd->free) { + const StgInfoTable *info = get_itbl((const StgClosure *)p); + bool prim = false; + size_t size; - switch (info->type) { + switch (info->type) { - case THUNK: - size = thunk_sizeW_fromITBL(info); - break; + case THUNK: + size = thunk_sizeW_fromITBL(info); + break; - case THUNK_1_1: - case THUNK_0_2: - case THUNK_2_0: - size = sizeofW(StgThunkHeader) + 2; - break; + case THUNK_1_1: + case THUNK_0_2: + case THUNK_2_0: + size = sizeofW(StgThunkHeader) + 2; + break; - case THUNK_1_0: - case THUNK_0_1: - case THUNK_SELECTOR: - size = sizeofW(StgThunkHeader) + 1; - break; + case THUNK_1_0: + case THUNK_0_1: + case THUNK_SELECTOR: + size = sizeofW(StgThunkHeader) + 1; + break; - case FUN: - case BLACKHOLE: - case BLOCKING_QUEUE: - case FUN_1_0: - case FUN_0_1: - case FUN_1_1: - case FUN_0_2: - case FUN_2_0: - case CONSTR: - case CONSTR_NOCAF: - case CONSTR_1_0: - case CONSTR_0_1: - case CONSTR_1_1: - case CONSTR_0_2: - case CONSTR_2_0: - size = sizeW_fromITBL(info); - break; + case FUN: + case BLACKHOLE: + case BLOCKING_QUEUE: + case FUN_1_0: + case FUN_0_1: + case FUN_1_1: + case FUN_0_2: + case FUN_2_0: + case CONSTR: + case CONSTR_NOCAF: + case CONSTR_1_0: + case CONSTR_0_1: + case CONSTR_1_1: + case CONSTR_0_2: + case CONSTR_2_0: + size = sizeW_fromITBL(info); + break; - case IND: - // Special case/Delicate Hack: INDs don't normally - // appear, since we're doing this heap census right - // after GC. However, GarbageCollect() also does - // resurrectThreads(), which can update some - // blackholes when it calls raiseAsync() on the - // resurrected threads. So we know that any IND will - // be the size of a BLACKHOLE. - size = BLACKHOLE_sizeW(); - break; + case IND: + // Special case/Delicate Hack: INDs don't normally + // appear, since we're doing this heap census right + // after GC. However, GarbageCollect() also does + // resurrectThreads(), which can update some + // blackholes when it calls raiseAsync() on the + // resurrected threads. So we know that any IND will + // be the size of a BLACKHOLE. + size = BLACKHOLE_sizeW(); + break; - case BCO: - prim = true; - size = bco_sizeW((StgBCO *)p); - break; + case BCO: + prim = true; + size = bco_sizeW((StgBCO *)p); + break; - case MVAR_CLEAN: - case MVAR_DIRTY: - case TVAR: - case WEAK: - case PRIM: - case MUT_PRIM: - case MUT_VAR_CLEAN: - case MUT_VAR_DIRTY: - prim = true; - size = sizeW_fromITBL(info); - break; + case MVAR_CLEAN: + case MVAR_DIRTY: + case TVAR: + case WEAK: + case PRIM: + case MUT_PRIM: + case MUT_VAR_CLEAN: + case MUT_VAR_DIRTY: + prim = true; + size = sizeW_fromITBL(info); + break; - case AP: - size = ap_sizeW((StgAP *)p); - break; + case AP: + size = ap_sizeW((StgAP *)p); + break; - case PAP: - size = pap_sizeW((StgPAP *)p); - break; + case PAP: + size = pap_sizeW((StgPAP *)p); + break; - case AP_STACK: - size = ap_stack_sizeW((StgAP_STACK *)p); - break; + case AP_STACK: + size = ap_stack_sizeW((StgAP_STACK *)p); + break; - case ARR_WORDS: - prim = true; - size = arr_words_sizeW((StgArrBytes*)p); - break; + case ARR_WORDS: + prim = true; + size = arr_words_sizeW((StgArrBytes*)p); + break; - case MUT_ARR_PTRS_CLEAN: - case MUT_ARR_PTRS_DIRTY: - case MUT_ARR_PTRS_FROZEN_CLEAN: - case MUT_ARR_PTRS_FROZEN_DIRTY: - prim = true; - size = mut_arr_ptrs_sizeW((StgMutArrPtrs *)p); - break; + case MUT_ARR_PTRS_CLEAN: + case MUT_ARR_PTRS_DIRTY: + case MUT_ARR_PTRS_FROZEN_CLEAN: + case MUT_ARR_PTRS_FROZEN_DIRTY: + prim = true; + size = mut_arr_ptrs_sizeW((StgMutArrPtrs *)p); + break; - case SMALL_MUT_ARR_PTRS_CLEAN: - case SMALL_MUT_ARR_PTRS_DIRTY: - case SMALL_MUT_ARR_PTRS_FROZEN_CLEAN: - case SMALL_MUT_ARR_PTRS_FROZEN_DIRTY: - prim = true; - size = small_mut_arr_ptrs_sizeW((StgSmallMutArrPtrs *)p); - break; + case SMALL_MUT_ARR_PTRS_CLEAN: + case SMALL_MUT_ARR_PTRS_DIRTY: + case SMALL_MUT_ARR_PTRS_FROZEN_CLEAN: + case SMALL_MUT_ARR_PTRS_FROZEN_DIRTY: + prim = true; + size = small_mut_arr_ptrs_sizeW((StgSmallMutArrPtrs *)p); + break; - case TSO: - prim = true; + case TSO: + prim = true; #if defined(PROFILING) - if (RtsFlags.ProfFlags.includeTSOs) { - size = sizeofW(StgTSO); - break; - } else { - // Skip this TSO and move on to the next object - p += sizeofW(StgTSO); - continue; - } -#else + if (RtsFlags.ProfFlags.includeTSOs) { size = sizeofW(StgTSO); break; + } else { + // Skip this TSO and move on to the next object + p += sizeofW(StgTSO); + continue; + } +#else + size = sizeofW(StgTSO); + break; #endif - case STACK: - prim = true; + case STACK: + prim = true; #if defined(PROFILING) - if (RtsFlags.ProfFlags.includeTSOs) { - size = stack_sizeW((StgStack*)p); - break; - } else { - // Skip this TSO and move on to the next object - p += stack_sizeW((StgStack*)p); - continue; - } -#else + if (RtsFlags.ProfFlags.includeTSOs) { size = stack_sizeW((StgStack*)p); break; + } else { + // Skip this TSO and move on to the next object + p += stack_sizeW((StgStack*)p); + continue; + } +#else + size = stack_sizeW((StgStack*)p); + break; #endif - case TREC_CHUNK: - prim = true; - size = sizeofW(StgTRecChunk); - break; - - case COMPACT_NFDATA: - barf("heapCensus, found compact object in the wrong list"); - break; + case TREC_CHUNK: + prim = true; + size = sizeofW(StgTRecChunk); + break; - default: - barf("heapCensus, unknown object: %d", info->type); - } + case COMPACT_NFDATA: + barf("heapCensus, found compact object in the wrong list"); + break; - heapProfObject(census,(StgClosure*)p,size,prim); + default: + barf("heapCensus, unknown object: %d", info->type); + } - p += size; + heapProfObject(census,(StgClosure*)p,size,prim); + + p += size; + + /* skip over slop, see Note [slop on the heap] */ + while (p < bd->free && !*p) p++; + /* Note [skipping slop in the heap profiler] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * + * We make sure to zero slop that can remain after a major GC so + * here we can assume any slop words we see until the block's free + * pointer are zero. Since info pointers are always nonzero we can + * use this to scan for the next valid heap closure. + * + * Note that not all types of slop are relevant here, only the ones + * that can reman after major GC. So essentially just large objects + * and pinned objects. All other closures will have been packed nice + * and thight into fresh blocks. + */ + } +} - /* skip over slop, see Note [slop on the heap] */ +/* ----------------------------------------------------------------------------- + * Code to perform a heap census. + * -------------------------------------------------------------------------- */ +static void +heapCensusChain( Census *census, bdescr *bd ) +{ + for (; bd != NULL; bd = bd->link) { + // When we shrink a large ARR_WORDS, we do not adjust the free pointer + // of the associated block descriptor, thus introducing slop at the end + // of the object. This slop remains after GC, violating the assumption + // of the loop below that all slop has been eliminated (#11627). + // The slop isn't always zeroed (e.g. in non-profiling mode, cf + // OVERWRITING_CLOSURE_OFS). + // Consequently, we handle large ARR_WORDS objects as a special case. + if (bd->flags & BF_LARGE) { + StgPtr p = bd->start; + // There may be some initial zeros due to object alignment. while (p < bd->free && !*p) p++; - /* Note [skipping slop in the heap profiler] - * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - * - * We make sure to zero slop that can remain after a major GC so - * here we can assume any slop words we see until the block's free - * pointer are zero. Since info pointers are always nonzero we can - * use this to scan for the next valid heap closure. - * - * Note that not all types of slop are relevant here, only the ones - * that can reman after major GC. So essentially just large objects - * and pinned objects. All other closures will have been packed nice - * and thight into fresh blocks. - */ + if (get_itbl((StgClosure *)p)->type == ARR_WORDS) { + size_t size = arr_words_sizeW((StgArrBytes *)p); + bool prim = true; + heapProfObject(census, (StgClosure *)p, size, prim); + continue; + } } + + heapCensusBlock(census, bd); } } ===================================== rts/RtsFlags.c ===================================== @@ -1849,6 +1849,16 @@ static void normaliseRtsOpts (void) barf("The non-moving collector doesn't support -G1"); } +#if !defined(PROFILING) && !defined(DEBUG) + // The mark-region collector is incompatible with heap census unless + // we zero slop of blackhole'd thunks, which doesn't happen in the + // vanilla way. See #9666. + if (RtsFlags.ProfFlags.doHeapProfile && RtsFlags.GcFlags.sweep) { + barf("The mark-region collector can only be used with profiling\n" + "when linked against the profiled RTS."); + } +#endif + if (RtsFlags.ProfFlags.doHeapProfile != NO_HEAP_PROFILING && RtsFlags.GcFlags.useNonmoving) { barf("The non-moving collector doesn't support profiling"); ===================================== rts/Stats.c ===================================== @@ -570,7 +570,7 @@ stat_endGC (Capability *cap, gc_thread *initiating_gct, W_ live, W_ copied, W_ s // Emit events to the event log // Has to be emitted while all caps stopped for GC, but before GC_END. - // See trac.haskell.org/ThreadScope/wiki/RTSsummaryEvents + // See https://gitlab.haskell.org/ghc/ghc/-/wikis/RTSsummaryEvents // for a detailed design rationale of the current setup // of GC eventlog events. traceEventGcGlobalSync(cap); ===================================== rts/linker/Elf.c ===================================== @@ -32,6 +32,9 @@ #include #include #include +#if defined(HAVE_DLFCN_H) +#include +#endif #if defined(HAVE_SYS_STAT_H) #include #endif ===================================== rts/sm/Storage.c ===================================== @@ -952,10 +952,20 @@ accountAllocation(Capability *cap, W_ n) * of closures. This trick is used by the sanity checking code and the heap * profiler, see Note [skipping slop in the heap profiler]. * - * When profiling we zero: - * - Pinned object alignment slop, see MEMSET_IF_PROFILING_W in allocatePinned. + * In general we zero: + * + * - Pinned object alignment slop, see MEMSET_SLOP_W in allocatePinned. + * - Large object alignment slop, see MEMSET_SLOP_W in allocatePinned. * - Shrunk array slop, see OVERWRITING_CLOSURE_MUTABLE. * + * Note that this is necessary even in the vanilla (e.g. non-profiling) RTS + * since the user may trigger a heap census via +RTS -hT, which can be used + * even when not linking against the profiled RTS. Failing to zero slop + * due to array shrinking has resulted in a few nasty bugs (#17572, #9666). + * However, since array shrink may result in large amounts of slop (unlike + * alignment), we take care to only zero such slop when heap profiling or DEBUG + * are enabled. + * * When performing LDV profiling or using a (single threaded) debug RTS we zero * slop even when overwriting immutable closures, see Note [zeroing slop when * overwriting closures]. @@ -1126,12 +1136,7 @@ allocateMightFail (Capability *cap, W_ n) * * See Note [skipping slop in the heap profiler] */ -#if defined(PROFILING) -#define MEMSET_IF_PROFILING_W(p, val, len_w) memset(p, val, (len_w) * sizeof(W_)) -#else -#define MEMSET_IF_PROFILING_W(p, val, len_w) \ - do { (void)(p); (void)(val); (void)(len_w); } while(0) -#endif +#define MEMSET_SLOP_W(p, val, len_w) memset(p, val, (len_w) * sizeof(W_)) /* --------------------------------------------------------------------------- Allocate a fixed/pinned object. @@ -1184,9 +1189,9 @@ allocatePinned (Capability *cap, W_ n /*words*/, W_ alignment /*bytes*/, W_ alig } else { Bdescr(p)->flags |= BF_PINNED; W_ off_w = ALIGN_WITH_OFF_W(p, alignment, align_off); - MEMSET_IF_PROFILING_W(p, 0, off_w); + MEMSET_SLOP_W(p, 0, off_w); p += off_w; - MEMSET_IF_PROFILING_W(p + n, 0, alignment_w - off_w - 1); + MEMSET_SLOP_W(p + n, 0, alignment_w - off_w - 1); return p; } } @@ -1258,7 +1263,7 @@ allocatePinned (Capability *cap, W_ n /*words*/, W_ alignment /*bytes*/, W_ alig p = bd->free; - MEMSET_IF_PROFILING_W(p, 0, off_w); + MEMSET_SLOP_W(p, 0, off_w); n += off_w; p += off_w; ===================================== utils/deriveConstants/Main.hs ===================================== @@ -561,6 +561,8 @@ wanteds os = concat ,structField C "StgCompactNFDataBlock" "owner" ,structField C "StgCompactNFDataBlock" "next" + ,structField_ C "RtsFlags_ProfFlags_doHeapProfile" + "RTS_FLAGS" "ProfFlags.doHeapProfile" ,structField_ C "RtsFlags_ProfFlags_showCCSOnException" "RTS_FLAGS" "ProfFlags.showCCSOnException" ,structField_ C "RtsFlags_DebugFlags_apply" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/73f23069b34cea50d237c10125b5814df6b19bff...ff664f40d63a021fb815ec5e794a1c7556968cb8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/73f23069b34cea50d237c10125b5814df6b19bff...ff664f40d63a021fb815ec5e794a1c7556968cb8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Dec 14 15:31:49 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 14 Dec 2020 10:31:49 -0500 Subject: [Git][ghc/ghc][ghc-9.0] Backport: Fix for #18955 to GHC 9.0 Message-ID: <5fd7856552d96_6b2131d5c38146781d@gitlab.mail> Ben Gamari pushed to branch ghc-9.0 at Glasgow Haskell Compiler / GHC Commits: 00f07ca5 by Roland Senn at 2020-12-08T20:16:09+01:00 Backport: Fix for #18955 to GHC 9.0 Since MR !554 (#15454) GHCi automatically enabled the flag `-fobject-code` on any module using the UnboxedTuples or UnboxedSum extensions. MR !1553 (#16876) allowed to inhibit the automatic compiling to object-code of these modules by setting the `fbyte-code` flag. However, it assigned 2 different semantics to this flag and introduced the regression described in issue #18955. This MR fixes this regression by unsetting the internal flag `Opt_ByteCodeIfUnboxed` before it's copied to DynFlags local to the module. - - - - - 8 changed files: - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Session.hs - ghc/GHCi/UI.hs - + testsuite/tests/ghci/scripts/T18955.hs - + testsuite/tests/ghci/scripts/T18955.script - + testsuite/tests/ghci/scripts/T18955.stdout - testsuite/tests/ghci/scripts/all.T Changes: ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -273,7 +273,7 @@ data GeneralFlag | Opt_SingleLibFolder | Opt_KeepCAFs | Opt_KeepGoing - | Opt_ByteCode + | Opt_ByteCodeIfUnboxed | Opt_LinkRts -- output style opts ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -2230,7 +2230,7 @@ enableCodeGenForUnboxedTuplesOrSums = where condition ms = unboxed_tuples_or_sums (ms_hspp_opts ms) && - not (gopt Opt_ByteCode (ms_hspp_opts ms)) && + not (gopt Opt_ByteCodeIfUnboxed (ms_hspp_opts ms)) && (isBootSummary ms == NotBoot) unboxed_tuples_or_sums d = xopt LangExt.UnboxedTuples d || xopt LangExt.UnboxedSums d ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -3091,10 +3091,10 @@ dynamic_flags_deps = [ , make_ord_flag defFlag "fno-code" (NoArg ((upd $ \d -> d { ghcLink=NoLink }) >> setTarget HscNothing)) - , make_ord_flag defFlag "fbyte-code" - (noArgM $ \dflags -> do - setTarget HscInterpreted - pure $ gopt_set dflags Opt_ByteCode) + , make_ord_flag defFlag "fbyte-code" (NoArg ((upd $ \d -> + -- Enabling Opt_ByteCodeIfUnboxed is a workaround for #18955. + -- See the comments for resetOptByteCodeIfUnboxed for more details. + gopt_set d Opt_ByteCodeIfUnboxed) >> setTarget HscInterpreted)) , make_ord_flag defFlag "fobject-code" $ NoArg $ do dflags <- liftEwM getCmdLineState setTarget $ defaultObjectTarget dflags ===================================== ghc/GHCi/UI.hs ===================================== @@ -1941,6 +1941,7 @@ reloadModuleDefer = wrapDeferTypeErrors . reloadModule -- sessions. doLoadAndCollectInfo :: GhciMonad m => Bool -> LoadHowMuch -> m SuccessFlag doLoadAndCollectInfo retain_context howmuch = do + resetOptByteCodeIfUnboxed -- #18955 doCollectInfo <- isOptionSet CollectInfo doLoad retain_context howmuch >>= \case @@ -1953,6 +1954,24 @@ doLoadAndCollectInfo retain_context howmuch = do return Succeeded flag -> return flag +-- An `OPTIONS_GHC -fbyte-code` pragma at the beginning of a module sets the +-- flag `Opt_ByteCodeIfUnboxed` locally for this module. This stops automatic +-- compilation of this module to object code, if the module uses (or depends +-- on a module using) the UnboxedSums/Tuples extensions. +-- However a GHCi `:set -fbyte-code` command sets the flag Opt_ByteCodeIfUnboxed +-- globally to all modules. This triggered #18955. This function unsets the +-- flag from the global DynFlags before they are copied to the module-specific +-- DynFlags. +-- This is a temporary workaround until GHCi will support unboxed tuples and +-- unboxed sums. +resetOptByteCodeIfUnboxed :: GhciMonad m => m () +resetOptByteCodeIfUnboxed = do + dflags <- getDynFlags + when (gopt Opt_ByteCodeIfUnboxed dflags) $ do + _ <- GHC.setProgramDynFlags $ gopt_unset dflags Opt_ByteCodeIfUnboxed + pure () + pure () + doLoad :: GhciMonad m => Bool -> LoadHowMuch -> m SuccessFlag doLoad retain_context howmuch = do -- turn off breakpoints before we load: we can't turn them off later, because ===================================== testsuite/tests/ghci/scripts/T18955.hs ===================================== @@ -0,0 +1,2 @@ +main :: IO () +main = putStrLn "Hello World" ===================================== testsuite/tests/ghci/scripts/T18955.script ===================================== @@ -0,0 +1,3 @@ +:set -v1 +:set -fbyte-code +:l T18955 ===================================== testsuite/tests/ghci/scripts/T18955.stdout ===================================== @@ -0,0 +1,2 @@ +[1 of 1] Compiling Main ( T18955.hs, interpreted ) +Ok, one module loaded. ===================================== testsuite/tests/ghci/scripts/all.T ===================================== @@ -318,3 +318,4 @@ test('T17403', normal, ghci_script, ['T17403.script']) test('T17431', normal, ghci_script, ['T17431.script']) test('T17549', normal, ghci_script, ['T17549.script']) test('T17669', [extra_run_opts('-fexternal-interpreter -fobject-code'), expect_broken(17669)], ghci_script, ['T17669.script']) +test('T18955', [extra_hc_opts("-fobject-code")], ghci_script, ['T18955.script']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/00f07ca5a7f6b51fd94508a8da3a4cbf1ee3b73c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/00f07ca5a7f6b51fd94508a8da3a4cbf1ee3b73c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Dec 14 15:32:01 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 14 Dec 2020 10:32:01 -0500 Subject: [Git][ghc/ghc][wip/backports-9.0] 4 commits: Backport: Fix for #18955 to GHC 9.0 Message-ID: <5fd78571c7a73_6b216281648146902d@gitlab.mail> Ben Gamari pushed to branch wip/backports-9.0 at Glasgow Haskell Compiler / GHC Commits: 00f07ca5 by Roland Senn at 2020-12-08T20:16:09+01:00 Backport: Fix for #18955 to GHC 9.0 Since MR !554 (#15454) GHCi automatically enabled the flag `-fobject-code` on any module using the UnboxedTuples or UnboxedSum extensions. MR !1553 (#16876) allowed to inhibit the automatic compiling to object-code of these modules by setting the `fbyte-code` flag. However, it assigned 2 different semantics to this flag and introduced the regression described in issue #18955. This MR fixes this regression by unsetting the internal flag `Opt_ByteCodeIfUnboxed` before it's copied to DynFlags local to the module. - - - - - 3a1af9bf by Ben Gamari at 2020-12-14T10:31:58-05:00 Bump Cabal submodule to 3.4.0.0-rc5 - - - - - f081501e by Andreas Klebinger at 2020-12-14T10:31:58-05:00 RegAlloc: Add missing raPlatformfield to RegAllocStatsSpill Fixes #18994 Co-Author: Benjamin Maurer <maurer.benjamin at gmail.com> (cherry picked from commit 3e3555cc9c2a9f5246895f151259fd2a81621f38) - - - - - ca506ea7 by Shayne Fletcher at 2020-12-14T10:31:58-05:00 Fix bad span calculations of post qualified imports (cherry picked from commit 4a437bc19d2026845948356a932b2cac2417eb12) - - - - - 15 changed files: - compiler/GHC/CmmToAsm/Reg/Graph.hs - compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Parser.y - ghc/GHCi/UI.hs - libraries/Cabal - + testsuite/tests/ghci/scripts/T18955.hs - + testsuite/tests/ghci/scripts/T18955.script - + testsuite/tests/ghci/scripts/T18955.stdout - testsuite/tests/ghci/scripts/all.T - testsuite/tests/module/all.T - + testsuite/tests/module/mod185.hs - + testsuite/tests/module/mod185.stderr Changes: ===================================== compiler/GHC/CmmToAsm/Reg/Graph.hs ===================================== @@ -278,7 +278,8 @@ regAlloc_spin config spinCount triv regsFree slotsFree slotsCount debug_codeGrap , raCoalesced = rmCoalesce , raSpillStats = spillStats , raSpillCosts = spillCosts - , raSpilled = code_spilled } + , raSpilled = code_spilled + , raPlatform = platform } -- Bundle up all the register allocator statistics. -- .. but make sure to drop them on the floor if they're not ===================================== compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs ===================================== @@ -73,7 +73,11 @@ data RegAllocStats statics instr , raSpillCosts :: SpillCostInfo -- | Code with spill instructions added. - , raSpilled :: [LiveCmmDecl statics instr] } + , raSpilled :: [LiveCmmDecl statics instr] + + -- | Target platform + , raPlatform :: !Platform + } -- a successful coloring ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -273,7 +273,7 @@ data GeneralFlag | Opt_SingleLibFolder | Opt_KeepCAFs | Opt_KeepGoing - | Opt_ByteCode + | Opt_ByteCodeIfUnboxed | Opt_LinkRts -- output style opts ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -2230,7 +2230,7 @@ enableCodeGenForUnboxedTuplesOrSums = where condition ms = unboxed_tuples_or_sums (ms_hspp_opts ms) && - not (gopt Opt_ByteCode (ms_hspp_opts ms)) && + not (gopt Opt_ByteCodeIfUnboxed (ms_hspp_opts ms)) && (isBootSummary ms == NotBoot) unboxed_tuples_or_sums d = xopt LangExt.UnboxedTuples d || xopt LangExt.UnboxedSums d ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -3091,10 +3091,10 @@ dynamic_flags_deps = [ , make_ord_flag defFlag "fno-code" (NoArg ((upd $ \d -> d { ghcLink=NoLink }) >> setTarget HscNothing)) - , make_ord_flag defFlag "fbyte-code" - (noArgM $ \dflags -> do - setTarget HscInterpreted - pure $ gopt_set dflags Opt_ByteCode) + , make_ord_flag defFlag "fbyte-code" (NoArg ((upd $ \d -> + -- Enabling Opt_ByteCodeIfUnboxed is a workaround for #18955. + -- See the comments for resetOptByteCodeIfUnboxed for more details. + gopt_set d Opt_ByteCodeIfUnboxed) >> setTarget HscInterpreted)) , make_ord_flag defFlag "fobject-code" $ NoArg $ do dflags <- liftEwM getCmdLineState setTarget $ defaultObjectTarget dflags ===================================== compiler/GHC/Parser.y ===================================== @@ -967,18 +967,20 @@ importdecls_semi importdecl :: { LImportDecl GhcPs } : 'import' maybe_src maybe_safe optqualified maybe_pkg modid optqualified maybeas maybeimpspec {% do { - ; checkImportDecl $4 $7 - ; ams (L (comb4 $1 $6 (snd $8) $9) $ + ; let { ; mPreQual = unLoc $4 + ; mPostQual = unLoc $7 } + ; checkImportDecl mPreQual mPostQual + ; ams (L (comb5 $1 $6 $7 (snd $8) $9) $ ImportDecl { ideclExt = noExtField , ideclSourceSrc = snd $ fst $2 , ideclName = $6, ideclPkgQual = snd $5 , ideclSource = snd $2, ideclSafe = snd $3 - , ideclQualified = importDeclQualifiedStyle $4 $7 + , ideclQualified = importDeclQualifiedStyle mPreQual mPostQual , ideclImplicit = False , ideclAs = unLoc (snd $8) , ideclHiding = unLoc $9 }) - (mj AnnImport $1 : fst (fst $2) ++ fst $3 ++ fmap (mj AnnQualified) (maybeToList $4) - ++ fst $5 ++ fmap (mj AnnQualified) (maybeToList $7) ++ fst $8) + (mj AnnImport $1 : fst (fst $2) ++ fst $3 ++ fmap (mj AnnQualified) (maybeToList mPreQual) + ++ fst $5 ++ fmap (mj AnnQualified) (maybeToList mPostQual) ++ fst $8) } } @@ -1002,9 +1004,9 @@ maybe_pkg :: { ([AddAnn],Maybe StringLiteral) } ; return ([mj AnnPackageName $1], Just (StringLiteral (getSTRINGs $1) pkgFS)) } } | {- empty -} { ([],Nothing) } -optqualified :: { Maybe (Located Token) } - : 'qualified' { Just $1 } - | {- empty -} { Nothing } +optqualified :: { Located (Maybe (Located Token)) } + : 'qualified' { sL1 $1 (Just $1) } + | {- empty -} { noLoc Nothing } maybeas :: { ([AddAnn],Located (Maybe (Located ModuleName))) } : 'as' modid { ([mj AnnAs $1] @@ -3754,6 +3756,11 @@ comb4 a b c d = a `seq` b `seq` c `seq` d `seq` (combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $ combineSrcSpans (getLoc c) (getLoc d)) +comb5 :: Located a -> Located b -> Located c -> Located d -> Located e -> SrcSpan +comb5 a b c d e = a `seq` b `seq` c `seq` d `seq` e `seq` + (combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $ + combineSrcSpans (getLoc c) $ combineSrcSpans (getLoc d) (getLoc e)) + -- strict constructor version: {-# INLINE sL #-} sL :: SrcSpan -> a -> Located a ===================================== ghc/GHCi/UI.hs ===================================== @@ -1941,6 +1941,7 @@ reloadModuleDefer = wrapDeferTypeErrors . reloadModule -- sessions. doLoadAndCollectInfo :: GhciMonad m => Bool -> LoadHowMuch -> m SuccessFlag doLoadAndCollectInfo retain_context howmuch = do + resetOptByteCodeIfUnboxed -- #18955 doCollectInfo <- isOptionSet CollectInfo doLoad retain_context howmuch >>= \case @@ -1953,6 +1954,24 @@ doLoadAndCollectInfo retain_context howmuch = do return Succeeded flag -> return flag +-- An `OPTIONS_GHC -fbyte-code` pragma at the beginning of a module sets the +-- flag `Opt_ByteCodeIfUnboxed` locally for this module. This stops automatic +-- compilation of this module to object code, if the module uses (or depends +-- on a module using) the UnboxedSums/Tuples extensions. +-- However a GHCi `:set -fbyte-code` command sets the flag Opt_ByteCodeIfUnboxed +-- globally to all modules. This triggered #18955. This function unsets the +-- flag from the global DynFlags before they are copied to the module-specific +-- DynFlags. +-- This is a temporary workaround until GHCi will support unboxed tuples and +-- unboxed sums. +resetOptByteCodeIfUnboxed :: GhciMonad m => m () +resetOptByteCodeIfUnboxed = do + dflags <- getDynFlags + when (gopt Opt_ByteCodeIfUnboxed dflags) $ do + _ <- GHC.setProgramDynFlags $ gopt_unset dflags Opt_ByteCodeIfUnboxed + pure () + pure () + doLoad :: GhciMonad m => Bool -> LoadHowMuch -> m SuccessFlag doLoad retain_context howmuch = do -- turn off breakpoints before we load: we can't turn them off later, because ===================================== libraries/Cabal ===================================== @@ -1 +1 @@ -Subproject commit 5aea8a4b8463e1ae95272e190a1022764164294f +Subproject commit 7907a676ada3a5944cfa3b45e23deda7496767cf ===================================== testsuite/tests/ghci/scripts/T18955.hs ===================================== @@ -0,0 +1,2 @@ +main :: IO () +main = putStrLn "Hello World" ===================================== testsuite/tests/ghci/scripts/T18955.script ===================================== @@ -0,0 +1,3 @@ +:set -v1 +:set -fbyte-code +:l T18955 ===================================== testsuite/tests/ghci/scripts/T18955.stdout ===================================== @@ -0,0 +1,2 @@ +[1 of 1] Compiling Main ( T18955.hs, interpreted ) +Ok, one module loaded. ===================================== testsuite/tests/ghci/scripts/all.T ===================================== @@ -318,3 +318,4 @@ test('T17403', normal, ghci_script, ['T17403.script']) test('T17431', normal, ghci_script, ['T17431.script']) test('T17549', normal, ghci_script, ['T17549.script']) test('T17669', [extra_run_opts('-fexternal-interpreter -fobject-code'), expect_broken(17669)], ghci_script, ['T17669.script']) +test('T18955', [extra_hc_opts("-fobject-code")], ghci_script, ['T18955.script']) ===================================== testsuite/tests/module/all.T ===================================== @@ -268,6 +268,7 @@ test('mod181', normal, compile, ['']) test('mod182', normal, compile_fail, ['']) test('mod183', normal, compile_fail, ['']) test('mod184', normal, compile, ['-Wprepositive-qualified-module']) +test('mod185', normal, compile, ['-ddump-parsed-ast']) test('T1148', normal, compile, ['']) test('T1074', normal, compile, ['']) ===================================== testsuite/tests/module/mod185.hs ===================================== @@ -0,0 +1,5 @@ +{-# LANGUAGE ImportQualifiedPost #-} +-- The span of the import decl should include the 'qualified' keyword. +import Prelude qualified + +main = Prelude.undefined ===================================== testsuite/tests/module/mod185.stderr ===================================== @@ -0,0 +1,62 @@ +==================== Parser AST ==================== + +({ mod185.hs:1:1 } + (HsModule + (VirtualBraces + (1)) + (Nothing) + (Nothing) + [({ mod185.hs:3:1-24 } + (ImportDecl + (NoExtField) + (NoSourceText) + ({ mod185.hs:3:8-14 } + {ModuleName: Prelude}) + (Nothing) + (NotBoot) + (False) + (QualifiedPost) + (False) + (Nothing) + (Nothing)))] + [({ mod185.hs:5:1-24 } + (ValD + (NoExtField) + (FunBind + (NoExtField) + ({ mod185.hs:5:1-4 } + (Unqual + {OccName: main})) + (MG + (NoExtField) + ({ mod185.hs:5:1-24 } + [({ mod185.hs:5:1-24 } + (Match + (NoExtField) + (FunRhs + ({ mod185.hs:5:1-4 } + (Unqual + {OccName: main})) + (Prefix) + (NoSrcStrict)) + [] + (GRHSs + (NoExtField) + [({ mod185.hs:5:6-24 } + (GRHS + (NoExtField) + [] + ({ mod185.hs:5:8-24 } + (HsVar + (NoExtField) + ({ mod185.hs:5:8-24 } + (Qual + {ModuleName: Prelude} + {OccName: undefined}))))))] + ({ } + (EmptyLocalBinds + (NoExtField))))))]) + (FromSource)) + [])))] + (Nothing) + (Nothing))) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9ca9e1fd2197a57291824ed4e4266182b8d909a1...ca506ea7457df6ff971abb65a4f94025813bb737 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9ca9e1fd2197a57291824ed4e4266182b8d909a1...ca506ea7457df6ff971abb65a4f94025813bb737 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Dec 14 15:37:27 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 14 Dec 2020 10:37:27 -0500 Subject: [Git][ghc/ghc][wip/T19030] 14 commits: CodeGen: Make folds User/DefinerOfRegs INLINEABLE. Message-ID: <5fd786b7f78d_6b2162825c014788e2@gitlab.mail> Ben Gamari pushed to branch wip/T19030 at Glasgow Haskell Compiler / GHC Commits: 51e3bb6d by Andreas Klebinger at 2020-12-08T22:43:21-05:00 CodeGen: Make folds User/DefinerOfRegs INLINEABLE. Reduces allocation for the test case I was looking at by about 1.2%. Mostly from avoiding allocation of some folding functions which turn into let-no-escape bindings which just reuse their environment instead. We also force inlining in a few key places in CmmSink which helps a bit more. - - - - - 69ae10c3 by Andreas Klebinger at 2020-12-08T22:43:21-05:00 CmmSink: Force inlining of foldRegsDefd Helps avoid allocating the folding function. Improves perf for T3294 by about 1%. - - - - - 6e3da800 by Andreas Klebinger at 2020-12-08T22:43:21-05:00 Cmm: Make a few types and utility function slightly stricter. About 0.6% reduction in allocations for the code I was looking at. Not a huge difference but no need to throw away performance. - - - - - aef44d7f by Andreas Klebinger at 2020-12-08T22:43:21-05:00 Cmm.Sink: Optimize retaining of assignments, live sets. Sinking requires us to track live local regs after each cmm statement. We used to do this via "Set LocalReg". However we can replace this with a solution based on IntSet which is overall more efficient without losing much. The thing we lose is width of the variables, which isn't used by the sinking pass anyway. I also reworked how we keep assignments to regs mentioned in skipped assignments. I put the details into Note [Keeping assignemnts mentioned in skipped RHSs]. The gist of it is instead of keeping track of it via the use count which is a `IntMap Int` we now use the live regs set (IntSet) which is quite a bit faster. I think it also matches the semantics a lot better. The skipped (not discarded) assignment does in fact keep the regs on it's rhs alive so keeping track of this in the live set seems like the clearer solution as well. Improves allocations for T3294 by yet another 1%. - - - - - 59f2249b by Andreas Klebinger at 2020-12-08T22:43:21-05:00 GHC.Cmm.Opt: Be stricter in results. Optimization either returns Nothing if nothing is to be done or `Just <cmmExpr>` otherwise. There is no point in being lazy in `cmmExpr`. We usually inspect this element so the thunk gets forced not long after. We might eliminate it as dead code once in a blue moon but that's not a case worth optimizing for. Overall the impact of this is rather low. As Cmm.Opt doesn't allocate much (compared to the rest of GHC) to begin with. - - - - - 54b88eac by Andreas Klebinger at 2020-12-08T22:43:57-05:00 Bump time submodule. This should fix #19002. - - - - - 35e7b0c6 by Kirill Elagin at 2020-12-10T01:45:54-05:00 doc: Clarify the default for -fomit-yields “Yield points enabled” is confusing (and probably wrong? I am not 100% sure what it means). Change it to a simple “on”. Undo this change from 2c23fff2e03e77187dc4d01f325f5f43a0e7cad2. - - - - - 3551c554 by Kirill Elagin at 2020-12-10T01:45:54-05:00 doc: Extra-clarify -fomit-yields Be more clear on what this optimisation being on by default means in terms of yields. - - - - - 6484f0d7 by Sergei Trofimovich at 2020-12-10T01:46:33-05:00 rts/linker/Elf.c: add missing <dlfcn.h> include (musl support) The change fixes build failure on musl: ``` rts/linker/Elf.c:2031:3: error: warning: implicit declaration of function 'dlclose'; did you mean 'close'? [-Wimplicit-function-declaration] 2031 | dlclose(nc->dlopen_handle); | ^~~~~~~ | close ``` Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - ab24ed9b by Ben Gamari at 2020-12-11T03:55:51-05:00 users guide: Fix syntax errors Fixes errors introduced by 3a55b3a2574f913d046f3a6f82db48d7f6df32e3. - - - - - d3a24d31 by Ben Gamari at 2020-12-11T03:55:51-05:00 users guide: Describe GC lifecycle events Every time I am asked about how to interpret these events I need to figure it out from scratch. It's well past time that the users guide properly documents these. - - - - - 741309b9 by Ben Gamari at 2020-12-11T03:56:27-05:00 gitlab-ci: Fix incorrect Docker image for nightly cross job Also refactor the job definition to eliminate the bug by construction. - - - - - 19703bc8 by Ben Gamari at 2020-12-11T03:56:27-05:00 gitlab-ci: Fix name of flavour in ThreadSanitizer job It looks like I neglected to update this after introduce flavour transformers. - - - - - e02c5308 by Ben Gamari at 2020-12-14T10:36:35-05:00 ghci: Take editor from VISUAL environment variable Following the example of `git`, as noted in #19030. Fixes #19030. - - - - - 19 changed files: - .gitlab-ci.yml - compiler/GHC/Cmm/Expr.hs - + compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Liveness.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/Utils/Outputable.hs - compiler/ghc.cabal.in - docs/users_guide/9.2.1-notes.rst - docs/users_guide/eventlog-formats.rst - docs/users_guide/ghci.rst - docs/users_guide/runtime_control.rst - docs/users_guide/using-optimisation.rst - ghc/GHCi/UI.hs - libraries/time - rts/Stats.c - rts/linker/Elf.c Changes: ===================================== .gitlab-ci.yml ===================================== @@ -257,27 +257,24 @@ validate-x86_64-linux-deb9-unreg-hadrian: CONFIGURE_ARGS: --enable-unregisterised TEST_ENV: "x86_64-linux-deb9-unreg-hadrian" -validate-x86_64-linux-deb10-hadrian-cross-aarch64: - <<: *nightly +.build-x86_64-linux-deb10-hadrian-cross-aarch64: extends: .validate-linux-hadrian - stage: full-build image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV" variables: BIN_DIST_NAME: "ghc-x86_64-deb9-linux" - rules: - - if: '$CI_MERGE_REQUEST_LABELS =~ /.*cross-compilation.*/' - variables: CONFIGURE_ARGS: --with-intree-gmp CROSS_TARGET: "aarch64-linux-gnu" +validate-x86_64-linux-deb10-hadrian-cross-aarch64: + extends: .build-x86_64-linux-deb10-hadrian-cross-aarch64 + stage: full-build + rules: + - if: '$CI_MERGE_REQUEST_LABELS =~ /.*cross-compilation.*/' + nightly-x86_64-linux-deb10-hadrian-cross-aarch64: <<: *nightly - extends: .validate-linux-hadrian + extends: .build-x86_64-linux-deb10-hadrian-cross-aarch64 stage: full-build - variables: - CONFIGURE_ARGS: --with-intree-gmp - CROSS_TARGET: "aarch64-linux-gnu" - ############################################################ @@ -712,7 +709,7 @@ nightly-x86_64-linux-deb9-integer-simple: stage: full-build variables: TEST_ENV: "x86_64-linux-deb9-tsan" - BUILD_FLAVOUR: "thread-sanitizer" + BUILD_FLAVOUR: "default+thread_sanitizer" TSAN_OPTIONS: "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions" # Haddock is large enough to make TSAN choke without massive quantities of # memory. ===================================== compiler/GHC/Cmm/Expr.hs ===================================== @@ -53,14 +53,14 @@ import GHC.Types.Basic (Alignment, mkAlignment, alignmentOf) ----------------------------------------------------------------------------- data CmmExpr - = CmmLit CmmLit -- Literal + = CmmLit !CmmLit -- Literal | CmmLoad !CmmExpr !CmmType -- Read memory location | CmmReg !CmmReg -- Contents of register | CmmMachOp MachOp [CmmExpr] -- Machine operation (+, -, *, etc.) | CmmStackSlot Area {-# UNPACK #-} !Int -- addressing expression of a stack slot -- See Note [CmmStackSlot aliasing] - | CmmRegOff !CmmReg Int + | CmmRegOff !CmmReg !Int -- CmmRegOff reg i -- ** is shorthand only, meaning ** -- CmmMachOp (MO_Add rep) [x, CmmLit (CmmInt (fromIntegral i) rep)] @@ -173,16 +173,16 @@ Now, the assignments of y go away, -} data CmmLit - = CmmInt !Integer Width + = CmmInt !Integer !Width -- Interpretation: the 2's complement representation of the value -- is truncated to the specified size. This is easier than trying -- to keep the value within range, because we don't know whether -- it will be used as a signed or unsigned value (the CmmType doesn't -- distinguish between signed & unsigned). - | CmmFloat Rational Width + | CmmFloat Rational !Width | CmmVec [CmmLit] -- Vector literal | CmmLabel CLabel -- Address of label - | CmmLabelOff CLabel Int -- Address of label + byte offset + | CmmLabelOff CLabel !Int -- Address of label + byte offset -- Due to limitations in the C backend, the following -- MUST ONLY be used inside the info table indicated by label2 @@ -191,7 +191,7 @@ data CmmLit -- Don't use it at all unless tablesNextToCode. -- It is also used inside the NCG during when generating -- position-independent code. - | CmmLabelDiffOff CLabel CLabel Int Width -- label1 - label2 + offset + | CmmLabelDiffOff CLabel CLabel !Int !Width -- label1 - label2 + offset -- In an expression, the width just has the effect of MO_SS_Conv -- from wordWidth to the desired width. -- @@ -363,6 +363,7 @@ instance DefinerOfRegs LocalReg CmmReg where foldRegsDefd _ _ z (CmmGlobal _) = z instance UserOfRegs GlobalReg CmmReg where + {-# INLINEABLE foldRegsUsed #-} foldRegsUsed _ _ z (CmmLocal _) = z foldRegsUsed _ f z (CmmGlobal reg) = f z reg @@ -379,6 +380,7 @@ instance Ord r => DefinerOfRegs r r where instance (Ord r, UserOfRegs r CmmReg) => UserOfRegs r CmmExpr where -- The (Ord r) in the context is necessary here -- See Note [Recursive superclasses] in GHC.Tc.TyCl.Instance + {-# INLINEABLE foldRegsUsed #-} foldRegsUsed platform f !z e = expr z e where expr z (CmmLit _) = z expr z (CmmLoad addr _) = foldRegsUsed platform f z addr ===================================== compiler/GHC/Cmm/LRegSet.hs ===================================== @@ -0,0 +1,53 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module GHC.Cmm.LRegSet ( + LRegSet, + LRegKey, + + emptyLRegSet, + nullLRegSet, + insertLRegSet, + elemLRegSet, + + deleteFromLRegSet, + sizeLRegSet, + + plusLRegSet, + elemsLRegSet + ) where + +import GHC.Prelude +import GHC.Types.Unique +import GHC.Cmm.Expr + +import Data.IntSet as IntSet + +-- Compact sets for membership tests of local variables. + +type LRegSet = IntSet.IntSet +type LRegKey = Int + +emptyLRegSet :: LRegSet +emptyLRegSet = IntSet.empty + +nullLRegSet :: LRegSet -> Bool +nullLRegSet = IntSet.null + +insertLRegSet :: LocalReg -> LRegSet -> LRegSet +insertLRegSet l = IntSet.insert (getKey (getUnique l)) + +elemLRegSet :: LocalReg -> LRegSet -> Bool +elemLRegSet l = IntSet.member (getKey (getUnique l)) + +deleteFromLRegSet :: LRegSet -> LocalReg -> LRegSet +deleteFromLRegSet set reg = IntSet.delete (getKey . getUnique $ reg) set + +sizeLRegSet :: IntSet -> Int +sizeLRegSet = IntSet.size + +plusLRegSet :: IntSet -> IntSet -> IntSet +plusLRegSet = IntSet.union + +elemsLRegSet :: IntSet -> [Int] +elemsLRegSet = IntSet.toList ===================================== compiler/GHC/Cmm/Liveness.hs ===================================== @@ -6,9 +6,12 @@ module GHC.Cmm.Liveness ( CmmLocalLive , cmmLocalLiveness + , cmmLocalLivenessL , cmmGlobalLiveness , liveLattice + , liveLatticeL , gen_kill + , gen_killL ) where @@ -22,11 +25,14 @@ import GHC.Cmm.Dataflow.Block import GHC.Cmm.Dataflow.Collections import GHC.Cmm.Dataflow import GHC.Cmm.Dataflow.Label +import GHC.Cmm.LRegSet import GHC.Data.Maybe import GHC.Utils.Outputable import GHC.Utils.Panic +import GHC.Types.Unique + ----------------------------------------------------------------------------- -- Calculating what variables are live on entry to a basic block ----------------------------------------------------------------------------- @@ -92,3 +98,66 @@ xferLive platform (BlockCC eNode middle xNode) fBase = in mapSingleton (entryLabel eNode) result {-# SPECIALIZE xferLive :: Platform -> TransferFun (CmmLive LocalReg) #-} {-# SPECIALIZE xferLive :: Platform -> TransferFun (CmmLive GlobalReg) #-} + +----------------------------------------------------------------------------- +-- | Specialization that only retains the keys for local variables. +-- +-- Local variablas are mostly glorified Ints, and some parts of the compiler +-- really don't care about anything but the Int part. So we can avoid some +-- overhead by computing a IntSet instead of a Set LocalReg which (unsurprisingly) +-- is quite a bit faster. +----------------------------------------------------------------------------- + +type BlockEntryLivenessL = LabelMap LRegSet + +-- | The dataflow lattice +liveLatticeL :: DataflowLattice LRegSet +liveLatticeL = DataflowLattice emptyLRegSet add + where + add (OldFact old) (NewFact new) = + let !join = plusLRegSet old new + in changedIf (sizeLRegSet join > sizeLRegSet old) join + + +cmmLocalLivenessL :: Platform -> CmmGraph -> BlockEntryLivenessL +cmmLocalLivenessL platform graph = + check $ analyzeCmmBwd liveLatticeL (xferLiveL platform) graph mapEmpty + where + entry = g_entry graph + check facts = + noLiveOnEntryL entry (expectJust "check" $ mapLookup entry facts) facts + +-- | On entry to the procedure, there had better not be any LocalReg's live-in. +noLiveOnEntryL :: BlockId -> LRegSet -> a -> a +noLiveOnEntryL bid in_fact x = + if nullLRegSet in_fact then x + else pprPanic "LocalReg's live-in to graph" (ppr bid <+> ppr reg_uniques) + where + -- We convert the int's to uniques so that the printing matches that + -- of registers. + reg_uniques = map mkUniqueGrimily $ elemsLRegSet in_fact + + + + +gen_killL + :: (DefinerOfRegs LocalReg n, UserOfRegs LocalReg n) + => Platform -> n -> LRegSet -> LRegSet +gen_killL platform node set = + let !afterKill = foldRegsDefd platform deleteFromLRegSet set node + in foldRegsUsed platform (flip insertLRegSet) afterKill node +{-# INLINE gen_killL #-} + +xferLiveL + :: ( UserOfRegs LocalReg (CmmNode O O) + , DefinerOfRegs LocalReg (CmmNode O O) + , UserOfRegs LocalReg (CmmNode O C) + , DefinerOfRegs LocalReg (CmmNode O C) + ) + => Platform -> TransferFun LRegSet +xferLiveL platform (BlockCC eNode middle xNode) fBase = + let joined = gen_killL platform xNode $! joinOutFacts liveLatticeL xNode fBase + !result = foldNodesBwdOO (gen_killL platform) middle joined + in mapSingleton (entryLabel eNode) result + + ===================================== compiler/GHC/Cmm/Node.hs ===================================== @@ -318,6 +318,7 @@ foreignTargetHints target -- Instances of register and slot users / definers instance UserOfRegs LocalReg (CmmNode e x) where + {-# INLINEABLE foldRegsUsed #-} foldRegsUsed platform f !z n = case n of CmmAssign _ expr -> fold f z expr CmmStore addr rval -> fold f (fold f z addr) rval @@ -332,6 +333,7 @@ instance UserOfRegs LocalReg (CmmNode e x) where fold f z n = foldRegsUsed platform f z n instance UserOfRegs GlobalReg (CmmNode e x) where + {-# INLINEABLE foldRegsUsed #-} foldRegsUsed platform f !z n = case n of CmmAssign _ expr -> fold f z expr CmmStore addr rval -> fold f (fold f z addr) rval @@ -348,10 +350,12 @@ instance UserOfRegs GlobalReg (CmmNode e x) where instance (Ord r, UserOfRegs r CmmReg) => UserOfRegs r ForeignTarget where -- The (Ord r) in the context is necessary here -- See Note [Recursive superclasses] in GHC.Tc.TyCl.Instance + {-# INLINEABLE foldRegsUsed #-} foldRegsUsed _ _ !z (PrimTarget _) = z foldRegsUsed platform f !z (ForeignTarget e _) = foldRegsUsed platform f z e instance DefinerOfRegs LocalReg (CmmNode e x) where + {-# INLINEABLE foldRegsDefd #-} foldRegsDefd platform f !z n = case n of CmmAssign lhs _ -> fold f z lhs CmmUnsafeForeignCall _ fs _ -> fold f z fs @@ -362,6 +366,7 @@ instance DefinerOfRegs LocalReg (CmmNode e x) where fold f z n = foldRegsDefd platform f z n instance DefinerOfRegs GlobalReg (CmmNode e x) where + {-# INLINEABLE foldRegsDefd #-} foldRegsDefd platform f !z n = case n of CmmAssign lhs _ -> fold f z lhs CmmUnsafeForeignCall tgt _ _ -> fold f z (foreignTargetRegs tgt) ===================================== compiler/GHC/Cmm/Opt.hs ===================================== @@ -58,7 +58,7 @@ cmmMachOpFoldM -> Maybe CmmExpr cmmMachOpFoldM _ op [CmmLit (CmmInt x rep)] - = Just $ case op of + = Just $! case op of MO_S_Neg _ -> CmmLit (CmmInt (-x) rep) MO_Not _ -> CmmLit (CmmInt (complement x) rep) @@ -90,13 +90,13 @@ cmmMachOpFoldM platform conv_outer [CmmMachOp conv_inner [x]] -- but remember to use the signedness from the widening, just in case -- the final conversion is a widen. | rep1 < rep2 && rep2 > rep3 -> - Just $ cmmMachOpFold platform (intconv signed1 rep1 rep3) [x] + Just $! cmmMachOpFold platform (intconv signed1 rep1 rep3) [x] -- Nested widenings: collapse if the signedness is the same | rep1 < rep2 && rep2 < rep3 && signed1 == signed2 -> - Just $ cmmMachOpFold platform (intconv signed1 rep1 rep3) [x] + Just $! cmmMachOpFold platform (intconv signed1 rep1 rep3) [x] -- Nested narrowings: collapse | rep1 > rep2 && rep2 > rep3 -> - Just $ cmmMachOpFold platform (MO_UU_Conv rep1 rep3) [x] + Just $! cmmMachOpFold platform (MO_UU_Conv rep1 rep3) [x] | otherwise -> Nothing where @@ -117,34 +117,34 @@ cmmMachOpFoldM platform mop [CmmLit (CmmInt x xrep), CmmLit (CmmInt y _)] = case mop of -- for comparisons: don't forget to narrow the arguments before -- comparing, since they might be out of range. - MO_Eq _ -> Just $ CmmLit (CmmInt (if x_u == y_u then 1 else 0) (wordWidth platform)) - MO_Ne _ -> Just $ CmmLit (CmmInt (if x_u /= y_u then 1 else 0) (wordWidth platform)) - - MO_U_Gt _ -> Just $ CmmLit (CmmInt (if x_u > y_u then 1 else 0) (wordWidth platform)) - MO_U_Ge _ -> Just $ CmmLit (CmmInt (if x_u >= y_u then 1 else 0) (wordWidth platform)) - MO_U_Lt _ -> Just $ CmmLit (CmmInt (if x_u < y_u then 1 else 0) (wordWidth platform)) - MO_U_Le _ -> Just $ CmmLit (CmmInt (if x_u <= y_u then 1 else 0) (wordWidth platform)) - - MO_S_Gt _ -> Just $ CmmLit (CmmInt (if x_s > y_s then 1 else 0) (wordWidth platform)) - MO_S_Ge _ -> Just $ CmmLit (CmmInt (if x_s >= y_s then 1 else 0) (wordWidth platform)) - MO_S_Lt _ -> Just $ CmmLit (CmmInt (if x_s < y_s then 1 else 0) (wordWidth platform)) - MO_S_Le _ -> Just $ CmmLit (CmmInt (if x_s <= y_s then 1 else 0) (wordWidth platform)) - - MO_Add r -> Just $ CmmLit (CmmInt (x + y) r) - MO_Sub r -> Just $ CmmLit (CmmInt (x - y) r) - MO_Mul r -> Just $ CmmLit (CmmInt (x * y) r) - MO_U_Quot r | y /= 0 -> Just $ CmmLit (CmmInt (x_u `quot` y_u) r) - MO_U_Rem r | y /= 0 -> Just $ CmmLit (CmmInt (x_u `rem` y_u) r) - MO_S_Quot r | y /= 0 -> Just $ CmmLit (CmmInt (x `quot` y) r) - MO_S_Rem r | y /= 0 -> Just $ CmmLit (CmmInt (x `rem` y) r) - - MO_And r -> Just $ CmmLit (CmmInt (x .&. y) r) - MO_Or r -> Just $ CmmLit (CmmInt (x .|. y) r) - MO_Xor r -> Just $ CmmLit (CmmInt (x `xor` y) r) - - MO_Shl r -> Just $ CmmLit (CmmInt (x `shiftL` fromIntegral y) r) - MO_U_Shr r -> Just $ CmmLit (CmmInt (x_u `shiftR` fromIntegral y) r) - MO_S_Shr r -> Just $ CmmLit (CmmInt (x `shiftR` fromIntegral y) r) + MO_Eq _ -> Just $! CmmLit (CmmInt (if x_u == y_u then 1 else 0) (wordWidth platform)) + MO_Ne _ -> Just $! CmmLit (CmmInt (if x_u /= y_u then 1 else 0) (wordWidth platform)) + + MO_U_Gt _ -> Just $! CmmLit (CmmInt (if x_u > y_u then 1 else 0) (wordWidth platform)) + MO_U_Ge _ -> Just $! CmmLit (CmmInt (if x_u >= y_u then 1 else 0) (wordWidth platform)) + MO_U_Lt _ -> Just $! CmmLit (CmmInt (if x_u < y_u then 1 else 0) (wordWidth platform)) + MO_U_Le _ -> Just $! CmmLit (CmmInt (if x_u <= y_u then 1 else 0) (wordWidth platform)) + + MO_S_Gt _ -> Just $! CmmLit (CmmInt (if x_s > y_s then 1 else 0) (wordWidth platform)) + MO_S_Ge _ -> Just $! CmmLit (CmmInt (if x_s >= y_s then 1 else 0) (wordWidth platform)) + MO_S_Lt _ -> Just $! CmmLit (CmmInt (if x_s < y_s then 1 else 0) (wordWidth platform)) + MO_S_Le _ -> Just $! CmmLit (CmmInt (if x_s <= y_s then 1 else 0) (wordWidth platform)) + + MO_Add r -> Just $! CmmLit (CmmInt (x + y) r) + MO_Sub r -> Just $! CmmLit (CmmInt (x - y) r) + MO_Mul r -> Just $! CmmLit (CmmInt (x * y) r) + MO_U_Quot r | y /= 0 -> Just $! CmmLit (CmmInt (x_u `quot` y_u) r) + MO_U_Rem r | y /= 0 -> Just $! CmmLit (CmmInt (x_u `rem` y_u) r) + MO_S_Quot r | y /= 0 -> Just $! CmmLit (CmmInt (x `quot` y) r) + MO_S_Rem r | y /= 0 -> Just $! CmmLit (CmmInt (x `rem` y) r) + + MO_And r -> Just $! CmmLit (CmmInt (x .&. y) r) + MO_Or r -> Just $! CmmLit (CmmInt (x .|. y) r) + MO_Xor r -> Just $! CmmLit (CmmInt (x `xor` y) r) + + MO_Shl r -> Just $! CmmLit (CmmInt (x `shiftL` fromIntegral y) r) + MO_U_Shr r -> Just $! CmmLit (CmmInt (x_u `shiftR` fromIntegral y) r) + MO_S_Shr r -> Just $! CmmLit (CmmInt (x `shiftR` fromIntegral y) r) _ -> Nothing @@ -162,7 +162,7 @@ cmmMachOpFoldM platform mop [CmmLit (CmmInt x xrep), CmmLit (CmmInt y _)] cmmMachOpFoldM platform op [x@(CmmLit _), y] | not (isLit y) && isCommutableMachOp op - = Just (cmmMachOpFold platform op [y, x]) + = Just $! (cmmMachOpFold platform op [y, x]) -- Turn (a+b)+c into a+(b+c) where possible. Because literals are -- moved to the right, it is more likely that we will find @@ -183,7 +183,7 @@ cmmMachOpFoldM platform op [x@(CmmLit _), y] cmmMachOpFoldM platform mop1 [CmmMachOp mop2 [arg1,arg2], arg3] | mop2 `associates_with` mop1 && not (isLit arg1) && not (isPicReg arg1) - = Just (cmmMachOpFold platform mop2 [arg1, cmmMachOpFold platform mop1 [arg2,arg3]]) + = Just $! (cmmMachOpFold platform mop2 [arg1, cmmMachOpFold platform mop1 [arg2,arg3]]) where MO_Add{} `associates_with` MO_Sub{} = True mop1 `associates_with` mop2 = @@ -192,7 +192,7 @@ cmmMachOpFoldM platform mop1 [CmmMachOp mop2 [arg1,arg2], arg3] -- special case: (a - b) + c ==> a + (c - b) cmmMachOpFoldM platform mop1@(MO_Add{}) [CmmMachOp mop2@(MO_Sub{}) [arg1,arg2], arg3] | not (isLit arg1) && not (isPicReg arg1) - = Just (cmmMachOpFold platform mop1 [arg1, cmmMachOpFold platform mop2 [arg3,arg2]]) + = Just $! (cmmMachOpFold platform mop1 [arg1, cmmMachOpFold platform mop2 [arg3,arg2]]) -- special case: (PicBaseReg + lit) + N ==> PicBaseReg + (lit+N) -- @@ -205,27 +205,27 @@ cmmMachOpFoldM platform mop1@(MO_Add{}) [CmmMachOp mop2@(MO_Sub{}) [arg1,arg2], cmmMachOpFoldM _ MO_Add{} [ CmmMachOp op at MO_Add{} [pic, CmmLit lit] , CmmLit (CmmInt n rep) ] | isPicReg pic - = Just $ CmmMachOp op [pic, CmmLit $ cmmOffsetLit lit off ] + = Just $! CmmMachOp op [pic, CmmLit $ cmmOffsetLit lit off ] where off = fromIntegral (narrowS rep n) -- Make a RegOff if we can cmmMachOpFoldM _ (MO_Add _) [CmmReg reg, CmmLit (CmmInt n rep)] - = Just $ cmmRegOff reg (fromIntegral (narrowS rep n)) + = Just $! cmmRegOff reg (fromIntegral (narrowS rep n)) cmmMachOpFoldM _ (MO_Add _) [CmmRegOff reg off, CmmLit (CmmInt n rep)] - = Just $ cmmRegOff reg (off + fromIntegral (narrowS rep n)) + = Just $! cmmRegOff reg (off + fromIntegral (narrowS rep n)) cmmMachOpFoldM _ (MO_Sub _) [CmmReg reg, CmmLit (CmmInt n rep)] - = Just $ cmmRegOff reg (- fromIntegral (narrowS rep n)) + = Just $! cmmRegOff reg (- fromIntegral (narrowS rep n)) cmmMachOpFoldM _ (MO_Sub _) [CmmRegOff reg off, CmmLit (CmmInt n rep)] - = Just $ cmmRegOff reg (off - fromIntegral (narrowS rep n)) + = Just $! cmmRegOff reg (off - fromIntegral (narrowS rep n)) -- Fold label(+/-)offset into a CmmLit where possible cmmMachOpFoldM _ (MO_Add _) [CmmLit lit, CmmLit (CmmInt i rep)] - = Just $ CmmLit (cmmOffsetLit lit (fromIntegral (narrowU rep i))) + = Just $! CmmLit (cmmOffsetLit lit (fromIntegral (narrowU rep i))) cmmMachOpFoldM _ (MO_Add _) [CmmLit (CmmInt i rep), CmmLit lit] - = Just $ CmmLit (cmmOffsetLit lit (fromIntegral (narrowU rep i))) + = Just $! CmmLit (cmmOffsetLit lit (fromIntegral (narrowU rep i))) cmmMachOpFoldM _ (MO_Sub _) [CmmLit lit, CmmLit (CmmInt i rep)] - = Just $ CmmLit (cmmOffsetLit lit (fromIntegral (negate (narrowU rep i)))) + = Just $! CmmLit (cmmOffsetLit lit (fromIntegral (negate (narrowU rep i)))) -- Comparison of literal with widened operand: perform the comparison @@ -245,7 +245,7 @@ cmmMachOpFoldM platform cmp [CmmMachOp conv [x], CmmLit (CmmInt i _)] -- and the literal fits in the smaller size: i == narrow_fn rep i -- then we can do the comparison at the smaller size - = Just (cmmMachOpFold platform narrow_cmp [x, CmmLit (CmmInt i rep)]) + = Just $! (cmmMachOpFold platform narrow_cmp [x, CmmLit (CmmInt i rep)]) where maybe_conversion (MO_UU_Conv from to) | to > from @@ -320,8 +320,8 @@ cmmMachOpFoldM platform mop [x, (CmmLit (CmmInt 1 rep))] MO_Mul _ -> Just x MO_S_Quot _ -> Just x MO_U_Quot _ -> Just x - MO_S_Rem _ -> Just $ CmmLit (CmmInt 0 rep) - MO_U_Rem _ -> Just $ CmmLit (CmmInt 0 rep) + MO_S_Rem _ -> Just $! CmmLit (CmmInt 0 rep) + MO_U_Rem _ -> Just $! CmmLit (CmmInt 0 rep) -- Comparisons; trickier -- See Note [Comparison operators] @@ -346,18 +346,18 @@ cmmMachOpFoldM platform mop [x, (CmmLit (CmmInt n _))] = case mop of MO_Mul rep | Just p <- exactLog2 n -> - Just (cmmMachOpFold platform (MO_Shl rep) [x, CmmLit (CmmInt p rep)]) + Just $! (cmmMachOpFold platform (MO_Shl rep) [x, CmmLit (CmmInt p rep)]) MO_U_Quot rep | Just p <- exactLog2 n -> - Just (cmmMachOpFold platform (MO_U_Shr rep) [x, CmmLit (CmmInt p rep)]) + Just $! (cmmMachOpFold platform (MO_U_Shr rep) [x, CmmLit (CmmInt p rep)]) MO_U_Rem rep | Just _ <- exactLog2 n -> - Just (cmmMachOpFold platform (MO_And rep) [x, CmmLit (CmmInt (n - 1) rep)]) + Just $! (cmmMachOpFold platform (MO_And rep) [x, CmmLit (CmmInt (n - 1) rep)]) MO_S_Quot rep | Just p <- exactLog2 n, CmmReg _ <- x -> -- We duplicate x in signedQuotRemHelper, hence require -- it is a reg. FIXME: remove this restriction. - Just (cmmMachOpFold platform (MO_S_Shr rep) + Just $! (cmmMachOpFold platform (MO_S_Shr rep) [signedQuotRemHelper rep p, CmmLit (CmmInt p rep)]) MO_S_Rem rep | Just p <- exactLog2 n, @@ -366,7 +366,7 @@ cmmMachOpFoldM platform mop [x, (CmmLit (CmmInt n _))] -- We replace (x `rem` 2^p) by (x - (x `quot` 2^p) * 2^p). -- Moreover, we fuse MO_S_Shr (last operation of MO_S_Quot) -- and MO_S_Shl (multiplication by 2^p) into a single MO_And operation. - Just (cmmMachOpFold platform (MO_Sub rep) + Just $! (cmmMachOpFold platform (MO_Sub rep) [x, cmmMachOpFold platform (MO_And rep) [signedQuotRemHelper rep p, CmmLit (CmmInt (- n) rep)]]) _ -> Nothing ===================================== compiler/GHC/Cmm/Sink.hs ===================================== @@ -1,4 +1,6 @@ {-# LANGUAGE GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} + module GHC.Cmm.Sink ( cmmSink ) where @@ -8,6 +10,7 @@ import GHC.Prelude import GHC.Cmm import GHC.Cmm.Opt import GHC.Cmm.Liveness +import GHC.Cmm.LRegSet import GHC.Cmm.Utils import GHC.Cmm.Dataflow.Block import GHC.Cmm.Dataflow.Label @@ -16,29 +19,13 @@ import GHC.Cmm.Dataflow.Graph import GHC.Platform.Regs import GHC.Platform -import GHC.Types.Unique import GHC.Types.Unique.FM import qualified Data.IntSet as IntSet import Data.List (partition) -import qualified Data.Set as Set import Data.Maybe --- Compact sets for membership tests of local variables. - -type LRegSet = IntSet.IntSet - -emptyLRegSet :: LRegSet -emptyLRegSet = IntSet.empty - -nullLRegSet :: LRegSet -> Bool -nullLRegSet = IntSet.null - -insertLRegSet :: LocalReg -> LRegSet -> LRegSet -insertLRegSet l = IntSet.insert (getKey (getUnique l)) - -elemLRegSet :: LocalReg -> LRegSet -> Bool -elemLRegSet l = IntSet.member (getKey (getUnique l)) +import GHC.Exts (inline) -- ----------------------------------------------------------------------------- -- Sinking and inlining @@ -167,8 +154,8 @@ type Assignments = [Assignment] cmmSink :: Platform -> CmmGraph -> CmmGraph cmmSink platform graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks where - liveness = cmmLocalLiveness platform graph - getLive l = mapFindWithDefault Set.empty l liveness + liveness = cmmLocalLivenessL platform graph + getLive l = mapFindWithDefault emptyLRegSet l liveness blocks = revPostorder graph @@ -188,8 +175,8 @@ cmmSink platform graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks -- Annotate the middle nodes with the registers live *after* -- the node. This will help us decide whether we can inline -- an assignment in the current node or not. - live = Set.unions (map getLive succs) - live_middle = gen_kill platform last live + live = IntSet.unions (map getLive succs) + live_middle = gen_killL platform last live ann_middles = annotate platform live_middle (blockToList middle) -- Now sink and inline in this block @@ -201,7 +188,7 @@ cmmSink platform graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks -- one predecessor), so identify the join points and the set -- of registers live in them. (joins, nonjoins) = partition (`mapMember` join_pts) succs - live_in_joins = Set.unions (map getLive joins) + live_in_joins = IntSet.unions (map getLive joins) -- We do not want to sink an assignment into multiple branches, -- so identify the set of registers live in multiple successors. @@ -210,26 +197,28 @@ cmmSink platform graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks -- now live in multiple branches. init_live_sets = map getLive nonjoins live_in_multi live_sets r = - case filter (Set.member r) live_sets of + case filter (elemLRegSet r) live_sets of (_one:_two:_) -> True _ -> False -- Now, drop any assignments that we will not sink any further. (dropped_last, assigs'') = dropAssignments platform drop_if init_live_sets assigs' + drop_if :: (LocalReg, CmmExpr, AbsMem) + -> [LRegSet] -> (Bool, [LRegSet]) drop_if a@(r,rhs,_) live_sets = (should_drop, live_sets') where should_drop = conflicts platform a final_last || not (isTrivial platform rhs) && live_in_multi live_sets r - || r `Set.member` live_in_joins + || r `elemLRegSet` live_in_joins live_sets' | should_drop = live_sets | otherwise = map upd live_sets - upd set | r `Set.member` set = set `Set.union` live_rhs + upd set | r `elemLRegSet` set = set `IntSet.union` live_rhs | otherwise = set - live_rhs = foldRegsUsed platform extendRegSet emptyRegSet rhs + live_rhs = foldRegsUsed platform (flip insertLRegSet) emptyLRegSet rhs final_middle = foldl' blockSnoc middle' dropped_last @@ -266,9 +255,9 @@ isTrivial _ _ = False -- -- annotate each node with the set of registers live *after* the node -- -annotate :: Platform -> LocalRegSet -> [CmmNode O O] -> [(LocalRegSet, CmmNode O O)] +annotate :: Platform -> LRegSet -> [CmmNode O O] -> [(LRegSet, CmmNode O O)] annotate platform live nodes = snd $ foldr ann (live,[]) nodes - where ann n (live,nodes) = (gen_kill platform n live, (live,n) : nodes) + where ann n (live,nodes) = (gen_killL platform n live, (live,n) : nodes) -- -- Find the blocks that have multiple successors (join points) @@ -285,13 +274,13 @@ findJoinPoints blocks = mapFilter (>1) succ_counts -- filter the list of assignments to remove any assignments that -- are not live in a continuation. -- -filterAssignments :: Platform -> LocalRegSet -> Assignments -> Assignments +filterAssignments :: Platform -> LRegSet -> Assignments -> Assignments filterAssignments platform live assigs = reverse (go assigs []) where go [] kept = kept go (a@(r,_,_):as) kept | needed = go as (a:kept) | otherwise = go as kept where - needed = r `Set.member` live + needed = r `elemLRegSet` live || any (conflicts platform a) (map toNode kept) -- Note that we must keep assignments that are -- referred to by other assignments we have @@ -312,7 +301,7 @@ filterAssignments platform live assigs = reverse (go assigs []) -- walk :: Platform - -> [(LocalRegSet, CmmNode O O)] -- nodes of the block, annotated with + -> [(LRegSet, CmmNode O O)] -- nodes of the block, annotated with -- the set of registers live *after* -- this node. @@ -366,11 +355,11 @@ shouldSink _ _other = Nothing -- out of inlining, but the inliner will see that r is live -- after the instruction and choose not to inline r in the rhs. -- -shouldDiscard :: CmmNode e x -> LocalRegSet -> Bool +shouldDiscard :: CmmNode e x -> LRegSet -> Bool shouldDiscard node live = case node of CmmAssign r (CmmReg r') | r == r' -> True - CmmAssign (CmmLocal r) _ -> not (r `Set.member` live) + CmmAssign (CmmLocal r) _ -> not (r `elemLRegSet` live) _otherwise -> False @@ -403,8 +392,9 @@ dropAssignments platform should_drop state assigs -- inlining opens up opportunities for doing so. tryToInline - :: Platform - -> LocalRegSet -- set of registers live after this + :: forall x. Platform + -> LRegSet -- set of registers live after this + -- -> LocalRegSet -- set of registers live after this -- node. We cannot inline anything -- that is live after the node, unless -- it is small enough to duplicate. @@ -415,35 +405,42 @@ tryToInline , Assignments -- Remaining assignments ) -tryToInline platform live node assigs = go usages node emptyLRegSet assigs +tryToInline platform liveAfter node assigs = + -- pprTrace "tryToInline assig length:" (ppr $ length assigs) $ + go usages liveAfter node emptyLRegSet assigs where usages :: UniqFM LocalReg Int -- Maps each LocalReg to a count of how often it is used usages = foldLocalRegsUsed platform addUsage emptyUFM node - go _usages node _skipped [] = (node, []) + go :: UniqFM LocalReg Int -> LRegSet -> CmmNode O x -> LRegSet -> Assignments + -> (CmmNode O x, Assignments) + go _usages _live node _skipped [] = (node, []) - go usages node skipped (a@(l,rhs,_) : rest) - | cannot_inline = dont_inline - | occurs_none = discard -- Note [discard during inlining] - | occurs_once = inline_and_discard - | isTrivial platform rhs = inline_and_keep - | otherwise = dont_inline + go usages live node skipped (a@(l,rhs,_) : rest) + | cannot_inline = dont_inline + | occurs_none = discard -- Note [discard during inlining] + | occurs_once = inline_and_discard + | isTrivial platform rhs = inline_and_keep + | otherwise = dont_inline where - inline_and_discard = go usages' inl_node skipped rest + inline_and_discard = go usages' live inl_node skipped rest where usages' = foldLocalRegsUsed platform addUsage usages rhs - discard = go usages node skipped rest + discard = go usages live node skipped rest dont_inline = keep node -- don't inline the assignment, keep it inline_and_keep = keep inl_node -- inline the assignment, keep it + keep :: CmmNode O x -> (CmmNode O x, Assignments) keep node' = (final_node, a : rest') - where (final_node, rest') = go usages' node' (insertLRegSet l skipped) rest - usages' = foldLocalRegsUsed platform (\m r -> addToUFM m r 2) - usages rhs - -- we must not inline anything that is mentioned in the RHS - -- of a binding that we have already skipped, so we set the - -- usages of the regs on the RHS to 2. + where (final_node, rest') = go usages live' node' (insertLRegSet l skipped) rest + + -- Avoid discarding of assignments to vars on the rhs. + -- See Note [Keeping assignemnts mentioned in skipped RHSs] + -- usages' = foldLocalRegsUsed platform (\m r -> addToUFM m r 2) + -- usages rhs + live' = inline foldLocalRegsUsed platform (\m r -> insertLRegSet r m) + live rhs cannot_inline = skipped `regsUsedIn` rhs -- Note [dependent assignments] || l `elemLRegSet` skipped @@ -451,7 +448,7 @@ tryToInline platform live node assigs = go usages node emptyLRegSet assigs -- How often is l used in the current node. l_usages = lookupUFM usages l - l_live = l `elemRegSet` live + l_live = l `elemLRegSet` live occurs_once = not l_live && l_usages == Just 1 occurs_none = not l_live && l_usages == Nothing @@ -467,6 +464,27 @@ tryToInline platform live node assigs = go usages node emptyLRegSet assigs inl_exp (CmmMachOp op args) = cmmMachOpFold platform op args inl_exp other = other +{- Note [Keeping assignemnts mentioned in skipped RHSs] + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + If we have to assignments: [z = y, y = e1] and we skip + z we *must* retain the assignment y = e1. This is because + we might inline "z = y" into another node later on so we + must ensure y is still defined at this point. + + If we dropped the assignment of "y = e1" then we would end up + referencing a variable which hasn't been mentioned after + inlining. + + We use a hack to do this. + + We pretend the regs from the rhs are live after the current + node. Since we only discard assignments to variables + which are dead after the current block this prevents discarding of the + assignment. It still allows inlining should e1 be a trivial rhs + however. + +-} {- Note [improveConditional] @@ -610,18 +628,34 @@ conflicts platform (r, rhs, addr) node -- (7) otherwise, no conflict | otherwise = False +{- Note [Inlining foldRegsDefd] + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + foldRegsDefd is, after optimization, *not* a small function so + it's only marked INLINEABLE, but not INLINE. + + However in some specific cases we call it *very* often making it + important to avoid the overhead of allocating the folding function. + + So we simply force inlining via the magic inline function. + For T3294 this improves allocation with -O by ~1%. + +-} + -- Returns True if node defines any global registers that are used in the -- Cmm expression globalRegistersConflict :: Platform -> CmmExpr -> CmmNode e x -> Bool globalRegistersConflict platform expr node = - foldRegsDefd platform (\b r -> b || regUsedIn platform (CmmGlobal r) expr) + -- See Note [Inlining foldRegsDefd] + inline foldRegsDefd platform (\b r -> b || regUsedIn platform (CmmGlobal r) expr) False node -- Returns True if node defines any local registers that are used in the -- Cmm expression localRegistersConflict :: Platform -> CmmExpr -> CmmNode e x -> Bool localRegistersConflict platform expr node = - foldRegsDefd platform (\b r -> b || regUsedIn platform (CmmLocal r) expr) + -- See Note [Inlining foldRegsDefd] + inline foldRegsDefd platform (\b r -> b || regUsedIn platform (CmmLocal r) expr) False node -- Note [Sinking and calls] ===================================== compiler/GHC/Cmm/Utils.hs ===================================== @@ -264,9 +264,11 @@ cmmOffset platform e byte_off = case e of CmmStackSlot area off -> CmmStackSlot area (off - byte_off) -- note stack area offsets increase towards lower addresses CmmMachOp (MO_Add rep) [expr, CmmLit (CmmInt byte_off1 _rep)] - -> CmmMachOp (MO_Add rep) [expr, CmmLit (CmmInt (byte_off1 + toInteger byte_off) rep)] - _ -> CmmMachOp (MO_Add width) [e, CmmLit (CmmInt (toInteger byte_off) width)] - where width = cmmExprWidth platform e + -> let !lit_off = (byte_off1 + toInteger byte_off) + in CmmMachOp (MO_Add rep) [expr, CmmLit (CmmInt lit_off rep)] + _ -> let !width = cmmExprWidth platform e + in + CmmMachOp (MO_Add width) [e, CmmLit (CmmInt (toInteger byte_off) width)] -- Smart constructor for CmmRegOff. Same caveats as cmmOffset above. cmmRegOff :: CmmReg -> Int -> CmmExpr ===================================== compiler/GHC/Utils/Outputable.hs ===================================== @@ -115,6 +115,7 @@ import Data.Int import qualified Data.IntMap as IM import Data.Set (Set) import qualified Data.Set as Set +import qualified Data.IntSet as IntSet import Data.String import Data.Word import System.IO ( Handle ) @@ -863,6 +864,9 @@ instance (Outputable a) => Outputable (NonEmpty a) where instance (Outputable a) => Outputable (Set a) where ppr s = braces (fsep (punctuate comma (map ppr (Set.toList s)))) +instance Outputable IntSet.IntSet where + ppr s = braces (fsep (punctuate comma (map ppr (IntSet.toList s)))) + instance (Outputable a, Outputable b) => Outputable (a, b) where ppr (x,y) = parens (sep [ppr x <> comma, ppr y]) ===================================== compiler/ghc.cabal.in ===================================== @@ -205,6 +205,7 @@ Library GHC.Cmm.Switch GHC.Cmm.Switch.Implement GHC.CmmToAsm + GHC.Cmm.LRegSet GHC.CmmToAsm.BlockLayout GHC.CmmToAsm.CFG GHC.CmmToAsm.CFG.Dominators ===================================== docs/users_guide/9.2.1-notes.rst ===================================== @@ -53,6 +53,14 @@ Compiler will have to be updated, as GHC no longer uses flattening skolems or flattening metavariables. +GHCi +~~~~ + +- GHCi's :ghci-cmd:`:edit` command now looks for an editor in + the :envvar:`VISUAL` environment variable before + :envvar:`EDITOR`, following UNIX convention. + (:ghc-ticket:`19030`) + ``ghc-prim`` library ~~~~~~~~~~~~~~~~~~~~ ===================================== docs/users_guide/eventlog-formats.rst ===================================== @@ -207,9 +207,61 @@ Thread and scheduling events :base-ref:`Control.Concurrent.setThreadLabel`). +.. _gc-events: + Garbage collector events ~~~~~~~~~~~~~~~~~~~~~~~~ +The following events mark various points of the lifecycle of a moving garbage +collection. + +A typical garbage collection will look something like the following: + +1. A capability realizes that it needs a garbage collection (e.g. as a result + of running out of nursery) and requests a garbage collection. This is + marked by :event-type:`REQUEST_SEQ_GC` or :event-type:`REQUEST_PAR_GC`. + +2. As other capabilities reach yield points and suspend execution they emit + :event-type:`STOP_THREAD` events. + +3. When all capabilities have suspended execution, collection will begin, + marked by a :event-type:`GC_START` event. + +4. As individual parallel GC threads commence with scavenging they will emit + :event-type:`GC_WORK` events. + +5. If a parallel GC thread runs out of work it will emit a + :event-type:`GC_IDLE` event. If it is later handed more work it will emit + another :event-type:`GC_WORK` event. + +6. Eventually when scavenging has finished a :event-type:`GC_DONE` event + will be emitted by each GC thread. + +7. A bit of book-keeping is performed. + +8. A :event-type:`GC_END` event will be emitted marking the end of the GC cycle. + +9. A :event-type:`HEAP_SIZE` event will be emitted giving the + cumulative heap allocations of the program until now. + +10. A :event-type:`GC_STATS_GHC` event will be emitted + containing various details of the collection and heap state. + +11. In the case of a major collection, a + :event-type:`HEAP_LIVE` event will be emitted describing + the current size of the live on-heap data. + +12. In the case of the :ghc-flag:`-threaded` RTS, a + :event-type:`SPARK_COUNTERS` event will be emitted giving + details on how many sparks have been created, evaluated, and GC'd. + +13. As mutator threads resume execution they will emit :event-type:`RUN_THREAD` + events. + +Note that in the case of the concurrent non-moving collector additional events +will be emitted during the concurrent phase of collection. These are described +in :ref:`nonmoving-gc-events`. + .. event-type:: GC_START :tag: 9 @@ -685,6 +737,46 @@ These events mark various stages of the :rts-flag:`non-moving collection <--nonmoving-gc>` lifecycle. These are enabled with the ``+RTS -lg`` event-set. +A typical non-moving collection cycle will look something like the following: + +1. The preparatory phase of collection will emit the usual events associated + with a moving collection. See :ref:`gc-events` for details. + +2. The concurrent write barrier is enabled and the concurrent mark thread is + started. From this point forward mutator threads may emit + :event-type:`CONC_UPD_REM_SET_FLUSH` events, indicating that they have + flushed their capability-local update remembered sets. + +3. Concurrent marking begins, denoted by a :event-type:`CONC_MARK_BEGIN` event. + +4. When the mark queue is depleted a :event-type:`CONC_MARK_END` is emitted. + +5. If necessary (e.g. due to weak pointer marking), the marking process will + continue, returning to step (3) above. + +6. When the collector has done as much concurrent marking as it can it will + enter the post-mark synchronization phase of collection, denoted by a + :event-type:`CONC_SYNC_BEGIN` event. + +7. Mutator threads will suspend execution and, if necessary, flush their update + remembered sets (indicated by :event-type:`CONC_UPD_REM_SET_FLUSH` events). + +8. The collector will do any final marking necessary (indicated by + :event-type:`CONC_MARK_BEGIN` and :event-type:`CONC_MARK_END` events). + +9. The collector will do a small amount of sweeping, disable the write barrier, + emit a :event-type:`CONC_SYNC_END` event, and allow mutators to resume + +10. The collector will begin the concurrent sweep phase, indicated by a + :event-type:`CONC_SWEEP_BEGIN` event. + +11. Once sweeping has concluded a :event-type:`CONC_SWEEP_END` event will be + emitted and the concurrent collector thread will terminate. + +12. A :event-type:`NONMOVING_HEAP_CENSUS` event will be emitted describing the + fragmentation state of the non-moving heap. + + .. event-type:: CONC_MARK_BEGIN :tag: 200 @@ -742,8 +834,9 @@ with the ``+RTS -lg`` event-set. Non-moving heap census ~~~~~~~~~~~~~~~~~~~~~~ -The non-moving heap census events (enabled with the ``+RTS -ln`` event-set) are -intended to provide insight into fragmentation of the non-moving heap. +The non-moving heap census events (enabled with the :rts-flag:`+RTS -ln <-l ⟨flags⟩>` +event-set) are intended to provide insight into fragmentation of the non-moving +heap. .. event-type:: NONMOVING_HEAP_CENSUS @@ -760,8 +853,8 @@ Ticky counters ~~~~~~~~~~~~~~ Programs compiled with :ghc-flag:`-ticky` and :ghc-flag:`-eventlog` and invoked -with ``+RTS -lT`` will emit periodic samples of the ticky entry counters to the -eventlog. +with :rts-flag:`+RTS -lT <-l ⟨flags⟩>` will emit periodic samples of the ticky +entry counters to the eventlog. .. event-type:: TICKY_COUNTER_DEF ===================================== docs/users_guide/ghci.rst ===================================== @@ -2443,9 +2443,10 @@ commonly used commands. Opens an editor to edit the file ⟨file⟩, or the most recently loaded module if ⟨file⟩ is omitted. If there were errors during the last loading, the cursor will be positioned at the line of the first - error. The editor to invoke is taken from the :envvar:`EDITOR` environment - variable, or a default editor on your system if :envvar:`EDITOR` is not - set. You can change the editor using :ghci-cmd:`:set editor`. + error. The editor to invoke is taken from the :envvar:`VISUAL` or + :envvar:`EDITOR` environment variables, or a default editor on your system + if neither is not set. You can change the editor using :ghci-cmd:`:set + editor`. .. ghci-cmd:: :enable; * | ⟨num⟩ ... ===================================== docs/users_guide/runtime_control.rst ===================================== @@ -1194,6 +1194,9 @@ When the program is linked with the :ghc-flag:`-eventlog` option - ``f`` — parallel sparks (fully accurate). Disabled by default. + - ``T`` — :ghc-flag:`ticky-ticky profiler <-ticky>` events. Disabled by + default. + - ``u`` — user events. These are events emitted from Haskell code using functions such as ``Debug.Trace.traceEvent``. Enabled by default. ===================================== docs/users_guide/using-optimisation.rst ===================================== @@ -720,7 +720,7 @@ by saying ``-fno-wombat``. :reverse: -fno-omit-yields :category: - :default: yield points enabled + :default: on (yields are *not* inserted) Tells GHC to omit heap checks when no allocation is being performed. While this improves binary sizes by about 5%, it @@ -1197,16 +1197,16 @@ by saying ``-fno-wombat``. This is the full syntax for cardinalities, demands and sub-demands in BNF: - .. code-block:: + .. code-block:: none - card ::= B | A | 1 | U | S | M semantics as in the table above + card ::= B | A | 1 | U | S | M semantics as in the table above - d ::= card sd card = how often, sd = how deep - | card abbreviation: Same as "card card" + d ::= card sd card = how often, sd = how deep + | card abbreviation: Same as "card card" - sd ::= card polymorphic sub-demand, card at every level - | P(d,d,..) product sub-demand - | Ccard(sd) call sub-demand + sd ::= card polymorphic sub-demand, card at every level + | P(d,d,..) product sub-demand + | Ccard(sd) call sub-demand For example, ``fst`` is strict in its argument, and also in the first component of the argument. It will not evaluate the argument's second @@ -1234,17 +1234,17 @@ by saying ``-fno-wombat``. We summarise a function's demand properties in its *demand signature*. This is the general syntax: - .. code-block:: + .. code-block:: none - {x->dx,y->dy,z->dz...}...div - ^ ^ ^ ^ ^ ^ - | | | | | | - | \---+---+------/ | - | | | - demand on free demand on divergence - variables arguments information - (omitted if empty) (omitted if - no information) + {x->dx,y->dy,z->dz...}...div + ^ ^ ^ ^ ^ ^ + | | | | | | + | \---+---+------/ | + | | | + demand on free demand on divergence + variables arguments information + (omitted if empty) (omitted if + no information) We summarise ``fst``'s demand properties in its *demand signature* ````, which just says "If ``fst`` is applied to one argument, @@ -1260,13 +1260,11 @@ by saying ``-fno-wombat``. **Call sub-demands** - Consider ``maybe``: + Consider ``maybe``: :: - .. code-block:: - - maybe :: b -> (a -> b) -> Maybe a -> b - maybe n _ Nothing = n - maybe _ s (Just a) = s a + maybe :: b -> (a -> b) -> Maybe a -> b + maybe n _ Nothing = n + maybe _ s (Just a) = s a We give it demand signature ``<1C1(U)>``. The ``C1(U)`` is a *call sub-demand* that says "Called at most once, where the result is used ===================================== ghc/GHCi/UI.hs ===================================== @@ -421,13 +421,14 @@ defFullHelpText = findEditor :: IO String findEditor = do - getEnv "EDITOR" - `catchIO` \_ -> do + getEnv "VISUAL" <|> getEnv "EDITOR" <|> defaultEditor + where + defaultEditor = do #if defined(mingw32_HOST_OS) - win <- System.Win32.getWindowsDirectory - return (win "notepad.exe") + win <- System.Win32.getWindowsDirectory + return (win "notepad.exe") #else - return "" + return "" #endif default_progname, default_stop :: String ===================================== libraries/time ===================================== @@ -1 +1 @@ -Subproject commit c25d6a76702b454426e149fb590da5cb69f3bd0a +Subproject commit df292e1a74c6a87c2c1c889679074dd46ad39461 ===================================== rts/Stats.c ===================================== @@ -570,7 +570,7 @@ stat_endGC (Capability *cap, gc_thread *initiating_gct, W_ live, W_ copied, W_ s // Emit events to the event log // Has to be emitted while all caps stopped for GC, but before GC_END. - // See trac.haskell.org/ThreadScope/wiki/RTSsummaryEvents + // See https://gitlab.haskell.org/ghc/ghc/-/wikis/RTSsummaryEvents // for a detailed design rationale of the current setup // of GC eventlog events. traceEventGcGlobalSync(cap); ===================================== rts/linker/Elf.c ===================================== @@ -32,6 +32,9 @@ #include #include #include +#if defined(HAVE_DLFCN_H) +#include +#endif #if defined(HAVE_SYS_STAT_H) #include #endif View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ecb8b36971a883594f4d2651b57bff1fffbf04ea...e02c53087c5c3a1de38aeeb79b5dc16fd1185a65 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ecb8b36971a883594f4d2651b57bff1fffbf04ea...e02c53087c5c3a1de38aeeb79b5dc16fd1185a65 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Dec 14 15:41:26 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 14 Dec 2020 10:41:26 -0500 Subject: [Git][ghc/ghc][wip/tyconapp-opts] 16 commits: Fix kind inference for data types. Again. Message-ID: <5fd787a648304_6b215ab2cc8148129@gitlab.mail> Ben Gamari pushed to branch wip/tyconapp-opts at Glasgow Haskell Compiler / GHC Commits: 62ed6957 by Simon Peyton Jones at 2020-12-08T15:31:41-05:00 Fix kind inference for data types. Again. This patch fixes several aspects of kind inference for data type declarations, especially data /instance/ declarations Specifically 1. In kcConDecls/kcConDecl make it clear that the tc_res_kind argument is only used in the H98 case; and in that case there is no result kind signature; and hence no need for the disgusting splitPiTys in kcConDecls (now thankfully gone). The GADT case is a bit different to before, and much nicer. This is what fixes #18891. See Note [kcConDecls: kind-checking data type decls] 2. Do not look at the constructor decls of a data/newtype instance in tcDataFamInstanceHeader. See GHC.Tc.TyCl.Instance Note [Kind inference for data family instances]. This was a new realisation that arose when doing (1) This causes a few knock-on effects in the tests suite, because we require more information than before in the instance /header/. New user-manual material about this in "Kind inference in data type declarations" and "Kind inference for data/newtype instance declarations". 3. Minor improvement in kcTyClDecl, combining GADT and H98 cases 4. Fix #14111 and #8707 by allowing the header of a data instance to affect kind inferece for the the data constructor signatures; as described at length in Note [GADT return types] in GHC.Tc.TyCl This led to a modest refactoring of the arguments (and argument order) of tcConDecl/tcConDecls. 5. Fix #19000 by inverting the sense of the test in new_locs in GHC.Tc.Solver.Canonical.canDecomposableTyConAppOK. - - - - - 0abe3ddf by Adam Sandberg Ericsson at 2020-12-08T15:32:19-05:00 hadrian: build the _l and _thr_l rts flavours in the develN flavours The ghc binary requires the eventlog rts since fc644b1a643128041cfec25db84e417851e28bab - - - - - 51e3bb6d by Andreas Klebinger at 2020-12-08T22:43:21-05:00 CodeGen: Make folds User/DefinerOfRegs INLINEABLE. Reduces allocation for the test case I was looking at by about 1.2%. Mostly from avoiding allocation of some folding functions which turn into let-no-escape bindings which just reuse their environment instead. We also force inlining in a few key places in CmmSink which helps a bit more. - - - - - 69ae10c3 by Andreas Klebinger at 2020-12-08T22:43:21-05:00 CmmSink: Force inlining of foldRegsDefd Helps avoid allocating the folding function. Improves perf for T3294 by about 1%. - - - - - 6e3da800 by Andreas Klebinger at 2020-12-08T22:43:21-05:00 Cmm: Make a few types and utility function slightly stricter. About 0.6% reduction in allocations for the code I was looking at. Not a huge difference but no need to throw away performance. - - - - - aef44d7f by Andreas Klebinger at 2020-12-08T22:43:21-05:00 Cmm.Sink: Optimize retaining of assignments, live sets. Sinking requires us to track live local regs after each cmm statement. We used to do this via "Set LocalReg". However we can replace this with a solution based on IntSet which is overall more efficient without losing much. The thing we lose is width of the variables, which isn't used by the sinking pass anyway. I also reworked how we keep assignments to regs mentioned in skipped assignments. I put the details into Note [Keeping assignemnts mentioned in skipped RHSs]. The gist of it is instead of keeping track of it via the use count which is a `IntMap Int` we now use the live regs set (IntSet) which is quite a bit faster. I think it also matches the semantics a lot better. The skipped (not discarded) assignment does in fact keep the regs on it's rhs alive so keeping track of this in the live set seems like the clearer solution as well. Improves allocations for T3294 by yet another 1%. - - - - - 59f2249b by Andreas Klebinger at 2020-12-08T22:43:21-05:00 GHC.Cmm.Opt: Be stricter in results. Optimization either returns Nothing if nothing is to be done or `Just <cmmExpr>` otherwise. There is no point in being lazy in `cmmExpr`. We usually inspect this element so the thunk gets forced not long after. We might eliminate it as dead code once in a blue moon but that's not a case worth optimizing for. Overall the impact of this is rather low. As Cmm.Opt doesn't allocate much (compared to the rest of GHC) to begin with. - - - - - 54b88eac by Andreas Klebinger at 2020-12-08T22:43:57-05:00 Bump time submodule. This should fix #19002. - - - - - 35e7b0c6 by Kirill Elagin at 2020-12-10T01:45:54-05:00 doc: Clarify the default for -fomit-yields “Yield points enabled” is confusing (and probably wrong? I am not 100% sure what it means). Change it to a simple “on”. Undo this change from 2c23fff2e03e77187dc4d01f325f5f43a0e7cad2. - - - - - 3551c554 by Kirill Elagin at 2020-12-10T01:45:54-05:00 doc: Extra-clarify -fomit-yields Be more clear on what this optimisation being on by default means in terms of yields. - - - - - 6484f0d7 by Sergei Trofimovich at 2020-12-10T01:46:33-05:00 rts/linker/Elf.c: add missing <dlfcn.h> include (musl support) The change fixes build failure on musl: ``` rts/linker/Elf.c:2031:3: error: warning: implicit declaration of function 'dlclose'; did you mean 'close'? [-Wimplicit-function-declaration] 2031 | dlclose(nc->dlopen_handle); | ^~~~~~~ | close ``` Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - ab24ed9b by Ben Gamari at 2020-12-11T03:55:51-05:00 users guide: Fix syntax errors Fixes errors introduced by 3a55b3a2574f913d046f3a6f82db48d7f6df32e3. - - - - - d3a24d31 by Ben Gamari at 2020-12-11T03:55:51-05:00 users guide: Describe GC lifecycle events Every time I am asked about how to interpret these events I need to figure it out from scratch. It's well past time that the users guide properly documents these. - - - - - 741309b9 by Ben Gamari at 2020-12-11T03:56:27-05:00 gitlab-ci: Fix incorrect Docker image for nightly cross job Also refactor the job definition to eliminate the bug by construction. - - - - - 19703bc8 by Ben Gamari at 2020-12-11T03:56:27-05:00 gitlab-ci: Fix name of flavour in ThreadSanitizer job It looks like I neglected to update this after introduce flavour transformers. - - - - - 96685344 by Ben Gamari at 2020-12-14T10:41:08-05:00 Optimise nullary type constructor usage During the compilation of programs GHC very frequently deals with the `Type` type, which is a synonym of `TYPE 'LiftedRep`. This patch teaches GHC to avoid expanding the `Type` synonym (and other nullary type synonyms) during type comparisons, saving a good amount of work. This optimisation is described in `Note [Comparing nullary type synonyms]`. To maximize the impact of this optimisation, we introduce a few special-cases to reduce `TYPE 'LiftedRep` to `Type`. See `Note [Prefer Type over TYPE 'LiftedPtrRep]`. Closes #17958. Metric Decrease: T18698b T1969 T12227 T12545 T12707 T14683 T3064 T5631 T5642 T9020 T9630 T9872a T13035 haddock.Cabal haddock.base - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - + compiler/GHC/Builtin/Types/Prim.hs-boot - compiler/GHC/Cmm/Expr.hs - + compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Liveness.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Hs/Extension.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Utils/Outputable.hs - compiler/ghc.cabal.in - docs/users_guide/9.2.1-notes.rst - docs/users_guide/eventlog-formats.rst - docs/users_guide/exts/poly_kinds.rst - docs/users_guide/runtime_control.rst - docs/users_guide/using-optimisation.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2eb43a4686bd27237749b711da4b7301a857388b...96685344071e36a9aca04ba9e984da3e9774c1fd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2eb43a4686bd27237749b711da4b7301a857388b...96685344071e36a9aca04ba9e984da3e9774c1fd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Dec 14 16:03:07 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Mon, 14 Dec 2020 11:03:07 -0500 Subject: [Git][ghc/ghc][wip/T17656] Kill floatEqualities completely Message-ID: <5fd78cbb365be_6b213272ce01486728@gitlab.mail> Simon Peyton Jones pushed to branch wip/T17656 at Glasgow Haskell Compiler / GHC Commits: 73748d4d by Simon Peyton Jones at 2020-12-14T16:01:30+00:00 Kill floatEqualities completely This patch delivers on #17656, by entirel killing off the complex floatEqualities mechanism. Previously, floatEqualities would float an equality out of an implication, so that it could be solved at an outer level. But now we simply do unification in-place, without floating the constraint, relying on level numbers to determine untouchability. There are a number of important new Notes: * GHC.Tc.Utils.Unify Note [Unification preconditions] describes the preconditions for unification, including both skolem-escape and touchability. * GHC.Tc.Solver.Interact Note [Solve by unification] describes what we do when we do unify * GHC.Tc.Solver.Monad Note [The Unification Level Flag] describes how we control solver iteration under this new scheme * GHC.Tc.Solver.Monad Note [Tracking Given equalities] describes how we track when we have Given equalities * GHC.Tc.Types.Constraint Note [HasGivenEqs] is a new explanation of the ic_given_eqs field of an implication A big raft of subtle Notes in Solver, concerning floatEqualities, disappears. Main code changes: * GHC.Tc.Solver.floatEqualities disappears entirely * GHC.Tc.Solver.Monad: new fields in InertCans, inert_given_eq_lvl and inert_given_eq, updated by updateGivenEqs See Note [Tracking Given equalities]. * In exchange for updateGivenEqa, GHC.Tc.Solver.Monad.getHasGivenEqs is much simpler and more efficient * I found I could kill of metaTyVarUpdateOK entirely One test case T14683 showed a 4.5% decrease in compile-time allocation. Other changes were small Metric Decrease: T14683 - - - - - 18 changed files: - compiler/GHC/Runtime/Heap/Inspect.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Interact.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Utils/Unify.hs - testsuite/tests/ghci.debugger/scripts/break012.stdout - testsuite/tests/partial-sigs/should_compile/T10403.stderr - testsuite/tests/partial-sigs/should_compile/T14715.stderr - testsuite/tests/partial-sigs/should_fail/ScopedNamedWildcardsBad.stderr - testsuite/tests/typecheck/should_fail/ExpandSynsFail2.stderr - testsuite/tests/typecheck/should_fail/T7453.stderr Changes: ===================================== compiler/GHC/Runtime/Heap/Inspect.hs ===================================== @@ -577,7 +577,7 @@ newOpenVar = liftTcM (do { kind <- newOpenTypeKind ~~~~~~~~~~~~~~~~~~~~~~ In the GHCi debugger we use unification variables whose MetaInfo is RuntimeUnkTv. The special property of a RuntimeUnkTv is that it can -unify with a polytype (see GHC.Tc.Utils.Unify.metaTyVarUpdateOK). +unify with a polytype (see GHC.Tc.Utils.Unify.checkTypeEq). If we don't do this `:print ` will fail if the type of has nested `forall`s or `=>`s. ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -907,7 +907,7 @@ That is the entire point of qlUnify! Wrinkles: * We must not make an occurs-check; we use occCheckExpand for that. -* metaTyVarUpdateOK also checks for various other things, including +* checkTypeEq also checks for various other things, including - foralls, and predicate types (which we want to allow here) - type families (relates to a very specific and exotic performance question, that is unlikely to bite here) ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -311,7 +311,7 @@ Note [Promotion in signatures] If an unsolved metavariable in a signature is not generalized (because we're not generalizing the construct -- e.g., pattern sig -- or because the metavars are constrained -- see kindGeneralizeSome) -we need to promote to maintain (WantedTvInv) of Note [TcLevel and untouchable type variables] +we need to promote to maintain (WantedTvInv) of Note [TcLevel invariants] in GHC.Tc.Utils.TcType. Note that promotion is identical in effect to generalizing and the reinstantiating with a fresh metavariable at the current level. So in some sense, we generalize *all* variables, but then re-instantiate @@ -329,7 +329,7 @@ the pattern signature (which is not kind-generalized). When we are checking the *body* of foo, though, we need to unify the type of x with the argument type of bar. At this point, the ambient TcLevel is 1, and spotting a matavariable with level 2 would violate the (WantedTvInv) invariant of -Note [TcLevel and untouchable type variables]. So, instead of kind-generalizing, +Note [TcLevel invariants]. So, instead of kind-generalizing, we promote the metavariable to level 1. This is all done in kindGeneralizeNone. -} ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -264,7 +264,7 @@ floatKindEqualities wc = float_wc emptyVarSet wc = Nothing -- A short cut /plus/ we must keep track of IC_BadTelescope | otherwise = do { (simples, holes) <- float_wc new_trapping_tvs wanted - ; when (not (isEmptyBag simples) && given_eqs /= NoGivenEqs) $ + ; when (not (isEmptyBag simples) && given_eqs == MaybeGivenEqs) $ Nothing -- If there are some constraints to float out, but we can't -- because we don't float out past local equalities @@ -1282,7 +1282,8 @@ decideMonoTyVars infer_mode name_taus psigs candidates mr_msg ; traceTc "decideMonoTyVars" $ vcat - [ text "mono_tvs0 =" <+> ppr mono_tvs0 + [ text "infer_mode =" <+> ppr infer_mode + , text "mono_tvs0 =" <+> ppr mono_tvs0 , text "no_quant =" <+> ppr no_quant , text "maybe_quant =" <+> ppr maybe_quant , text "eq_constraints =" <+> ppr eq_constraints @@ -1405,7 +1406,10 @@ decideQuantifiedTyVars name_taus psigs candidates dvs_plus = dv { dv_kvs = pick cand_kvs, dv_tvs = pick cand_tvs } ; traceTc "decideQuantifiedTyVars" (vcat - [ text "candidates =" <+> ppr candidates + [ text "tau_tys =" <+> ppr tau_tys + , text "candidates =" <+> ppr candidates + , text "cand_kvs =" <+> ppr cand_kvs + , text "cand_tvs =" <+> ppr cand_tvs , text "tau_tys =" <+> ppr tau_tys , text "seed_tys =" <+> ppr seed_tys , text "seed_tcvs =" <+> ppr (tyCoVarsOfTypes seed_tys) @@ -1660,22 +1664,14 @@ solveWantedsAndDrop wanted solveWanteds :: WantedConstraints -> TcS WantedConstraints -- so that the inert set doesn't mindlessly propagate. -- NB: wc_simples may be wanted /or/ derived now -solveWanteds wc@(WC { wc_simple = simples, wc_impl = implics, wc_holes = holes }) +solveWanteds wc@(WC { wc_holes = holes }) = do { cur_lvl <- TcS.getTcLevel ; traceTcS "solveWanteds {" $ vcat [ text "Level =" <+> ppr cur_lvl , ppr wc ] - ; wc1 <- solveSimpleWanteds simples - -- Any insoluble constraints are in 'simples' and so get rewritten - -- See Note [Rewrite insolubles] in GHC.Tc.Solver.Monad - - ; (floated_eqs, implics2) <- solveNestedImplications $ - implics `unionBags` wc_impl wc1 - - ; dflags <- getDynFlags - ; solved_wc <- simpl_loop 0 (solverIterations dflags) floated_eqs - (wc1 { wc_impl = implics2 }) + ; dflags <- getDynFlags + ; solved_wc <-simplify_loop 0 (solverIterations dflags) True wc ; holes' <- simplifyHoles holes ; let final_wc = solved_wc { wc_holes = holes' } @@ -1688,9 +1684,41 @@ solveWanteds wc@(WC { wc_simple = simples, wc_impl = implics, wc_holes = holes } ; return final_wc } -simpl_loop :: Int -> IntWithInf -> Cts - -> WantedConstraints -> TcS WantedConstraints -simpl_loop n limit floated_eqs wc@(WC { wc_simple = simples }) +simplify_loop :: Int -> IntWithInf -> Bool + -> WantedConstraints -> TcS WantedConstraints +-- Do a round of solving, and call maybe_simplify_again to iterate +-- The 'definitely_redo_implications' flags is False if the only reason we +-- are iterating is that we have added some new Derived superclasses (from Wanteds) +-- hoping for fundeps to help us. +simplify_loop n limit definitely_redo_implications + wc@(WC { wc_simple = simples, wc_impl = implics }) + = do { csTraceTcS $ + text "simplify_loop iteration=" <> int n + <+> (parens $ hsep [ text "definitely_redo =" <+> ppr definitely_redo_implications <> comma + , int (lengthBag simples) <+> text "simples to solve" ]) + ; traceTcS "simplify_loop: wc =" (ppr wc) + + ; (unifs1, wc1) <- reportUnifications $ -- See Note [Superclass iteration] + solveSimpleWanteds simples + -- Any insoluble constraints are in 'simples' and so get rewritten + -- See Note [Rewrite insolubles] in GHC.Tc.Solver.Monad + + ; wc2 <- if not definitely_redo_implications + && unifs1 == 0 + && isEmptyBag (wc_impl wc1) + then return (wc { wc_simple = wc_simple wc1 }) -- Short cut + else do { implics2 <- solveNestedImplications $ + implics `unionBags` (wc_impl wc1) + ; return (wc { wc_simple = wc_simple wc1 + , wc_impl = implics2 }) } + + ; unif_happened <- resetUnificationFlag + -- Note [The Unification Level Flag] in GHC.Tc.Solver.Monad + ; maybe_simplify_again (n+1) limit unif_happened wc2 } + +maybe_simplify_again :: Int -> IntWithInf -> Bool + -> WantedConstraints -> TcS WantedConstraints +maybe_simplify_again n limit unif_happened wc@(WC { wc_simple = simples }) | n `intGtLimit` limit = do { -- Add an error (not a warning) if we blow the limit, -- Typically if we blow the limit we are going to report some other error @@ -1699,17 +1727,12 @@ simpl_loop n limit floated_eqs wc@(WC { wc_simple = simples }) addErrTcS (hang (text "solveWanteds: too many iterations" <+> parens (text "limit =" <+> ppr limit)) 2 (vcat [ text "Unsolved:" <+> ppr wc - , ppUnless (isEmptyBag floated_eqs) $ - text "Floated equalities:" <+> ppr floated_eqs , text "Set limit with -fconstraint-solver-iterations=n; n=0 for no limit" ])) ; return wc } - | not (isEmptyBag floated_eqs) - = simplify_again n limit True (wc { wc_simple = floated_eqs `unionBags` simples }) - -- Put floated_eqs first so they get solved first - -- NB: the floated_eqs may include /derived/ equalities - -- arising from fundeps inside an implication + | unif_happened + = simplify_loop n limit True wc | superClassesMightHelp wc = -- We still have unsolved goals, and apparently no way to solve them, @@ -1722,82 +1745,65 @@ simpl_loop n limit floated_eqs wc@(WC { wc_simple = simples }) do { new_given <- makeSuperClasses pending_given ; new_wanted <- makeSuperClasses pending_wanted ; solveSimpleGivens new_given -- Add the new Givens to the inert set - ; simplify_again n limit (null pending_given) + ; simplify_loop n limit (not (null pending_given)) $ wc { wc_simple = simples1 `unionBags` listToBag new_wanted } } } + -- (not (null pending_given)): see Note [Superclass iteration] | otherwise = return wc -simplify_again :: Int -> IntWithInf -> Bool - -> WantedConstraints -> TcS WantedConstraints --- We have definitely decided to have another go at solving --- the wanted constraints (we have tried at least once already -simplify_again n limit no_new_given_scs - wc@(WC { wc_simple = simples, wc_impl = implics }) - = do { csTraceTcS $ - text "simpl_loop iteration=" <> int n - <+> (parens $ hsep [ text "no new given superclasses =" <+> ppr no_new_given_scs <> comma - , int (lengthBag simples) <+> text "simples to solve" ]) - ; traceTcS "simpl_loop: wc =" (ppr wc) - - ; (unifs1, wc1) <- reportUnifications $ - solveSimpleWanteds $ - simples - - -- See Note [Cutting off simpl_loop] - -- We have already tried to solve the nested implications once - -- Try again only if we have unified some meta-variables - -- (which is a bit like adding more givens), or we have some - -- new Given superclasses - ; let new_implics = wc_impl wc1 - ; if unifs1 == 0 && - no_new_given_scs && - isEmptyBag new_implics - - then -- Do not even try to solve the implications - simpl_loop (n+1) limit emptyBag (wc1 { wc_impl = implics }) - - else -- Try to solve the implications - do { (floated_eqs2, implics2) <- solveNestedImplications $ - implics `unionBags` new_implics - ; simpl_loop (n+1) limit floated_eqs2 (wc1 { wc_impl = implics2 }) - } } +{- Note [Superclass iteration] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider this implication constraint + forall a. + [W] d: C Int beta + forall b. blah +where + class D a b | a -> b + class D a b => C a b +We will expand d's superclasses, giving [D] D Int beta, in the hope of geting +fundeps to unify beta. Doing so is usually fruitless (no useful fundeps), +and if so it seems a pity to waste time iterating the implications (forall b. blah) +(If we add new Given superclasses it's a different matter: it's really worth looking +at the implications.) + +Hence the definitely_redo_implications flag to simplify_loop. It's usually +True, but False in the case where the only reason to iterate is new Derived +superclasses. In that case we check whether the new Deriveds actually led to +any new unifications, and iterate the implications only if so. +-} solveNestedImplications :: Bag Implication - -> TcS (Cts, Bag Implication) + -> TcS (Bag Implication) -- Precondition: the TcS inerts may contain unsolved simples which have -- to be converted to givens before we go inside a nested implication. solveNestedImplications implics | isEmptyBag implics - = return (emptyBag, emptyBag) + = return (emptyBag) | otherwise = do { traceTcS "solveNestedImplications starting {" empty - ; (floated_eqs_s, unsolved_implics) <- mapAndUnzipBagM solveImplication implics - ; let floated_eqs = concatBag floated_eqs_s + ; unsolved_implics <- mapBagM solveImplication implics -- ... and we are back in the original TcS inerts -- Notice that the original includes the _insoluble_simples so it was safe to ignore -- them in the beginning of this function. ; traceTcS "solveNestedImplications end }" $ - vcat [ text "all floated_eqs =" <+> ppr floated_eqs - , text "unsolved_implics =" <+> ppr unsolved_implics ] + vcat [ text "unsolved_implics =" <+> ppr unsolved_implics ] - ; return (floated_eqs, catBagMaybes unsolved_implics) } + ; return (catBagMaybes unsolved_implics) } solveImplication :: Implication -- Wanted - -> TcS (Cts, -- All wanted or derived floated equalities: var = type - Maybe Implication) -- Simplified implication (empty or singleton) + -> TcS (Maybe Implication) -- Simplified implication (empty or singleton) -- Precondition: The TcS monad contains an empty worklist and given-only inerts -- which after trying to solve this implication we must restore to their original value solveImplication imp@(Implic { ic_tclvl = tclvl , ic_binds = ev_binds_var - , ic_skols = skols , ic_given = given_ids , ic_wanted = wanteds , ic_info = info , ic_status = status }) | isSolvedStatus status - = return (emptyCts, Just imp) -- Do nothing + = return (Just imp) -- Do nothing | otherwise -- Even for IC_Insoluble it is worth doing more work -- The insoluble stuff might be in one sub-implication @@ -1819,7 +1825,7 @@ solveImplication imp@(Implic { ic_tclvl = tclvl ; residual_wanted <- solveWanteds wanteds -- solveWanteds, *not* solveWantedsAndDrop, because -- we want to retain derived equalities so we can float - -- them out in floatEqualities + -- them out in floatEqualities. ; (has_eqs, given_insols) <- getHasGivenEqs tclvl -- Call getHasGivenEqs /after/ solveWanteds, because @@ -1828,10 +1834,6 @@ solveImplication imp@(Implic { ic_tclvl = tclvl ; return (has_eqs, given_insols, residual_wanted) } - ; (floated_eqs, residual_wanted) - <- floatEqualities skols given_ids ev_binds_var - has_given_eqs residual_wanted - ; traceTcS "solveImplication 2" (ppr given_insols $$ ppr residual_wanted) ; let final_wanted = residual_wanted `addInsols` given_insols @@ -1845,15 +1847,14 @@ solveImplication imp@(Implic { ic_tclvl = tclvl ; tcvs <- TcS.getTcEvTyCoVars ev_binds_var ; traceTcS "solveImplication end }" $ vcat [ text "has_given_eqs =" <+> ppr has_given_eqs - , text "floated_eqs =" <+> ppr floated_eqs , text "res_implic =" <+> ppr res_implic , text "implication evbinds =" <+> ppr (evBindMapBinds evbinds) , text "implication tvcs =" <+> ppr tcvs ] - ; return (floated_eqs, res_implic) } + ; return res_implic } -- TcLevels must be strictly increasing (see (ImplicInv) in - -- Note [TcLevel and untouchable type variables] in GHC.Tc.Utils.TcType), + -- Note [TcLevel invariants] in GHC.Tc.Utils.TcType), -- and in fact I think they should always increase one level at a time. -- Though sensible, this check causes lots of testsuite failures. It is @@ -2237,49 +2238,8 @@ Consider (see #9939) We report (Eq a) as redundant, whereas actually (Ord a) is. But it's really not easy to detect that! - -Note [Cutting off simpl_loop] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -It is very important not to iterate in simpl_loop unless there is a chance -of progress. #8474 is a classic example: - - * There's a deeply-nested chain of implication constraints. - ?x:alpha => ?y1:beta1 => ... ?yn:betan => [W] ?x:Int - - * From the innermost one we get a [D] alpha ~ Int, - but alpha is untouchable until we get out to the outermost one - - * We float [D] alpha~Int out (it is in floated_eqs), but since alpha - is untouchable, the solveInteract in simpl_loop makes no progress - - * So there is no point in attempting to re-solve - ?yn:betan => [W] ?x:Int - via solveNestedImplications, because we'll just get the - same [D] again - - * If we *do* re-solve, we'll get an infinite loop. It is cut off by - the fixed bound of 10, but solving the next takes 10*10*...*10 (ie - exponentially many) iterations! - -Conclusion: we should call solveNestedImplications only if we did -some unification in solveSimpleWanteds; because that's the only way -we'll get more Givens (a unification is like adding a Given) to -allow the implication to make progress. -} -promoteTyVarTcS :: TcTyVar -> TcS () --- When we float a constraint out of an implication we must restore --- invariant (WantedInv) in Note [TcLevel and untouchable type variables] in GHC.Tc.Utils.TcType --- See Note [Promoting unification variables] --- We don't just call promoteTyVar because we want to use unifyTyVar, --- not writeMetaTyVar -promoteTyVarTcS tv - = do { tclvl <- TcS.getTcLevel - ; when (isFloatedTouchableMetaTyVar tclvl tv) $ - do { cloned_tv <- TcS.cloneMetaTyVar tv - ; let rhs_tv = setMetaTyVarTcLevel cloned_tv tclvl - ; unifyTyVar tv (mkTyVarTy rhs_tv) } } - -- | Like 'defaultTyVar', but in the TcS monad. defaultTyVarTcS :: TcTyVar -> TcS Bool defaultTyVarTcS the_tv @@ -2314,7 +2274,7 @@ approximateWC float_past_equalities wc concatMapBag (float_implic trapping_tvs) implics float_implic :: TcTyCoVarSet -> Implication -> Cts float_implic trapping_tvs imp - | float_past_equalities || ic_given_eqs imp == NoGivenEqs + | float_past_equalities || ic_given_eqs imp /= MaybeGivenEqs = float_wc new_trapping_tvs (ic_wanted imp) | otherwise -- Take care with equalities = emptyCts -- See (1) under Note [ApproximateWC] @@ -2414,7 +2374,7 @@ approximateWC to produce a list of candidate constraints. Then we MUST a) Promote any meta-tyvars that have been floated out by approximateWC, to restore invariant (WantedInv) described in - Note [TcLevel and untouchable type variables] in GHC.Tc.Utils.TcType. + Note [TcLevel invariants] in GHC.Tc.Utils.TcType. b) Default the kind of any meta-tyvars that are not mentioned in in the environment. @@ -2430,8 +2390,7 @@ Note [Promoting unification variables] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When we float an equality out of an implication we must "promote" free unification variables of the equality, in order to maintain Invariant -(WantedInv) from Note [TcLevel and untouchable type variables] in -TcType. for the leftover implication. +(WantedInv) from Note [TcLevel invariants] in GHC.Tc.Types.TcType. This is absolutely necessary. Consider the following example. We start with two implications and a class with a functional dependency. @@ -2468,276 +2427,6 @@ beta! Concrete example is in indexed_types/should_fail/ExtraTcsUntch.hs: in (g1 '3', g2 undefined) - -********************************************************************************* -* * -* Floating equalities * -* * -********************************************************************************* - -Note [Float Equalities out of Implications] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -For ordinary pattern matches (including existentials) we float -equalities out of implications, for instance: - data T where - MkT :: Eq a => a -> T - f x y = case x of MkT _ -> (y::Int) -We get the implication constraint (x::T) (y::alpha): - forall a. [untouchable=alpha] Eq a => alpha ~ Int -We want to float out the equality into a scope where alpha is no -longer untouchable, to solve the implication! - -But we cannot float equalities out of implications whose givens may -yield or contain equalities: - - data T a where - T1 :: T Int - T2 :: T Bool - T3 :: T a - - h :: T a -> a -> Int - - f x y = case x of - T1 -> y::Int - T2 -> y::Bool - T3 -> h x y - -We generate constraint, for (x::T alpha) and (y :: beta): - [untouchables = beta] (alpha ~ Int => beta ~ Int) -- From 1st branch - [untouchables = beta] (alpha ~ Bool => beta ~ Bool) -- From 2nd branch - (alpha ~ beta) -- From 3rd branch - -If we float the equality (beta ~ Int) outside of the first implication and -the equality (beta ~ Bool) out of the second we get an insoluble constraint. -But if we just leave them inside the implications, we unify alpha := beta and -solve everything. - -Principle: - We do not want to float equalities out which may - need the given *evidence* to become soluble. - -Consequence: classes with functional dependencies don't matter (since there is -no evidence for a fundep equality), but equality superclasses do matter (since -they carry evidence). --} - -floatEqualities :: [TcTyVar] -> [EvId] -> EvBindsVar -> HasGivenEqs - -> WantedConstraints - -> TcS (Cts, WantedConstraints) --- Main idea: see Note [Float Equalities out of Implications] --- --- Precondition: the wc_simple of the incoming WantedConstraints are --- fully zonked, so that we can see their free variables --- --- Postcondition: The returned floated constraints (Cts) are only --- Wanted or Derived --- --- Also performs some unifications (via promoteTyVar), adding to --- monadically-carried ty_binds. These will be used when processing --- floated_eqs later --- --- Subtleties: Note [Float equalities from under a skolem binding] --- Note [Skolem escape] --- Note [What prevents a constraint from floating] -floatEqualities skols given_ids ev_binds_var has_given_eqs - wanteds@(WC { wc_simple = simples }) - | MaybeGivenEqs <- has_given_eqs -- There are some given equalities, so don't float - = return (emptyBag, wanteds) -- Note [Float Equalities out of Implications] - - | otherwise - = do { -- First zonk: the inert set (from whence they came) is not - -- necessarily fully zonked; equalities are not kicked out - -- if a unification cannot make progress. See Note - -- [inert_eqs: the inert equalities] in GHC.Tc.Solver.Monad, which - -- describes how the inert set might not actually be inert. - simples <- TcS.zonkSimples simples - ; binds <- TcS.getTcEvBindsMap ev_binds_var - - -- Now we can pick the ones to float - -- The constraints are de-canonicalised - ; let (candidate_eqs, no_float_cts) = partitionBag is_float_eq_candidate simples - - seed_skols = mkVarSet skols `unionVarSet` - mkVarSet given_ids `unionVarSet` - foldr add_non_flt_ct emptyVarSet no_float_cts `unionVarSet` - evBindMapToVarSet binds - -- seed_skols: See Note [What prevents a constraint from floating] (1,2,3) - -- Include the EvIds of any non-floating constraints - - extended_skols = transCloVarSet (add_captured_ev_ids candidate_eqs) seed_skols - -- extended_skols contains the EvIds of all the trapped constraints - -- See Note [What prevents a constraint from floating] (3) - - (flt_eqs, no_flt_eqs) = partitionBag (is_floatable extended_skols) - candidate_eqs - - remaining_simples = no_float_cts `andCts` no_flt_eqs - - -- Promote any unification variables mentioned in the floated equalities - -- See Note [Promoting unification variables] - ; mapM_ promoteTyVarTcS (tyCoVarsOfCtsList flt_eqs) - - ; traceTcS "floatEqualities" (vcat [ text "Skols =" <+> ppr skols - , text "Extended skols =" <+> ppr extended_skols - , text "Simples =" <+> ppr simples - , text "Candidate eqs =" <+> ppr candidate_eqs - , text "Floated eqs =" <+> ppr flt_eqs]) - ; return ( flt_eqs, wanteds { wc_simple = remaining_simples } ) } - - where - add_non_flt_ct :: Ct -> VarSet -> VarSet - add_non_flt_ct ct acc | isDerivedCt ct = acc - | otherwise = extendVarSet acc (ctEvId ct) - - is_floatable :: VarSet -> Ct -> Bool - is_floatable skols ct - | isDerivedCt ct = tyCoVarsOfCt ct `disjointVarSet` skols - | otherwise = not (ctEvId ct `elemVarSet` skols) - - add_captured_ev_ids :: Cts -> VarSet -> VarSet - add_captured_ev_ids cts skols = foldr extra_skol emptyVarSet cts - where - extra_skol ct acc - | isDerivedCt ct = acc - | tyCoVarsOfCt ct `intersectsVarSet` skols = extendVarSet acc (ctEvId ct) - | otherwise = acc - - -- Identify which equalities are candidates for floating - -- Float out alpha ~ ty which might be unified outside - -- See Note [Which equalities to float] - is_float_eq_candidate ct - | pred <- ctPred ct - , EqPred NomEq ty1 ty2 <- classifyPredType pred - , case ct of - CIrredCan {} -> False -- See Note [Do not float blocked constraints] - _ -> True -- See #18855 - = float_eq ty1 ty2 || float_eq ty2 ty1 - | otherwise - = False - - float_eq ty1 ty2 - = case getTyVar_maybe ty1 of - Just tv1 -> isMetaTyVar tv1 - && (not (isTyVarTyVar tv1) || isTyVarTy ty2) - Nothing -> False - -{- Note [Do not float blocked constraints] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -As #18855 showed, we must not float an equality that is blocked. -Consider - forall a[4]. [W] co1: alpha[4] ~ Maybe (a[4] |> bco) - [W] co2: alpha[4] ~ Maybe (beta[4] |> bco]) - [W] bco: kappa[2] ~ Type - -Now co1, co2 are blocked by bco. We will eventually float out bco -and solve it at level 2. But the danger is that we will *also* -float out co2, and that is bad bad bad. Because we'll promote alpha -and beta to level 2, and then fail to unify the promoted beta -with the skolem a[4]. - -Solution: don't float out blocked equalities. Remember: we only want -to float out if we can solve; see Note [Which equalities to float]. - -(Future plan: kill floating altogether.) - -Note [Float equalities from under a skolem binding] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Which of the simple equalities can we float out? Obviously, only -ones that don't mention the skolem-bound variables. But that is -over-eager. Consider - [2] forall a. F a beta[1] ~ gamma[2], G beta[1] gamma[2] ~ Int -The second constraint doesn't mention 'a'. But if we float it, -we'll promote gamma[2] to gamma'[1]. Now suppose that we learn that -beta := Bool, and F a Bool = a, and G Bool _ = Int. Then we'll -we left with the constraint - [2] forall a. a ~ gamma'[1] -which is insoluble because gamma became untouchable. - -Solution: float only constraints that stand a jolly good chance of -being soluble simply by being floated, namely ones of form - a ~ ty -where 'a' is a currently-untouchable unification variable, but may -become touchable by being floated (perhaps by more than one level). - -We had a very complicated rule previously, but this is nice and -simple. (To see the notes, look at this Note in a version of -GHC.Tc.Solver prior to Oct 2014). - -Note [Which equalities to float] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Which equalities should we float? We want to float ones where there -is a decent chance that floating outwards will allow unification to -happen. In particular, float out equalities that are: - -* Of form (alpha ~# ty) or (ty ~# alpha), where - * alpha is a meta-tyvar. - * And 'alpha' is not a TyVarTv with 'ty' being a non-tyvar. In that - case, floating out won't help either, and it may affect grouping - of error messages. - - NB: generally we won't see (ty ~ alpha), with alpha on the right because - of Note [Unification variables on the left] in GHC.Tc.Utils.Unify, - but if we have (F tys ~ alpha) and alpha is untouchable, then it will - appear on the right. Example T4494. - -* Nominal. No point in floating (alpha ~R# ty), because we do not - unify representational equalities even if alpha is touchable. - See Note [Do not unify representational equalities] in GHC.Tc.Solver.Interact. - -Note [Skolem escape] -~~~~~~~~~~~~~~~~~~~~ -You might worry about skolem escape with all this floating. -For example, consider - [2] forall a. (a ~ F beta[2] delta, - Maybe beta[2] ~ gamma[1]) - -The (Maybe beta ~ gamma) doesn't mention 'a', so we float it, and -solve with gamma := beta. But what if later delta:=Int, and - F b Int = b. -Then we'd get a ~ beta[2], and solve to get beta:=a, and now the -skolem has escaped! - -But it's ok: when we float (Maybe beta[2] ~ gamma[1]), we promote beta[2] -to beta[1], and that means the (a ~ beta[1]) will be stuck, as it should be. - -Note [What prevents a constraint from floating] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -What /prevents/ a constraint from floating? If it mentions one of the -"bound variables of the implication". What are they? - -The "bound variables of the implication" are - - 1. The skolem type variables `ic_skols` - - 2. The "given" evidence variables `ic_given`. Example: - forall a. (co :: t1 ~# t2) => [W] co2 : (a ~# b |> co) - Here 'co' is bound - - 3. The binders of all evidence bindings in `ic_binds`. Example - forall a. (d :: t1 ~ t2) - EvBinds { (co :: t1 ~# t2) = superclass-sel d } - => [W] co2 : (a ~# b |> co) - Here `co` is gotten by superclass selection from `d`, and the - wanted constraint co2 must not float. - - 4. And the evidence variable of any equality constraint (incl - Wanted ones) whose type mentions a bound variable. Example: - forall k. [W] co1 :: t1 ~# t2 |> co2 - [W] co2 :: k ~# * - Here, since `k` is bound, so is `co2` and hence so is `co1`. - -Here (1,2,3) are handled by the "seed_skols" calculation, and -(4) is done by the transCloVarSet call. - -The possible dependence on givens, and evidence bindings, is more -subtle than we'd realised at first. See #14584. - -How can (4) arise? Suppose we have (k :: *), (a :: k), and ([G} k ~ *). -Then form an equality like (a ~ Int) we might end up with - [W] co1 :: k ~ * - [W] co2 :: (a |> co1) ~ Int - - ********************************************************************************* * * * Defaulting and disambiguation * ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -4,9 +4,9 @@ module GHC.Tc.Solver.Canonical( canonicalize, - unifyDerived, + unifyDerived, unifyTest, UnifyTestResult(..), makeSuperClasses, - StopOrContinue(..), stopWith, continueWith, + StopOrContinue(..), stopWith, continueWith, andWhenContinue, solveCallStack -- For GHC.Tc.Solver ) where @@ -51,7 +51,8 @@ import GHC.Data.Bag import GHC.Utils.Monad import Control.Monad import Data.Maybe ( isJust, isNothing ) -import Data.List ( zip4 ) +import Data.List ( zip4, partition ) +import GHC.Types.Unique.Set( nonDetEltsUniqSet ) import GHC.Types.Basic import Data.Bifunctor ( bimap ) @@ -2269,8 +2270,8 @@ canEqCanLHS2 ev eq_rel swapped lhs1 ps_xi1 lhs2 ps_xi2 mco -- This function handles the case where one side is a tyvar and the other is -- a type family application. Which to put on the left? --- If we can unify the variable, put it on the left, as this may be our only --- shot to unify. +-- If the tyvar is a touchable meta-tyvar, put it on the left, as this may +-- be our only shot to unify. -- Otherwise, put the function on the left, because it's generally better to -- rewrite away function calls. This makes types smaller. And it seems necessary: -- [W] F alpha ~ alpha @@ -2278,22 +2279,20 @@ canEqCanLHS2 ev eq_rel swapped lhs1 ps_xi1 lhs2 ps_xi2 mco -- [W] G alpha beta ~ Int ( where we have type instance G a a = a ) -- If we end up with a stuck alpha ~ F alpha, we won't be able to solve this. -- Test case: indexed-types/should_compile/CEqCanOccursCheck --- It would probably work to always put the variable on the left, but we think --- it would be less efficient. canEqTyVarFunEq :: CtEvidence -- :: lhs ~ (rhs |> mco) -- or (rhs |> mco) ~ lhs if swapped -> EqRel -> SwapFlag - -> TyVar -> TcType -- lhs, pretty lhs - -> TyCon -> [Xi] -> TcType -- rhs fun, rhs args, pretty rhs + -> TyVar -> TcType -- lhs (or if swapped rhs), pretty lhs + -> TyCon -> [Xi] -> TcType -- rhs (or if swapped lhs) fun and args, pretty rhs -> MCoercion -- :: kind(rhs) ~N kind(lhs) -> TcS (StopOrContinue Ct) canEqTyVarFunEq ev eq_rel swapped tv1 ps_xi1 fun_tc2 fun_args2 ps_xi2 mco - = do { tclvl <- getTcLevel - ; dflags <- getDynFlags - ; if | isTouchableMetaTyVar tclvl tv1 - , MTVU_OK _ <- checkTyVarEq dflags YesTypeFamilies tv1 (ps_xi2 `mkCastTyMCo` mco) - -> canEqCanLHSFinish ev eq_rel swapped (TyVarLHS tv1) - (ps_xi2 `mkCastTyMCo` mco) + = do { can_unify <- unifyTest ev tv1 rhs + ; dflags <- getDynFlags + ; if | case can_unify of { NoUnify -> False; _ -> True } + , MTVU_OK {} <- checkTyVarEq dflags YesTypeFamilies tv1 rhs + -> canEqCanLHSFinish ev eq_rel swapped (TyVarLHS tv1) rhs + | otherwise -> do { new_ev <- rewriteCastedEquality ev eq_rel swapped (mkTyVarTy tv1) (mkTyConApp fun_tc2 fun_args2) @@ -2303,6 +2302,59 @@ canEqTyVarFunEq ev eq_rel swapped tv1 ps_xi1 fun_tc2 fun_args2 ps_xi2 mco (ps_xi1 `mkCastTyMCo` sym_mco) } } where sym_mco = mkTcSymMCo mco + rhs = ps_xi2 `mkCastTyMCo` mco + +data UnifyTestResult + = UnifySameLevel + | UnifyOuterLevel [TcTyVar] -- Promote these + TcLevel -- ..to this level + | NoUnify + +instance Outputable UnifyTestResult where + ppr UnifySameLevel = text "UnifySameLevel" + ppr (UnifyOuterLevel tvs lvl) = text "UnifyOuterLevel" <> parens (ppr lvl <+> ppr tvs) + ppr NoUnify = text "NoUnify" + +unifyTest :: CtEvidence -> TcTyVar -> TcType -> TcS UnifyTestResult +-- This is the key test for untouchability: +-- See Note [Unification preconditions] +-- in GHC.Tc.Utils.Unify +unifyTest ev tv1 rhs + | not (isGiven ev) + , MetaTv { mtv_tclvl = tv_lvl, mtv_info = info } <- tcTyVarDetails tv1 + , canSolveByUnification info rhs + = do { ambient_lvl <- getTcLevel + ; given_eq_lvl <- getInnermostGivenEqLevel + + ; if | tv_lvl `sameDepthAs` ambient_lvl + -> return UnifySameLevel + + | tv_lvl `deeperThanOrSame` given_eq_lvl -- No intervening given equalities + , all (does_not_escape tv_lvl) free_skols -- No skolem escapes + -> return (UnifyOuterLevel free_metas tv_lvl) + + | otherwise + -> return NoUnify } + | otherwise + = return NoUnify + where + fvs = nonDetEltsUniqSet $ tyCoVarsOfType rhs + (free_metas, free_skols) = partition is_promotable fvs + + does_not_escape tv_lvl fv + | isTyVar fv = tv_lvl `deeperThanOrSame` tcTyVarLevel fv + | otherwise = True + -- Coercion variables are not an escape risk + -- If an implication binds a coercion variable, it'll have equalities, + -- so the "intervening given equalities" test above will catch it + -- Coercion holes get filled with coercions, so again no problem. + + is_promotable fv + | isTyVar fv + , MetaTv { mtv_info = info } <- tcTyVarDetails fv + = isTouchableInfo info -- Can't promote cycle breakers + | otherwise + = False -- The RHS here is either not CanEqLHS, or it's one that we -- want to rewrite the LHS to (as per e.g. swapOverTyVars) ===================================== compiler/GHC/Tc/Solver/Interact.hs ===================================== @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP, MultiWayIf #-} {-# OPTIONS_GHC -Wno-incomplete-record-updates #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} @@ -14,7 +14,6 @@ import GHC.Prelude import GHC.Types.Basic ( SwapFlag(..), infinity, IntWithInf, intGtLimit ) import GHC.Tc.Solver.Canonical -import GHC.Tc.Utils.Unify( canSolveByUnification ) import GHC.Types.Var.Set import GHC.Core.Type as Type import GHC.Core.InstEnv ( DFunInstType ) @@ -39,6 +38,7 @@ import GHC.Tc.Types import GHC.Tc.Types.Constraint import GHC.Core.Predicate import GHC.Tc.Types.Origin +import GHC.Tc.Utils.TcMType( promoteTyVarTo ) import GHC.Tc.Solver.Monad import GHC.Data.Bag import GHC.Utils.Monad ( concatMapM, foldlM ) @@ -430,12 +430,11 @@ interactWithInertsStage :: WorkItem -> TcS (StopOrContinue Ct) interactWithInertsStage wi = do { inerts <- getTcSInerts - ; lvl <- getTcLevel ; let ics = inert_cans inerts ; case wi of - CEqCan {} -> interactEq lvl ics wi - CIrredCan {} -> interactIrred ics wi - CDictCan {} -> interactDict ics wi + CEqCan {} -> interactEq ics wi + CIrredCan {} -> interactIrred ics wi + CDictCan {} -> interactDict ics wi _ -> pprPanic "interactWithInerts" (ppr wi) } -- CNonCanonical have been canonicalised @@ -1439,8 +1438,8 @@ inertsCanDischarge inerts lhs rhs fr | otherwise = False -- Work item is fully discharged -interactEq :: TcLevel -> InertCans -> Ct -> TcS (StopOrContinue Ct) -interactEq tclvl inerts workItem@(CEqCan { cc_lhs = lhs +interactEq :: InertCans -> Ct -> TcS (StopOrContinue Ct) +interactEq inerts workItem@(CEqCan { cc_lhs = lhs , cc_rhs = rhs , cc_ev = ev , cc_eq_rel = eq_rel }) @@ -1465,24 +1464,43 @@ interactEq tclvl inerts workItem@(CEqCan { cc_lhs = lhs = do { traceTcS "Not unifying representational equality" (ppr workItem) ; continueWith workItem } - -- try improvement, if possible - | TyFamLHS fam_tc fam_args <- lhs - , isImprovable ev - = do { improveLocalFunEqs ev inerts fam_tc fam_args rhs - ; continueWith workItem } - - | TyVarLHS tv <- lhs - , canSolveByUnification tclvl tv rhs - = do { solveByUnification ev tv rhs - ; n_kicked <- kickOutAfterUnification tv - ; return (Stop ev (text "Solved by unification" <+> pprKicked n_kicked)) } - | otherwise - = continueWith workItem - -interactEq _ _ wi = pprPanic "interactEq" (ppr wi) - -solveByUnification :: CtEvidence -> TcTyVar -> Xi -> TcS () + = case lhs of + TyVarLHS tv -> tryToSolveByUnification workItem ev tv rhs + + TyFamLHS tc args -> do { when (isImprovable ev) $ + -- Try improvement, if possible + improveLocalFunEqs ev inerts tc args rhs + ; continueWith workItem } + +interactEq _ wi = pprPanic "interactEq" (ppr wi) + +---------------------- +-- We have a meta-tyvar on the left, and metaTyVarUpateOK has said "yes" +-- So try to solve by unifying. +-- Three reasons why not: +-- Skolem escape +-- Given equalities (GADTs) +-- Unifying a TyVarTv with a non-tyvar type +tryToSolveByUnification :: Ct -> CtEvidence + -> TcTyVar -- LHS tyvar + -> TcType -- RHS + -> TcS (StopOrContinue Ct) +tryToSolveByUnification work_item ev tv rhs + = do { can_unify <- unifyTest ev tv rhs + ; traceTcS "tryToSolveByUnification" (vcat [ ppr tv <+> char '~' <+> ppr rhs + , ppr can_unify ]) + + ; case can_unify of + NoUnify -> continueWith work_item + -- For the latter two cases see Note [Solve by unification] + UnifySameLevel -> solveByUnification ev tv rhs + UnifyOuterLevel free_metas tv_lvl + -> do { wrapTcS $ mapM_ (promoteTyVarTo tv_lvl) free_metas + ; setUnificationFlag tv_lvl + ; solveByUnification ev tv rhs } } + +solveByUnification :: CtEvidence -> TcTyVar -> Xi -> TcS (StopOrContinue Ct) -- Solve with the identity coercion -- Precondition: kind(xi) equals kind(tv) -- Precondition: CtEvidence is Wanted or Derived @@ -1504,9 +1522,10 @@ solveByUnification wd tv xi text "Coercion:" <+> pprEq tv_ty xi, text "Left Kind is:" <+> ppr (tcTypeKind tv_ty), text "Right Kind is:" <+> ppr (tcTypeKind xi) ] - ; unifyTyVar tv xi - ; setEvBindIfWanted wd (evCoercion (mkTcNomReflCo xi)) } + ; setEvBindIfWanted wd (evCoercion (mkTcNomReflCo xi)) + ; n_kicked <- kickOutAfterUnification tv + ; return (Stop wd (text "Solved by unification" <+> pprKicked n_kicked)) } {- Note [Avoid double unifications] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1542,6 +1561,34 @@ and we want to get alpha := N b. See also #15144, which was caused by unifying a representational equality. +Note [Solve by unification] +~~~~~~~~~~~~~~~~~~~~~~~~~~~ +If we solve + alpha[n] ~ ty +by unification, there are two cases to consider + +* UnifySameLevel: if the ambient level is 'n', then + we can simply update alpha := ty, and do nothing else + +* UnifyOuterLevel free_metas n: if the ambient level is greater than + 'n' (the level of alpha), in addition to setting alpha := ty we must + do two other things: + + 1. Promote all the free meta-vars of 'ty' to level n. After all, + alpha[n] is at level n, and so if we set, say, + alpha[n] := Maybe beta[m], + we must ensure that when unifying beta we do skolem-escape checks + etc relevent to level n. Simple way to do that: promote beta to + level n. + + 2. Set the Unification Level Flag to record that a level-n unification has + taken place. See Note [The Unification Level Flag] + +NB: UnifySameLevel is just an optimisation for UnifyOuterLevel. Promotion +would be a no-op, and setting the unification flag unnecessarily would just +make the solver iterate more often. (We don't need to iterate when unifying +at the ambient level becuase of the kick-out mechanism.) + ************************************************************************ * * ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -17,7 +17,7 @@ module GHC.Tc.Solver.Monad ( -- The TcS monad TcS, runTcS, runTcSDeriveds, runTcSWithEvBinds, runTcSInerts, - failTcS, warnTcS, addErrTcS, + failTcS, warnTcS, addErrTcS, wrapTcS, runTcSEqualities, nestTcS, nestImplicTcS, setEvBindsTcS, emitImplicationTcS, emitTvImplicationTcS, @@ -31,6 +31,7 @@ module GHC.Tc.Solver.Monad ( panicTcS, traceTcS, traceFireTcS, bumpStepCountTcS, csTraceTcS, wrapErrTcS, wrapWarnTcS, + resetUnificationFlag, setUnificationFlag, -- Evidence creation and transformation MaybeNew(..), freshGoals, isFresh, getEvExpr, @@ -60,7 +61,7 @@ module GHC.Tc.Solver.Monad ( updInertTcS, updInertCans, updInertDicts, updInertIrreds, getHasGivenEqs, setInertCans, getInertEqs, getInertCans, getInertGivens, - getInertInsols, + getInertInsols, getInnermostGivenEqLevel, getTcSInerts, setTcSInerts, matchableGivens, prohibitedSuperClassSolve, mightMatchLater, getUnsolvedInerts, @@ -186,7 +187,7 @@ import Control.Monad import GHC.Utils.Monad import Data.IORef import Data.List ( partition, mapAccumL ) -import qualified Data.Semigroup as S +-- import qualified Data.Semigroup as S import Data.List.NonEmpty ( NonEmpty(..), cons, toList, nonEmpty ) import qualified Data.List.NonEmpty as NE import Control.Arrow ( first ) @@ -418,12 +419,14 @@ instance Outputable InertSet where emptyInertCans :: InertCans emptyInertCans - = IC { inert_eqs = emptyDVarEnv - , inert_dicts = emptyDicts - , inert_safehask = emptyDicts - , inert_funeqs = emptyFunEqs - , inert_insts = [] - , inert_irreds = emptyCts } + = IC { inert_eqs = emptyDVarEnv + , inert_given_eq_lvl = topTcLevel + , inert_given_eqs = False + , inert_dicts = emptyDicts + , inert_safehask = emptyDicts + , inert_funeqs = emptyFunEqs + , inert_insts = [] + , inert_irreds = emptyCts } emptyInert :: InertSet emptyInert @@ -697,6 +700,19 @@ data InertCans -- See Note [Detailed InertCans Invariants] for more -- Irreducible predicates that cannot be made canonical, -- and which don't interact with others (e.g. (c a)) -- and insoluble predicates (e.g. Int ~ Bool, or a ~ [a]) + + , inert_given_eq_lvl :: TcLevel + -- The TcLevel of the innermost implication that has Given + -- equalities, of the sort that make a unification variable + -- untouchable. See Note [Tracking Given equalities] + + , inert_given_eqs :: Bool + -- True <=> The inert Givens *at this level* (tcl_tclvl) + -- could includes at least one equality /other than/ a + -- let-bound skolem equality. + -- NB: (c a) doesn't count as an equality for this purpose + -- Reason: report these givens when reporting a failed equality + -- See Note [Tracking Given equalities] } type InertEqs = DTyVarEnv EqualCtList @@ -730,7 +746,124 @@ listToEqualCtList :: [Ct] -> Maybe EqualCtList -- non-empty listToEqualCtList cts = EqualCtList <$> nonEmpty cts -{- Note [Detailed InertCans Invariants] +{- Note [Tracking Given equalities] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +For reasons described in (UNTOUCHABLE) in GHC.Tc.Utils.Unify +Note [When unification can happen], we can't unify + alpha[2] ~ Int +under a level-4 implication if there are any Given equalities +bound by the implications at level 3 of 4. To that end, the +InertCans tracks + + inert_given_eq_lvl :: TcLevel + -- The TcLevel of the innermost implication that has Given + -- equalities, of the sort that make a unification variable + -- untouchable. See Note [Tracking Given equalities] + +We update inert_given_eq_lvl whenever we add a Given to the +inert set, in updateGivenEqs. + +Then at ambient level 'l', the unification variable alpha[n] is +untouchable if n <= inert_given_eq_lvl. + +Exactly which constraints should trigger (UNTOUCHABLE), and hence +should update inert_given_eq_lvl? + +* We do /not/ need to worry about let-bound skolems, such ast + forall[2] a. a ~ [b] => blah + See Note [Let-bound skolems] + +* Consider an implication + forall[2]. beta[1] => alpha[1] ~ Int + where beta is a unification variable that has already been unified + to () in an outer scope. Then alpha[1] is perfectly touchable and + we can unify alpha := Int. So when deciding whether the givens contain + an equality, we should canonicalise first, rather than just looking at + the /original/ givens (#8644). + + * However, we must take account of *potential* equalities. Consider the + same example again, but this time we have /not/ yet unified beta: + forall[2] beta[1] => ...blah... + + Because beta might turn into an equality, updateGivenEqs conservatively + treats it as a potential equality, and updates inert_give_eq_lvl + + * What about something like forall[2] a b. a ~ F b => [W] alpha[1] ~ X y z? + + That Given cannot affect the Wanted, because the Given is entirely + *local*: it mentions only skolems bound in the very same + implication. Such equalities need not make alpha untouchable. (Test + case typecheck/should_compile/LocalGivenEqs has a real-life + motivating example, with some detailed commentary.) + Hence the 'mentionsOuterVar' test in updateGivenEqs. + + However, solely to support better error messages + (see Note [HasGivenEqs] in GHC.Tc.Types.Constraint) we also track + these "local" equalities in the boolean inert_given_eqs field. + This field is used only to set the ic_given_eqs field to LocalGivenEqs; + see the function getHasGivenEqs. + + Here is a simpler case that triggers this behaviour: + + data T where + MkT :: F a ~ G b => a -> b -> T + + f (MkT _ _) = True + + Because of this behaviour around local equality givens, we can infer the + type of f. This is typecheck/should_compile/LocalGivenEqs2. + + * We need not look at the equality relation involved (nominal vs + representational), because representational equalities can still + imply nominal ones. For example, if (G a ~R G b) and G's argument's + role is nominal, then we can deduce a ~N b. + +Note [Let-bound skolems] +~~~~~~~~~~~~~~~~~~~~~~~~ +If * the inert set contains a canonical Given CEqCan (a ~ ty) +and * 'a' is a skolem bound in this very implication, + +then: +a) The Given is pretty much a let-binding, like + f :: (a ~ b->c) => a -> a + Here the equality constraint is like saying + let a = b->c in ... + It is not adding any new, local equality information, + and hence can be ignored by has_given_eqs + +b) 'a' will have been completely substituted out in the inert set, + so we can safely discard it. + +For an example, see #9211. + +See also GHC.Tc.Utils.Unify Note [Deeper level on the left] for how we ensure +that the right variable is on the left of the equality when both are +tyvars. + +You might wonder whether the skolem really needs to be bound "in the +very same implication" as the equuality constraint. +Consider this (c.f. #15009): + + data S a where + MkS :: (a ~ Int) => S a + + g :: forall a. S a -> a -> blah + g x y = let h = \z. ( z :: Int + , case x of + MkS -> [y,z]) + in ... + +From the type signature for `g`, we get `y::a` . Then when we +encounter the `\z`, we'll assign `z :: alpha[1]`, say. Next, from the +body of the lambda we'll get + + [W] alpha[1] ~ Int -- From z::Int + [W] forall[2]. (a ~ Int) => [W] alpha[1] ~ a -- From [y,z] + +Now, unify alpha := a. Now we are stuck with an unsolved alpha~Int! +So we must treat alpha as untouchable under the forall[2] implication. + +Note [Detailed InertCans Invariants] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The InertCans represents a collection of constraints with the following properties: @@ -1027,6 +1160,8 @@ instance Outputable InertCans where ppr (IC { inert_eqs = eqs , inert_funeqs = funeqs, inert_dicts = dicts , inert_safehask = safehask, inert_irreds = irreds + , inert_given_eq_lvl = ge_lvl + , inert_given_eqs = given_eqs , inert_insts = insts }) = braces $ vcat @@ -1043,6 +1178,8 @@ instance Outputable InertCans where text "Irreds =" <+> pprCts irreds , ppUnless (null insts) $ text "Given instances =" <+> vcat (map ppr insts) + , text "Innermost given equalities =" <+> ppr ge_lvl + , text "Given eqs at this level =" <+> ppr given_eqs ] where folder (EqualCtList eqs) rest = nonEmptyToBag eqs `andCts` rest @@ -1456,20 +1593,40 @@ findEq icans (TyFamLHS fun_tc fun_args) addInertForAll :: QCInst -> TcS () -- Add a local Given instance, typically arising from a type signature addInertForAll new_qci - = do { ics <- getInertCans - ; insts' <- add_qci (inert_insts ics) - ; setInertCans (ics { inert_insts = insts' }) } + = do { ics <- getInertCans + ; ics1 <- add_qci ics + + -- Update given equalities. Painful! C.f updateGivenEqs + ; tclvl <- getTcLevel + ; let ics2 | not_equality = ics1 + | otherwise = ics1 { inert_given_eq_lvl = ge_lvl' + , inert_given_eqs = geqs' } + !(IC { inert_given_eq_lvl = ge_lvl + , inert_given_eqs = geqs }) = ics1 + + not_equality = isClassPred pred && not (isEqPred pred) + -- True <=> definitely not an equality + -- Heads like (f a) might be an equality + + pred = qci_pred new_qci + is_eq_pred = isEqPred pred -- Definitely an equality + geqs' = geqs || is_eq_pred + + ge_lvl' | tclvl `strictlyDeeperThan` ge_lvl = tclvl + | otherwise = ge_lvl + + ; setInertCans ics2 } where - add_qci :: [QCInst] -> TcS [QCInst] + add_qci :: InertCans -> TcS InertCans -- See Note [Do not add duplicate quantified instances] - add_qci qcis + add_qci ics@(IC { inert_insts = qcis }) | any same_qci qcis = do { traceTcS "skipping duplicate quantified instance" (ppr new_qci) - ; return qcis } + ; return ics } | otherwise = do { traceTcS "adding new inert quantified instance" (ppr new_qci) - ; return (new_qci : qcis) } + ; return (ics { inert_insts = new_qci : qcis }) } same_qci old_qci = tcEqType (ctEvPred (qci_ev old_qci)) (ctEvPred (qci_ev new_qci)) @@ -1523,7 +1680,8 @@ addInertCan ct ; ics <- getInertCans ; ct <- maybeEmitShadow ics ct ; ics <- maybeKickOut ics ct - ; setInertCans (add_item ics ct) + ; tclvl <- getTcLevel + ; setInertCans (add_item tclvl ics ct) ; traceTcS "addInertCan }" $ empty } @@ -1536,23 +1694,65 @@ maybeKickOut ics ct | otherwise = return ics -add_item :: InertCans -> Ct -> InertCans -add_item ics item@(CEqCan { cc_lhs = TyFamLHS tc tys }) - = ics { inert_funeqs = addCanFunEq (inert_funeqs ics) tc tys item } - -add_item ics item@(CEqCan { cc_lhs = TyVarLHS tv }) - = ics { inert_eqs = addTyEq (inert_eqs ics) tv item } - -add_item ics@(IC { inert_irreds = irreds }) item@(CIrredCan {}) - = ics { inert_irreds = irreds `Bag.snocBag` item } - -add_item ics item@(CDictCan { cc_class = cls, cc_tyargs = tys }) +add_item :: TcLevel -> InertCans -> Ct -> InertCans +add_item tc_lvl + ics@(IC { inert_funeqs = funeqs, inert_eqs = eqs }) + item@(CEqCan { cc_lhs = lhs }) + = updateGivenEqs tc_lvl item $ + case lhs of + TyFamLHS tc tys -> ics { inert_funeqs = addCanFunEq funeqs tc tys item } + TyVarLHS tv -> ics { inert_eqs = addTyEq eqs tv item } + +add_item tc_lvl ics@(IC { inert_irreds = irreds }) item@(CIrredCan {}) + = updateGivenEqs tc_lvl item $ -- An Irred might turn out to be an + -- equality, so we play safe + ics { inert_irreds = irreds `Bag.snocBag` item } + +add_item _ ics item@(CDictCan { cc_class = cls, cc_tyargs = tys }) = ics { inert_dicts = addDict (inert_dicts ics) cls tys item } -add_item _ item +add_item _ _ item = pprPanic "upd_inert set: can't happen! Inserting " $ ppr item -- Can't be CNonCanonical because they only land in inert_irreds +updateGivenEqs :: TcLevel -> Ct -> InertCans -> InertCans +-- Set the inert_given_eq_level to the current level (tclvl) +-- if the constraint is a given equality that should prevent +-- filling in an outer unification variable. +-- See See Note [Tracking Given equalities] +-- +-- ToDo: what about Quantified Constraints? +updateGivenEqs tclvl ct inerts@(IC { inert_given_eq_lvl = ge_lvl + , inert_given_eqs = geqs }) + | not (isGivenCt ct) = inerts + | not_equality ct = inerts -- See Note [Let-bound skolems] + | otherwise = inerts { inert_given_eq_lvl = ge_lvl' + , inert_given_eqs = geqs' } + where + ge_lvl' | tclvl `strictlyDeeperThan` ge_lvl + , mentionsOuterVar tclvl (ctEvidence ct) + -- Includes things like (c a), which *might* be an equality + = tclvl + | otherwise + = ge_lvl + + geqs' = geqs || is_equality ct + + + is_equality :: Ct -> Bool + -- True <=> definitely an equality, albeit perhaps insoluble + -- and hence not canonical + is_equality (CEqCan {}) = True + is_equality ct = isEqPrimPred (ctPred ct) + + not_equality :: Ct -> Bool + -- True <=> definitely not an equality of any kind + -- except for a let-bound skolem, which doesn't count + -- See Note [Let-bound skolems] + not_equality (CEqCan { cc_lhs = TyVarLHS tv }) = not (isOuterTyVar tclvl tv) + not_equality (CDictCan {}) = True + not_equality _ = False + ----------------------------------------- kickOutRewritable :: CtFlavourRole -- Flavour/role of the equality that -- is being added to the inert set @@ -1596,7 +1796,6 @@ kick_out_rewritable :: CtFlavourRole -- Flavour/role of the equality that kick_out_rewritable new_fr new_lhs ics@(IC { inert_eqs = tv_eqs , inert_dicts = dictmap - , inert_safehask = safehask , inert_funeqs = funeqmap , inert_irreds = irreds , inert_insts = old_insts }) @@ -1610,12 +1809,12 @@ kick_out_rewritable new_fr new_lhs | otherwise = (kicked_out, inert_cans_in) where - inert_cans_in = IC { inert_eqs = tv_eqs_in - , inert_dicts = dicts_in - , inert_safehask = safehask -- ?? - , inert_funeqs = feqs_in - , inert_irreds = irs_in - , inert_insts = insts_in } + -- inert_safehask stays unchanged; is that right? + inert_cans_in = ics { inert_eqs = tv_eqs_in + , inert_dicts = dicts_in + , inert_funeqs = feqs_in + , inert_irreds = irs_in + , inert_insts = insts_in } kicked_out :: WorkList -- NB: use extendWorkList to ensure that kicked-out equalities get priority @@ -1968,6 +2167,10 @@ updInertIrreds upd_fn getInertEqs :: TcS (DTyVarEnv EqualCtList) getInertEqs = do { inert <- getInertCans; return (inert_eqs inert) } +getInnermostGivenEqLevel :: TcS TcLevel +getInnermostGivenEqLevel = do { inert <- getInertCans + ; return (inert_given_eq_lvl inert) } + getInertInsols :: TcS Cts -- Returns insoluble equality constraints -- specifically including Givens @@ -2077,63 +2280,43 @@ getUnsolvedInerts getHasGivenEqs :: TcLevel -- TcLevel of this implication -> TcS ( HasGivenEqs -- are there Given equalities? , Cts ) -- Insoluble equalities arising from givens --- See Note [When does an implication have given equalities?] +-- See Note [Tracking Given equalities] getHasGivenEqs tclvl - = do { inerts@(IC { inert_eqs = ieqs, inert_funeqs = funeqs, inert_irreds = irreds }) + = do { inerts@(IC { inert_irreds = irreds + , inert_given_eqs = given_eqs + , inert_given_eq_lvl = ge_lvl }) <- getInertCans - ; let has_given_eqs = foldMap check_local_given_ct irreds - S.<> foldMap (lift_equal_ct_list check_local_given_tv_eq) ieqs - S.<> foldMapFunEqs (lift_equal_ct_list check_local_given_ct) funeqs - insols = filterBag insolubleEqCt irreds + ; let insols = filterBag insolubleEqCt irreds -- Specifically includes ones that originated in some -- outer context but were refined to an insoluble by -- a local equality; so do /not/ add ct_given_here. + -- See Note [HasGivenEqs] in GHC.Tc.Types.Constraint, and + -- Note [Tracking Given equalities] in this module + has_ge | ge_lvl == tclvl = MaybeGivenEqs + | given_eqs = LocalGivenEqs + | otherwise = NoGivenEqs + ; traceTcS "getHasGivenEqs" $ - vcat [ text "has_given_eqs:" <+> ppr has_given_eqs + vcat [ text "given_eqs:" <+> ppr given_eqs + , text "ge_lvl:" <+> ppr ge_lvl + , text "ambient level:" <+> ppr tclvl , text "Inerts:" <+> ppr inerts , text "Insols:" <+> ppr insols] - ; return (has_given_eqs, insols) } - where - check_local_given_ct :: Ct -> HasGivenEqs - check_local_given_ct ct - | given_here ev = if mentions_outer_var ev then MaybeGivenEqs else LocalGivenEqs - | otherwise = NoGivenEqs - where - ev = ctEvidence ct - - lift_equal_ct_list :: (Ct -> HasGivenEqs) -> EqualCtList -> HasGivenEqs - -- returns NoGivenEqs for non-singleton lists, as Given lists are always - -- singletons - lift_equal_ct_list check (EqualCtList (ct :| [])) = check ct - lift_equal_ct_list _ _ = NoGivenEqs - - check_local_given_tv_eq :: Ct -> HasGivenEqs - check_local_given_tv_eq (CEqCan { cc_lhs = TyVarLHS tv, cc_ev = ev}) - | given_here ev - = if is_outer_var tv then MaybeGivenEqs else NoGivenEqs - -- See Note [Let-bound skolems] - | otherwise - = NoGivenEqs - check_local_given_tv_eq other_ct = check_local_given_ct other_ct - - given_here :: CtEvidence -> Bool - -- True for a Given bound by the current implication, - -- i.e. the current level - given_here ev = isGiven ev - && tclvl == ctLocLevel (ctEvLoc ev) - - mentions_outer_var :: CtEvidence -> Bool - mentions_outer_var = anyFreeVarsOfType is_outer_var . ctEvPred - - is_outer_var :: TyCoVar -> Bool - is_outer_var tv - -- NB: a meta-tv alpha[3] may end up unifying with skolem b[2], - -- so treat it as an "outer" var, even at level 3. - -- This will become redundant after fixing #18929. - | isTyVar tv = isTouchableMetaTyVar tclvl tv || - tclvl `strictlyDeeperThan` tcTyVarLevel tv - | otherwise = False + ; return (has_ge, insols) } + +mentionsOuterVar :: TcLevel -> CtEvidence -> Bool +mentionsOuterVar tclvl ev + = anyFreeVarsOfType (isOuterTyVar tclvl) $ + ctEvPred ev + +isOuterTyVar :: TcLevel -> TyCoVar -> Bool +-- True of a type variable that comes from a +-- shallower level than the ambient level (tclvl) +isOuterTyVar tclvl tv + | isTyVar tv = tclvl `strictlyDeeperThan` tcTyVarLevel tv + -- Includes CycleBreakerTvs which are meta-tyvars + | otherwise = False -- Coercion variables; doesn't much matter -- | Returns Given constraints that might, -- potentially, match the given pred. This is used when checking to see if a @@ -2267,112 +2450,6 @@ Examples: This treatment fixes #18910 and is tested in typecheck/should_compile/InstanceGivenOverlap{,2} -Note [When does an implication have given equalities?] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider an implication - beta => alpha ~ Int -where beta is a unification variable that has already been unified -to () in an outer scope. Then we can float the (alpha ~ Int) out -just fine. So when deciding whether the givens contain an equality, -we should canonicalise first, rather than just looking at the original -givens (#8644). - -So we simply look at the inert, canonical Givens and see if there are -any equalities among them, the calculation of has_given_eqs. There -are some wrinkles: - - * We must know which ones are bound in *this* implication and which - are bound further out. We can find that out from the TcLevel - of the Given, which is itself recorded in the tcl_tclvl field - of the TcLclEnv stored in the Given (ev_given_here). - - What about interactions between inner and outer givens? - - Outer given is rewritten by an inner given, then there must - have been an inner given equality, hence the “given-eq” flag - will be true anyway. - - - Inner given rewritten by outer, retains its level (ie. The inner one) - - * We must take account of *potential* equalities, like the one above: - beta => ...blah... - If we still don't know what beta is, we conservatively treat it as potentially - becoming an equality. Hence including 'irreds' in the calculation or has_given_eqs. - Note that we can't really know what's in an irred, so any irred is considered - a potential equality. - - * What about something like forall a b. a ~ F b => [W] c ~ X y z? That Given - cannot affect the Wanted, because the Given is entirely *local*: it mentions - only skolems bound in the very same implication. Such equalities need not - prevent floating. (Test case typecheck/should_compile/LocalGivenEqs has a - real-life motivating example, with some detailed commentary.) These - equalities are noted with LocalGivenEqs: they do not prevent floating, but - they also are allowed to show up in error messages. See - Note [Suppress redundant givens during error reporting] in GHC.Tc.Errors. - The difference between what stops floating and what is suppressed from - error messages is why we need three options for HasGivenEqs. - - There is also a simpler case that triggers this behaviour: - - data T where - MkT :: F a ~ G b => a -> b -> T - - f (MkT _ _) = True - - Because of this behaviour around local equality givens, we can infer the - type of f. This is typecheck/should_compile/LocalGivenEqs2. - - * See Note [Let-bound skolems] for another wrinkle - - * We need not look at the equality relation involved (nominal vs representational), - because representational equalities can still imply nominal ones. For example, - if (G a ~R G b) and G's argument's role is nominal, then we can deduce a ~N b. - -Note [Let-bound skolems] -~~~~~~~~~~~~~~~~~~~~~~~~ -If * the inert set contains a canonical Given CEqCan (a ~ ty) -and * 'a' is a skolem bound in this very implication, - -then: -a) The Given is pretty much a let-binding, like - f :: (a ~ b->c) => a -> a - Here the equality constraint is like saying - let a = b->c in ... - It is not adding any new, local equality information, - and hence can be ignored by has_given_eqs - -b) 'a' will have been completely substituted out in the inert set, - so we can safely discard it. - -For an example, see #9211. - -See also GHC.Tc.Utils.Unify Note [Deeper level on the left] for how we ensure -that the right variable is on the left of the equality when both are -tyvars. - -You might wonder whether the skokem really needs to be bound "in the -very same implication" as the equuality constraint. -(c.f. #15009) Consider this: - - data S a where - MkS :: (a ~ Int) => S a - - g :: forall a. S a -> a -> blah - g x y = let h = \z. ( z :: Int - , case x of - MkS -> [y,z]) - in ... - -From the type signature for `g`, we get `y::a` . Then when we -encounter the `\z`, we'll assign `z :: alpha[1]`, say. Next, from the -body of the lambda we'll get - - [W] alpha[1] ~ Int -- From z::Int - [W] forall[2]. (a ~ Int) => [W] alpha[1] ~ a -- From [y,z] - -Now, suppose we decide to float `alpha ~ a` out of the implication -and then unify `alpha := a`. Now we are stuck! But if treat -`alpha ~ Int` first, and unify `alpha := Int`, all is fine. -But we absolutely cannot float that equality or we will get stuck. -} removeInertCts :: [Ct] -> InertCans -> InertCans @@ -2552,8 +2629,8 @@ tcAppMapToBag m = foldTcAppMap consBag m emptyBag foldTcAppMap :: (a -> b -> b) -> TcAppMap a -> b -> b foldTcAppMap k m z = foldDTyConEnv (foldTM k) z m -foldMapTcAppMap :: Monoid m => (a -> m) -> TcAppMap a -> m -foldMapTcAppMap f = foldMap (foldMap f) +-- foldMapTcAppMap :: Monoid m => (a -> m) -> TcAppMap a -> m +-- foldMapTcAppMap f = foldMap (foldMap f) {- ********************************************************************* @@ -2688,8 +2765,8 @@ findFunEqsByTyCon m tc foldFunEqs :: (a -> b -> b) -> FunEqMap a -> b -> b foldFunEqs = foldTcAppMap -foldMapFunEqs :: Monoid m => (a -> m) -> FunEqMap a -> m -foldMapFunEqs = foldMapTcAppMap +-- foldMapFunEqs :: Monoid m => (a -> m) -> FunEqMap a -> m +-- foldMapFunEqs = foldMapTcAppMap insertFunEq :: FunEqMap a -> TyCon -> [Type] -> a -> FunEqMap a insertFunEq m tc tys val = insertTcApp m tc tys val @@ -2723,6 +2800,12 @@ data TcSEnv -- The number of unification variables we have filled -- The important thing is whether it is non-zero + tcs_unif_lvl :: IORef (Maybe TcLevel), + -- The Unification Level Flag + -- Outermost level at which we have unified a meta tyvar + -- Starts at Nothing, then (Just i), then (Just j) where j do { inerts <- TcM.readTcRef old_inert_var - ; let nest_inert = inerts { inert_cycle_breakers = [] } - -- all other InertSet fields are inherited + ; let nest_inert = inerts { inert_cycle_breakers = [] + , inert_cans = (inert_cans inerts) + { inert_given_eqs = False } } + -- All other InertSet fields are inherited ; new_inert_var <- TcM.newTcRef nest_inert ; new_wl_var <- TcM.newTcRef emptyWorkList - ; let nest_env = TcSEnv { tcs_ev_binds = ref + ; let nest_env = TcSEnv { tcs_count = count -- Inherited + , tcs_unif_lvl = unif_lvl -- Inherited + , tcs_ev_binds = ref , tcs_unified = unified_var - , tcs_count = count , tcs_inerts = new_inert_var , tcs_worklist = new_wl_var } ; res <- TcM.setTcLevel inner_tclvl $ @@ -3260,6 +3349,97 @@ pprKicked :: Int -> SDoc pprKicked 0 = empty pprKicked n = parens (int n <+> text "kicked out") +{- ********************************************************************* +* * +* The Unification Level Flag * +* * +********************************************************************* -} + +{- Note [The Unification Level Flag and iterating the solver] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider a deep tree of implication constraints + forall[1] a. -- Outer-implic + C alpha[1] -- Simple + forall[2] c. ....(C alpha[1]).... -- Implic-1 + forall[2] b. ....(alpha[1] ~ Int).... -- Implic-2 + +The (C alpha) is insoluble until we know alpha. We solve alpha +by unifying alpha:=Int somewhere deep inside Implic-2. But then we +must try to solve the Outer-implic all over again. This time we can +solve (C alpha) both in Outer-implic, and nested inside Implic-1. + +When should we iterate solving a level-n implication? +Answer: if any unification of a tyvar at level n takes place + in the ic_implics of that implication. + +* What if a unification takes place at level n-1? Then don't iterate + level n, because we'll iterate level n-1, and that will in turn iterate + level n. + +* What if a unification takes place at level n, in the ic_simples of + level n? No need to track this, because the kick-out mechanism deals + with it. (We can't drop kick-out in favour of iteration, becuase kick-out + works for skolem-equalities, not just unifications.) + +So the monad-global Unification Level Flag, kept in tcs_unif_lvl keeps +track of + - Whether any unifications at all have taken place (Nothing => no unifications) + - If so, what is the outermost level that has seen a unification (Just lvl) + +The iteration done in the simplify_loop/maybe_simplify_again loop in GHC.Tc.Solver. + +It helpful not to iterate unless there is a chance of progress. #8474 is +an example: + + * There's a deeply-nested chain of implication constraints. + ?x:alpha => ?y1:beta1 => ... ?yn:betan => [W] ?x:Int + + * From the innermost one we get a [D] alpha[1] ~ Int, + so we can unify. + + * It's better not to iterate the inner implications, but go all the + way out to level 1 before iterating -- because iterating level 1 + will iterate the inner levels anyway. + +(In the olden days when we "floated" thse Derived constraints, this was +much, much more important -- we got exponential behaviour, as each iteration +produced the same Derived constraint.) +-} + + +resetUnificationFlag :: TcS Bool +-- We are at ambient level i +-- If the unification flag = Just i, reset it to Nothing and return True +-- Otherwise leave it unchanged and return False +resetUnificationFlag + = TcS $ \env -> + do { let ref = tcs_unif_lvl env + ; ambient_lvl <- TcM.getTcLevel + ; mb_lvl <- TcM.readTcRef ref + ; TcM.traceTc "resetUnificationFlag" $ + vcat [ text "ambient:" <+> ppr ambient_lvl + , text "unif_lvl:" <+> ppr mb_lvl ] + ; case mb_lvl of + Nothing -> return False + Just unif_lvl | ambient_lvl `strictlyDeeperThan` unif_lvl + -> return False + | otherwise + -> do { TcM.writeTcRef ref Nothing + ; return True } } + +setUnificationFlag :: TcLevel -> TcS () +-- (setUnificationFlag i) sets the unification level to (Just i) +-- unless it already is (Just j) where j <= i +setUnificationFlag lvl + = TcS $ \env -> + do { let ref = tcs_unif_lvl env + ; mb_lvl <- TcM.readTcRef ref + ; case mb_lvl of + Just unif_lvl | lvl `deeperThanOrSame` unif_lvl + -> return () + _ -> TcM.writeTcRef ref (Just lvl) } + + {- ********************************************************************* * * * Instantiation etc. ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -1095,7 +1095,7 @@ Yuk! data Implication = Implic { -- Invariants for a tree of implications: - -- see TcType Note [TcLevel and untouchable type variables] + -- see TcType Note [TcLevel invariants] ic_tclvl :: TcLevel, -- TcLevel of unification variables -- allocated /inside/ this implication @@ -1172,44 +1172,57 @@ data ImplicStatus | IC_Unsolved -- Neither of the above; might go either way --- | Does this implication have Given equalities? --- See Note [When does an implication have given equalities?] in GHC.Tc.Solver.Monad, --- which also explains why we need three options here. Also, see --- Note [Suppress redundant givens during error reporting] in GHC.Tc.Errors --- --- Stops floating | Suppresses Givens in errors --- ----------------------------------------------- --- NoGivenEqs NO | YES --- LocalGivenEqs NO | NO --- MaybeGivenEqs YES | NO --- --- Examples: --- --- NoGivenEqs: Eq a => ... --- (Show a, Num a) => ... --- forall a. a ~ Either Int Bool => ... --- See Note [Let-bound skolems] in GHC.Tc.Solver.Monad for --- that last one --- --- LocalGivenEqs: forall a b. F a ~ G b => ... --- forall a. F a ~ Int => ... --- --- MaybeGivenEqs: (a ~ b) => ... --- forall a. F a ~ b => ... --- --- The check is conservative. A MaybeGivenEqs might not have any equalities. --- A LocalGivenEqs might local equalities, but it definitely does not have non-local --- equalities. A NoGivenEqs definitely does not have equalities (except let-bound --- skolems). -data HasGivenEqs - = NoGivenEqs -- definitely no given equalities, - -- except by Note [Let-bound skolems] in GHC.Tc.Solver.Monad - | LocalGivenEqs -- might have Given equalities that affect only local skolems - -- e.g. forall a b. (a ~ F b) => ...; definitely no others - | MaybeGivenEqs -- might have any kind of Given equalities; no floating out - -- is possible. +data HasGivenEqs -- See Note [HasGivenEqs] + = NoGivenEqs -- Definitely no given equalities, + -- except by Note [Let-bound skolems] in GHC.Tc.Solver.Monad + | LocalGivenEqs -- Might have Given equalities, but only ones that affect only + -- local skolems e.g. forall a b. (a ~ F b) => ... + | MaybeGivenEqs -- Might have any kind of Given equalities; no floating out + -- is possible. deriving Eq +{- Note [HasGivenEqs] +~~~~~~~~~~~~~~~~~~~~~ +The GivenEqs data type describes the Given constraints of an implication constraint: + +* NoGivenEqs: definitely no Given equalities, except perhaps let-bound skolems + which don't count: see Note [Let-bound skolems] in GHC.Tc.Solver.Monad + Examples: forall a. Eq a => ... + forall a. (Show a, Num a) => ... + forall a. a ~ Either Int Bool => ... -- Let-bound skolem + +* LocalGivenEqs: definitely no Given equalities that would affect principal + types. But may have equalities that affect only skolems of this implication + (and hence do not affect princial types) + Examples: forall a. F a ~ Int => ... + forall a b. F a ~ G b => ... + +* MaybeGivenEqs: may have Given equalities that would affect principal + types + Examples: forall. (a ~ b) => ... + forall a. F a ~ b => ... + forall a. c a => ... -- The 'c' might be instantiated to (b ~) + forall a. C a b => .... + where class x~y => C a b + so there is an equality in the superclass of a Given + +The HasGivenEqs classifications affect two things: + +* Suppressing redundant givens during error reporting; see GHC.Tc.Errors + Note [Suppress redundant givens during error reporting] + +* Floating in approximateWC. + +Specifically, here's how it goes: + + Stops floating | Suppresses Givens in errors + in approximateWC | + ----------------------------------------------- + NoGivenEqs NO | YES + LocalGivenEqs NO | NO + MaybeGivenEqs YES | NO +-} + instance Outputable Implication where ppr (Implic { ic_tclvl = tclvl, ic_skols = skols , ic_given = given, ic_given_eqs = given_eqs ===================================== compiler/GHC/Tc/Utils/Monad.hs ===================================== @@ -1867,7 +1867,7 @@ It's distressingly delicate though: class constraints mentioned above. But we may /also/ end up taking constraints built at some inner level, and emitting them at some outer level, and then breaking the TcLevel invariants - See Note [TcLevel and untouchable type variables] in GHC.Tc.Utils.TcType + See Note [TcLevel invariants] in GHC.Tc.Utils.TcType So dropMisleading has a horridly ad-hoc structure. It keeps only /insoluble/ flat constraints (which are unlikely to very visibly trip ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -80,7 +80,7 @@ module GHC.Tc.Utils.TcMType ( --------------------------------- -- Promotion, defaulting, skolemisation - defaultTyVar, promoteTyVar, promoteTyVarSet, + defaultTyVar, promoteTyVarTo, promoteTyVarSet, quantifyTyVars, isQuantifiableTv, skolemiseUnboundMetaTyVar, zonkAndSkolemise, skolemiseQuantifiedTyVar, @@ -965,12 +965,18 @@ writeMetaTyVarRef tyvar ref ty ; writeTcRef ref (Indirect ty) } -- Everything from here on only happens if DEBUG is on + -- Need to zonk 'ty' because we may only recently have promoted + -- its free meta-tyvars (see Solver.Interact.tryToSolveByUnification) | otherwise = do { meta_details <- readMutVar ref; -- Zonk kinds to allow the error check to work ; zonked_tv_kind <- zonkTcType tv_kind - ; zonked_ty_kind <- zonkTcType ty_kind - ; let kind_check_ok = tcIsConstraintKind zonked_tv_kind + ; zonked_ty <- zonkTcType ty + ; let zonked_ty_kind = tcTypeKind zonked_ty + zonked_ty_lvl = tcTypeLevel zonked_ty + level_check_ok = not (zonked_ty_lvl `strictlyDeeperThan` tv_lvl) + level_check_msg = ppr zonked_ty_lvl $$ ppr tv_lvl $$ ppr tyvar $$ ppr ty + kind_check_ok = tcIsConstraintKind zonked_tv_kind || tcEqKind zonked_ty_kind zonked_tv_kind -- Hack alert! tcIsConstraintKind: see GHC.Tc.Gen.HsType -- Note [Extra-constraint holes in partial type signatures] @@ -995,13 +1001,9 @@ writeMetaTyVarRef tyvar ref ty ; writeMutVar ref (Indirect ty) } where tv_kind = tyVarKind tyvar - ty_kind = tcTypeKind ty tv_lvl = tcTyVarLevel tyvar - ty_lvl = tcTypeLevel ty - level_check_ok = not (ty_lvl `strictlyDeeperThan` tv_lvl) - level_check_msg = ppr ty_lvl $$ ppr tv_lvl $$ ppr tyvar $$ ppr ty double_upd_msg details = hang (text "Double update of meta tyvar") 2 (ppr tyvar $$ ppr details) @@ -1570,8 +1572,8 @@ than the ambient level (see Note [Use level numbers of quantification]). Note [Use level numbers for quantification] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The level numbers assigned to metavariables are very useful. Not only -do they track touchability (Note [TcLevel and untouchable type variables] -in GHC.Tc.Utils.TcType), but they also allow us to determine which variables to +do they track touchability (Note [TcLevel invariants] in GHC.Tc.Utils.TcType), +but they also allow us to determine which variables to generalise. The rule is this: When generalising, quantify only metavariables with a TcLevel greater @@ -2005,29 +2007,29 @@ a \/\a in the final result but all the occurrences of a will be zonked to () * * ********************************************************************* -} -promoteTyVar :: TcTyVar -> TcM Bool +promoteTyVarTo :: TcLevel -> TcTyVar -> TcM Bool -- When we float a constraint out of an implication we must restore --- invariant (WantedInv) in Note [TcLevel and untouchable type variables] in GHC.Tc.Utils.TcType +-- invariant (WantedInv) in Note [TcLevel invariants] in GHC.Tc.Utils.TcType -- Return True <=> we did some promotion -- Also returns either the original tyvar (no promotion) or the new one -- See Note [Promoting unification variables] -promoteTyVar tv - = do { tclvl <- getTcLevel - ; if (isFloatedTouchableMetaTyVar tclvl tv) - then do { cloned_tv <- cloneMetaTyVar tv - ; let rhs_tv = setMetaTyVarTcLevel cloned_tv tclvl - ; writeMetaTyVar tv (mkTyVarTy rhs_tv) - ; traceTc "promoteTyVar" (ppr tv <+> text "-->" <+> ppr rhs_tv) - ; return True } - else do { traceTc "promoteTyVar: no" (ppr tv) - ; return False } } +promoteTyVarTo tclvl tv + | isFloatedTouchableMetaTyVar tclvl tv + = do { cloned_tv <- cloneMetaTyVar tv + ; let rhs_tv = setMetaTyVarTcLevel cloned_tv tclvl + ; writeMetaTyVar tv (mkTyVarTy rhs_tv) + ; traceTc "promoteTyVar" (ppr tv <+> text "-->" <+> ppr rhs_tv) + ; return True } + | otherwise + = do { traceTc "promoteTyVar: no" (ppr tv) + ; return False } -- Returns whether or not *any* tyvar is defaulted promoteTyVarSet :: TcTyVarSet -> TcM Bool promoteTyVarSet tvs - = do { bools <- mapM promoteTyVar (nonDetEltsUniqSet tvs) + = do { tclvl <- getTcLevel + ; bools <- mapM (promoteTyVarTo tclvl) (nonDetEltsUniqSet tvs) -- Non-determinism is OK because order of promotion doesn't matter - ; return (or bools) } ===================================== compiler/GHC/Tc/Utils/TcType.hs ===================================== @@ -33,7 +33,7 @@ module GHC.Tc.Utils.TcType ( -- TcLevel TcLevel(..), topTcLevel, pushTcLevel, isTopTcLevel, - strictlyDeeperThan, sameDepthAs, + strictlyDeeperThan, deeperThanOrSame, sameDepthAs, tcTypeLevel, tcTyVarLevel, maxTcLevel, promoteSkolem, promoteSkolemX, promoteSkolemsX, -------------------------------- @@ -45,7 +45,7 @@ module GHC.Tc.Utils.TcType ( isAmbiguousTyVar, isCycleBreakerTyVar, metaTyVarRef, metaTyVarInfo, isFlexi, isIndirect, isRuntimeUnkSkol, metaTyVarTcLevel, setMetaTyVarTcLevel, metaTyVarTcLevel_maybe, - isTouchableMetaTyVar, + isTouchableInfo, isTouchableMetaTyVar, isFloatedTouchableMetaTyVar, findDupTyVarTvs, mkTyVarNamePairs, @@ -516,7 +516,7 @@ data TcTyVarDetails | MetaTv { mtv_info :: MetaInfo , mtv_ref :: IORef MetaDetails - , mtv_tclvl :: TcLevel } -- See Note [TcLevel and untouchable type variables] + , mtv_tclvl :: TcLevel } -- See Note [TcLevel invariants] vanillaSkolemTv, superSkolemTv :: TcTyVarDetails -- See Note [Binding when looking up instances] in GHC.Core.InstEnv @@ -574,13 +574,14 @@ instance Outputable MetaInfo where ********************************************************************* -} newtype TcLevel = TcLevel Int deriving( Eq, Ord ) - -- See Note [TcLevel and untouchable type variables] for what this Int is + -- See Note [TcLevel invariants] for what this Int is -- See also Note [TcLevel assignment] {- -Note [TcLevel and untouchable type variables] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [TcLevel invariants] +~~~~~~~~~~~~~~~~~~~~~~~~~ * Each unification variable (MetaTv) + and skolem (SkolemTv) and each Implication has a level number (of type TcLevel) @@ -602,9 +603,8 @@ Note [TcLevel and untouchable type variables] LESS THAN OR EQUAL TO the ic_tclvl of I See Note [WantedInv] -* A unification variable is *touchable* if its level number - is EQUAL TO that of its immediate parent implication, - and it is a TauTv or TyVarTv (but /not/ CycleBreakerTv) +The level of a MetaTyVar also governs its untouchability. See +Note [Unification preconditions] in GHC.Tc.Utils.Unify. Note [WantedInv] ~~~~~~~~~~~~~~~~ @@ -679,13 +679,17 @@ strictlyDeeperThan :: TcLevel -> TcLevel -> Bool strictlyDeeperThan (TcLevel tv_tclvl) (TcLevel ctxt_tclvl) = tv_tclvl > ctxt_tclvl +deeperThanOrSame :: TcLevel -> TcLevel -> Bool +deeperThanOrSame (TcLevel tv_tclvl) (TcLevel ctxt_tclvl) + = tv_tclvl >= ctxt_tclvl + sameDepthAs :: TcLevel -> TcLevel -> Bool sameDepthAs (TcLevel ctxt_tclvl) (TcLevel tv_tclvl) = ctxt_tclvl == tv_tclvl -- NB: invariant ctxt_tclvl >= tv_tclvl -- So <= would be equivalent checkTcLevelInvariant :: TcLevel -> TcLevel -> Bool --- Checks (WantedInv) from Note [TcLevel and untouchable type variables] +-- Checks (WantedInv) from Note [TcLevel invariants] checkTcLevelInvariant (TcLevel ctxt_tclvl) (TcLevel tv_tclvl) = ctxt_tclvl >= tv_tclvl ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -37,7 +37,7 @@ module GHC.Tc.Utils.Unify ( matchExpectedFunKind, matchActualFunTySigma, matchActualFunTysRho, - metaTyVarUpdateOK, occCheckForErrors, MetaTyVarUpdateResult(..), + occCheckForErrors, MetaTyVarUpdateResult(..), checkTyVarEq, checkTyFamEq, checkTypeEq, AreTypeFamiliesOK(..) ) where @@ -1169,17 +1169,17 @@ uType t_or_k origin orig_ty1 orig_ty2 -- so that type variables tend to get filled in with -- the most informative version of the type go (TyVarTy tv1) ty2 - = do { lookup_res <- lookupTcTyVar tv1 + = do { lookup_res <- isFilledMetaTyVar_maybe tv1 ; case lookup_res of - Filled ty1 -> do { traceTc "found filled tyvar" (ppr tv1 <+> text ":->" <+> ppr ty1) - ; go ty1 ty2 } - Unfilled _ -> uUnfilledVar origin t_or_k NotSwapped tv1 ty2 } + Just ty1 -> do { traceTc "found filled tyvar" (ppr tv1 <+> text ":->" <+> ppr ty1) + ; go ty1 ty2 } + Nothing -> uUnfilledVar origin t_or_k NotSwapped tv1 ty2 } go ty1 (TyVarTy tv2) - = do { lookup_res <- lookupTcTyVar tv2 + = do { lookup_res <- isFilledMetaTyVar_maybe tv2 ; case lookup_res of - Filled ty2 -> do { traceTc "found filled tyvar" (ppr tv2 <+> text ":->" <+> ppr ty2) - ; go ty1 ty2 } - Unfilled _ -> uUnfilledVar origin t_or_k IsSwapped tv2 ty1 } + Just ty2 -> do { traceTc "found filled tyvar" (ppr tv2 <+> text ":->" <+> ppr ty2) + ; go ty1 ty2 } + Nothing -> uUnfilledVar origin t_or_k IsSwapped tv2 ty1 } -- See Note [Expanding synonyms during unification] go ty1@(TyConApp tc1 []) (TyConApp tc2 []) @@ -1433,10 +1433,11 @@ uUnfilledVar2 origin t_or_k swapped tv1 ty2 ; go dflags cur_lvl } where go dflags cur_lvl - | canSolveByUnification cur_lvl tv1 ty2 + | isTouchableMetaTyVar cur_lvl tv1 + , canSolveByUnification (metaTyVarInfo tv1) ty2 + , MTVU_OK {} <- checkTyVarEq dflags NoTypeFamilies tv1 ty2 -- See Note [Prevent unification with type families] about the NoTypeFamilies: - , MTVU_OK ty2' <- metaTyVarUpdateOK dflags NoTypeFamilies tv1 ty2 - = do { co_k <- uType KindLevel kind_origin (tcTypeKind ty2') (tyVarKind tv1) + = do { co_k <- uType KindLevel kind_origin (tcTypeKind ty2) (tyVarKind tv1) ; traceTc "uUnfilledVar2 ok" $ vcat [ ppr tv1 <+> dcolon <+> ppr (tyVarKind tv1) , ppr ty2 <+> dcolon <+> ppr (tcTypeKind ty2) @@ -1446,8 +1447,8 @@ uUnfilledVar2 origin t_or_k swapped tv1 ty2 -- Only proceed if the kinds match -- NB: tv1 should still be unfilled, despite the kind unification -- because tv1 is not free in ty2 (or, hence, in its kind) - then do { writeMetaTyVar tv1 ty2' - ; return (mkTcNomReflCo ty2') } + then do { writeMetaTyVar tv1 ty2 + ; return (mkTcNomReflCo ty2) } else defer } -- This cannot be solved now. See GHC.Tc.Solver.Canonical -- Note [Equalities with incompatible kinds] @@ -1464,6 +1465,22 @@ uUnfilledVar2 origin t_or_k swapped tv1 ty2 defer = unSwap swapped (uType_defer t_or_k origin) ty1 ty2 +canSolveByUnification :: MetaInfo -> TcType -> Bool +-- See Note [Unification preconditions, (TYVAR-TV)] +canSolveByUnification info xi + = case info of + CycleBreakerTv -> False + TyVarTv -> case tcGetTyVar_maybe xi of + Nothing -> False + Just tv -> case tcTyVarDetails tv of + MetaTv { mtv_info = info } + -> case info of + TyVarTv -> True + _ -> False + SkolemTv {} -> True + RuntimeUnk -> True + _ -> True + swapOverTyVars :: Bool -> TcTyVar -> TcTyVar -> Bool swapOverTyVars is_given tv1 tv2 -- See Note [Unification variables on the left] @@ -1507,8 +1524,94 @@ lhsPriority tv TauTv -> 2 RuntimeUnkTv -> 3 -{- Note [TyVar/TyVar orientation] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [Unification preconditions] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Question: given a homogeneous equality (alpha ~# ty), when is it OK to +unify alpha := ty? + +This note only applied to /homogeneous/ equalities, in which both +sides have the same kind, + +There are three reasons not to unify: + +1. (SKOL-ESC) Skolem-escape + Consider the constraint + forall[2] a[2]. alpha[1] ~ Maybe a[2] + If we unify alpha := Maybe a, the skolem 'a' may escape its scope. + The level alpha[1] says that alpha may be used outside this constraint, + where 'a' is not in scope at all. So we must not unify. + + Bottom line: when looking at a constraint alpha[n] := ty, do not unify + if any free varaible of 'ty' has level deeper (greater) than n + +2. (UNTOUCHABLE) Untouchable unification variables + Consider the constraint + forall[2] a[2]. b[1] ~ Int => alpha[1] ~ Int + There is no (SKOL-ESC) problem with unifying alpha := Int, but it might + not be the principal solution. Perhaps the "right" solution is alpha := b. + We simply can't tell. See "OutsideIn(X): modular type inference with local + assumptions", section 2.2. We say that alpha[1 is "untouchable" inside + this implication + + Bottom line: at amibient level 'l', when looking at a constraint + alpha[n] ~ ty, do not unify alpha := ty if there are any given equalities + between levels 'n' and 'l'. + + Exactly what is a "given equality" for the purpose of (UNTOUCHABLE)? + Answer: see Note [Tracking Given equalities] in GHC.Tc.Solver.Monad + +3. (TYVAR-TV) Unifying TyVarTvs and CycleBreakerTvs + This precondition looks at the MetaInfo of the unification variable: + + * TyVarTv: When considering alpha{tyv} ~ ty, if alpha{tyv} is a + TyVarTv it can only unify with a type variable, not with a + structured type. So if 'ty' is a structured type, such as (Maybe x), + don't unify. + + * CycleBreakerTv: never unified, except by restoreTyVarCycles. + + +Needless to say, all three have wrinkles: + +* (SKOL-ESC) Promotion. Given alpha[n] ~ ty, what if beta[k] is free + in 'ty', where beta is a unification variable, and k>n? 'beta' + stands for a monotype, and since it is part of a level-n type + (equal to alpha[n]), we must /promote/ beta to level n. Just make + up a fresh gamma[n], and unify beta[k] := gamma[n]. + +* (TYVAR-TV) Unification variables. Suppose alpha[tyv,n] is a level-n + TyVarTv (see Note [Signature skolems] in GHC.Tc.Types.TcType)? Now + consider alpha[tyv,n] ~ Bool. We don't want to unify because that + would break the TyVarTv invariant. + + What about alpha[tyv,n] ~ beta[tau,n], where beta is an ordinary + TauTv? Again, don't unify, because beta might later be unified + with, say Bool. (If levels permit, we reverse the orientation here; + see Note [TyVar/TyVar orientation].) + +* (UNTOUCHABLE) Untouchability. When considering (alpha[n] ~ ty), how + do we know whether there are any given equalities between level n + and the ambient level? We answer in two ways: + + * In the eager unifier, we only unify if l=n. If not, alpha may be + untouchable, and defer to the constraint solver. This check is + made in GHC.Tc.Utils.uUnifilledVar2, in the guard + isTouchableMetaTyVar. + + * In the constraint solver, we track where Given equalities occur + and use that to guard unification in GHC.Tc.Solver.Canonical.unifyTest + More details in Note [Tracking Given equalities] in GHC.Tc.Solver.Monad + + Historical note: in the olden days (pre 2021) the constraint solver + also used to unify only if l=n. Equalities were "floated" out of the + implication in a separate step, so that they would become touchable. + But the float/don't-float question turned out to be very delicate, + as you can see if you look at the long series of Notes associated with + GHC.Tc.Solver.floatEqualities, around Nov 2020. It's much easier + to unify in-place, with no floating. + +Note [TyVar/TyVar orientation] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Given (a ~ b), should we orient the CEqCan as (a~b) or (b~a)? This is a surprisingly tricky question! This is invariant (TyEq:TV). @@ -1616,8 +1719,8 @@ inert guy, so we get inert item: c ~ a And now the cycle just repeats -Note [Eliminate younger unification variables] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Historical Note [Eliminate younger unification variables] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Given a choice of unifying alpha := beta or beta := alpha we try, if possible, to eliminate the "younger" one, as determined @@ -1631,36 +1734,11 @@ This is a performance optimisation only. It turns out to fix It's simple to implement (see nicer_to_update_tv2 in swapOverTyVars). But, to my surprise, it didn't seem to make any significant difference to the compiler's performance, so I didn't take it any further. Still -it seemed to too nice to discard altogether, so I'm leaving these +it seemed too nice to discard altogether, so I'm leaving these notes. SLPJ Jan 18. --} --- @trySpontaneousSolve wi@ solves equalities where one side is a --- touchable unification variable. --- Returns True <=> spontaneous solve happened -canSolveByUnification :: TcLevel -> TcTyVar -> TcType -> Bool -canSolveByUnification tclvl tv xi - | isTouchableMetaTyVar tclvl tv - = case metaTyVarInfo tv of - TyVarTv -> is_tyvar xi - _ -> True - - | otherwise -- Untouchable - = False - where - is_tyvar xi - = case tcGetTyVar_maybe xi of - Nothing -> False - Just tv -> case tcTyVarDetails tv of - MetaTv { mtv_info = info } - -> case info of - TyVarTv -> True - _ -> False - SkolemTv {} -> True - RuntimeUnk -> True - -{- Note [Prevent unification with type families] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [Prevent unification with type families] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We prevent unification with type families because of an uneasy compromise. It's perfectly sound to unify with type families, and it even improves the error messages in the testsuite. It also modestly improves performance, at @@ -1764,35 +1842,6 @@ type-checking (with wrappers, etc.). Types get desugared very differently, causing this wibble in behavior seen here. -} -data LookupTyVarResult -- The result of a lookupTcTyVar call - = Unfilled TcTyVarDetails -- SkolemTv or virgin MetaTv - | Filled TcType - -lookupTcTyVar :: TcTyVar -> TcM LookupTyVarResult -lookupTcTyVar tyvar - | MetaTv { mtv_ref = ref } <- details - = do { meta_details <- readMutVar ref - ; case meta_details of - Indirect ty -> return (Filled ty) - Flexi -> do { is_touchable <- isTouchableTcM tyvar - -- Note [Unifying untouchables] - ; if is_touchable then - return (Unfilled details) - else - return (Unfilled vanillaSkolemTv) } } - | otherwise - = return (Unfilled details) - where - details = tcTyVarDetails tyvar - -{- -Note [Unifying untouchables] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We treat an untouchable type variable as if it was a skolem. That -ensures it won't unify with anything. It's a slight hack, because -we return a made-up TcTyVarDetails, but I think it works smoothly. --} - -- | Breaks apart a function kind into its pieces. matchExpectedFunKind :: Outputable fun @@ -1919,51 +1968,6 @@ instance Outputable AreTypeFamiliesOK where ppr YesTypeFamilies = text "YesTypeFamilies" ppr NoTypeFamilies = text "NoTypeFamilies" -metaTyVarUpdateOK :: DynFlags - -> AreTypeFamiliesOK -- allow type families in RHS? - -> TcTyVar -- tv :: k1 - -> TcType -- ty :: k2 - -> MetaTyVarUpdateResult TcType -- possibly-expanded ty --- (metaTyVarUpdateOK tv ty) --- Checks that the equality tv~ty is OK to be used to rewrite --- other equalities. Equivalently, checks the conditions for CEqCan --- (a) that tv doesn't occur in ty (occurs check) --- (b) that ty does not have any foralls or (perhaps) type functions --- (c) that ty does not have any blocking coercion holes --- See Note [Equalities with incompatible kinds] in "GHC.Tc.Solver.Canonical" --- --- Used in two places: --- - In the eager unifier: uUnfilledVar2 --- - In the canonicaliser: GHC.Tc.Solver.Canonical.canEqTyVar2 --- Note that in the latter case tv is not necessarily a meta-tyvar, --- despite the name of this function. - --- We have two possible outcomes: --- (1) Return the type to update the type variable with, --- [we know the update is ok] --- (2) Return Nothing, --- [the update might be dodgy] --- --- Note that "Nothing" does not mean "definite error". For example --- type family F a --- type instance F Int = Int --- consider --- a ~ F a --- This is perfectly reasonable, if we later get a ~ Int. For now, though, --- we return Nothing, leaving it to the later constraint simplifier to --- sort matters out. --- --- See Note [Refactoring hazard: metaTyVarUpdateOK] - -metaTyVarUpdateOK dflags ty_fam_ok tv ty - = case checkTyVarEq dflags ty_fam_ok tv ty of - MTVU_OK _ -> MTVU_OK ty - MTVU_Bad -> MTVU_Bad -- forall, predicate, type function - MTVU_HoleBlocker -> MTVU_HoleBlocker -- coercion hole - MTVU_Occurs -> case occCheckExpand [tv] ty of - Just expanded_ty -> MTVU_OK expanded_ty - Nothing -> MTVU_Occurs - checkTyVarEq :: DynFlags -> AreTypeFamiliesOK -> TcTyVar -> TcType -> MetaTyVarUpdateResult () checkTyVarEq dflags ty_fam_ok tv ty = inline checkTypeEq dflags ty_fam_ok (TyVarLHS tv) ty @@ -1987,6 +1991,14 @@ checkTypeEq :: DynFlags -> AreTypeFamiliesOK -> CanEqLHS -> TcType -- (d) a blocking coercion hole -- (e) an occurrence of the LHS (occurs check) -- +-- Note that an occurs-check does not mean "definite error". For example +-- type family F a +-- type instance F Int = Int +-- consider +-- b0 ~ F b0 +-- This is perfectly reasonable, if we later get b0 ~ Int. But we +-- certainly can't unify b0 := F b0 +-- -- For (a), (b), and (c) we check only the top level of the type, NOT -- inside the kinds of variables it mentions. For (d) we look deeply -- in coercions when the LHS is a tyvar (but skip coercions for type family @@ -1994,7 +2006,7 @@ checkTypeEq :: DynFlags -> AreTypeFamiliesOK -> CanEqLHS -> TcType -- -- checkTypeEq is called from -- * checkTyFamEq, checkTyVarEq (which inline it to specialise away the --- case-analysis on 'lhs' +-- case-analysis on 'lhs') -- * checkEqCanLHSFinish, which does not know the form of 'lhs' checkTypeEq dflags ty_fam_ok lhs ty = go ty ===================================== testsuite/tests/ghci.debugger/scripts/break012.stdout ===================================== @@ -1,14 +1,14 @@ Stopped in Main.g, break012.hs:5:10-18 -_result :: (p, a1 -> a1, (), a -> a -> a) = _ -a :: p = _ -b :: a2 -> a2 = _ +_result :: (a1, a2 -> a2, (), a -> a -> a) = _ +a :: a1 = _ +b :: a3 -> a3 = _ c :: () = _ d :: a -> a -> a = _ -a :: p -b :: a2 -> a2 +a :: a1 +b :: a3 -> a3 c :: () d :: a -> a -> a -a = (_t1::p) -b = (_t2::a2 -> a2) +a = (_t1::a1) +b = (_t2::a3 -> a3) c = (_t3::()) d = (_t4::a -> a -> a) ===================================== testsuite/tests/partial-sigs/should_compile/T10403.stderr ===================================== @@ -14,35 +14,18 @@ T10403.hs:15:12: warning: [-Wpartial-type-signatures (in -Wdefault)] • In the type signature: h1 :: _ => _ T10403.hs:19:7: warning: [-Wpartial-type-signatures (in -Wdefault)] - • Found type wildcard ‘_’ standing for ‘(a -> a1) -> f0 a -> H f0’ - Where: ‘f0’ is an ambiguous type variable + • Found type wildcard ‘_’ + standing for ‘(a -> a1) -> B t0 a -> H (B t0)’ + Where: ‘t0’ is an ambiguous type variable ‘a1’, ‘a’ are rigid type variables bound by - the inferred type of h2 :: (a -> a1) -> f0 a -> H f0 + the inferred type of h2 :: (a -> a1) -> B t0 a -> H (B t0) at T10403.hs:22:1-41 • In the type signature: h2 :: _ -T10403.hs:22:15: warning: [-Wdeferred-type-errors (in -Wdefault)] - • Ambiguous type variable ‘f0’ arising from a use of ‘fmap’ - prevents the constraint ‘(Functor f0)’ from being solved. - Relevant bindings include - b :: f0 a (bound at T10403.hs:22:6) - h2 :: (a -> a1) -> f0 a -> H f0 (bound at T10403.hs:22:1) - Probable fix: use a type annotation to specify what ‘f0’ should be. - These potential instances exist: - instance Functor IO -- Defined in ‘GHC.Base’ - instance Functor (B t) -- Defined at T10403.hs:10:10 - instance Functor I -- Defined at T10403.hs:6:10 - ...plus five others - ...plus two instances involving out-of-scope types - (use -fprint-potential-instances to see them all) - • In the second argument of ‘(.)’, namely ‘fmap (const ())’ - In the expression: (H . fmap (const ())) (fmap f b) - In an equation for ‘h2’: h2 f b = (H . fmap (const ())) (fmap f b) - T10403.hs:28:8: warning: [-Wdeferred-type-errors (in -Wdefault)] - • Couldn't match type ‘f0’ with ‘B t’ + • Couldn't match type ‘t0’ with ‘t’ Expected: H (B t) - Actual: H f0 + Actual: H (B t0) because type variable ‘t’ would escape its scope This (rigid, skolem) type variable is bound by the type signature for: ===================================== testsuite/tests/partial-sigs/should_compile/T14715.stderr ===================================== @@ -1,12 +1,11 @@ T14715.hs:13:53: warning: [-Wpartial-type-signatures (in -Wdefault)] - • Found extra-constraints wildcard standing for - ‘Reduce (LiftOf zq) zq’ - Where: ‘zq’ is a rigid type variable bound by + • Found extra-constraints wildcard standing for ‘Reduce z zq’ + Where: ‘z’, ‘zq’ are rigid type variables bound by the inferred type of - bench_mulPublic :: (z ~ LiftOf zq, Reduce (LiftOf zq) zq) => + bench_mulPublic :: (z ~ LiftOf zq, Reduce z zq) => Cyc zp -> Cyc z -> IO (zp, zq) - at T14715.hs:13:32-33 + at T14715.hs:13:27-33 • In the type signature: - bench_mulPublic :: forall z zp zq. - (z ~ LiftOf zq, _) => Cyc zp -> Cyc z -> IO (zp, zq) + bench_mulPublic :: forall z zp zq. (z ~ LiftOf zq, _) => + Cyc zp -> Cyc z -> IO (zp, zq) ===================================== testsuite/tests/partial-sigs/should_fail/ScopedNamedWildcardsBad.stderr ===================================== @@ -1,6 +1,11 @@ -ScopedNamedWildcardsBad.hs:8:21: error: +ScopedNamedWildcardsBad.hs:11:15: error: • Couldn't match expected type ‘Bool’ with actual type ‘Char’ - • In the first argument of ‘not’, namely ‘x’ - In the expression: not x - In an equation for ‘v’: v = not x + • In the first argument of ‘g’, namely ‘'x'’ + In the expression: g 'x' + In the expression: + let + v = not x + g :: _a -> _a + g x = x + in (g 'x') ===================================== testsuite/tests/typecheck/should_fail/ExpandSynsFail2.stderr ===================================== @@ -1,6 +1,6 @@ ExpandSynsFail2.hs:19:37: error: - • Couldn't match type ‘Int’ with ‘Bool’ + • Couldn't match type ‘Bool’ with ‘Int’ Expected: ST s Foo Actual: MyBarST s Type synonyms expanded: ===================================== testsuite/tests/typecheck/should_fail/T7453.stderr ===================================== @@ -1,6 +1,8 @@ -T7453.hs:10:30: error: - • Couldn't match expected type ‘t’ with actual type ‘p’ +T7453.hs:9:15: error: + • Couldn't match type ‘t’ with ‘p’ + Expected: Id t + Actual: Id p ‘t’ is a rigid type variable bound by the type signature for: z :: forall t. Id t @@ -8,17 +10,29 @@ T7453.hs:10:30: error: ‘p’ is a rigid type variable bound by the inferred type of cast1 :: p -> a at T7453.hs:(7,1)-(10,30) - • In the first argument of ‘Id’, namely ‘v’ - In the expression: Id v - In an equation for ‘aux’: aux = Id v + • In the expression: aux + In an equation for ‘z’: + z = aux + where + aux = Id v + In an equation for ‘cast1’: + cast1 v + = runId z + where + z :: Id t + z = aux + where + aux = Id v • Relevant bindings include - aux :: Id t (bound at T7453.hs:10:21) + aux :: Id p (bound at T7453.hs:10:21) z :: Id t (bound at T7453.hs:9:11) v :: p (bound at T7453.hs:7:7) cast1 :: p -> a (bound at T7453.hs:7:1) -T7453.hs:16:33: error: - • Couldn't match expected type ‘t1’ with actual type ‘p’ +T7453.hs:15:15: error: + • Couldn't match type ‘t1’ with ‘p’ + Expected: () -> t1 + Actual: () -> p ‘t1’ is a rigid type variable bound by the type signature for: z :: forall t1. () -> t1 @@ -26,11 +40,21 @@ T7453.hs:16:33: error: ‘p’ is a rigid type variable bound by the inferred type of cast2 :: p -> t at T7453.hs:(13,1)-(16,33) - • In the first argument of ‘const’, namely ‘v’ - In the expression: const v - In an equation for ‘aux’: aux = const v + • In the expression: aux + In an equation for ‘z’: + z = aux + where + aux = const v + In an equation for ‘cast2’: + cast2 v + = z () + where + z :: () -> t + z = aux + where + aux = const v • Relevant bindings include - aux :: b -> t1 (bound at T7453.hs:16:21) + aux :: forall {b}. b -> p (bound at T7453.hs:16:21) z :: () -> t1 (bound at T7453.hs:15:11) v :: p (bound at T7453.hs:13:7) cast2 :: p -> t (bound at T7453.hs:13:1) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/73748d4d0630157420173a5f695ecb9c1102ff28 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/73748d4d0630157420173a5f695ecb9c1102ff28 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Dec 14 16:09:26 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Mon, 14 Dec 2020 11:09:26 -0500 Subject: [Git][ghc/ghc][wip/T18987] 88 commits: [Sized Cmm] properly retain sizes. Message-ID: <5fd78e3696481_6b216741854148928f@gitlab.mail> Simon Peyton Jones pushed to branch wip/T18987 at Glasgow Haskell Compiler / GHC Commits: be5d74ca by Moritz Angermann at 2020-11-26T16:00:32-05:00 [Sized Cmm] properly retain sizes. This replaces all Word<N> = W<N># Word# and Int<N> = I<N># Int# with Word<N> = W<N># Word<N># and Int<N> = I<N># Int<N>#, thus providing us with properly sized primitives in the codegenerator instead of pretending they are all full machine words. This came up when implementing darwinpcs for arm64. The darwinpcs reqires us to pack function argugments in excess of registers on the stack. While most procedure call standards (pcs) assume arguments are just passed in 8 byte slots; and thus the caller does not know the exact signature to make the call, darwinpcs requires us to adhere to the prototype, and thus have the correct sizes. If we specify CInt in the FFI call, it should correspond to the C int, and not just be Word sized, when it's only half the size. This does change the expected output of T16402 but the new result is no less correct as it eliminates the narrowing (instead of the `and` as was previously done). Bumps the array, bytestring, text, and binary submodules. Co-Authored-By: Ben Gamari <ben at well-typed.com> Metric Increase: T13701 T14697 - - - - - a84e53f9 by Andreas Klebinger at 2020-11-26T16:00:32-05:00 RTS: Fix failed inlining of copy_tag. On windows using gcc-10 gcc failed to inline copy_tag into evacuate. To fix this we now set the always_inline attribute for the various copy* functions in Evac.c. The main motivation here is not the overhead of the function call, but rather that this allows the code to "specialize" for the size of the closure we copy which is often known at compile time. An earlier commit also tried to avoid evacuate_large inlining. But didn't quite succeed. So I also marked evacuate_large as noinline. Fixes #12416 - - - - - cdbd16f5 by Sylvain Henry at 2020-11-26T16:00:33-05:00 Fix toArgRep to support 64-bit reps on all systems [This is @Ericson2314 writing a commit message for @hsyl20's patch.] (Progress towards #11953, #17377, #17375) `Int64Rep` and `Word64Rep` are currently broken on 64-bit systems. This is because they should use "native arg rep" but instead use "large arg rep" as they do on 32-bit systems, which is either a non-concept or a 128-bit rep depending on one's vantage point. Now, these reps currently aren't used during 64-bit compilation, so the brokenness isn't observed, but I don't think that constitutes reasons not to fix it. Firstly, the linked issues there is a clearly expressed desire to use explicit-bitwidth constructs in more places. Secondly, per [1], there are other bugs that *do* manifest from not threading explicit-bitwidth information all the way through the compilation pipeline. One can therefore view this as one piece of the larger effort to do that, improve ergnomics, and squash remaining bugs. Also, this is needed for !3658. I could just merge this as part of that, but I'm keen on merging fixes "as they are ready" so the fixes that aren't ready are isolated and easier to debug. [1]: https://mail.haskell.org/pipermail/ghc-devs/2020-October/019332.html - - - - - a9378e69 by Tim Barnes at 2020-11-26T16:00:34-05:00 Set dynamic users-guide TOC spacing (fixes #18554) - - - - - 86a59d93 by Ben Gamari at 2020-11-26T16:00:34-05:00 rts: Use RTS_LIKELY in CHECK Most compilers probably already infer that `barf` diverges but it nevertheless doesn't hurt to be explicit. - - - - - 5757e82b by Matthew Pickering at 2020-11-26T16:00:35-05:00 Remove special case for GHC.ByteCode.Instr This was added in https://github.com/nomeata/ghc-heap-view/commit/34935206e51b9c86902481d84d2f368a6fd93423 GHC.ByteCode.Instr.BreakInfo no longer exists so the special case is dead code. Any check like this can be easily dealt with in client code. - - - - - d9c8b5b4 by Matthew Pickering at 2020-11-26T16:00:35-05:00 Split Up getClosureDataFromHeapRep Motivation 1. Don't enforce the repeated decoding of an info table, when the client can cache it (ghc-debug) 2. Allow the constructor information decoding to be overridden, this casues segfaults in ghc-debug - - - - - 3e3555cc by Andreas Klebinger at 2020-11-26T16:00:35-05:00 RegAlloc: Add missing raPlatformfield to RegAllocStatsSpill Fixes #18994 Co-Author: Benjamin Maurer <maurer.benjamin at gmail.com> - - - - - a1a75aa9 by Ben Gamari at 2020-11-27T06:20:41-05:00 rts: Allocate MBlocks with MAP_TOP_DOWN on Windows As noted in #18991, we would previously allocate heap in low memory. Due to this the linker, which typically *needs* low memory, would end up competing with the heap. In longer builds we end up running out of low memory entirely, leading to linking failures. - - - - - 75fc1ed5 by Sylvain Henry at 2020-11-28T15:40:23-05:00 Hadrian: fix detection of ghc-pkg for cross-compilers - - - - - 7cb5df96 by Sylvain Henry at 2020-11-28T15:40:23-05:00 hadrian: fix ghc-pkg uses (#17601) Make sure ghc-pkg doesn't read the compiler "settings" file by passing --no-user-package-db. - - - - - e3fd4226 by Ben Gamari at 2020-11-28T15:40:23-05:00 gitlab-ci: Introduce a nightly cross-compilation job This adds a job to test cross-compilation from x86-64 to AArch64 with Hadrian. Fixes #18234 - - - - - 698d3d96 by Ben Gamari at 2020-11-28T15:41:00-05:00 gitlab-ci: Only deploy GitLab Pages in ghc/ghc> The deployments are quite large and yet are currently only served for the ghc/ghc> project. - - - - - 625726f9 by David Eichmann at 2020-11-28T15:41:37-05:00 ghc-heap: partial TSO/STACK decoding Co-authored-by: Sven Tennie <sven.tennie at gmail.com> Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> Co-authored-by: Ben Gamari <bgamari.foss at gmail.com> - - - - - 22ea9c29 by Andreas Klebinger at 2020-11-28T15:42:13-05:00 Small optimization to CmmSink. Inside `regsUsedIn` we can avoid some thunks by specializing the recursion. In particular we avoid the thunk for `(f e z)` in the MachOp/Load branches, where we know this will evaluate to z. Reduces allocations for T3294 by ~1%. - - - - - bba42c62 by John Ericson at 2020-11-28T15:42:49-05:00 Make primop handler indentation more consistent - - - - - c82bc8e9 by John Ericson at 2020-11-28T15:42:49-05:00 Cleanup some primop constructor names Harmonize the internal (big sum type) names of the native vs fixed-sized number primops a bit. (Mainly by renaming the former.) No user-facing names are changed. - - - - - ae14f160 by Ben Gamari at 2020-11-28T15:43:25-05:00 testsuite: Mark T14702 as fragile on Windows Due to #18953. - - - - - 1bc104b0 by Ben Gamari at 2020-11-29T15:33:18-05:00 withTimings: Emit allocations counter This will allow us to back out the allocations per compiler pass from the eventlog. Note that we dump the allocation counter rather than the difference since this will allow us to determine how much work is done *between* `withTiming` blocks. - - - - - e992ea84 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 ThreadPaused: Don't zero slop until free vars are pushed When threadPaused blackholes a thunk it calls `OVERWRITING_CLOSURE` to zero the slop for the benefit of the sanity checker. Previously this was done *before* pushing the thunk's free variables to the update remembered set. Consequently we would pull zero'd pointers to the update remembered set. - - - - - e82cd140 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Fix regression from TSAN work The TSAN rework (specifically aad1f803) introduced a subtle regression in GC.c, swapping `g0` in place of `gen`. Whoops! Fixes #18997. - - - - - 35a5207e by GHC GitLab CI at 2020-11-29T15:33:54-05:00 rts/Messages: Add missing write barrier in THROWTO message update After a THROWTO message has been handle the message closure is overwritten by a NULL message. We must ensure that the original closure's pointers continue to be visible to the nonmoving GC. - - - - - 0120829f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Add missing write barrier in shrinkSmallByteArray - - - - - 8a4d8fb6 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 Updates: Don't zero slop until closure has been pushed Ensure that the the free variables have been pushed to the update remembered set before we zero the slop. - - - - - 2793cfdc by GHC GitLab CI at 2020-11-29T15:33:54-05:00 OSThreads: Fix error code checking pthread_join returns its error code and apparently doesn't set errno. - - - - - e391a16f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Don't join to mark_thread on shutdown The mark thread is not joinable as we detach from it on creation. - - - - - 60d088ab by Ben Gamari at 2020-11-29T15:33:54-05:00 nonmoving: Add reference to Ueno 2016 - - - - - 3aa60362 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Ensure that evacuated large objects are marked See Note [Non-moving GC: Marking evacuated objects]. - - - - - 8d304a99 by Ben Gamari at 2020-11-30T10:15:22-05:00 rts/m32: Refactor handling of allocator seeding Previously, in an attempt to reduce fragmentation, each new allocator would map a region of M32_MAX_PAGES fresh pages to seed itself. However, this ends up being extremely wasteful since it turns out that we often use fewer than this. Consequently, these pages end up getting freed which, ends up fragmenting our address space more than than we would have if we had naively allocated pages on-demand. Here we refactor m32 to avoid this waste while achieving the fragmentation mitigation previously desired. In particular, we move all page allocation into the global m32_alloc_page, which will pull a page from the free page pool. If the free page pool is empty we then refill it by allocating a region of M32_MAP_PAGES and adding them to the pool. Furthermore, we do away with the initial seeding entirely. That is, the allocator starts with no active pages: pages are rather allocated on an as-needed basis. On the whole this ends up being a pleasingly simple change, simultaneously making m32 more efficient, more robust, and simpler. Fixes #18980. - - - - - b6629289 by Ben Gamari at 2020-11-30T10:15:58-05:00 rts: Use CHECK instead of assert Use the GHC wrappers instead of <assert.h>. - - - - - 9f4efa6a by Ben Gamari at 2020-11-30T10:15:58-05:00 rts/linker: Replace some ASSERTs with CHECK In the past some people have confused ASSERT, which is for checking internal invariants, which CHECK, which should be used when checking things that might fail due to bad input (and therefore should be enabled even in the release compiler). Change some of these cases in the linker to use CHECK. - - - - - 0f8a4655 by Ryan Scott at 2020-11-30T10:16:34-05:00 Allow deploy:pages job to fail See #18973. - - - - - 49ebe369 by chessai at 2020-11-30T19:47:40-05:00 Optimisations in Data.Foldable (T17867) This PR concerns the following functions from `Data.Foldable`: * minimum * maximum * sum * product * minimumBy * maximumBy - Default implementations of these functions now use `foldl'` or `foldMap'`. - All have been marked with INLINEABLE to make room for further optimisations. - - - - - 4d79ef65 by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - 6af074ce by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - ab334262 by Viktor Dukhovni at 2020-11-30T19:48:17-05:00 dirty MVAR after mutating TSO queue head While the original head and tail of the TSO queue may be in the same generation as the MVAR, interior elements of the queue could be younger after a GC run and may then be exposed by putMVar operation that updates the queue head. Resolves #18919 - - - - - 5eb163f3 by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Don't allow shared libraries to be loaded multiple times - - - - - 490aa14d by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Initialise CCSs from native shared objects - - - - - 6ac3db5f by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Move shared library loading logic into Elf.c - - - - - b6698d73 by GHC GitLab CI at 2020-11-30T19:48:53-05:00 rts/linker: Don't declare dynamic objects with image_mapped This previously resulted in warnings due to spurious unmap failures. - - - - - b94a65af by jneira at 2020-11-30T19:49:31-05:00 Include tried paths in findToolDir error - - - - - 72a87fbc by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Move core flattening algorithm to Core.Unify This sets the stage for a later change, where this algorithm will be needed from GHC.Core.InstEnv. This commit also splits GHC.Core.Map into GHC.Core.Map.Type and GHC.Core.Map.Expr, in order to avoid module import cycles with GHC.Core. - - - - - 0dd45d0a by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Bump the # of commits searched for perf baseline The previous value of 75 meant that a feature branch with more than 75 commits would get spurious CI passes. This affects #18692, but does not fix that ticket, because if a baseline cannot be found, we should fail, not succeed. - - - - - 8bb52d91 by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Remove flattening variables This patch redesigns the flattener to simplify type family applications directly instead of using flattening meta-variables and skolems. The key new innovation is the CanEqLHS type and the new CEqCan constraint (Ct). A CanEqLHS is either a type variable or exactly-saturated type family application; either can now be rewritten using a CEqCan constraint in the inert set. Because the flattener no longer reduces all type family applications to variables, there was some performance degradation if a lengthy type family application is now flattened over and over (not making progress). To compensate, this patch contains some extra optimizations in the flattener, leading to a number of performance improvements. Close #18875. Close #18910. There are many extra parts of the compiler that had to be affected in writing this patch: * The family-application cache (formerly the flat-cache) sometimes stores coercions built from Given inerts. When these inerts get kicked out, we must kick out from the cache as well. (This was, I believe, true previously, but somehow never caused trouble.) Kicking out from the cache requires adding a filterTM function to TrieMap. * This patch obviates the need to distinguish "blocking" coercion holes from non-blocking ones (which, previously, arose from CFunEqCans). There is thus some simplification around coercion holes. * Extra commentary throughout parts of the code I read through, to preserve the knowledge I gained while working. * A change in the pure unifier around unifying skolems with other types. Unifying a skolem now leads to SurelyApart, not MaybeApart, as documented in Note [Binding when looking up instances] in GHC.Core.InstEnv. * Some more use of MCoercion where appropriate. * Previously, class-instance lookup automatically noticed that e.g. C Int was a "unifier" to a target [W] C (F Bool), because the F Bool was flattened to a variable. Now, a little more care must be taken around checking for unifying instances. * Previously, tcSplitTyConApp_maybe would split (Eq a => a). This is silly, because (=>) is not a tycon in Haskell. Fixed now, but there are some knock-on changes in e.g. TrieMap code and in the canonicaliser. * New function anyFreeVarsOf{Type,Co} to check whether a free variable satisfies a certain predicate. * Type synonyms now remember whether or not they are "forgetful"; a forgetful synonym drops at least one argument. This is useful when flattening; see flattenView. * The pattern-match completeness checker invokes the solver. This invocation might need to look through newtypes when checking representational equality. Thus, the desugarer needs to keep track of the in-scope variables to know what newtype constructors are in scope. I bet this bug was around before but never noticed. * Extra-constraints wildcards are no longer simplified before printing. See Note [Do not simplify ConstraintHoles] in GHC.Tc.Solver. * Whether or not there are Given equalities has become slightly subtler. See the new HasGivenEqs datatype. * Note [Type variable cycles in Givens] in GHC.Tc.Solver.Canonical explains a significant new wrinkle in the new approach. * See Note [What might match later?] in GHC.Tc.Solver.Interact, which explains the fix to #18910. * The inert_count field of InertCans wasn't actually used, so I removed it. Though I (Richard) did the implementation, Simon PJ was very involved in design and review. This updates the Haddock submodule to avoid #18932 by adding a type signature. ------------------------- Metric Decrease: T12227 T5030 T9872a T9872b T9872c Metric Increase: T9872d ------------------------- - - - - - d66660ba by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Rename the flattener to become the rewriter. Now that flattening doesn't produce flattening variables, it's not really flattening anything: it's rewriting. This change also means that the rewriter can no longer be confused the core flattener (in GHC.Core.Unify), which is sometimes used during type-checking. - - - - - add0aeae by Ben Gamari at 2020-12-01T19:58:17-05:00 rts: Introduce mmapAnonForLinker Previously most of the uses of mmapForLinker were mapping anonymous memory, resulting in a great deal of unnecessary repetition. Factor this out into a new helper. Also fixes a few places where error checking was missing or suboptimal. - - - - - 97d71646 by Ben Gamari at 2020-12-01T19:58:17-05:00 rts/linker: Introduce munmapForLinker Consolidates munmap calls to ensure consistent error handling. - - - - - d8872af0 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/Linker: Introduce Windows implementations for mmapForLinker, et al. - - - - - c35d0e03 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/m32: Introduce NEEDS_M32 macro Instead of relying on RTS_LINKER_USE_MMAP - - - - - 41c64eb5 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/linker: Use m32 to allocate symbol extras in PEi386 - - - - - e0b08c5f by Ben Gamari at 2020-12-03T13:01:47-05:00 gitlab-ci: Fix copy-paste error Also be more consistent in quoting. - - - - - 33ec3a06 by Ben Gamari at 2020-12-03T23:11:31-05:00 gitlab-ci: Run linters through ci.sh Ensuring that the right toolchain is used. - - - - - 4a437bc1 by Shayne Fletcher at 2020-12-05T09:06:38-05:00 Fix bad span calculations of post qualified imports - - - - - 8fac4b93 by Ben Gamari at 2020-12-05T09:07:13-05:00 testsuite: Add a test for #18923 - - - - - 62ed6957 by Simon Peyton Jones at 2020-12-08T15:31:41-05:00 Fix kind inference for data types. Again. This patch fixes several aspects of kind inference for data type declarations, especially data /instance/ declarations Specifically 1. In kcConDecls/kcConDecl make it clear that the tc_res_kind argument is only used in the H98 case; and in that case there is no result kind signature; and hence no need for the disgusting splitPiTys in kcConDecls (now thankfully gone). The GADT case is a bit different to before, and much nicer. This is what fixes #18891. See Note [kcConDecls: kind-checking data type decls] 2. Do not look at the constructor decls of a data/newtype instance in tcDataFamInstanceHeader. See GHC.Tc.TyCl.Instance Note [Kind inference for data family instances]. This was a new realisation that arose when doing (1) This causes a few knock-on effects in the tests suite, because we require more information than before in the instance /header/. New user-manual material about this in "Kind inference in data type declarations" and "Kind inference for data/newtype instance declarations". 3. Minor improvement in kcTyClDecl, combining GADT and H98 cases 4. Fix #14111 and #8707 by allowing the header of a data instance to affect kind inferece for the the data constructor signatures; as described at length in Note [GADT return types] in GHC.Tc.TyCl This led to a modest refactoring of the arguments (and argument order) of tcConDecl/tcConDecls. 5. Fix #19000 by inverting the sense of the test in new_locs in GHC.Tc.Solver.Canonical.canDecomposableTyConAppOK. - - - - - 0abe3ddf by Adam Sandberg Ericsson at 2020-12-08T15:32:19-05:00 hadrian: build the _l and _thr_l rts flavours in the develN flavours The ghc binary requires the eventlog rts since fc644b1a643128041cfec25db84e417851e28bab - - - - - 51e3bb6d by Andreas Klebinger at 2020-12-08T22:43:21-05:00 CodeGen: Make folds User/DefinerOfRegs INLINEABLE. Reduces allocation for the test case I was looking at by about 1.2%. Mostly from avoiding allocation of some folding functions which turn into let-no-escape bindings which just reuse their environment instead. We also force inlining in a few key places in CmmSink which helps a bit more. - - - - - 69ae10c3 by Andreas Klebinger at 2020-12-08T22:43:21-05:00 CmmSink: Force inlining of foldRegsDefd Helps avoid allocating the folding function. Improves perf for T3294 by about 1%. - - - - - 6e3da800 by Andreas Klebinger at 2020-12-08T22:43:21-05:00 Cmm: Make a few types and utility function slightly stricter. About 0.6% reduction in allocations for the code I was looking at. Not a huge difference but no need to throw away performance. - - - - - aef44d7f by Andreas Klebinger at 2020-12-08T22:43:21-05:00 Cmm.Sink: Optimize retaining of assignments, live sets. Sinking requires us to track live local regs after each cmm statement. We used to do this via "Set LocalReg". However we can replace this with a solution based on IntSet which is overall more efficient without losing much. The thing we lose is width of the variables, which isn't used by the sinking pass anyway. I also reworked how we keep assignments to regs mentioned in skipped assignments. I put the details into Note [Keeping assignemnts mentioned in skipped RHSs]. The gist of it is instead of keeping track of it via the use count which is a `IntMap Int` we now use the live regs set (IntSet) which is quite a bit faster. I think it also matches the semantics a lot better. The skipped (not discarded) assignment does in fact keep the regs on it's rhs alive so keeping track of this in the live set seems like the clearer solution as well. Improves allocations for T3294 by yet another 1%. - - - - - 59f2249b by Andreas Klebinger at 2020-12-08T22:43:21-05:00 GHC.Cmm.Opt: Be stricter in results. Optimization either returns Nothing if nothing is to be done or `Just <cmmExpr>` otherwise. There is no point in being lazy in `cmmExpr`. We usually inspect this element so the thunk gets forced not long after. We might eliminate it as dead code once in a blue moon but that's not a case worth optimizing for. Overall the impact of this is rather low. As Cmm.Opt doesn't allocate much (compared to the rest of GHC) to begin with. - - - - - 54b88eac by Andreas Klebinger at 2020-12-08T22:43:57-05:00 Bump time submodule. This should fix #19002. - - - - - 35e7b0c6 by Kirill Elagin at 2020-12-10T01:45:54-05:00 doc: Clarify the default for -fomit-yields “Yield points enabled” is confusing (and probably wrong? I am not 100% sure what it means). Change it to a simple “on”. Undo this change from 2c23fff2e03e77187dc4d01f325f5f43a0e7cad2. - - - - - 3551c554 by Kirill Elagin at 2020-12-10T01:45:54-05:00 doc: Extra-clarify -fomit-yields Be more clear on what this optimisation being on by default means in terms of yields. - - - - - 6484f0d7 by Sergei Trofimovich at 2020-12-10T01:46:33-05:00 rts/linker/Elf.c: add missing <dlfcn.h> include (musl support) The change fixes build failure on musl: ``` rts/linker/Elf.c:2031:3: error: warning: implicit declaration of function 'dlclose'; did you mean 'close'? [-Wimplicit-function-declaration] 2031 | dlclose(nc->dlopen_handle); | ^~~~~~~ | close ``` Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - ab24ed9b by Ben Gamari at 2020-12-11T03:55:51-05:00 users guide: Fix syntax errors Fixes errors introduced by 3a55b3a2574f913d046f3a6f82db48d7f6df32e3. - - - - - d3a24d31 by Ben Gamari at 2020-12-11T03:55:51-05:00 users guide: Describe GC lifecycle events Every time I am asked about how to interpret these events I need to figure it out from scratch. It's well past time that the users guide properly documents these. - - - - - 741309b9 by Ben Gamari at 2020-12-11T03:56:27-05:00 gitlab-ci: Fix incorrect Docker image for nightly cross job Also refactor the job definition to eliminate the bug by construction. - - - - - 19703bc8 by Ben Gamari at 2020-12-11T03:56:27-05:00 gitlab-ci: Fix name of flavour in ThreadSanitizer job It looks like I neglected to update this after introduce flavour transformers. - - - - - 381eb660 by Sylvain Henry at 2020-12-11T12:57:35-05:00 Display FFI labels (fix #18539) - - - - - 4548d1f8 by Aaron Allen at 2020-12-11T12:58:14-05:00 Elide extraneous messages for :doc command (#15784) Do not print `<has no documentation>` alongside a valid doc. Additionally, if two matching symbols lack documentation then the message will only be printed once. Hence, `<has no documentation>` will be printed at most once and only if all matching symbols are lacking docs. - - - - - 5eba91b6 by Aaron Allen at 2020-12-11T12:58:14-05:00 Add :doc test case for duplicate record fields Tests that the output of the `:doc` command is correct for duplicate record fields defined using -XDuplicateRecordFields. - - - - - 5feb9b2d by Ryan Scott at 2020-12-11T22:39:29-05:00 Delete outdated Note [Kind-checking tyvar binders for associated types] This Note has severely bitrotted, as it has no references anywhere in the codebase, and none of the functions that it mentions exist anymore. Let's just delete this. While I was in town, I deleted some outdated comments from `checkFamPatBinders` of a similar caliber. Fixes #19008. [ci skip] - - - - - f9f9f030 by Sylvain Henry at 2020-12-11T22:40:08-05:00 Arrows: correctly query arrow methods (#17423) Consider the following code: proc (C x y) -> ... Before this patch, the evidence binding for the Arrow dictionary was attached to the C pattern: proc (C x y) { $dArrow = ... } -> ... But then when we desugar this, we use arrow operations ("arr", ">>>"...) specialised for this arrow: let arr_xy = arr $dArrow -- <-- Not in scope! ... in arr_xy (\(C x y) { $dArrow = ... } -> ...) This patch allows arrow operations to be type-checked before the proc itself, avoiding this issue. Fix #17423 - - - - - aaa8f00f by Sylvain Henry at 2020-12-11T22:40:48-05:00 Validate script: fix configure command when using stack - - - - - b4a929a1 by Sylvain Henry at 2020-12-11T22:41:30-05:00 Hadrian: fix libffi tarball parsing Fix parsing of "libffi-3.3.tar.gz". NB: switch to a newer libffi isn't done in this patch - - - - - 690c8946 by Sylvain Henry at 2020-12-11T22:42:09-05:00 Parser: move parser utils into their own module Move code unrelated to runtime evaluation out of GHC.Runtime.Eval - - - - - 76be0e32 by Sylvain Henry at 2020-12-11T22:42:48-05:00 Move SizedSeq into ghc-boot - - - - - 3a16d764 by Sylvain Henry at 2020-12-11T22:42:48-05:00 ghci: don't compile unneeded modules - - - - - 2895fa60 by Sylvain Henry at 2020-12-11T22:42:48-05:00 ghci: reuse Arch from ghc-boot - - - - - 480a38d4 by Sylvain Henry at 2020-12-11T22:43:30-05:00 rts: don't use siginterrupt (#19019) - - - - - 4af6126d by Sylvain Henry at 2020-12-11T22:44:11-05:00 Use static array in zeroCount - - - - - 5bd71bfd by Sebastian Graf at 2020-12-12T04:45:09-05:00 DmdAnal: Annotate top-level function bindings with demands (#18894) It's useful to annotate a non-exported top-level function like `g` in ```hs module Lib (h) where g :: Int -> Int -> (Int,Int) g m 1 = (m, 0) g m n = (2 * m, 2 `div` n) {-# NOINLINE g #-} h :: Int -> Int h 1 = 0 h m | odd m = snd (g m 2) | otherwise = uncurry (+) (g 2 m) ``` with its demand `UCU(CS(P(1P(U),SP(U))`, which tells us that whenever `g` was called, the second component of the returned pair was evaluated strictly. Since #18903 we do so for local functions, where we can see all calls. For top-level functions, we can assume that all *exported* functions are demanded according to `topDmd` and thus get sound demands for non-exported top-level functions. The demand on `g` is crucial information for Nested CPR, which may the go on and unbox `g` for the second pair component. That is true even if that pair component may diverge, as is the case for the call site `g 13 0`, which throws a div-by-zero exception. In `T18894b`, you can even see the new demand annotation enabling us to eta-expand a function that we wouldn't be able to eta-expand without Call Arity. We only track bindings of function type in order not to risk huge compile-time regressions, see `isInterestingTopLevelFn`. There was a CoreLint check that rejected strict demand annotations on recursive or top-level bindings, which seems completely unjustified. All the cases I investigated were fine, so I removed it. Fixes #18894. - - - - - 3aae036e by Sebastian Graf at 2020-12-12T04:45:09-05:00 Demand: Simplify `CU(U)` to `U` (#19005) Both sub-demands encode the same information. This is a trivial change and already affects a few regression tests (e.g. `T5075`), so no separate regression test is necessary. - - - - - c6477639 by Adam Sandberg Ericsson at 2020-12-12T04:45:48-05:00 hadrian: correctly copy the docs dir into the bindist #18669 - - - - - e033dd05 by Adam Sandberg Ericsson at 2020-12-12T10:52:19+00:00 mkDocs: support hadrian bindists #18973 - - - - - 78580ba3 by John Ericson at 2020-12-13T07:14:50-05:00 Remove old .travis.yml - - - - - bacc459b by Simon Peyton Jones at 2020-12-14T16:08:46+00:00 Quick Look: zonk result type Provoked by #18987, this patch adds a missing zonkQuickLook of app_res_rho in tcApp. Most of the time this zonk is unnecesary. In fact, I can't think of a concrete case where it is needed -- hence no test. But even if it isn't necessary, the reasoning that allows it to be omitted is very subtle. So I've put it in. However, adding this zonk does /not/ affect the emitted constraints, so the reported symptoms for #18987 remain, but harmlessly so, and now documented in a new Note [Instantiation variables are short lived] in GHC.Tc.Gen.App. No change in behaviour, no tests. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - − .travis.yml - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Expr.hs - + compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Liveness.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/Reg/Graph.hs - compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs - compiler/GHC/CmmToC.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Axiom.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FVs.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c2e0eae643d07916af2886c28fd015f781b5c475...bacc459be24bb589d7a4417923944ce5767ef451 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c2e0eae643d07916af2886c28fd015f781b5c475...bacc459be24bb589d7a4417923944ce5767ef451 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Dec 14 17:08:00 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 14 Dec 2020 12:08:00 -0500 Subject: [Git][ghc/ghc][wip/tyconapp-opts] 19 commits: Display FFI labels (fix #18539) Message-ID: <5fd79bf08a7f1_6b2131d5c3815085ab@gitlab.mail> Ben Gamari pushed to branch wip/tyconapp-opts at Glasgow Haskell Compiler / GHC Commits: 381eb660 by Sylvain Henry at 2020-12-11T12:57:35-05:00 Display FFI labels (fix #18539) - - - - - 4548d1f8 by Aaron Allen at 2020-12-11T12:58:14-05:00 Elide extraneous messages for :doc command (#15784) Do not print `<has no documentation>` alongside a valid doc. Additionally, if two matching symbols lack documentation then the message will only be printed once. Hence, `<has no documentation>` will be printed at most once and only if all matching symbols are lacking docs. - - - - - 5eba91b6 by Aaron Allen at 2020-12-11T12:58:14-05:00 Add :doc test case for duplicate record fields Tests that the output of the `:doc` command is correct for duplicate record fields defined using -XDuplicateRecordFields. - - - - - 5feb9b2d by Ryan Scott at 2020-12-11T22:39:29-05:00 Delete outdated Note [Kind-checking tyvar binders for associated types] This Note has severely bitrotted, as it has no references anywhere in the codebase, and none of the functions that it mentions exist anymore. Let's just delete this. While I was in town, I deleted some outdated comments from `checkFamPatBinders` of a similar caliber. Fixes #19008. [ci skip] - - - - - f9f9f030 by Sylvain Henry at 2020-12-11T22:40:08-05:00 Arrows: correctly query arrow methods (#17423) Consider the following code: proc (C x y) -> ... Before this patch, the evidence binding for the Arrow dictionary was attached to the C pattern: proc (C x y) { $dArrow = ... } -> ... But then when we desugar this, we use arrow operations ("arr", ">>>"...) specialised for this arrow: let arr_xy = arr $dArrow -- <-- Not in scope! ... in arr_xy (\(C x y) { $dArrow = ... } -> ...) This patch allows arrow operations to be type-checked before the proc itself, avoiding this issue. Fix #17423 - - - - - aaa8f00f by Sylvain Henry at 2020-12-11T22:40:48-05:00 Validate script: fix configure command when using stack - - - - - b4a929a1 by Sylvain Henry at 2020-12-11T22:41:30-05:00 Hadrian: fix libffi tarball parsing Fix parsing of "libffi-3.3.tar.gz". NB: switch to a newer libffi isn't done in this patch - - - - - 690c8946 by Sylvain Henry at 2020-12-11T22:42:09-05:00 Parser: move parser utils into their own module Move code unrelated to runtime evaluation out of GHC.Runtime.Eval - - - - - 76be0e32 by Sylvain Henry at 2020-12-11T22:42:48-05:00 Move SizedSeq into ghc-boot - - - - - 3a16d764 by Sylvain Henry at 2020-12-11T22:42:48-05:00 ghci: don't compile unneeded modules - - - - - 2895fa60 by Sylvain Henry at 2020-12-11T22:42:48-05:00 ghci: reuse Arch from ghc-boot - - - - - 480a38d4 by Sylvain Henry at 2020-12-11T22:43:30-05:00 rts: don't use siginterrupt (#19019) - - - - - 4af6126d by Sylvain Henry at 2020-12-11T22:44:11-05:00 Use static array in zeroCount - - - - - 5bd71bfd by Sebastian Graf at 2020-12-12T04:45:09-05:00 DmdAnal: Annotate top-level function bindings with demands (#18894) It's useful to annotate a non-exported top-level function like `g` in ```hs module Lib (h) where g :: Int -> Int -> (Int,Int) g m 1 = (m, 0) g m n = (2 * m, 2 `div` n) {-# NOINLINE g #-} h :: Int -> Int h 1 = 0 h m | odd m = snd (g m 2) | otherwise = uncurry (+) (g 2 m) ``` with its demand `UCU(CS(P(1P(U),SP(U))`, which tells us that whenever `g` was called, the second component of the returned pair was evaluated strictly. Since #18903 we do so for local functions, where we can see all calls. For top-level functions, we can assume that all *exported* functions are demanded according to `topDmd` and thus get sound demands for non-exported top-level functions. The demand on `g` is crucial information for Nested CPR, which may the go on and unbox `g` for the second pair component. That is true even if that pair component may diverge, as is the case for the call site `g 13 0`, which throws a div-by-zero exception. In `T18894b`, you can even see the new demand annotation enabling us to eta-expand a function that we wouldn't be able to eta-expand without Call Arity. We only track bindings of function type in order not to risk huge compile-time regressions, see `isInterestingTopLevelFn`. There was a CoreLint check that rejected strict demand annotations on recursive or top-level bindings, which seems completely unjustified. All the cases I investigated were fine, so I removed it. Fixes #18894. - - - - - 3aae036e by Sebastian Graf at 2020-12-12T04:45:09-05:00 Demand: Simplify `CU(U)` to `U` (#19005) Both sub-demands encode the same information. This is a trivial change and already affects a few regression tests (e.g. `T5075`), so no separate regression test is necessary. - - - - - c6477639 by Adam Sandberg Ericsson at 2020-12-12T04:45:48-05:00 hadrian: correctly copy the docs dir into the bindist #18669 - - - - - e033dd05 by Adam Sandberg Ericsson at 2020-12-12T10:52:19+00:00 mkDocs: support hadrian bindists #18973 - - - - - 78580ba3 by John Ericson at 2020-12-13T07:14:50-05:00 Remove old .travis.yml - - - - - d9ce91b7 by Ben Gamari at 2020-12-14T12:07:13-05:00 Optimise nullary type constructor usage During the compilation of programs GHC very frequently deals with the `Type` type, which is a synonym of `TYPE 'LiftedRep`. This patch teaches GHC to avoid expanding the `Type` synonym (and other nullary type synonyms) during type comparisons, saving a good amount of work. This optimisation is described in `Note [Comparing nullary type synonyms]`. To maximize the impact of this optimisation, we introduce a few special-cases to reduce `TYPE 'LiftedRep` to `Type`. See `Note [Prefer Type over TYPE 'LiftedPtrRep]`. Closes #17958. Metric Decrease: T18698b T1969 T12227 T12545 T12707 T14683 T3064 T5631 T5642 T9020 T9630 T9872a T13035 haddock.Cabal haddock.base - - - - - 30 changed files: - − .travis.yml - compiler/GHC.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - + compiler/GHC/Builtin/Types/Prim.hs-boot - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - + compiler/GHC/Parser/Utils.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/Tc/Gen/Arrow.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Demand.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/96685344071e36a9aca04ba9e984da3e9774c1fd...d9ce91b73513f997f3fc5a94ccdde68014e055c6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/96685344071e36a9aca04ba9e984da3e9774c1fd...d9ce91b73513f997f3fc5a94ccdde68014e055c6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Dec 14 17:45:41 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 14 Dec 2020 12:45:41 -0500 Subject: [Git][ghc/ghc][wip/tyconapp-opts] 20 commits: Implement type applications in patterns Message-ID: <5fd7a4c527b6e_6b216281648151095e@gitlab.mail> Ben Gamari pushed to branch wip/tyconapp-opts at Glasgow Haskell Compiler / GHC Commits: 90945a22 by Cale Gibbard at 2020-12-11T12:36:23-05:00 Implement type applications in patterns The haddock submodule is also updated so that it understands the changes to patterns. - - - - - 0f15a2da by Sylvain Henry at 2020-12-14T12:45:26-05:00 Display FFI labels (fix #18539) - - - - - 46f1da59 by Aaron Allen at 2020-12-14T12:45:26-05:00 Elide extraneous messages for :doc command (#15784) Do not print `<has no documentation>` alongside a valid doc. Additionally, if two matching symbols lack documentation then the message will only be printed once. Hence, `<has no documentation>` will be printed at most once and only if all matching symbols are lacking docs. - - - - - d5c31cd0 by Aaron Allen at 2020-12-14T12:45:26-05:00 Add :doc test case for duplicate record fields Tests that the output of the `:doc` command is correct for duplicate record fields defined using -XDuplicateRecordFields. - - - - - 7af03d60 by Ryan Scott at 2020-12-14T12:45:26-05:00 Delete outdated Note [Kind-checking tyvar binders for associated types] This Note has severely bitrotted, as it has no references anywhere in the codebase, and none of the functions that it mentions exist anymore. Let's just delete this. While I was in town, I deleted some outdated comments from `checkFamPatBinders` of a similar caliber. Fixes #19008. [ci skip] - - - - - e733612b by Sylvain Henry at 2020-12-14T12:45:26-05:00 Arrows: correctly query arrow methods (#17423) Consider the following code: proc (C x y) -> ... Before this patch, the evidence binding for the Arrow dictionary was attached to the C pattern: proc (C x y) { $dArrow = ... } -> ... But then when we desugar this, we use arrow operations ("arr", ">>>"...) specialised for this arrow: let arr_xy = arr $dArrow -- <-- Not in scope! ... in arr_xy (\(C x y) { $dArrow = ... } -> ...) This patch allows arrow operations to be type-checked before the proc itself, avoiding this issue. Fix #17423 - - - - - 3f9fa2a2 by Sylvain Henry at 2020-12-14T12:45:26-05:00 Validate script: fix configure command when using stack - - - - - ec7926de by Sylvain Henry at 2020-12-14T12:45:26-05:00 Hadrian: fix libffi tarball parsing Fix parsing of "libffi-3.3.tar.gz". NB: switch to a newer libffi isn't done in this patch - - - - - 8c8884ff by Sylvain Henry at 2020-12-14T12:45:26-05:00 Parser: move parser utils into their own module Move code unrelated to runtime evaluation out of GHC.Runtime.Eval - - - - - 7e029c9a by Sylvain Henry at 2020-12-14T12:45:26-05:00 Move SizedSeq into ghc-boot - - - - - 039e76f9 by Sylvain Henry at 2020-12-14T12:45:26-05:00 ghci: don't compile unneeded modules - - - - - 08e38cae by Sylvain Henry at 2020-12-14T12:45:26-05:00 ghci: reuse Arch from ghc-boot - - - - - ef6c6ecf by Sylvain Henry at 2020-12-14T12:45:26-05:00 rts: don't use siginterrupt (#19019) - - - - - f10df0ea by Sylvain Henry at 2020-12-14T12:45:26-05:00 Use static array in zeroCount - - - - - cdcdb4aa by Sebastian Graf at 2020-12-14T12:45:26-05:00 DmdAnal: Annotate top-level function bindings with demands (#18894) It's useful to annotate a non-exported top-level function like `g` in ```hs module Lib (h) where g :: Int -> Int -> (Int,Int) g m 1 = (m, 0) g m n = (2 * m, 2 `div` n) {-# NOINLINE g #-} h :: Int -> Int h 1 = 0 h m | odd m = snd (g m 2) | otherwise = uncurry (+) (g 2 m) ``` with its demand `UCU(CS(P(1P(U),SP(U))`, which tells us that whenever `g` was called, the second component of the returned pair was evaluated strictly. Since #18903 we do so for local functions, where we can see all calls. For top-level functions, we can assume that all *exported* functions are demanded according to `topDmd` and thus get sound demands for non-exported top-level functions. The demand on `g` is crucial information for Nested CPR, which may the go on and unbox `g` for the second pair component. That is true even if that pair component may diverge, as is the case for the call site `g 13 0`, which throws a div-by-zero exception. In `T18894b`, you can even see the new demand annotation enabling us to eta-expand a function that we wouldn't be able to eta-expand without Call Arity. We only track bindings of function type in order not to risk huge compile-time regressions, see `isInterestingTopLevelFn`. There was a CoreLint check that rejected strict demand annotations on recursive or top-level bindings, which seems completely unjustified. All the cases I investigated were fine, so I removed it. Fixes #18894. - - - - - 19068448 by Sebastian Graf at 2020-12-14T12:45:26-05:00 Demand: Simplify `CU(U)` to `U` (#19005) Both sub-demands encode the same information. This is a trivial change and already affects a few regression tests (e.g. `T5075`), so no separate regression test is necessary. - - - - - 0202bd49 by Adam Sandberg Ericsson at 2020-12-14T12:45:26-05:00 hadrian: correctly copy the docs dir into the bindist #18669 - - - - - 6ead906f by Adam Sandberg Ericsson at 2020-12-14T12:45:26-05:00 mkDocs: support hadrian bindists #18973 - - - - - 547a01dc by John Ericson at 2020-12-14T12:45:26-05:00 Remove old .travis.yml - - - - - 6f404e92 by Ben Gamari at 2020-12-14T12:45:26-05:00 Optimise nullary type constructor usage During the compilation of programs GHC very frequently deals with the `Type` type, which is a synonym of `TYPE 'LiftedRep`. This patch teaches GHC to avoid expanding the `Type` synonym (and other nullary type synonyms) during type comparisons, saving a good amount of work. This optimisation is described in `Note [Comparing nullary type synonyms]`. To maximize the impact of this optimisation, we introduce a few special-cases to reduce `TYPE 'LiftedRep` to `Type`. See `Note [Prefer Type over TYPE 'LiftedPtrRep]`. Closes #17958. Metric Decrease: T18698b T1969 T12227 T12545 T12707 T14683 T3064 T5631 T5642 T9020 T9630 T9872a T13035 haddock.Cabal haddock.base - - - - - 30 changed files: - − .travis.yml - compiler/GHC.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - + compiler/GHC/Builtin/Types/Prim.hs-boot - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match/Constructor.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d9ce91b73513f997f3fc5a94ccdde68014e055c6...6f404e9285a848f847a6880bfe836a3f3bdef8e4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d9ce91b73513f997f3fc5a94ccdde68014e055c6...6f404e9285a848f847a6880bfe836a3f3bdef8e4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Dec 14 17:48:36 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 14 Dec 2020 12:48:36 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/win32-fixes Message-ID: <5fd7a574a384e_6b2167418541513569@gitlab.mail> Ben Gamari pushed new branch wip/win32-fixes at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/win32-fixes You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Dec 14 18:39:19 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 14 Dec 2020 13:39:19 -0500 Subject: [Git][ghc/ghc][master] 2 commits: Implement type applications in patterns Message-ID: <5fd7b15785a46_6b215016850154193c@gitlab.mail> Ben Gamari pushed to branch master at Glasgow Haskell Compiler / GHC Commits: c696bb2f by Cale Gibbard at 2020-12-14T13:37:09-05:00 Implement type applications in patterns The haddock submodule is also updated so that it understands the changes to patterns. - - - - - 7e9debd4 by Ben Gamari at 2020-12-14T13:37:09-05:00 Optimise nullary type constructor usage During the compilation of programs GHC very frequently deals with the `Type` type, which is a synonym of `TYPE 'LiftedRep`. This patch teaches GHC to avoid expanding the `Type` synonym (and other nullary type synonyms) during type comparisons, saving a good amount of work. This optimisation is described in `Note [Comparing nullary type synonyms]`. To maximize the impact of this optimisation, we introduce a few special-cases to reduce `TYPE 'LiftedRep` to `Type`. See `Note [Prefer Type over TYPE 'LiftedPtrRep]`. Closes #17958. Metric Decrease: T18698b T1969 T12227 T12545 T12707 T14683 T3064 T5631 T5642 T9020 T9630 T9872a T13035 haddock.Cabal haddock.base - - - - - 30 changed files: - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - + compiler/GHC/Builtin/Types/Prim.hs-boot - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Errors.hs - compiler/GHC/Parser/Errors/Ppr.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Parser/PostProcess/Haddock.hs - compiler/GHC/Parser/Types.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Pat.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/78580ba3f99565b0aecb25c4206718d4c8a52317...7e9debd4ceb068effe8ac81892d2cabcb8f55850 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/78580ba3f99565b0aecb25c4206718d4c8a52317...7e9debd4ceb068effe8ac81892d2cabcb8f55850 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Dec 14 18:42:48 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 14 Dec 2020 13:42:48 -0500 Subject: [Git][ghc/ghc][master] Revert "Optimise nullary type constructor usage" Message-ID: <5fd7b228c7085_6b2167418541542133@gitlab.mail> Ben Gamari pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 92377c27 by Ben Gamari at 2020-12-14T13:41:58-05:00 Revert "Optimise nullary type constructor usage" This was inadvertently merged. This reverts commit 7e9debd4ceb068effe8ac81892d2cabcb8f55850. - - - - - 23 changed files: - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - − compiler/GHC/Builtin/Types/Prim.hs-boot - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/TcType.hs - testsuite/tests/deSugar/should_compile/T2431.stderr - testsuite/tests/deriving/should_compile/T14578.stderr - testsuite/tests/plugins/plugins09.stdout - testsuite/tests/plugins/plugins10.stdout - testsuite/tests/plugins/plugins11.stdout - testsuite/tests/plugins/static-plugins.stdout - testsuite/tests/printer/T18052a.stderr - testsuite/tests/simplCore/should_compile/T13143.stderr - testsuite/tests/simplCore/should_compile/T18013.stderr - testsuite/tests/simplCore/should_compile/T7360.stderr - testsuite/tests/typecheck/should_compile/T13032.stderr - utils/haddock Changes: ===================================== compiler/GHC/Builtin/Types.hs ===================================== @@ -170,7 +170,6 @@ import GHC.Types.Var (VarBndr (Bndr)) import GHC.Settings.Constants ( mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE, mAX_SUM_SIZE ) import GHC.Unit.Module ( Module ) import GHC.Core.Type -import qualified GHC.Core.TyCo.Rep as TyCoRep (Type(TyConApp)) import GHC.Types.RepType import GHC.Core.DataCon import GHC.Core.ConLike @@ -689,9 +688,8 @@ constraintKindTyCon :: TyCon -- 'TyCon.isConstraintKindCon' assumes that this is an AlgTyCon! constraintKindTyCon = pcTyCon constraintKindTyConName Nothing [] [] --- See Note [Prefer Type over TYPE 'LiftedRep] in GHC.Core.TyCo.Rep. liftedTypeKind, typeToTypeKind, constraintKind :: Kind -liftedTypeKind = TyCoRep.TyConApp liftedTypeKindTyCon [] +liftedTypeKind = tYPE liftedRepTy typeToTypeKind = liftedTypeKind `mkVisFunTyMany` liftedTypeKind constraintKind = mkTyConApp constraintKindTyCon [] @@ -1412,12 +1410,11 @@ runtimeRepTy :: Type runtimeRepTy = mkTyConTy runtimeRepTyCon -- Type synonyms; see Note [TYPE and RuntimeRep] in GHC.Builtin.Types.Prim --- and Note [Prefer Type over TYPE 'LiftedRep] in GHC.Core.TyCo.Rep. -- type Type = tYPE 'LiftedRep liftedTypeKindTyCon :: TyCon liftedTypeKindTyCon = buildSynTyCon liftedTypeKindTyConName - [] liftedTypeKind [] rhs - where rhs = TyCoRep.TyConApp tYPETyCon [liftedRepTy] + [] liftedTypeKind [] + (tYPE liftedRepTy) runtimeRepTyCon :: TyCon runtimeRepTyCon = pcTyCon runtimeRepTyConName Nothing [] ===================================== compiler/GHC/Builtin/Types/Prim.hs ===================================== @@ -551,6 +551,10 @@ mkPrimTcName built_in_syntax occ key tycon = mkWiredInName gHC_PRIM (mkTcOccFS occ) key (mkATyCon tycon) built_in_syntax ----------------------------- +-- | Given a RuntimeRep, applies TYPE to it. +-- see Note [TYPE and RuntimeRep] +tYPE :: Type -> Type +tYPE rr = TyConApp tYPETyCon [rr] -- Given a Multiplicity, applies FUN to it. functionWithMultiplicity :: Type -> Type ===================================== compiler/GHC/Builtin/Types/Prim.hs-boot deleted ===================================== @@ -1,5 +0,0 @@ -module GHC.Builtin.Types.Prim where - -import GHC.Core.TyCon - -tYPETyCon :: TyCon ===================================== compiler/GHC/Core/TyCo/Rep.hs ===================================== @@ -52,7 +52,6 @@ module GHC.Core.TyCo.Rep ( mkVisFunTyMany, mkVisFunTysMany, mkInvisFunTyMany, mkInvisFunTysMany, mkTyConApp, - tYPE, -- * Functions over binders TyCoBinder(..), TyCoVarBinder, TyBinder, @@ -91,9 +90,8 @@ import GHC.Core.TyCon import GHC.Core.Coercion.Axiom -- others -import GHC.Builtin.Names ( liftedTypeKindTyConKey, liftedRepDataConKey, manyDataConKey, tYPETyConKey ) -import {-# SOURCE #-} GHC.Builtin.Types ( liftedTypeKindTyCon, liftedTypeKind, manyDataConTy ) -import {-# SOURCE #-} GHC.Builtin.Types.Prim ( tYPETyCon ) +import GHC.Builtin.Names ( liftedTypeKindTyConKey, manyDataConKey ) +import {-# SOURCE #-} GHC.Builtin.Types ( liftedTypeKindTyCon, manyDataConTy ) import GHC.Types.Basic ( LeftOrRight(..), pickLR ) import GHC.Types.Unique ( hasKey, Uniquable(..) ) import GHC.Utils.Outputable @@ -1011,7 +1009,7 @@ mkTyConApp tycon tys -- The FunTyCon (->) is always a visible one = FunTy { ft_af = VisArg, ft_mult = w, ft_arg = ty1, ft_res = ty2 } - -- See Note [Prefer Type over TYPE 'LiftedRep] + -- Note [mkTyConApp and Type] | tycon `hasKey` liftedTypeKindTyConKey = ASSERT2( null tys, ppr tycon $$ ppr tys ) liftedTypeKindTyConApp @@ -1020,21 +1018,21 @@ mkTyConApp tycon tys -- avoid reboxing every time `mkTyConApp` is called. = ASSERT2( null tys, ppr tycon $$ ppr tys ) manyDataConTy - -- See Note [Prefer Type over TYPE 'LiftedRep]. - | tycon `hasKey` tYPETyConKey - , [rep] <- tys - = tYPE rep - -- The catch-all case | otherwise = TyConApp tycon tys +-- This is a single, global definition of the type `Type` +-- Defined here so it is only allocated once. +-- See Note [mkTyConApp and Type] +liftedTypeKindTyConApp :: Type +liftedTypeKindTyConApp = TyConApp liftedTypeKindTyCon [] + {- -Note [Prefer Type over TYPE 'LiftedRep] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The Core of nearly any program will have numerous occurrences of - at TYPE 'LiftedRep@ (and, equivalently, 'Type') floating about. Concretely, while -investigating #17292 we found that these constituting a majority of TyConApp -constructors on the heap: +Note [mkTyConApp and Type] +~~~~~~~~~~~~~~~~~~~~~~~~~~ +Whilst benchmarking it was observed in #17292 that GHC allocated a lot +of `TyConApp` constructors. Upon further inspection a large number of these +TyConApp constructors were all duplicates of `Type` applied to no arguments. ``` (From a sample of 100000 TyConApp closures) @@ -1048,59 +1046,12 @@ constructors on the heap: 0x45e68fd - 538 - `TYPE ...` ``` -Consequently, we try hard to ensure that operations on such types are -efficient. Specifically, we strive to - - a. Avoid heap allocation of such types - b. Use a small (shallow in the tree-depth sense) representation - for such types - -Goal (b) is particularly useful as it makes traversals (e.g. free variable -traversal, substitution, and comparison) more efficient. -Comparison in particular takes special advantage of nullary type synonym -applications (e.g. things like @TyConApp typeTyCon []@), Note [Comparing -nullary type synonyms] in "GHC.Core.Type". - -To accomplish these we use a number of tricks: - - 1. Instead of representing the lifted kind as - @TyConApp tYPETyCon [liftedRepDataCon]@ we rather prefer to - use the 'GHC.Types.Type' type synonym (represented as a nullary TyConApp). - This serves goal (b) since there are no applied type arguments to traverse, - e.g., during comparison. - - 2. We have a top-level binding to represent `TyConApp GHC.Types.Type []` - (namely 'GHC.Builtin.Types.Prim.liftedTypeKind'), ensuring that we - don't need to allocate such types (goal (a)). - - 3. To avoid allocating 'TyConApp' constructors the - 'GHC.Builtin.Types.Prim.tYPE' function catches the lifted case and returns - `liftedTypeKind` instead of building an application (goal (a)). - - 4. Similarly, 'Type.mkTyConApp' catches applications of `TYPE` and - handles them using 'GHC.Builtin.Types.Prim.tYPE', ensuring - that it benefits from the optimisation described above (goal (a)). - -Note that it's quite important that we do not define 'liftedTypeKind' in terms -of 'mkTyConApp' since this tricks (1) and (4) would then result in a loop. - -See #17958. +Therefore in `mkTyConApp` we have a special case for `Type` to ensure that +only one `TyConApp 'Type []` closure is allocated during the course of +compilation. In order to avoid a potentially expensive series of checks in +`mkTyConApp` only this egregious case is special cased at the moment. -} --- | Given a RuntimeRep, applies TYPE to it. --- See Note [TYPE and RuntimeRep] in GHC.Builtin.Types.Prim. -tYPE :: Type -> Type -tYPE (TyConApp tc []) - -- See Note [Prefer Type of TYPE 'LiftedRep] - | tc `hasKey` liftedRepDataConKey = liftedTypeKind -- TYPE 'LiftedRep -tYPE rr = TyConApp tYPETyCon [rr] - --- This is a single, global definition of the type `Type` --- Defined here so it is only allocated once. --- See Note [Prefer Type over TYPE 'LiftedRep] in this module. -liftedTypeKindTyConApp :: Type -liftedTypeKindTyConApp = TyConApp liftedTypeKindTyCon [] - {- %************************************************************************ %* * ===================================== compiler/GHC/Core/TyCo/Subst.hs ===================================== @@ -424,7 +424,6 @@ zipTCvSubst tcvs tys -- | Generates the in-scope set for the 'TCvSubst' from the types in the -- incoming environment. No CoVars, please! mkTvSubstPrs :: [(TyVar, Type)] -> TCvSubst -mkTvSubstPrs [] = emptyTCvSubst mkTvSubstPrs prs = ASSERT2( onlyTyVarsAndNoCoercionTy, text "prs" <+> ppr prs ) mkTvSubst in_scope tenv @@ -742,8 +741,7 @@ subst_ty subst ty go (TyConApp tc tys) = (mkTyConApp $! tc) $! strictMap go tys -- NB: mkTyConApp, not TyConApp. -- mkTyConApp has optimizations. - -- See Note [Prefer Type over TYPE 'LiftedRep] - -- in GHC.Core.TyCo.Rep + -- See Note [mkTyConApp and Type] in GHC.Core.TyCo.Rep go ty@(FunTy { ft_mult = mult, ft_arg = arg, ft_res = res }) = let !mult' = go mult !arg' = go arg ===================================== compiler/GHC/Core/TyCon.hs ===================================== @@ -2327,14 +2327,12 @@ expandSynTyCon_maybe -- ^ Expand a type synonym application, if any expandSynTyCon_maybe tc tys | SynonymTyCon { tyConTyVars = tvs, synTcRhs = rhs, tyConArity = arity } <- tc - = case tys of - [] -> Just ([], rhs, []) -- Avoid a bit of work in the case of nullary synonyms - _ -> case tys `listLengthCmp` arity of - GT -> Just (tvs `zip` tys, rhs, drop arity tys) - EQ -> Just (tvs `zip` tys, rhs, []) - LT -> Nothing - | otherwise - = Nothing + = case tys `listLengthCmp` arity of + GT -> Just (tvs `zip` tys, rhs, drop arity tys) + EQ -> Just (tvs `zip` tys, rhs, []) + LT -> Nothing + | otherwise + = Nothing ---------------- ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -383,28 +383,34 @@ how roles in kinds might work out. -} -- | Gives the typechecker view of a type. This unwraps synonyms but --- leaves 'Constraint' alone. c.f. 'coreView', which turns 'Constraint' into --- 'Type'. Returns 'Nothing' if no unwrapping happens. +-- leaves 'Constraint' alone. c.f. coreView, which turns Constraint into +-- TYPE LiftedRep. Returns Nothing if no unwrapping happens. -- See also Note [coreView vs tcView] +{-# INLINE tcView #-} tcView :: Type -> Maybe Type -tcView (TyConApp tc tys) - | res@(Just _) <- expandSynTyConApp_maybe tc tys - = res +tcView (TyConApp tc tys) | Just (tenv, rhs, tys') <- expandSynTyCon_maybe tc tys + = Just (mkAppTys (substTy (mkTvSubstPrs tenv) rhs) tys') + -- The free vars of 'rhs' should all be bound by 'tenv', so it's + -- ok to use 'substTy' here. + -- See also Note [The substitution invariant] in GHC.Core.TyCo.Subst. + -- Its important to use mkAppTys, rather than (foldl AppTy), + -- because the function part might well return a + -- partially-applied type constructor; indeed, usually will! tcView _ = Nothing --- See Note [Inlining coreView]. -{-# INLINE tcView #-} +{-# INLINE coreView #-} coreView :: Type -> Maybe Type --- ^ This function strips off the /top layer only/ of a type synonym +-- ^ This function Strips off the /top layer only/ of a type synonym -- application (if any) its underlying representation type. --- Returns 'Nothing' if there is nothing to look through. --- This function considers 'Constraint' to be a synonym of @Type at . +-- Returns Nothing if there is nothing to look through. +-- This function considers 'Constraint' to be a synonym of @TYPE LiftedRep at . -- -- By being non-recursive and inlined, this case analysis gets efficiently -- joined onto the case analysis that the caller is already doing coreView ty@(TyConApp tc tys) - | res@(Just _) <- expandSynTyConApp_maybe tc tys - = res + | Just (tenv, rhs, tys') <- expandSynTyCon_maybe tc tys + = Just (mkAppTys (substTy (mkTvSubstPrs tenv) rhs) tys') + -- This equation is exactly like tcView -- At the Core level, Constraint = Type -- See Note [coreView vs tcView] @@ -413,48 +419,8 @@ coreView ty@(TyConApp tc tys) Just liftedTypeKind coreView _ = Nothing --- See Note [Inlining coreView]. -{-# INLINE coreView #-} - ------------------------------------------------ - --- | @expandSynTyConApp_maybe tc tys@ expands the RHS of type synonym @tc@ --- instantiated at arguments @tys@, or returns 'Nothing' if @tc@ is not a --- synonym. -expandSynTyConApp_maybe :: TyCon -> [Type] -> Maybe Type -expandSynTyConApp_maybe tc tys - | Just (tvs, rhs) <- synTyConDefn_maybe tc - , tys `lengthAtLeast` arity - = Just (expand_syn arity tvs rhs tys) - | otherwise - = Nothing - where - arity = tyConArity tc --- Without this INLINE the call to expandSynTyConApp_maybe in coreView --- will result in an avoidable allocation. -{-# INLINE expandSynTyConApp_maybe #-} - --- | A helper for 'expandSynTyConApp_maybe' to avoid inlining this cold path --- into call-sites. -expand_syn :: Int -- ^ the arity of the synonym - -> [TyVar] -- ^ the variables bound by the synonym - -> Type -- ^ the RHS of the synonym - -> [Type] -- ^ the type arguments the synonym is instantiated at. - -> Type -expand_syn arity tvs rhs tys - | tys `lengthExceeds` arity = mkAppTys rhs' (drop arity tys) - | otherwise = rhs' - where - rhs' = substTy (mkTvSubstPrs (tvs `zip` tys)) rhs - -- The free vars of 'rhs' should all be bound by 'tenv', so it's - -- ok to use 'substTy' here (which is what expandSynTyConApp_maybe does). - -- See also Note [The substitution invariant] in GHC.Core.TyCo.Subst. - -- Its important to use mkAppTys, rather than (foldl AppTy), - -- because the function part might well return a - -- partially-applied type constructor; indeed, usually will! --- We never want to inline this cold-path. -{-# INLINE expand_syn #-} +{-# INLINE coreFullView #-} coreFullView :: Type -> Type -- ^ Iterates 'coreView' until there is no more to synonym to expand. -- See Note [Inlining coreView]. @@ -466,7 +432,6 @@ coreFullView ty@(TyConApp tc _) | otherwise = ty coreFullView ty = ty -{-# INLINE coreFullView #-} {- Note [Inlining coreView] in GHC.Core.Type ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2242,36 +2207,6 @@ But the left is an AppTy while the right is a TyConApp. The solution is to use repSplitAppTy_maybe to break up the TyConApp into its pieces and then continue. Easy to do, but also easy to forget to do. - -Note [Comparing nullary type synonyms] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider the task of testing equality between two 'Type's of the form - - TyConApp tc [] - -where @tc@ is a type synonym. A naive way to perform this comparison these -would first expand the synonym and then compare the resulting expansions. - -However, this is obviously wasteful and the RHS of @tc@ may be large; it is -much better to rather compare the TyCons directly. Consequently, before -expanding type synonyms in type comparisons we first look for a nullary -TyConApp and simply compare the TyCons if we find one. Of course, if we find -that the TyCons are *not* equal then we still need to perform the expansion as -their RHSs may still be equal. - -We perform this optimisation in a number of places: - - * GHC.Core.Types.eqType - * GHC.Core.Types.nonDetCmpType - * GHC.Core.Unify.unify_ty - * TcCanonical.can_eq_nc' - * TcUnify.uType - -This optimisation is especially helpful for the ubiquitous GHC.Types.Type, -since GHC prefers to use the type synonym over @TYPE 'LiftedRep@ applications -whenever possible. See [Prefer Type over TYPE 'LiftedRep] in -GHC.Core.TyCo.Rep for details. - -} eqType :: Type -> Type -> Bool @@ -2383,10 +2318,6 @@ nonDetCmpTypeX env orig_t1 orig_t2 = -- Returns both the resulting ordering relation between the two types -- and whether either contains a cast. go :: RnEnv2 -> Type -> Type -> TypeOrdering - -- See Note [Comparing nullary type synonyms]. - go _ (TyConApp tc1 []) (TyConApp tc2 []) - | tc1 == tc2 - = TEQ go env t1 t2 | Just t1' <- coreView t1 = go env t1' t2 | Just t2' <- coreView t2 = go env t1 t2' ===================================== compiler/GHC/Core/Unify.hs ===================================== @@ -957,12 +957,7 @@ unify_ty :: UMEnv -- Respects newtypes, PredTypes unify_ty env ty1 ty2 kco - -- See Note [Comparing nullary type synonyms] in GHC.Core.Type. - | TyConApp tc1 [] <- ty1 - , TyConApp tc2 [] <- ty2 - , tc1 == tc2 = return () - - -- TODO: More commentary needed here + -- Use tcView, not coreView. See Note [coreView vs tcView] in GHC.Core.Type. | Just ty1' <- tcView ty1 = unify_ty env ty1' ty2 kco | Just ty2' <- tcView ty2 = unify_ty env ty1 ty2' kco | CastTy ty1' co <- ty1 = if um_unif env ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -956,11 +956,6 @@ can_eq_nc' -> Type -> Type -- RHS, after and before type-synonym expansion, resp -> TcS (StopOrContinue Ct) --- See Note [Comparing nullary type synonyms] in GHC.Core.Type. -can_eq_nc' _flat _rdr_env _envs ev eq_rel ty1@(TyConApp tc1 []) _ps_ty1 (TyConApp tc2 []) _ps_ty2 - | tc1 == tc2 - = canEqReflexive ev eq_rel ty1 - -- Expand synonyms first; see Note [Type synonyms and canonicalization] can_eq_nc' rewritten rdr_env envs ev eq_rel ty1 ps_ty1 ty2 ps_ty2 | Just ty1' <- tcView ty1 = can_eq_nc' rewritten rdr_env envs ev eq_rel ty1' ps_ty1 ty2 ps_ty2 ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -120,6 +120,7 @@ import GHC.Types.Id as Id import GHC.Types.Name import GHC.Types.Var.Set import GHC.Builtin.Types +import GHC.Builtin.Types.Prim import GHC.Types.Var.Env import GHC.Types.Name.Env import GHC.Utils.Misc ===================================== compiler/GHC/Tc/Utils/TcType.hs ===================================== @@ -1581,11 +1581,6 @@ tc_eq_type keep_syns vis_only orig_ty1 orig_ty2 = go orig_env orig_ty1 orig_ty2 where go :: RnEnv2 -> Type -> Type -> Bool - -- See Note [Comparing nullary type synonyms] in GHC.Core.Type. - go _ (TyConApp tc1 []) (TyConApp tc2 []) - | tc1 == tc2 - = True - go env t1 t2 | not keep_syns, Just t1' <- tcView t1 = go env t1' t2 go env t1 t2 | not keep_syns, Just t2' <- tcView t2 = go env t1 t2' ===================================== testsuite/tests/deSugar/should_compile/T2431.stderr ===================================== @@ -1,9 +1,9 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 63, types: 39, coercions: 1, joins: 0/0} + = {terms: 63, types: 43, coercions: 1, joins: 0/0} --- RHS size: {terms: 2, types: 3, coercions: 1, joins: 0/0} +-- RHS size: {terms: 2, types: 4, coercions: 1, joins: 0/0} T2431.$WRefl [InlPrag=INLINE[final] CONLIKE] :: forall a. a :~: a [GblId[DataConWrapper], Caf=NoCafRefs, @@ -15,7 +15,7 @@ T2431.$WRefl [InlPrag=INLINE[final] CONLIKE] :: forall a. a :~: a T2431.$WRefl = \ (@a) -> T2431.Refl @a @a @~(_N :: a GHC.Prim.~# a) --- RHS size: {terms: 4, types: 7, coercions: 0, joins: 0/0} +-- RHS size: {terms: 4, types: 8, coercions: 0, joins: 0/0} absurd :: forall a. (Int :~: Bool) -> a [GblId, Arity=1, Str=b, Cpr=b, Unf=OtherCon []] absurd = \ (@a) (x :: Int :~: Bool) -> case x of { } ===================================== testsuite/tests/deriving/should_compile/T14578.stderr ===================================== @@ -16,12 +16,13 @@ Derived class instances: = GHC.Prim.coerce @(T14578.App (Data.Functor.Compose.Compose f g) a -> T14578.App (Data.Functor.Compose.Compose f g) a - -> T14578.App (Data.Functor.Compose.Compose f g) a) + -> T14578.App (Data.Functor.Compose.Compose f g) a) @(T14578.Wat f g a -> T14578.Wat f g a -> T14578.Wat f g a) ((GHC.Base.<>) @(T14578.App (Data.Functor.Compose.Compose f g) a)) GHC.Base.sconcat = GHC.Prim.coerce - @(GHC.Base.NonEmpty (T14578.App (Data.Functor.Compose.Compose f g) a) + @(GHC.Base.NonEmpty + (T14578.App (Data.Functor.Compose.Compose f g) a) -> T14578.App (Data.Functor.Compose.Compose f g) a) @(GHC.Base.NonEmpty (T14578.Wat f g a) -> T14578.Wat f g a) (GHC.Base.sconcat @@ -30,7 +31,7 @@ Derived class instances: = GHC.Prim.coerce @(b -> T14578.App (Data.Functor.Compose.Compose f g) a - -> T14578.App (Data.Functor.Compose.Compose f g) a) + -> T14578.App (Data.Functor.Compose.Compose f g) a) @(b -> T14578.Wat f g a -> T14578.Wat f g a) (GHC.Base.stimes @(T14578.App (Data.Functor.Compose.Compose f g) a)) ===================================== testsuite/tests/plugins/plugins09.stdout ===================================== @@ -3,5 +3,6 @@ interfacePlugin: Prelude interfacePlugin: GHC.Float interfacePlugin: GHC.Base typeCheckPlugin (rn) +interfacePlugin: GHC.Types typeCheckPlugin (tc) interfacePlugin: GHC.Num.BigNat ===================================== testsuite/tests/plugins/plugins10.stdout ===================================== @@ -6,6 +6,7 @@ interfacePlugin: GHC.Float interfacePlugin: GHC.Base interfacePlugin: Language.Haskell.TH.Syntax typeCheckPlugin (rn) +interfacePlugin: GHC.Types typeCheckPlugin (tc) interfacePlugin: GHC.Num.BigNat parsePlugin(a) ===================================== testsuite/tests/plugins/plugins11.stdout ===================================== @@ -3,5 +3,6 @@ interfacePlugin: Prelude interfacePlugin: GHC.Float interfacePlugin: GHC.Base typeCheckPlugin (rn) +interfacePlugin: GHC.Types typeCheckPlugin (tc) interfacePlugin: GHC.Num.BigNat ===================================== testsuite/tests/plugins/static-plugins.stdout ===================================== @@ -5,11 +5,11 @@ interfacePlugin: GHC.Float interfacePlugin: GHC.Base interfacePlugin: System.IO typeCheckPlugin (rn) -interfacePlugin: GHC.Types +interfacePlugin: GHC.Prim interfacePlugin: GHC.Show +interfacePlugin: GHC.Types interfacePlugin: GHC.TopHandler typeCheckPlugin (tc) -interfacePlugin: GHC.Prim interfacePlugin: GHC.CString interfacePlugin: GHC.Num.BigNat ==pure.1 ===================================== testsuite/tests/printer/T18052a.stderr ===================================== @@ -10,9 +10,9 @@ Dependent packages: [base-4.16.0.0, ghc-bignum-1.0, ghc-prim-0.8.0] ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 24, types: 52, coercions: 0, joins: 0/0} + = {terms: 24, types: 61, coercions: 0, joins: 0/0} --- RHS size: {terms: 7, types: 6, coercions: 0, joins: 0/0} +-- RHS size: {terms: 7, types: 8, coercions: 0, joins: 0/0} T18052a.$b:||: :: forall {a} {b}. a -> b -> (a, b) [GblId, Arity=2, Unf=OtherCon []] T18052a.$b:||: = \ (@a) (@b) (x :: a) (y :: b) -> (x, y) @@ -22,7 +22,7 @@ T18052a.$b:||: = \ (@a) (@b) (x :: a) (y :: b) -> (x, y) [GblId] (+++) = ++ --- RHS size: {terms: 13, types: 18, coercions: 0, joins: 0/0} +-- RHS size: {terms: 13, types: 20, coercions: 0, joins: 0/0} T18052a.$m:||: :: forall {rep :: GHC.Types.RuntimeRep} {r :: TYPE rep} {a} {b}. (a, b) -> (a -> b -> r) -> ((# #) -> r) -> r ===================================== testsuite/tests/simplCore/should_compile/T13143.stderr ===================================== @@ -1,17 +1,17 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 71, types: 40, coercions: 0, joins: 0/0} + = {terms: 71, types: 44, coercions: 0, joins: 0/0} Rec { --- RHS size: {terms: 4, types: 3, coercions: 0, joins: 0/0} +-- RHS size: {terms: 4, types: 4, coercions: 0, joins: 0/0} T13143.$wf [InlPrag=NOINLINE, Occ=LoopBreaker] :: forall {a}. (# #) -> a [GblId, Arity=1, Str=b, Cpr=b, Unf=OtherCon []] T13143.$wf = \ (@a) _ [Occ=Dead] -> T13143.$wf @a GHC.Prim.(##) end Rec } --- RHS size: {terms: 4, types: 3, coercions: 0, joins: 0/0} +-- RHS size: {terms: 4, types: 4, coercions: 0, joins: 0/0} f [InlPrag=[final]] :: forall a. Int -> a [GblId, Arity=1, ===================================== testsuite/tests/simplCore/should_compile/T18013.stderr ===================================== @@ -129,9 +129,9 @@ Rule fired: Class op fmap (BUILTIN) ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 52, types: 101, coercions: 17, joins: 0/1} + = {terms: 52, types: 106, coercions: 17, joins: 0/1} --- RHS size: {terms: 37, types: 84, coercions: 17, joins: 0/1} +-- RHS size: {terms: 37, types: 87, coercions: 17, joins: 0/1} mapMaybeRule :: forall a b. Rule IO a b -> Rule IO (Maybe a) (Maybe b) [GblId, ===================================== testsuite/tests/simplCore/should_compile/T7360.stderr ===================================== @@ -1,7 +1,7 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 106, types: 45, coercions: 0, joins: 0/0} + = {terms: 106, types: 47, coercions: 0, joins: 0/0} -- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} T7360.$WFoo3 [InlPrag=INLINE[final] CONLIKE] :: Int %1 -> Foo @@ -31,7 +31,7 @@ T7360.fun4 :: () WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 20 0}] T7360.fun4 = fun1 T7360.Foo1 --- RHS size: {terms: 11, types: 7, coercions: 0, joins: 0/0} +-- RHS size: {terms: 11, types: 8, coercions: 0, joins: 0/0} fun2 :: forall {a}. [a] -> ((), Int) [GblId, Arity=1, ===================================== testsuite/tests/typecheck/should_compile/T13032.stderr ===================================== @@ -1,9 +1,9 @@ ==================== Desugar (after optimization) ==================== Result size of Desugar (after optimization) - = {terms: 13, types: 18, coercions: 0, joins: 0/0} + = {terms: 13, types: 24, coercions: 0, joins: 0/0} --- RHS size: {terms: 6, types: 8, coercions: 0, joins: 0/0} +-- RHS size: {terms: 6, types: 11, coercions: 0, joins: 0/0} f :: forall a b. (a ~ b) => a -> b -> Bool [LclIdX, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 48c4982646b7fe6343ccdf1581c97a7735fe8940 +Subproject commit acf235d607879eb9542127eb0ddb42a250b5b850 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/92377c27e1a48d0d3776f65c7074dfeb122b46db -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/92377c27e1a48d0d3776f65c7074dfeb122b46db You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Dec 14 18:49:34 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 14 Dec 2020 13:49:34 -0500 Subject: [Git][ghc/ghc][wip/tyconapp-opts] 23 commits: Display FFI labels (fix #18539) Message-ID: <5fd7b3be2d463_6b2131d5c3815480b1@gitlab.mail> Ben Gamari pushed to branch wip/tyconapp-opts at Glasgow Haskell Compiler / GHC Commits: 381eb660 by Sylvain Henry at 2020-12-11T12:57:35-05:00 Display FFI labels (fix #18539) - - - - - 4548d1f8 by Aaron Allen at 2020-12-11T12:58:14-05:00 Elide extraneous messages for :doc command (#15784) Do not print `<has no documentation>` alongside a valid doc. Additionally, if two matching symbols lack documentation then the message will only be printed once. Hence, `<has no documentation>` will be printed at most once and only if all matching symbols are lacking docs. - - - - - 5eba91b6 by Aaron Allen at 2020-12-11T12:58:14-05:00 Add :doc test case for duplicate record fields Tests that the output of the `:doc` command is correct for duplicate record fields defined using -XDuplicateRecordFields. - - - - - 5feb9b2d by Ryan Scott at 2020-12-11T22:39:29-05:00 Delete outdated Note [Kind-checking tyvar binders for associated types] This Note has severely bitrotted, as it has no references anywhere in the codebase, and none of the functions that it mentions exist anymore. Let's just delete this. While I was in town, I deleted some outdated comments from `checkFamPatBinders` of a similar caliber. Fixes #19008. [ci skip] - - - - - f9f9f030 by Sylvain Henry at 2020-12-11T22:40:08-05:00 Arrows: correctly query arrow methods (#17423) Consider the following code: proc (C x y) -> ... Before this patch, the evidence binding for the Arrow dictionary was attached to the C pattern: proc (C x y) { $dArrow = ... } -> ... But then when we desugar this, we use arrow operations ("arr", ">>>"...) specialised for this arrow: let arr_xy = arr $dArrow -- <-- Not in scope! ... in arr_xy (\(C x y) { $dArrow = ... } -> ...) This patch allows arrow operations to be type-checked before the proc itself, avoiding this issue. Fix #17423 - - - - - aaa8f00f by Sylvain Henry at 2020-12-11T22:40:48-05:00 Validate script: fix configure command when using stack - - - - - b4a929a1 by Sylvain Henry at 2020-12-11T22:41:30-05:00 Hadrian: fix libffi tarball parsing Fix parsing of "libffi-3.3.tar.gz". NB: switch to a newer libffi isn't done in this patch - - - - - 690c8946 by Sylvain Henry at 2020-12-11T22:42:09-05:00 Parser: move parser utils into their own module Move code unrelated to runtime evaluation out of GHC.Runtime.Eval - - - - - 76be0e32 by Sylvain Henry at 2020-12-11T22:42:48-05:00 Move SizedSeq into ghc-boot - - - - - 3a16d764 by Sylvain Henry at 2020-12-11T22:42:48-05:00 ghci: don't compile unneeded modules - - - - - 2895fa60 by Sylvain Henry at 2020-12-11T22:42:48-05:00 ghci: reuse Arch from ghc-boot - - - - - 480a38d4 by Sylvain Henry at 2020-12-11T22:43:30-05:00 rts: don't use siginterrupt (#19019) - - - - - 4af6126d by Sylvain Henry at 2020-12-11T22:44:11-05:00 Use static array in zeroCount - - - - - 5bd71bfd by Sebastian Graf at 2020-12-12T04:45:09-05:00 DmdAnal: Annotate top-level function bindings with demands (#18894) It's useful to annotate a non-exported top-level function like `g` in ```hs module Lib (h) where g :: Int -> Int -> (Int,Int) g m 1 = (m, 0) g m n = (2 * m, 2 `div` n) {-# NOINLINE g #-} h :: Int -> Int h 1 = 0 h m | odd m = snd (g m 2) | otherwise = uncurry (+) (g 2 m) ``` with its demand `UCU(CS(P(1P(U),SP(U))`, which tells us that whenever `g` was called, the second component of the returned pair was evaluated strictly. Since #18903 we do so for local functions, where we can see all calls. For top-level functions, we can assume that all *exported* functions are demanded according to `topDmd` and thus get sound demands for non-exported top-level functions. The demand on `g` is crucial information for Nested CPR, which may the go on and unbox `g` for the second pair component. That is true even if that pair component may diverge, as is the case for the call site `g 13 0`, which throws a div-by-zero exception. In `T18894b`, you can even see the new demand annotation enabling us to eta-expand a function that we wouldn't be able to eta-expand without Call Arity. We only track bindings of function type in order not to risk huge compile-time regressions, see `isInterestingTopLevelFn`. There was a CoreLint check that rejected strict demand annotations on recursive or top-level bindings, which seems completely unjustified. All the cases I investigated were fine, so I removed it. Fixes #18894. - - - - - 3aae036e by Sebastian Graf at 2020-12-12T04:45:09-05:00 Demand: Simplify `CU(U)` to `U` (#19005) Both sub-demands encode the same information. This is a trivial change and already affects a few regression tests (e.g. `T5075`), so no separate regression test is necessary. - - - - - c6477639 by Adam Sandberg Ericsson at 2020-12-12T04:45:48-05:00 hadrian: correctly copy the docs dir into the bindist #18669 - - - - - e033dd05 by Adam Sandberg Ericsson at 2020-12-12T10:52:19+00:00 mkDocs: support hadrian bindists #18973 - - - - - 78580ba3 by John Ericson at 2020-12-13T07:14:50-05:00 Remove old .travis.yml - - - - - c696bb2f by Cale Gibbard at 2020-12-14T13:37:09-05:00 Implement type applications in patterns The haddock submodule is also updated so that it understands the changes to patterns. - - - - - 7e9debd4 by Ben Gamari at 2020-12-14T13:37:09-05:00 Optimise nullary type constructor usage During the compilation of programs GHC very frequently deals with the `Type` type, which is a synonym of `TYPE 'LiftedRep`. This patch teaches GHC to avoid expanding the `Type` synonym (and other nullary type synonyms) during type comparisons, saving a good amount of work. This optimisation is described in `Note [Comparing nullary type synonyms]`. To maximize the impact of this optimisation, we introduce a few special-cases to reduce `TYPE 'LiftedRep` to `Type`. See `Note [Prefer Type over TYPE 'LiftedPtrRep]`. Closes #17958. Metric Decrease: T18698b T1969 T12227 T12545 T12707 T14683 T3064 T5631 T5642 T9020 T9630 T9872a T13035 haddock.Cabal haddock.base - - - - - 92377c27 by Ben Gamari at 2020-12-14T13:41:58-05:00 Revert "Optimise nullary type constructor usage" This was inadvertently merged. This reverts commit 7e9debd4ceb068effe8ac81892d2cabcb8f55850. - - - - - d0e8c10d by Sylvain Henry at 2020-12-14T19:45:13+01:00 Move Unit related fields from DynFlags to HscEnv The unit database cache, the home unit and the unit state were stored in DynFlags while they ought to be stored in the compiler session state (HscEnv). This patch fixes this. It introduces a new UnitEnv type that should be used in the future to handle separate unit environments (especially host vs target units). Related to #17957 Bump haddock submodule - - - - - 7c1056ef by Ben Gamari at 2020-12-14T13:49:05-05:00 Optimise nullary type constructor usage During the compilation of programs GHC very frequently deals with the `Type` type, which is a synonym of `TYPE 'LiftedRep`. This patch teaches GHC to avoid expanding the `Type` synonym (and other nullary type synonyms) during type comparisons, saving a good amount of work. This optimisation is described in `Note [Comparing nullary type synonyms]`. To maximize the impact of this optimisation, we introduce a few special-cases to reduce `TYPE 'LiftedRep` to `Type`. See `Note [Prefer Type over TYPE 'LiftedPtrRep]`. Closes #17958. Metric Decrease: T18698b T1969 T12227 T12545 T12707 T14683 T3064 T5631 T5642 T9020 T9630 T9872a T13035 haddock.Cabal haddock.base - - - - - 30 changed files: - − .travis.yml - compiler/GHC.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - + compiler/GHC/Builtin/Types/Prim.hs-boot - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Parser/Monad.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Env.hs - compiler/GHC/Driver/Hooks.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6f404e9285a848f847a6880bfe836a3f3bdef8e4...7c1056ef11209a5a5133438213a2a294a9772a57 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6f404e9285a848f847a6880bfe836a3f3bdef8e4...7c1056ef11209a5a5133438213a2a294a9772a57 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Dec 14 19:07:19 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 14 Dec 2020 14:07:19 -0500 Subject: [Git][ghc/ghc][wip/T19030] 22 commits: Display FFI labels (fix #18539) Message-ID: <5fd7b7e740a91_6b215ab2cc815510e5@gitlab.mail> Ben Gamari pushed to branch wip/T19030 at Glasgow Haskell Compiler / GHC Commits: 381eb660 by Sylvain Henry at 2020-12-11T12:57:35-05:00 Display FFI labels (fix #18539) - - - - - 4548d1f8 by Aaron Allen at 2020-12-11T12:58:14-05:00 Elide extraneous messages for :doc command (#15784) Do not print `<has no documentation>` alongside a valid doc. Additionally, if two matching symbols lack documentation then the message will only be printed once. Hence, `<has no documentation>` will be printed at most once and only if all matching symbols are lacking docs. - - - - - 5eba91b6 by Aaron Allen at 2020-12-11T12:58:14-05:00 Add :doc test case for duplicate record fields Tests that the output of the `:doc` command is correct for duplicate record fields defined using -XDuplicateRecordFields. - - - - - 5feb9b2d by Ryan Scott at 2020-12-11T22:39:29-05:00 Delete outdated Note [Kind-checking tyvar binders for associated types] This Note has severely bitrotted, as it has no references anywhere in the codebase, and none of the functions that it mentions exist anymore. Let's just delete this. While I was in town, I deleted some outdated comments from `checkFamPatBinders` of a similar caliber. Fixes #19008. [ci skip] - - - - - f9f9f030 by Sylvain Henry at 2020-12-11T22:40:08-05:00 Arrows: correctly query arrow methods (#17423) Consider the following code: proc (C x y) -> ... Before this patch, the evidence binding for the Arrow dictionary was attached to the C pattern: proc (C x y) { $dArrow = ... } -> ... But then when we desugar this, we use arrow operations ("arr", ">>>"...) specialised for this arrow: let arr_xy = arr $dArrow -- <-- Not in scope! ... in arr_xy (\(C x y) { $dArrow = ... } -> ...) This patch allows arrow operations to be type-checked before the proc itself, avoiding this issue. Fix #17423 - - - - - aaa8f00f by Sylvain Henry at 2020-12-11T22:40:48-05:00 Validate script: fix configure command when using stack - - - - - b4a929a1 by Sylvain Henry at 2020-12-11T22:41:30-05:00 Hadrian: fix libffi tarball parsing Fix parsing of "libffi-3.3.tar.gz". NB: switch to a newer libffi isn't done in this patch - - - - - 690c8946 by Sylvain Henry at 2020-12-11T22:42:09-05:00 Parser: move parser utils into their own module Move code unrelated to runtime evaluation out of GHC.Runtime.Eval - - - - - 76be0e32 by Sylvain Henry at 2020-12-11T22:42:48-05:00 Move SizedSeq into ghc-boot - - - - - 3a16d764 by Sylvain Henry at 2020-12-11T22:42:48-05:00 ghci: don't compile unneeded modules - - - - - 2895fa60 by Sylvain Henry at 2020-12-11T22:42:48-05:00 ghci: reuse Arch from ghc-boot - - - - - 480a38d4 by Sylvain Henry at 2020-12-11T22:43:30-05:00 rts: don't use siginterrupt (#19019) - - - - - 4af6126d by Sylvain Henry at 2020-12-11T22:44:11-05:00 Use static array in zeroCount - - - - - 5bd71bfd by Sebastian Graf at 2020-12-12T04:45:09-05:00 DmdAnal: Annotate top-level function bindings with demands (#18894) It's useful to annotate a non-exported top-level function like `g` in ```hs module Lib (h) where g :: Int -> Int -> (Int,Int) g m 1 = (m, 0) g m n = (2 * m, 2 `div` n) {-# NOINLINE g #-} h :: Int -> Int h 1 = 0 h m | odd m = snd (g m 2) | otherwise = uncurry (+) (g 2 m) ``` with its demand `UCU(CS(P(1P(U),SP(U))`, which tells us that whenever `g` was called, the second component of the returned pair was evaluated strictly. Since #18903 we do so for local functions, where we can see all calls. For top-level functions, we can assume that all *exported* functions are demanded according to `topDmd` and thus get sound demands for non-exported top-level functions. The demand on `g` is crucial information for Nested CPR, which may the go on and unbox `g` for the second pair component. That is true even if that pair component may diverge, as is the case for the call site `g 13 0`, which throws a div-by-zero exception. In `T18894b`, you can even see the new demand annotation enabling us to eta-expand a function that we wouldn't be able to eta-expand without Call Arity. We only track bindings of function type in order not to risk huge compile-time regressions, see `isInterestingTopLevelFn`. There was a CoreLint check that rejected strict demand annotations on recursive or top-level bindings, which seems completely unjustified. All the cases I investigated were fine, so I removed it. Fixes #18894. - - - - - 3aae036e by Sebastian Graf at 2020-12-12T04:45:09-05:00 Demand: Simplify `CU(U)` to `U` (#19005) Both sub-demands encode the same information. This is a trivial change and already affects a few regression tests (e.g. `T5075`), so no separate regression test is necessary. - - - - - c6477639 by Adam Sandberg Ericsson at 2020-12-12T04:45:48-05:00 hadrian: correctly copy the docs dir into the bindist #18669 - - - - - e033dd05 by Adam Sandberg Ericsson at 2020-12-12T10:52:19+00:00 mkDocs: support hadrian bindists #18973 - - - - - 78580ba3 by John Ericson at 2020-12-13T07:14:50-05:00 Remove old .travis.yml - - - - - c696bb2f by Cale Gibbard at 2020-12-14T13:37:09-05:00 Implement type applications in patterns The haddock submodule is also updated so that it understands the changes to patterns. - - - - - 7e9debd4 by Ben Gamari at 2020-12-14T13:37:09-05:00 Optimise nullary type constructor usage During the compilation of programs GHC very frequently deals with the `Type` type, which is a synonym of `TYPE 'LiftedRep`. This patch teaches GHC to avoid expanding the `Type` synonym (and other nullary type synonyms) during type comparisons, saving a good amount of work. This optimisation is described in `Note [Comparing nullary type synonyms]`. To maximize the impact of this optimisation, we introduce a few special-cases to reduce `TYPE 'LiftedRep` to `Type`. See `Note [Prefer Type over TYPE 'LiftedPtrRep]`. Closes #17958. Metric Decrease: T18698b T1969 T12227 T12545 T12707 T14683 T3064 T5631 T5642 T9020 T9630 T9872a T13035 haddock.Cabal haddock.base - - - - - 92377c27 by Ben Gamari at 2020-12-14T13:41:58-05:00 Revert "Optimise nullary type constructor usage" This was inadvertently merged. This reverts commit 7e9debd4ceb068effe8ac81892d2cabcb8f55850. - - - - - a00e6602 by Ben Gamari at 2020-12-14T14:07:12-05:00 ghci: Take editor from VISUAL environment variable Following the example of `git`, as noted in #19030. Fixes #19030. - - - - - 30 changed files: - − .travis.yml - compiler/GHC.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Errors.hs - compiler/GHC/Parser/Errors/Ppr.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Parser/PostProcess/Haddock.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e02c53087c5c3a1de38aeeb79b5dc16fd1185a65...a00e66025bfffefd8a3bcd0de2b35bbd2ba7e174 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e02c53087c5c3a1de38aeeb79b5dc16fd1185a65...a00e66025bfffefd8a3bcd0de2b35bbd2ba7e174 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Dec 14 19:13:55 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 14 Dec 2020 14:13:55 -0500 Subject: [Git][ghc/ghc][wip/backports-8.10] 6 commits: Fix bad span calculations of post qualified imports Message-ID: <5fd7b97362835_6b2174471c15551ac@gitlab.mail> Ben Gamari pushed to branch wip/backports-8.10 at Glasgow Haskell Compiler / GHC Commits: fac6a05d by Shayne Fletcher at 2020-12-14T14:13:49-05:00 Fix bad span calculations of post qualified imports (cherry picked from commit 57f3fdb1fbeb82b5b19bc5e2970d8857c2514fcc) - - - - - 5072f019 by Ben Gamari at 2020-12-14T14:13:49-05:00 gitlab-ci: Rename RELEASE variable to RELEASE_JOB This interfered with the autoconf variable of the same name, breaking pre-release builds. (cherry picked from commit 15dca84793d5ec4ff922726477923e40caa075eb) (cherry picked from commit 3e55edd97c8eba271f5cb64b9362796791e0e887) - - - - - 86c8c8df by Ben Gamari at 2020-12-14T14:13:49-05:00 configure: Release 8.10.3 - - - - - 8e548f38 by Ben Gamari at 2020-12-14T14:13:49-05:00 Disable deprecation warnings in Cabal build - - - - - a4c19abe by Ben Gamari at 2020-12-14T14:13:49-05:00 hadrian: Reindent Settings.Warnings The previous state was quite illegible. - - - - - 0b3497ef by Ben Gamari at 2020-12-14T14:13:49-05:00 hadrian: Pass -Werror before other arguments Previously we would append -Werror to the argument list. However, this ended up overriding the -Wno-error=... flags in Settings.Warnings. - - - - - 10 changed files: - .gitlab-ci.yml - compiler/parser/Parser.y - configure.ac - hadrian/src/Flavour.hs - hadrian/src/Settings/Warnings.hs - libraries/text - mk/warnings.mk - testsuite/tests/module/all.T - + testsuite/tests/module/mod185.hs - + testsuite/tests/module/mod185.stderr Changes: ===================================== .gitlab-ci.yml ===================================== @@ -52,7 +52,7 @@ stages: expire_in: 1 year only: variables: - - $RELEASE == "yes" + - $RELEASE_JOB == "yes" ############################################################ # Runner Tags ===================================== compiler/parser/Parser.y ===================================== @@ -973,18 +973,20 @@ importdecls_semi importdecl :: { LImportDecl GhcPs } : 'import' maybe_src maybe_safe optqualified maybe_pkg modid optqualified maybeas maybeimpspec {% do { - ; checkImportDecl $4 $7 - ; ams (cL (comb4 $1 $6 (snd $8) $9) $ + ; let { ; mPreQual = unLoc $4 + ; mPostQual = unLoc $7 } + ; checkImportDecl mPreQual mPostQual + ; ams (cL (comb5 $1 $6 $7 (snd $8) $9) $ ImportDecl { ideclExt = noExtField , ideclSourceSrc = snd $ fst $2 , ideclName = $6, ideclPkgQual = snd $5 , ideclSource = snd $2, ideclSafe = snd $3 - , ideclQualified = importDeclQualifiedStyle $4 $7 + , ideclQualified = importDeclQualifiedStyle mPreQual mPostQual , ideclImplicit = False , ideclAs = unLoc (snd $8) , ideclHiding = unLoc $9 }) - (mj AnnImport $1 : fst (fst $2) ++ fst $3 ++ fmap (mj AnnQualified) (maybeToList $4) - ++ fst $5 ++ fmap (mj AnnQualified) (maybeToList $7) ++ fst $8) + (mj AnnImport $1 : fst (fst $2) ++ fst $3 ++ fmap (mj AnnQualified) (maybeToList mPreQual) + ++ fst $5 ++ fmap (mj AnnQualified) (maybeToList mPostQual) ++ fst $8) } } @@ -1008,9 +1010,9 @@ maybe_pkg :: { ([AddAnn],Maybe StringLiteral) } ; return ([mj AnnPackageName $1], Just (StringLiteral (getSTRINGs $1) pkgFS)) } } | {- empty -} { ([],Nothing) } -optqualified :: { Maybe (Located Token) } - : 'qualified' { Just $1 } - | {- empty -} { Nothing } +optqualified :: { Located (Maybe (Located Token)) } + : 'qualified' { sL1 $1 (Just $1) } + | {- empty -} { noLoc Nothing } maybeas :: { ([AddAnn],Located (Maybe (Located ModuleName))) } : 'as' modid { ([mj AnnAs $1] @@ -3896,6 +3898,11 @@ comb4 a b c d = a `seq` b `seq` c `seq` d `seq` (combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $ combineSrcSpans (getLoc c) (getLoc d)) +comb5 :: Located a -> Located b -> Located c -> Located d -> Located e -> SrcSpan +comb5 a b c d e = a `seq` b `seq` c `seq` d `seq` e `seq` + (combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $ + combineSrcSpans (getLoc c) $ combineSrcSpans (getLoc d) (getLoc e)) + -- strict constructor version: {-# INLINE sL #-} sL :: HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a ===================================== configure.ac ===================================== @@ -13,10 +13,10 @@ dnl # see what flags are available. (Better yet, read the documentation!) # -AC_INIT([The Glorious Glasgow Haskell Compilation System], [8.10.2], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) +AC_INIT([The Glorious Glasgow Haskell Compilation System], [8.10.3], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) # Set this to YES for a released version, otherwise NO -: ${RELEASE=NO} +: ${RELEASE=YES} # The primary version (e.g. 7.5, 7.4.1) is set in the AC_INIT line # above. If this is not a released version, then we will append the ===================================== hadrian/src/Flavour.hs ===================================== @@ -2,7 +2,7 @@ module Flavour ( Flavour (..), werror , DocTargets, DocTarget(..) -- * Flavour transformers - , addArgs + , addArgs, addArgsBefore , splitSections, splitSectionsIf , enableThreadSanitizer , enableDebugInfo, enableTickyGhc @@ -71,10 +71,15 @@ data DocTarget = Haddocks | SphinxHTML | SphinxPDFs | SphinxMan | SphinxInfo addArgs :: Args -> Flavour -> Flavour addArgs args' fl = fl { args = args fl <> args' } +addArgsBefore :: Args -> Flavour -> Flavour +addArgsBefore args' fl = fl { args = args' <> args fl } + -- | Turn on -Werror for packages built with the stage1 compiler. -- It mimics the CI settings so is useful to turn on when developing. werror :: Flavour -> Flavour -werror = addArgs (builder Ghc ? notStage0 ? arg "-Werror") +werror = addArgsBefore (builder Ghc ? notStage0 ? arg "-Werror") + -- N.B. We add this flag *before* the others to ensure that we don't override + -- the -Wno-error flags defined in "Settings.Warnings". -- | Build C and Haskell objects with debugging information. enableDebugInfo :: Flavour -> Flavour ===================================== hadrian/src/Settings/Warnings.hs ===================================== @@ -20,35 +20,39 @@ ghcWarningsArgs = do isIntegerSimple <- (== integerSimple) <$> getIntegerPackage mconcat [ stage0 ? mconcat - [ libraryPackage ? pure [ "-fno-warn-deprecated-flags" ] - , package terminfo ? pure [ "-fno-warn-unused-imports" ] - , package transformers ? pure [ "-fno-warn-unused-matches" - , "-fno-warn-unused-imports" ] ] + [ libraryPackage ? pure [ "-fno-warn-deprecated-flags" ] + , package terminfo ? pure [ "-fno-warn-unused-imports" ] + , package transformers ? pure [ "-fno-warn-unused-matches" + , "-fno-warn-unused-imports" ] ] , notStage0 ? mconcat - [ libraryPackage ? pure [ "-Wno-deprecated-flags" ] - , package base ? pure [ "-Wno-trustworthy-safe" ] - , package binary ? pure [ "-Wno-deprecations" ] - , package bytestring ? pure [ "-Wno-inline-rule-shadowing" ] - , package compiler ? pure [ "-Wcpp-undef" ] - , package directory ? pure [ "-Wno-unused-imports" ] - , package ghc ? pure [ "-Wcpp-undef" ] - , package ghcPrim ? pure [ "-Wno-trustworthy-safe" ] - , package haddock ? pure [ "-Wno-unused-imports" - , "-Wno-deprecations" ] - , package haskeline ? pure [ "-Wno-deprecations" - , "-Wno-unused-imports" - , "-Wno-redundant-constraints" - , "-Wno-simplifiable-class-constraints" ] - , package pretty ? pure [ "-Wno-unused-imports" ] - , package primitive ? pure [ "-Wno-unused-imports" - , "-Wno-deprecations" ] - , package rts ? pure [ "-Wcpp-undef" ] - , package terminfo ? pure [ "-Wno-unused-imports" ] - , isIntegerSimple ? - package text ? pure [ "-Wno-unused-imports" ] - , package transformers ? pure [ "-Wno-unused-matches" - , "-Wno-unused-imports" - , "-Wno-redundant-constraints" - , "-Wno-orphans" ] - , package win32 ? pure [ "-Wno-trustworthy-safe" ] - , package xhtml ? pure [ "-Wno-unused-imports" ] ] ] + [ libraryPackage ? pure [ "-Wno-deprecated-flags" ] + , package base ? pure [ "-Wno-trustworthy-safe" ] + , package binary ? pure [ "-Wno-deprecations" ] + , package bytestring ? pure [ "-Wno-inline-rule-shadowing" ] + , package compiler ? pure [ "-Wcpp-undef" ] + , package directory ? pure [ "-Wno-unused-imports" ] + , package ghc ? pure [ "-Wcpp-undef" ] + , package ghcPrim ? pure [ "-Wno-trustworthy-safe" ] + , package haddock ? pure [ "-Wno-unused-imports" + , "-Wno-deprecations" ] + , package haskeline ? pure [ "-Wno-deprecations" + , "-Wno-unused-imports" + , "-Wno-redundant-constraints" + , "-Wno-simplifiable-class-constraints" ] + , package pretty ? pure [ "-Wno-unused-imports" ] + , package primitive ? pure [ "-Wno-unused-imports" + , "-Wno-deprecations" ] + , package rts ? pure [ "-Wcpp-undef" ] + , package terminfo ? pure [ "-Wno-unused-imports" ] + , isIntegerSimple ? + package text ? pure [ "-Wno-unused-imports" ] + , package transformers ? pure [ "-Wno-unused-matches" + , "-Wno-unused-imports" + , "-Wno-redundant-constraints" + , "-Wno-orphans" ] + , package win32 ? pure [ "-Wno-trustworthy-safe" ] + , package xhtml ? pure [ "-Wno-unused-imports" ] + ] + , mconcat + [ package cabal ? pure [ "-Wno-error=deprecations" ] ] + ] ===================================== libraries/text ===================================== @@ -1 +1 @@ -Subproject commit be54b46175db603aafea3e3f19a6a75e87a29828 +Subproject commit e07c14940c25f33fe5b282912d745d3a79dd4ade ===================================== mk/warnings.mk ===================================== @@ -80,6 +80,8 @@ libraries/haskeline_dist-install_EXTRA_HC_OPTS += -Wno-unused-imports libraries/haskeline_dist-install_EXTRA_HC_OPTS += -Wno-redundant-constraints libraries/haskeline_dist-install_EXTRA_HC_OPTS += -Wno-simplifiable-class-constraints +# Due to deprecation warning +libraries/Cabal_dist-install_EXTRA_HC_OPTS += -Wno-error=deprecations # temporarily turn off unused-imports warnings for pretty libraries/pretty_dist-install_EXTRA_HC_OPTS += -Wno-unused-imports ===================================== testsuite/tests/module/all.T ===================================== @@ -268,6 +268,7 @@ test('mod181', normal, compile, ['']) test('mod182', normal, compile_fail, ['']) test('mod183', normal, compile_fail, ['']) test('mod184', normal, compile, ['-Wprepositive-qualified-module']) +test('mod185', normal, compile, ['-ddump-parsed-ast']) test('T1148', normal, compile, ['']) test('T1074', normal, compile, ['']) ===================================== testsuite/tests/module/mod185.hs ===================================== @@ -0,0 +1,5 @@ +{-# LANGUAGE ImportQualifiedPost #-} +-- The span of the import decl should include the 'qualified' keyword. +import Prelude qualified + +main = Prelude.undefined ===================================== testsuite/tests/module/mod185.stderr ===================================== @@ -0,0 +1,61 @@ +==================== Parser AST ==================== + +({ mod185.hs:1:1 } + (HsModule + (Nothing) + (Nothing) + [({ mod185.hs:3:1-24 } + (ImportDecl + (NoExtField) + (NoSourceText) + ({ mod185.hs:3:8-14 } + {ModuleName: Prelude}) + (Nothing) + (False) + (False) + (QualifiedPost) + (False) + (Nothing) + (Nothing)))] + [({ mod185.hs:5:1-24 } + (ValD + (NoExtField) + (FunBind + (NoExtField) + ({ mod185.hs:5:1-4 } + (Unqual + {OccName: main})) + (MG + (NoExtField) + ({ mod185.hs:5:1-24 } + [({ mod185.hs:5:1-24 } + (Match + (NoExtField) + (FunRhs + ({ mod185.hs:5:1-4 } + (Unqual + {OccName: main})) + (Prefix) + (NoSrcStrict)) + [] + (GRHSs + (NoExtField) + [({ mod185.hs:5:6-24 } + (GRHS + (NoExtField) + [] + ({ mod185.hs:5:8-24 } + (HsVar + (NoExtField) + ({ mod185.hs:5:8-24 } + (Qual + {ModuleName: Prelude} + {OccName: undefined}))))))] + ({ } + (EmptyLocalBinds + (NoExtField))))))]) + (FromSource)) + (WpHole) + [])))] + (Nothing) + (Nothing))) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/eb9c45a0d612f8e16a0b0abd686534fedfdbac78...0b3497ef219311a12d7bbe756fb7210cee8a2f7b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/eb9c45a0d612f8e16a0b0abd686534fedfdbac78...0b3497ef219311a12d7bbe756fb7210cee8a2f7b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Dec 14 20:20:31 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 14 Dec 2020 15:20:31 -0500 Subject: [Git][ghc/ghc][wip/andreask/opt_dumps] 37 commits: Fix kind inference for data types. Again. Message-ID: <5fd7c90f6fc13_6b216281648156572@gitlab.mail> Ben Gamari pushed to branch wip/andreask/opt_dumps at Glasgow Haskell Compiler / GHC Commits: 62ed6957 by Simon Peyton Jones at 2020-12-08T15:31:41-05:00 Fix kind inference for data types. Again. This patch fixes several aspects of kind inference for data type declarations, especially data /instance/ declarations Specifically 1. In kcConDecls/kcConDecl make it clear that the tc_res_kind argument is only used in the H98 case; and in that case there is no result kind signature; and hence no need for the disgusting splitPiTys in kcConDecls (now thankfully gone). The GADT case is a bit different to before, and much nicer. This is what fixes #18891. See Note [kcConDecls: kind-checking data type decls] 2. Do not look at the constructor decls of a data/newtype instance in tcDataFamInstanceHeader. See GHC.Tc.TyCl.Instance Note [Kind inference for data family instances]. This was a new realisation that arose when doing (1) This causes a few knock-on effects in the tests suite, because we require more information than before in the instance /header/. New user-manual material about this in "Kind inference in data type declarations" and "Kind inference for data/newtype instance declarations". 3. Minor improvement in kcTyClDecl, combining GADT and H98 cases 4. Fix #14111 and #8707 by allowing the header of a data instance to affect kind inferece for the the data constructor signatures; as described at length in Note [GADT return types] in GHC.Tc.TyCl This led to a modest refactoring of the arguments (and argument order) of tcConDecl/tcConDecls. 5. Fix #19000 by inverting the sense of the test in new_locs in GHC.Tc.Solver.Canonical.canDecomposableTyConAppOK. - - - - - 0abe3ddf by Adam Sandberg Ericsson at 2020-12-08T15:32:19-05:00 hadrian: build the _l and _thr_l rts flavours in the develN flavours The ghc binary requires the eventlog rts since fc644b1a643128041cfec25db84e417851e28bab - - - - - 51e3bb6d by Andreas Klebinger at 2020-12-08T22:43:21-05:00 CodeGen: Make folds User/DefinerOfRegs INLINEABLE. Reduces allocation for the test case I was looking at by about 1.2%. Mostly from avoiding allocation of some folding functions which turn into let-no-escape bindings which just reuse their environment instead. We also force inlining in a few key places in CmmSink which helps a bit more. - - - - - 69ae10c3 by Andreas Klebinger at 2020-12-08T22:43:21-05:00 CmmSink: Force inlining of foldRegsDefd Helps avoid allocating the folding function. Improves perf for T3294 by about 1%. - - - - - 6e3da800 by Andreas Klebinger at 2020-12-08T22:43:21-05:00 Cmm: Make a few types and utility function slightly stricter. About 0.6% reduction in allocations for the code I was looking at. Not a huge difference but no need to throw away performance. - - - - - aef44d7f by Andreas Klebinger at 2020-12-08T22:43:21-05:00 Cmm.Sink: Optimize retaining of assignments, live sets. Sinking requires us to track live local regs after each cmm statement. We used to do this via "Set LocalReg". However we can replace this with a solution based on IntSet which is overall more efficient without losing much. The thing we lose is width of the variables, which isn't used by the sinking pass anyway. I also reworked how we keep assignments to regs mentioned in skipped assignments. I put the details into Note [Keeping assignemnts mentioned in skipped RHSs]. The gist of it is instead of keeping track of it via the use count which is a `IntMap Int` we now use the live regs set (IntSet) which is quite a bit faster. I think it also matches the semantics a lot better. The skipped (not discarded) assignment does in fact keep the regs on it's rhs alive so keeping track of this in the live set seems like the clearer solution as well. Improves allocations for T3294 by yet another 1%. - - - - - 59f2249b by Andreas Klebinger at 2020-12-08T22:43:21-05:00 GHC.Cmm.Opt: Be stricter in results. Optimization either returns Nothing if nothing is to be done or `Just <cmmExpr>` otherwise. There is no point in being lazy in `cmmExpr`. We usually inspect this element so the thunk gets forced not long after. We might eliminate it as dead code once in a blue moon but that's not a case worth optimizing for. Overall the impact of this is rather low. As Cmm.Opt doesn't allocate much (compared to the rest of GHC) to begin with. - - - - - 54b88eac by Andreas Klebinger at 2020-12-08T22:43:57-05:00 Bump time submodule. This should fix #19002. - - - - - 35e7b0c6 by Kirill Elagin at 2020-12-10T01:45:54-05:00 doc: Clarify the default for -fomit-yields “Yield points enabled” is confusing (and probably wrong? I am not 100% sure what it means). Change it to a simple “on”. Undo this change from 2c23fff2e03e77187dc4d01f325f5f43a0e7cad2. - - - - - 3551c554 by Kirill Elagin at 2020-12-10T01:45:54-05:00 doc: Extra-clarify -fomit-yields Be more clear on what this optimisation being on by default means in terms of yields. - - - - - 6484f0d7 by Sergei Trofimovich at 2020-12-10T01:46:33-05:00 rts/linker/Elf.c: add missing <dlfcn.h> include (musl support) The change fixes build failure on musl: ``` rts/linker/Elf.c:2031:3: error: warning: implicit declaration of function 'dlclose'; did you mean 'close'? [-Wimplicit-function-declaration] 2031 | dlclose(nc->dlopen_handle); | ^~~~~~~ | close ``` Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - ab24ed9b by Ben Gamari at 2020-12-11T03:55:51-05:00 users guide: Fix syntax errors Fixes errors introduced by 3a55b3a2574f913d046f3a6f82db48d7f6df32e3. - - - - - d3a24d31 by Ben Gamari at 2020-12-11T03:55:51-05:00 users guide: Describe GC lifecycle events Every time I am asked about how to interpret these events I need to figure it out from scratch. It's well past time that the users guide properly documents these. - - - - - 741309b9 by Ben Gamari at 2020-12-11T03:56:27-05:00 gitlab-ci: Fix incorrect Docker image for nightly cross job Also refactor the job definition to eliminate the bug by construction. - - - - - 19703bc8 by Ben Gamari at 2020-12-11T03:56:27-05:00 gitlab-ci: Fix name of flavour in ThreadSanitizer job It looks like I neglected to update this after introduce flavour transformers. - - - - - 381eb660 by Sylvain Henry at 2020-12-11T12:57:35-05:00 Display FFI labels (fix #18539) - - - - - 4548d1f8 by Aaron Allen at 2020-12-11T12:58:14-05:00 Elide extraneous messages for :doc command (#15784) Do not print `<has no documentation>` alongside a valid doc. Additionally, if two matching symbols lack documentation then the message will only be printed once. Hence, `<has no documentation>` will be printed at most once and only if all matching symbols are lacking docs. - - - - - 5eba91b6 by Aaron Allen at 2020-12-11T12:58:14-05:00 Add :doc test case for duplicate record fields Tests that the output of the `:doc` command is correct for duplicate record fields defined using -XDuplicateRecordFields. - - - - - 5feb9b2d by Ryan Scott at 2020-12-11T22:39:29-05:00 Delete outdated Note [Kind-checking tyvar binders for associated types] This Note has severely bitrotted, as it has no references anywhere in the codebase, and none of the functions that it mentions exist anymore. Let's just delete this. While I was in town, I deleted some outdated comments from `checkFamPatBinders` of a similar caliber. Fixes #19008. [ci skip] - - - - - f9f9f030 by Sylvain Henry at 2020-12-11T22:40:08-05:00 Arrows: correctly query arrow methods (#17423) Consider the following code: proc (C x y) -> ... Before this patch, the evidence binding for the Arrow dictionary was attached to the C pattern: proc (C x y) { $dArrow = ... } -> ... But then when we desugar this, we use arrow operations ("arr", ">>>"...) specialised for this arrow: let arr_xy = arr $dArrow -- <-- Not in scope! ... in arr_xy (\(C x y) { $dArrow = ... } -> ...) This patch allows arrow operations to be type-checked before the proc itself, avoiding this issue. Fix #17423 - - - - - aaa8f00f by Sylvain Henry at 2020-12-11T22:40:48-05:00 Validate script: fix configure command when using stack - - - - - b4a929a1 by Sylvain Henry at 2020-12-11T22:41:30-05:00 Hadrian: fix libffi tarball parsing Fix parsing of "libffi-3.3.tar.gz". NB: switch to a newer libffi isn't done in this patch - - - - - 690c8946 by Sylvain Henry at 2020-12-11T22:42:09-05:00 Parser: move parser utils into their own module Move code unrelated to runtime evaluation out of GHC.Runtime.Eval - - - - - 76be0e32 by Sylvain Henry at 2020-12-11T22:42:48-05:00 Move SizedSeq into ghc-boot - - - - - 3a16d764 by Sylvain Henry at 2020-12-11T22:42:48-05:00 ghci: don't compile unneeded modules - - - - - 2895fa60 by Sylvain Henry at 2020-12-11T22:42:48-05:00 ghci: reuse Arch from ghc-boot - - - - - 480a38d4 by Sylvain Henry at 2020-12-11T22:43:30-05:00 rts: don't use siginterrupt (#19019) - - - - - 4af6126d by Sylvain Henry at 2020-12-11T22:44:11-05:00 Use static array in zeroCount - - - - - 5bd71bfd by Sebastian Graf at 2020-12-12T04:45:09-05:00 DmdAnal: Annotate top-level function bindings with demands (#18894) It's useful to annotate a non-exported top-level function like `g` in ```hs module Lib (h) where g :: Int -> Int -> (Int,Int) g m 1 = (m, 0) g m n = (2 * m, 2 `div` n) {-# NOINLINE g #-} h :: Int -> Int h 1 = 0 h m | odd m = snd (g m 2) | otherwise = uncurry (+) (g 2 m) ``` with its demand `UCU(CS(P(1P(U),SP(U))`, which tells us that whenever `g` was called, the second component of the returned pair was evaluated strictly. Since #18903 we do so for local functions, where we can see all calls. For top-level functions, we can assume that all *exported* functions are demanded according to `topDmd` and thus get sound demands for non-exported top-level functions. The demand on `g` is crucial information for Nested CPR, which may the go on and unbox `g` for the second pair component. That is true even if that pair component may diverge, as is the case for the call site `g 13 0`, which throws a div-by-zero exception. In `T18894b`, you can even see the new demand annotation enabling us to eta-expand a function that we wouldn't be able to eta-expand without Call Arity. We only track bindings of function type in order not to risk huge compile-time regressions, see `isInterestingTopLevelFn`. There was a CoreLint check that rejected strict demand annotations on recursive or top-level bindings, which seems completely unjustified. All the cases I investigated were fine, so I removed it. Fixes #18894. - - - - - 3aae036e by Sebastian Graf at 2020-12-12T04:45:09-05:00 Demand: Simplify `CU(U)` to `U` (#19005) Both sub-demands encode the same information. This is a trivial change and already affects a few regression tests (e.g. `T5075`), so no separate regression test is necessary. - - - - - c6477639 by Adam Sandberg Ericsson at 2020-12-12T04:45:48-05:00 hadrian: correctly copy the docs dir into the bindist #18669 - - - - - e033dd05 by Adam Sandberg Ericsson at 2020-12-12T10:52:19+00:00 mkDocs: support hadrian bindists #18973 - - - - - 78580ba3 by John Ericson at 2020-12-13T07:14:50-05:00 Remove old .travis.yml - - - - - c696bb2f by Cale Gibbard at 2020-12-14T13:37:09-05:00 Implement type applications in patterns The haddock submodule is also updated so that it understands the changes to patterns. - - - - - 7e9debd4 by Ben Gamari at 2020-12-14T13:37:09-05:00 Optimise nullary type constructor usage During the compilation of programs GHC very frequently deals with the `Type` type, which is a synonym of `TYPE 'LiftedRep`. This patch teaches GHC to avoid expanding the `Type` synonym (and other nullary type synonyms) during type comparisons, saving a good amount of work. This optimisation is described in `Note [Comparing nullary type synonyms]`. To maximize the impact of this optimisation, we introduce a few special-cases to reduce `TYPE 'LiftedRep` to `Type`. See `Note [Prefer Type over TYPE 'LiftedPtrRep]`. Closes #17958. Metric Decrease: T18698b T1969 T12227 T12545 T12707 T14683 T3064 T5631 T5642 T9020 T9630 T9872a T13035 haddock.Cabal haddock.base - - - - - 92377c27 by Ben Gamari at 2020-12-14T13:41:58-05:00 Revert "Optimise nullary type constructor usage" This was inadvertently merged. This reverts commit 7e9debd4ceb068effe8ac81892d2cabcb8f55850. - - - - - c5187fe9 by Andreas Klebinger at 2020-12-14T15:20:15-05:00 Optimize dumping of consecutive whitespace. The naive way of putting out n characters of indent would be something like `hPutStr hdl (replicate n ' ')`. However this is quite inefficient as we allocate an absurd number of strings consisting of simply spaces as we don't cache them. To improve on this we now track if we can simply write ascii spaces via hPutBuf instead. This is the case when running with -ddump-to-file where we force the encoding to be UTF8. This avoids both the cost of going through encoding as well as avoiding allocation churn from all the white space. Instead we simply use hPutBuf on a preallocated unlifted string. When dumping stg like this: > nofib/spectral/simple/Main.hs -fforce-recomp -ddump-stg-final -ddump-to-file -c +RTS -s Allocations went from 1,778 MB to 1,702MB. About a 4% reduction of allocation! I did not measure the difference in runtime but expect it to be similar. Bumps the haddock submodule since the interface of GHC's Pretty slightly changed. ------------------------- Metric Decrease: T12227 ------------------------- - - - - - 30 changed files: - .gitlab-ci.yml - − .travis.yml - compiler/GHC.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/Expr.hs - + compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Liveness.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Driver/Ppr.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Extension.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Docs.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/432bac851a6893b4455f517fd5bea72c508789fd...c5187fe9509948971fd27e28556f20356e701229 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/432bac851a6893b4455f517fd5bea72c508789fd...c5187fe9509948971fd27e28556f20356e701229 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Dec 14 20:21:45 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 14 Dec 2020 15:21:45 -0500 Subject: [Git][ghc/ghc][wip/tyconapp-opts] 2 commits: Optimize dumping of consecutive whitespace. Message-ID: <5fd7c959d77c7_6b2174471c15666d0@gitlab.mail> Ben Gamari pushed to branch wip/tyconapp-opts at Glasgow Haskell Compiler / GHC Commits: c5187fe9 by Andreas Klebinger at 2020-12-14T15:20:15-05:00 Optimize dumping of consecutive whitespace. The naive way of putting out n characters of indent would be something like `hPutStr hdl (replicate n ' ')`. However this is quite inefficient as we allocate an absurd number of strings consisting of simply spaces as we don't cache them. To improve on this we now track if we can simply write ascii spaces via hPutBuf instead. This is the case when running with -ddump-to-file where we force the encoding to be UTF8. This avoids both the cost of going through encoding as well as avoiding allocation churn from all the white space. Instead we simply use hPutBuf on a preallocated unlifted string. When dumping stg like this: > nofib/spectral/simple/Main.hs -fforce-recomp -ddump-stg-final -ddump-to-file -c +RTS -s Allocations went from 1,778 MB to 1,702MB. About a 4% reduction of allocation! I did not measure the difference in runtime but expect it to be similar. Bumps the haddock submodule since the interface of GHC's Pretty slightly changed. ------------------------- Metric Decrease: T12227 ------------------------- - - - - - 795ff28d by Ben Gamari at 2020-12-14T15:21:31-05:00 Optimise nullary type constructor usage During the compilation of programs GHC very frequently deals with the `Type` type, which is a synonym of `TYPE 'LiftedRep`. This patch teaches GHC to avoid expanding the `Type` synonym (and other nullary type synonyms) during type comparisons, saving a good amount of work. This optimisation is described in `Note [Comparing nullary type synonyms]`. To maximize the impact of this optimisation, we introduce a few special-cases to reduce `TYPE 'LiftedRep` to `Type`. See `Note [Prefer Type over TYPE 'LiftedPtrRep]`. Closes #17958. Metric Decrease: T18698b T1969 T12227 T12545 T12707 T14683 T3064 T5631 T5642 T9020 T9630 T9872a T13035 haddock.Cabal haddock.base - - - - - 28 changed files: - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - + compiler/GHC/Builtin/Types/Prim.hs-boot - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Driver/Ppr.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Utils/Error.hs - compiler/GHC/Utils/Outputable.hs - compiler/GHC/Utils/Ppr.hs - testsuite/tests/deSugar/should_compile/T2431.stderr - testsuite/tests/deriving/should_compile/T14578.stderr - testsuite/tests/plugins/plugins09.stdout - testsuite/tests/plugins/plugins10.stdout - testsuite/tests/plugins/plugins11.stdout - testsuite/tests/plugins/static-plugins.stdout - testsuite/tests/printer/T18052a.stderr - testsuite/tests/simplCore/should_compile/T13143.stderr - testsuite/tests/simplCore/should_compile/T18013.stderr - testsuite/tests/simplCore/should_compile/T7360.stderr - testsuite/tests/typecheck/should_compile/T13032.stderr - utils/haddock Changes: ===================================== compiler/GHC/Builtin/Types.hs ===================================== @@ -170,6 +170,7 @@ import GHC.Types.Var (VarBndr (Bndr)) import GHC.Settings.Constants ( mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE, mAX_SUM_SIZE ) import GHC.Unit.Module ( Module ) import GHC.Core.Type +import qualified GHC.Core.TyCo.Rep as TyCoRep (Type(TyConApp)) import GHC.Types.RepType import GHC.Core.DataCon import GHC.Core.ConLike @@ -688,8 +689,9 @@ constraintKindTyCon :: TyCon -- 'TyCon.isConstraintKindCon' assumes that this is an AlgTyCon! constraintKindTyCon = pcTyCon constraintKindTyConName Nothing [] [] +-- See Note [Prefer Type over TYPE 'LiftedRep] in GHC.Core.TyCo.Rep. liftedTypeKind, typeToTypeKind, constraintKind :: Kind -liftedTypeKind = tYPE liftedRepTy +liftedTypeKind = TyCoRep.TyConApp liftedTypeKindTyCon [] typeToTypeKind = liftedTypeKind `mkVisFunTyMany` liftedTypeKind constraintKind = mkTyConApp constraintKindTyCon [] @@ -1410,11 +1412,12 @@ runtimeRepTy :: Type runtimeRepTy = mkTyConTy runtimeRepTyCon -- Type synonyms; see Note [TYPE and RuntimeRep] in GHC.Builtin.Types.Prim +-- and Note [Prefer Type over TYPE 'LiftedRep] in GHC.Core.TyCo.Rep. -- type Type = tYPE 'LiftedRep liftedTypeKindTyCon :: TyCon liftedTypeKindTyCon = buildSynTyCon liftedTypeKindTyConName - [] liftedTypeKind [] - (tYPE liftedRepTy) + [] liftedTypeKind [] rhs + where rhs = TyCoRep.TyConApp tYPETyCon [liftedRepTy] runtimeRepTyCon :: TyCon runtimeRepTyCon = pcTyCon runtimeRepTyConName Nothing [] ===================================== compiler/GHC/Builtin/Types/Prim.hs ===================================== @@ -551,10 +551,6 @@ mkPrimTcName built_in_syntax occ key tycon = mkWiredInName gHC_PRIM (mkTcOccFS occ) key (mkATyCon tycon) built_in_syntax ----------------------------- --- | Given a RuntimeRep, applies TYPE to it. --- see Note [TYPE and RuntimeRep] -tYPE :: Type -> Type -tYPE rr = TyConApp tYPETyCon [rr] -- Given a Multiplicity, applies FUN to it. functionWithMultiplicity :: Type -> Type ===================================== compiler/GHC/Builtin/Types/Prim.hs-boot ===================================== @@ -0,0 +1,5 @@ +module GHC.Builtin.Types.Prim where + +import GHC.Core.TyCon + +tYPETyCon :: TyCon ===================================== compiler/GHC/Core/TyCo/Rep.hs ===================================== @@ -52,6 +52,7 @@ module GHC.Core.TyCo.Rep ( mkVisFunTyMany, mkVisFunTysMany, mkInvisFunTyMany, mkInvisFunTysMany, mkTyConApp, + tYPE, -- * Functions over binders TyCoBinder(..), TyCoVarBinder, TyBinder, @@ -90,8 +91,9 @@ import GHC.Core.TyCon import GHC.Core.Coercion.Axiom -- others -import GHC.Builtin.Names ( liftedTypeKindTyConKey, manyDataConKey ) -import {-# SOURCE #-} GHC.Builtin.Types ( liftedTypeKindTyCon, manyDataConTy ) +import GHC.Builtin.Names ( liftedTypeKindTyConKey, liftedRepDataConKey, manyDataConKey, tYPETyConKey ) +import {-# SOURCE #-} GHC.Builtin.Types ( liftedTypeKindTyCon, liftedTypeKind, manyDataConTy ) +import {-# SOURCE #-} GHC.Builtin.Types.Prim ( tYPETyCon ) import GHC.Types.Basic ( LeftOrRight(..), pickLR ) import GHC.Types.Unique ( hasKey, Uniquable(..) ) import GHC.Utils.Outputable @@ -1009,7 +1011,7 @@ mkTyConApp tycon tys -- The FunTyCon (->) is always a visible one = FunTy { ft_af = VisArg, ft_mult = w, ft_arg = ty1, ft_res = ty2 } - -- Note [mkTyConApp and Type] + -- See Note [Prefer Type over TYPE 'LiftedRep] | tycon `hasKey` liftedTypeKindTyConKey = ASSERT2( null tys, ppr tycon $$ ppr tys ) liftedTypeKindTyConApp @@ -1018,21 +1020,21 @@ mkTyConApp tycon tys -- avoid reboxing every time `mkTyConApp` is called. = ASSERT2( null tys, ppr tycon $$ ppr tys ) manyDataConTy + -- See Note [Prefer Type over TYPE 'LiftedRep]. + | tycon `hasKey` tYPETyConKey + , [rep] <- tys + = tYPE rep + -- The catch-all case | otherwise = TyConApp tycon tys --- This is a single, global definition of the type `Type` --- Defined here so it is only allocated once. --- See Note [mkTyConApp and Type] -liftedTypeKindTyConApp :: Type -liftedTypeKindTyConApp = TyConApp liftedTypeKindTyCon [] - {- -Note [mkTyConApp and Type] -~~~~~~~~~~~~~~~~~~~~~~~~~~ -Whilst benchmarking it was observed in #17292 that GHC allocated a lot -of `TyConApp` constructors. Upon further inspection a large number of these -TyConApp constructors were all duplicates of `Type` applied to no arguments. +Note [Prefer Type over TYPE 'LiftedRep] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The Core of nearly any program will have numerous occurrences of + at TYPE 'LiftedRep@ (and, equivalently, 'Type') floating about. Concretely, while +investigating #17292 we found that these constituting a majority of TyConApp +constructors on the heap: ``` (From a sample of 100000 TyConApp closures) @@ -1046,12 +1048,59 @@ TyConApp constructors were all duplicates of `Type` applied to no arguments. 0x45e68fd - 538 - `TYPE ...` ``` -Therefore in `mkTyConApp` we have a special case for `Type` to ensure that -only one `TyConApp 'Type []` closure is allocated during the course of -compilation. In order to avoid a potentially expensive series of checks in -`mkTyConApp` only this egregious case is special cased at the moment. +Consequently, we try hard to ensure that operations on such types are +efficient. Specifically, we strive to + + a. Avoid heap allocation of such types + b. Use a small (shallow in the tree-depth sense) representation + for such types + +Goal (b) is particularly useful as it makes traversals (e.g. free variable +traversal, substitution, and comparison) more efficient. +Comparison in particular takes special advantage of nullary type synonym +applications (e.g. things like @TyConApp typeTyCon []@), Note [Comparing +nullary type synonyms] in "GHC.Core.Type". + +To accomplish these we use a number of tricks: + + 1. Instead of representing the lifted kind as + @TyConApp tYPETyCon [liftedRepDataCon]@ we rather prefer to + use the 'GHC.Types.Type' type synonym (represented as a nullary TyConApp). + This serves goal (b) since there are no applied type arguments to traverse, + e.g., during comparison. + + 2. We have a top-level binding to represent `TyConApp GHC.Types.Type []` + (namely 'GHC.Builtin.Types.Prim.liftedTypeKind'), ensuring that we + don't need to allocate such types (goal (a)). + + 3. To avoid allocating 'TyConApp' constructors the + 'GHC.Builtin.Types.Prim.tYPE' function catches the lifted case and returns + `liftedTypeKind` instead of building an application (goal (a)). + + 4. Similarly, 'Type.mkTyConApp' catches applications of `TYPE` and + handles them using 'GHC.Builtin.Types.Prim.tYPE', ensuring + that it benefits from the optimisation described above (goal (a)). + +Note that it's quite important that we do not define 'liftedTypeKind' in terms +of 'mkTyConApp' since this tricks (1) and (4) would then result in a loop. + +See #17958. -} +-- | Given a RuntimeRep, applies TYPE to it. +-- See Note [TYPE and RuntimeRep] in GHC.Builtin.Types.Prim. +tYPE :: Type -> Type +tYPE (TyConApp tc []) + -- See Note [Prefer Type of TYPE 'LiftedRep] + | tc `hasKey` liftedRepDataConKey = liftedTypeKind -- TYPE 'LiftedRep +tYPE rr = TyConApp tYPETyCon [rr] + +-- This is a single, global definition of the type `Type` +-- Defined here so it is only allocated once. +-- See Note [Prefer Type over TYPE 'LiftedRep] in this module. +liftedTypeKindTyConApp :: Type +liftedTypeKindTyConApp = TyConApp liftedTypeKindTyCon [] + {- %************************************************************************ %* * ===================================== compiler/GHC/Core/TyCo/Subst.hs ===================================== @@ -424,6 +424,7 @@ zipTCvSubst tcvs tys -- | Generates the in-scope set for the 'TCvSubst' from the types in the -- incoming environment. No CoVars, please! mkTvSubstPrs :: [(TyVar, Type)] -> TCvSubst +mkTvSubstPrs [] = emptyTCvSubst mkTvSubstPrs prs = ASSERT2( onlyTyVarsAndNoCoercionTy, text "prs" <+> ppr prs ) mkTvSubst in_scope tenv @@ -741,7 +742,8 @@ subst_ty subst ty go (TyConApp tc tys) = (mkTyConApp $! tc) $! strictMap go tys -- NB: mkTyConApp, not TyConApp. -- mkTyConApp has optimizations. - -- See Note [mkTyConApp and Type] in GHC.Core.TyCo.Rep + -- See Note [Prefer Type over TYPE 'LiftedRep] + -- in GHC.Core.TyCo.Rep go ty@(FunTy { ft_mult = mult, ft_arg = arg, ft_res = res }) = let !mult' = go mult !arg' = go arg ===================================== compiler/GHC/Core/TyCon.hs ===================================== @@ -2327,12 +2327,14 @@ expandSynTyCon_maybe -- ^ Expand a type synonym application, if any expandSynTyCon_maybe tc tys | SynonymTyCon { tyConTyVars = tvs, synTcRhs = rhs, tyConArity = arity } <- tc - = case tys `listLengthCmp` arity of - GT -> Just (tvs `zip` tys, rhs, drop arity tys) - EQ -> Just (tvs `zip` tys, rhs, []) - LT -> Nothing - | otherwise - = Nothing + = case tys of + [] -> Just ([], rhs, []) -- Avoid a bit of work in the case of nullary synonyms + _ -> case tys `listLengthCmp` arity of + GT -> Just (tvs `zip` tys, rhs, drop arity tys) + EQ -> Just (tvs `zip` tys, rhs, []) + LT -> Nothing + | otherwise + = Nothing ---------------- ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -383,34 +383,28 @@ how roles in kinds might work out. -} -- | Gives the typechecker view of a type. This unwraps synonyms but --- leaves 'Constraint' alone. c.f. coreView, which turns Constraint into --- TYPE LiftedRep. Returns Nothing if no unwrapping happens. +-- leaves 'Constraint' alone. c.f. 'coreView', which turns 'Constraint' into +-- 'Type'. Returns 'Nothing' if no unwrapping happens. -- See also Note [coreView vs tcView] -{-# INLINE tcView #-} tcView :: Type -> Maybe Type -tcView (TyConApp tc tys) | Just (tenv, rhs, tys') <- expandSynTyCon_maybe tc tys - = Just (mkAppTys (substTy (mkTvSubstPrs tenv) rhs) tys') - -- The free vars of 'rhs' should all be bound by 'tenv', so it's - -- ok to use 'substTy' here. - -- See also Note [The substitution invariant] in GHC.Core.TyCo.Subst. - -- Its important to use mkAppTys, rather than (foldl AppTy), - -- because the function part might well return a - -- partially-applied type constructor; indeed, usually will! +tcView (TyConApp tc tys) + | res@(Just _) <- expandSynTyConApp_maybe tc tys + = res tcView _ = Nothing +-- See Note [Inlining coreView]. +{-# INLINE tcView #-} -{-# INLINE coreView #-} coreView :: Type -> Maybe Type --- ^ This function Strips off the /top layer only/ of a type synonym +-- ^ This function strips off the /top layer only/ of a type synonym -- application (if any) its underlying representation type. --- Returns Nothing if there is nothing to look through. --- This function considers 'Constraint' to be a synonym of @TYPE LiftedRep at . +-- Returns 'Nothing' if there is nothing to look through. +-- This function considers 'Constraint' to be a synonym of @Type at . -- -- By being non-recursive and inlined, this case analysis gets efficiently -- joined onto the case analysis that the caller is already doing coreView ty@(TyConApp tc tys) - | Just (tenv, rhs, tys') <- expandSynTyCon_maybe tc tys - = Just (mkAppTys (substTy (mkTvSubstPrs tenv) rhs) tys') - -- This equation is exactly like tcView + | res@(Just _) <- expandSynTyConApp_maybe tc tys + = res -- At the Core level, Constraint = Type -- See Note [coreView vs tcView] @@ -419,8 +413,48 @@ coreView ty@(TyConApp tc tys) Just liftedTypeKind coreView _ = Nothing +-- See Note [Inlining coreView]. +{-# INLINE coreView #-} + +----------------------------------------------- + +-- | @expandSynTyConApp_maybe tc tys@ expands the RHS of type synonym @tc@ +-- instantiated at arguments @tys@, or returns 'Nothing' if @tc@ is not a +-- synonym. +expandSynTyConApp_maybe :: TyCon -> [Type] -> Maybe Type +expandSynTyConApp_maybe tc tys + | Just (tvs, rhs) <- synTyConDefn_maybe tc + , tys `lengthAtLeast` arity + = Just (expand_syn arity tvs rhs tys) + | otherwise + = Nothing + where + arity = tyConArity tc +-- Without this INLINE the call to expandSynTyConApp_maybe in coreView +-- will result in an avoidable allocation. +{-# INLINE expandSynTyConApp_maybe #-} + +-- | A helper for 'expandSynTyConApp_maybe' to avoid inlining this cold path +-- into call-sites. +expand_syn :: Int -- ^ the arity of the synonym + -> [TyVar] -- ^ the variables bound by the synonym + -> Type -- ^ the RHS of the synonym + -> [Type] -- ^ the type arguments the synonym is instantiated at. + -> Type +expand_syn arity tvs rhs tys + | tys `lengthExceeds` arity = mkAppTys rhs' (drop arity tys) + | otherwise = rhs' + where + rhs' = substTy (mkTvSubstPrs (tvs `zip` tys)) rhs + -- The free vars of 'rhs' should all be bound by 'tenv', so it's + -- ok to use 'substTy' here (which is what expandSynTyConApp_maybe does). + -- See also Note [The substitution invariant] in GHC.Core.TyCo.Subst. + -- Its important to use mkAppTys, rather than (foldl AppTy), + -- because the function part might well return a + -- partially-applied type constructor; indeed, usually will! +-- We never want to inline this cold-path. +{-# INLINE expand_syn #-} -{-# INLINE coreFullView #-} coreFullView :: Type -> Type -- ^ Iterates 'coreView' until there is no more to synonym to expand. -- See Note [Inlining coreView]. @@ -432,6 +466,7 @@ coreFullView ty@(TyConApp tc _) | otherwise = ty coreFullView ty = ty +{-# INLINE coreFullView #-} {- Note [Inlining coreView] in GHC.Core.Type ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2207,6 +2242,36 @@ But the left is an AppTy while the right is a TyConApp. The solution is to use repSplitAppTy_maybe to break up the TyConApp into its pieces and then continue. Easy to do, but also easy to forget to do. + +Note [Comparing nullary type synonyms] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider the task of testing equality between two 'Type's of the form + + TyConApp tc [] + +where @tc@ is a type synonym. A naive way to perform this comparison these +would first expand the synonym and then compare the resulting expansions. + +However, this is obviously wasteful and the RHS of @tc@ may be large; it is +much better to rather compare the TyCons directly. Consequently, before +expanding type synonyms in type comparisons we first look for a nullary +TyConApp and simply compare the TyCons if we find one. Of course, if we find +that the TyCons are *not* equal then we still need to perform the expansion as +their RHSs may still be equal. + +We perform this optimisation in a number of places: + + * GHC.Core.Types.eqType + * GHC.Core.Types.nonDetCmpType + * GHC.Core.Unify.unify_ty + * TcCanonical.can_eq_nc' + * TcUnify.uType + +This optimisation is especially helpful for the ubiquitous GHC.Types.Type, +since GHC prefers to use the type synonym over @TYPE 'LiftedRep@ applications +whenever possible. See [Prefer Type over TYPE 'LiftedRep] in +GHC.Core.TyCo.Rep for details. + -} eqType :: Type -> Type -> Bool @@ -2318,6 +2383,10 @@ nonDetCmpTypeX env orig_t1 orig_t2 = -- Returns both the resulting ordering relation between the two types -- and whether either contains a cast. go :: RnEnv2 -> Type -> Type -> TypeOrdering + -- See Note [Comparing nullary type synonyms]. + go _ (TyConApp tc1 []) (TyConApp tc2 []) + | tc1 == tc2 + = TEQ go env t1 t2 | Just t1' <- coreView t1 = go env t1' t2 | Just t2' <- coreView t2 = go env t1 t2' ===================================== compiler/GHC/Core/Unify.hs ===================================== @@ -957,7 +957,12 @@ unify_ty :: UMEnv -- Respects newtypes, PredTypes unify_ty env ty1 ty2 kco - -- Use tcView, not coreView. See Note [coreView vs tcView] in GHC.Core.Type. + -- See Note [Comparing nullary type synonyms] in GHC.Core.Type. + | TyConApp tc1 [] <- ty1 + , TyConApp tc2 [] <- ty2 + , tc1 == tc2 = return () + + -- TODO: More commentary needed here | Just ty1' <- tcView ty1 = unify_ty env ty1' ty2 kco | Just ty2' <- tcView ty2 = unify_ty env ty1 ty2' kco | CastTy ty1' co <- ty1 = if um_unif env ===================================== compiler/GHC/Driver/Ppr.hs ===================================== @@ -66,7 +66,7 @@ showSDocDebug dflags d = renderWithContext ctx d printForUser :: DynFlags -> Handle -> PrintUnqualified -> Depth -> SDoc -> IO () printForUser dflags handle unqual depth doc - = printSDocLn ctx PageMode handle doc + = printSDocLn ctx (PageMode False) handle doc where ctx = initSDocContext dflags (mkUserStyle unqual depth) -- | Like 'printSDocLn' but specialized with 'LeftMode' and ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -1365,7 +1365,7 @@ defaultFatalMessager = hPutStrLn stderr jsonLogAction :: LogAction jsonLogAction dflags reason severity srcSpan msg = - defaultLogActionHPutStrDoc dflags stdout + defaultLogActionHPutStrDoc dflags True stdout (withPprStyle (PprCode CStyle) (doc $$ text "")) where str = renderWithContext (initSDocContext dflags defaultUserStyle) msg @@ -1388,9 +1388,9 @@ defaultLogAction dflags reason severity srcSpan msg SevWarning -> printWarns SevError -> printWarns where - printOut = defaultLogActionHPrintDoc dflags stdout - printErrs = defaultLogActionHPrintDoc dflags stderr - putStrSDoc = defaultLogActionHPutStrDoc dflags stdout + printOut = defaultLogActionHPrintDoc dflags False stdout + printErrs = defaultLogActionHPrintDoc dflags False stderr + putStrSDoc = defaultLogActionHPutStrDoc dflags False stdout -- Pretty print the warning flag, if any (#10752) message = mkLocMessageAnn flagMsg severity srcSpan msg @@ -1430,16 +1430,19 @@ defaultLogAction dflags reason severity srcSpan msg | otherwise = "" -- | Like 'defaultLogActionHPutStrDoc' but appends an extra newline. -defaultLogActionHPrintDoc :: DynFlags -> Handle -> SDoc -> IO () -defaultLogActionHPrintDoc dflags h d - = defaultLogActionHPutStrDoc dflags h (d $$ text "") - -defaultLogActionHPutStrDoc :: DynFlags -> Handle -> SDoc -> IO () -defaultLogActionHPutStrDoc dflags h d +defaultLogActionHPrintDoc :: DynFlags -> Bool -> Handle -> SDoc -> IO () +defaultLogActionHPrintDoc dflags asciiSpace h d + = defaultLogActionHPutStrDoc dflags asciiSpace h (d $$ text "") + +-- | The boolean arguments let's the pretty printer know if it can optimize indent +-- by writing ascii ' ' characters without going through decoding. +defaultLogActionHPutStrDoc :: DynFlags -> Bool -> Handle -> SDoc -> IO () +defaultLogActionHPutStrDoc dflags asciiSpace h d -- Don't add a newline at the end, so that successive -- calls to this log-action can output all on the same line - = printSDoc ctx Pretty.PageMode h d - where ctx = initSDocContext dflags defaultUserStyle + = printSDoc ctx (Pretty.PageMode asciiSpace) h d + where + ctx = initSDocContext dflags defaultUserStyle newtype FlushOut = FlushOut (IO ()) ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -956,6 +956,11 @@ can_eq_nc' -> Type -> Type -- RHS, after and before type-synonym expansion, resp -> TcS (StopOrContinue Ct) +-- See Note [Comparing nullary type synonyms] in GHC.Core.Type. +can_eq_nc' _flat _rdr_env _envs ev eq_rel ty1@(TyConApp tc1 []) _ps_ty1 (TyConApp tc2 []) _ps_ty2 + | tc1 == tc2 + = canEqReflexive ev eq_rel ty1 + -- Expand synonyms first; see Note [Type synonyms and canonicalization] can_eq_nc' rewritten rdr_env envs ev eq_rel ty1 ps_ty1 ty2 ps_ty2 | Just ty1' <- tcView ty1 = can_eq_nc' rewritten rdr_env envs ev eq_rel ty1' ps_ty1 ty2 ps_ty2 ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -120,7 +120,6 @@ import GHC.Types.Id as Id import GHC.Types.Name import GHC.Types.Var.Set import GHC.Builtin.Types -import GHC.Builtin.Types.Prim import GHC.Types.Var.Env import GHC.Types.Name.Env import GHC.Utils.Misc ===================================== compiler/GHC/Tc/Utils/TcType.hs ===================================== @@ -1581,6 +1581,11 @@ tc_eq_type keep_syns vis_only orig_ty1 orig_ty2 = go orig_env orig_ty1 orig_ty2 where go :: RnEnv2 -> Type -> Type -> Bool + -- See Note [Comparing nullary type synonyms] in GHC.Core.Type. + go _ (TyConApp tc1 []) (TyConApp tc2 []) + | tc1 == tc2 + = True + go env t1 t2 | not keep_syns, Just t1' <- tcView t1 = go env t1' t2 go env t1 t2 | not keep_syns, Just t2' <- tcView t2 = go env t1 t2' ===================================== compiler/GHC/Utils/Error.hs ===================================== @@ -327,7 +327,8 @@ dumpSDocWithStyle sty dflags dumpOpt hdr doc = $$ blankLine $$ doc return $ mkDumpDoc hdr d - defaultLogActionHPrintDoc dflags handle (withPprStyle sty doc') + -- When we dump to files we use UTF8. Which allows ascii spaces. + defaultLogActionHPrintDoc dflags True handle (withPprStyle sty doc') -- write the dump to stdout writeDump Nothing = do ===================================== compiler/GHC/Utils/Outputable.hs ===================================== @@ -567,7 +567,7 @@ pprCode cs d = withPprStyle (PprCode cs) d renderWithContext :: SDocContext -> SDoc -> String renderWithContext ctx sdoc - = let s = Pretty.style{ Pretty.mode = PageMode, + = let s = Pretty.style{ Pretty.mode = PageMode False, Pretty.lineLength = sdocLineLength ctx } in Pretty.renderStyle s $ runSDoc sdoc ctx ===================================== compiler/GHC/Utils/Ppr.hs ===================================== @@ -917,16 +917,26 @@ data Style , ribbonsPerLine :: Float -- ^ Ratio of line length to ribbon length } --- | The default style (@mode=PageMode, lineLength=100, ribbonsPerLine=1.5@). +-- | The default style (@mode=PageMode False, lineLength=100, ribbonsPerLine=1.5@). style :: Style -style = Style { lineLength = 100, ribbonsPerLine = 1.5, mode = PageMode } +style = Style { lineLength = 100, ribbonsPerLine = 1.5, mode = PageMode False } -- | Rendering mode. -data Mode = PageMode -- ^ Normal +data Mode = PageMode { asciiSpace :: Bool } -- ^ Normal | ZigZagMode -- ^ With zig-zag cuts | LeftMode -- ^ No indentation, infinitely long lines | OneLineMode -- ^ All on one line +-- | Can we output an ascii space character for spaces? +-- Mostly true, but not for e.g. UTF16 +-- See Note [putSpaces optimizations] for why we bother +-- to track this. +hasAsciiSpace :: Mode -> Bool +hasAsciiSpace mode = + case mode of + PageMode asciiSpace -> asciiSpace + _ -> False + -- | Render the @Doc@ to a String using the given @Style at . renderStyle :: Style -> Doc -> String renderStyle s = fullRender (mode s) (lineLength s) (ribbonsPerLine s) @@ -1034,6 +1044,20 @@ printDoc :: Mode -> Int -> Handle -> Doc -> IO () -- printDoc adds a newline to the end printDoc mode cols hdl doc = printDoc_ mode cols hdl (doc $$ text "") +{- Note [putSpaces optimizations] + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +When using dump flags a lot of what we are dumping ends up being whitespace. +This is especially true for Core/Stg dumps. Enough so that it's worth optimizing. + +Especially in the common case of writing to an UTF8 or similarly encoded file +where space is equal to ascii space we use hPutBuf to write a preallocated +buffer to the file. This avoids a fair bit of allocation. + +For other cases we fall back to the old and slow path for simplicity. + +-} + printDoc_ :: Mode -> Int -> Handle -> Doc -> IO () -- printDoc_ does not add a newline at the end, so that -- successive calls can output stuff on the same line @@ -1051,9 +1075,27 @@ printDoc_ mode pprCols hdl doc -- the I/O library's encoding layer. (#3398) put (ZStr s) next = hPutFZS hdl s >> next put (LStr s) next = hPutPtrString hdl s >> next - put (RStr n c) next = hPutStr hdl (replicate n c) >> next + put (RStr n c) next + | c == ' ' + = putSpaces n >> next + | otherwise + = hPutStr hdl (replicate n c) >> next + putSpaces n + -- If we use ascii spaces we are allowed to use hPutBuf + -- See Note [putSpaces optimizations] + | hasAsciiSpace mode + , n <= 100 + = hPutBuf hdl (Ptr spaces') n + | hasAsciiSpace mode + , n > 100 + = hPutBuf hdl (Ptr spaces') 100 >> putSpaces (n-100) + + | otherwise = hPutStr hdl (replicate n ' ') done = return () -- hPutChar hdl '\n' + -- 100 spaces, so we avoid the allocation of replicate n ' ' + spaces' = " "# + -- some versions of hPutBuf will barf if the length is zero hPutPtrString :: Handle -> PtrString -> IO () ===================================== testsuite/tests/deSugar/should_compile/T2431.stderr ===================================== @@ -1,9 +1,9 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 63, types: 43, coercions: 1, joins: 0/0} + = {terms: 63, types: 39, coercions: 1, joins: 0/0} --- RHS size: {terms: 2, types: 4, coercions: 1, joins: 0/0} +-- RHS size: {terms: 2, types: 3, coercions: 1, joins: 0/0} T2431.$WRefl [InlPrag=INLINE[final] CONLIKE] :: forall a. a :~: a [GblId[DataConWrapper], Caf=NoCafRefs, @@ -15,7 +15,7 @@ T2431.$WRefl [InlPrag=INLINE[final] CONLIKE] :: forall a. a :~: a T2431.$WRefl = \ (@a) -> T2431.Refl @a @a @~(_N :: a GHC.Prim.~# a) --- RHS size: {terms: 4, types: 8, coercions: 0, joins: 0/0} +-- RHS size: {terms: 4, types: 7, coercions: 0, joins: 0/0} absurd :: forall a. (Int :~: Bool) -> a [GblId, Arity=1, Str=b, Cpr=b, Unf=OtherCon []] absurd = \ (@a) (x :: Int :~: Bool) -> case x of { } ===================================== testsuite/tests/deriving/should_compile/T14578.stderr ===================================== @@ -16,13 +16,12 @@ Derived class instances: = GHC.Prim.coerce @(T14578.App (Data.Functor.Compose.Compose f g) a -> T14578.App (Data.Functor.Compose.Compose f g) a - -> T14578.App (Data.Functor.Compose.Compose f g) a) + -> T14578.App (Data.Functor.Compose.Compose f g) a) @(T14578.Wat f g a -> T14578.Wat f g a -> T14578.Wat f g a) ((GHC.Base.<>) @(T14578.App (Data.Functor.Compose.Compose f g) a)) GHC.Base.sconcat = GHC.Prim.coerce - @(GHC.Base.NonEmpty - (T14578.App (Data.Functor.Compose.Compose f g) a) + @(GHC.Base.NonEmpty (T14578.App (Data.Functor.Compose.Compose f g) a) -> T14578.App (Data.Functor.Compose.Compose f g) a) @(GHC.Base.NonEmpty (T14578.Wat f g a) -> T14578.Wat f g a) (GHC.Base.sconcat @@ -31,7 +30,7 @@ Derived class instances: = GHC.Prim.coerce @(b -> T14578.App (Data.Functor.Compose.Compose f g) a - -> T14578.App (Data.Functor.Compose.Compose f g) a) + -> T14578.App (Data.Functor.Compose.Compose f g) a) @(b -> T14578.Wat f g a -> T14578.Wat f g a) (GHC.Base.stimes @(T14578.App (Data.Functor.Compose.Compose f g) a)) ===================================== testsuite/tests/plugins/plugins09.stdout ===================================== @@ -3,6 +3,5 @@ interfacePlugin: Prelude interfacePlugin: GHC.Float interfacePlugin: GHC.Base typeCheckPlugin (rn) -interfacePlugin: GHC.Types typeCheckPlugin (tc) interfacePlugin: GHC.Num.BigNat ===================================== testsuite/tests/plugins/plugins10.stdout ===================================== @@ -6,7 +6,6 @@ interfacePlugin: GHC.Float interfacePlugin: GHC.Base interfacePlugin: Language.Haskell.TH.Syntax typeCheckPlugin (rn) -interfacePlugin: GHC.Types typeCheckPlugin (tc) interfacePlugin: GHC.Num.BigNat parsePlugin(a) ===================================== testsuite/tests/plugins/plugins11.stdout ===================================== @@ -3,6 +3,5 @@ interfacePlugin: Prelude interfacePlugin: GHC.Float interfacePlugin: GHC.Base typeCheckPlugin (rn) -interfacePlugin: GHC.Types typeCheckPlugin (tc) interfacePlugin: GHC.Num.BigNat ===================================== testsuite/tests/plugins/static-plugins.stdout ===================================== @@ -5,11 +5,11 @@ interfacePlugin: GHC.Float interfacePlugin: GHC.Base interfacePlugin: System.IO typeCheckPlugin (rn) -interfacePlugin: GHC.Prim -interfacePlugin: GHC.Show interfacePlugin: GHC.Types +interfacePlugin: GHC.Show interfacePlugin: GHC.TopHandler typeCheckPlugin (tc) +interfacePlugin: GHC.Prim interfacePlugin: GHC.CString interfacePlugin: GHC.Num.BigNat ==pure.1 ===================================== testsuite/tests/printer/T18052a.stderr ===================================== @@ -10,9 +10,9 @@ Dependent packages: [base-4.16.0.0, ghc-bignum-1.0, ghc-prim-0.8.0] ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 24, types: 61, coercions: 0, joins: 0/0} + = {terms: 24, types: 52, coercions: 0, joins: 0/0} --- RHS size: {terms: 7, types: 8, coercions: 0, joins: 0/0} +-- RHS size: {terms: 7, types: 6, coercions: 0, joins: 0/0} T18052a.$b:||: :: forall {a} {b}. a -> b -> (a, b) [GblId, Arity=2, Unf=OtherCon []] T18052a.$b:||: = \ (@a) (@b) (x :: a) (y :: b) -> (x, y) @@ -22,7 +22,7 @@ T18052a.$b:||: = \ (@a) (@b) (x :: a) (y :: b) -> (x, y) [GblId] (+++) = ++ --- RHS size: {terms: 13, types: 20, coercions: 0, joins: 0/0} +-- RHS size: {terms: 13, types: 18, coercions: 0, joins: 0/0} T18052a.$m:||: :: forall {rep :: GHC.Types.RuntimeRep} {r :: TYPE rep} {a} {b}. (a, b) -> (a -> b -> r) -> ((# #) -> r) -> r ===================================== testsuite/tests/simplCore/should_compile/T13143.stderr ===================================== @@ -1,17 +1,17 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 71, types: 44, coercions: 0, joins: 0/0} + = {terms: 71, types: 40, coercions: 0, joins: 0/0} Rec { --- RHS size: {terms: 4, types: 4, coercions: 0, joins: 0/0} +-- RHS size: {terms: 4, types: 3, coercions: 0, joins: 0/0} T13143.$wf [InlPrag=NOINLINE, Occ=LoopBreaker] :: forall {a}. (# #) -> a [GblId, Arity=1, Str=b, Cpr=b, Unf=OtherCon []] T13143.$wf = \ (@a) _ [Occ=Dead] -> T13143.$wf @a GHC.Prim.(##) end Rec } --- RHS size: {terms: 4, types: 4, coercions: 0, joins: 0/0} +-- RHS size: {terms: 4, types: 3, coercions: 0, joins: 0/0} f [InlPrag=[final]] :: forall a. Int -> a [GblId, Arity=1, ===================================== testsuite/tests/simplCore/should_compile/T18013.stderr ===================================== @@ -129,9 +129,9 @@ Rule fired: Class op fmap (BUILTIN) ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 52, types: 106, coercions: 17, joins: 0/1} + = {terms: 52, types: 101, coercions: 17, joins: 0/1} --- RHS size: {terms: 37, types: 87, coercions: 17, joins: 0/1} +-- RHS size: {terms: 37, types: 84, coercions: 17, joins: 0/1} mapMaybeRule :: forall a b. Rule IO a b -> Rule IO (Maybe a) (Maybe b) [GblId, ===================================== testsuite/tests/simplCore/should_compile/T7360.stderr ===================================== @@ -1,7 +1,7 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 106, types: 47, coercions: 0, joins: 0/0} + = {terms: 106, types: 45, coercions: 0, joins: 0/0} -- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} T7360.$WFoo3 [InlPrag=INLINE[final] CONLIKE] :: Int %1 -> Foo @@ -31,7 +31,7 @@ T7360.fun4 :: () WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 20 0}] T7360.fun4 = fun1 T7360.Foo1 --- RHS size: {terms: 11, types: 8, coercions: 0, joins: 0/0} +-- RHS size: {terms: 11, types: 7, coercions: 0, joins: 0/0} fun2 :: forall {a}. [a] -> ((), Int) [GblId, Arity=1, ===================================== testsuite/tests/typecheck/should_compile/T13032.stderr ===================================== @@ -1,9 +1,9 @@ ==================== Desugar (after optimization) ==================== Result size of Desugar (after optimization) - = {terms: 13, types: 24, coercions: 0, joins: 0/0} + = {terms: 13, types: 18, coercions: 0, joins: 0/0} --- RHS size: {terms: 6, types: 11, coercions: 0, joins: 0/0} +-- RHS size: {terms: 6, types: 8, coercions: 0, joins: 0/0} f :: forall a b. (a ~ b) => a -> b -> Bool [LclIdX, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit acf235d607879eb9542127eb0ddb42a250b5b850 +Subproject commit 48c4982646b7fe6343ccdf1581c97a7735fe8940 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7c1056ef11209a5a5133438213a2a294a9772a57...795ff28d72a83b0f4dad9087b82d0cd825c84c4b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7c1056ef11209a5a5133438213a2a294a9772a57...795ff28d72a83b0f4dad9087b82d0cd825c84c4b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Dec 14 20:22:18 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 14 Dec 2020 15:22:18 -0500 Subject: [Git][ghc/ghc][wip/andreask/opt_dumps] 2 commits: Move Unit related fields from DynFlags to HscEnv Message-ID: <5fd7c97ade302_6b213272ce0156757c@gitlab.mail> Ben Gamari pushed to branch wip/andreask/opt_dumps at Glasgow Haskell Compiler / GHC Commits: d0e8c10d by Sylvain Henry at 2020-12-14T19:45:13+01:00 Move Unit related fields from DynFlags to HscEnv The unit database cache, the home unit and the unit state were stored in DynFlags while they ought to be stored in the compiler session state (HscEnv). This patch fixes this. It introduces a new UnitEnv type that should be used in the future to handle separate unit environments (especially host vs target units). Related to #17957 Bump haddock submodule - - - - - af855ac1 by Andreas Klebinger at 2020-12-14T15:22:13-05:00 Optimize dumping of consecutive whitespace. The naive way of putting out n characters of indent would be something like `hPutStr hdl (replicate n ' ')`. However this is quite inefficient as we allocate an absurd number of strings consisting of simply spaces as we don't cache them. To improve on this we now track if we can simply write ascii spaces via hPutBuf instead. This is the case when running with -ddump-to-file where we force the encoding to be UTF8. This avoids both the cost of going through encoding as well as avoiding allocation churn from all the white space. Instead we simply use hPutBuf on a preallocated unlifted string. When dumping stg like this: > nofib/spectral/simple/Main.hs -fforce-recomp -ddump-stg-final -ddump-to-file -c +RTS -s Allocations went from 1,778 MB to 1,702MB. About a 4% reduction of allocation! I did not measure the difference in runtime but expect it to be similar. Bumps the haddock submodule since the interface of GHC's Pretty slightly changed. ------------------------- Metric Decrease: T12227 ------------------------- - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Parser/Monad.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Env.hs - compiler/GHC/Driver/Hooks.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/MakeFile.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Monad.hs - compiler/GHC/Driver/Ppr.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Driver/Session.hs-boot - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Usage.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Recomp/Flags.hs - compiler/GHC/Iface/Rename.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Linker/Dynamic.hs - compiler/GHC/Linker/ExtraObj.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Linker/MacOS.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c5187fe9509948971fd27e28556f20356e701229...af855ac1d37359df3db8c48dc6c9dd2f3fe24e77 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c5187fe9509948971fd27e28556f20356e701229...af855ac1d37359df3db8c48dc6c9dd2f3fe24e77 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Dec 14 20:22:34 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 14 Dec 2020 15:22:34 -0500 Subject: [Git][ghc/ghc][wip/tyconapp-opts] 3 commits: Move Unit related fields from DynFlags to HscEnv Message-ID: <5fd7c98a9156a_6b21725ac4015684d8@gitlab.mail> Ben Gamari pushed to branch wip/tyconapp-opts at Glasgow Haskell Compiler / GHC Commits: d0e8c10d by Sylvain Henry at 2020-12-14T19:45:13+01:00 Move Unit related fields from DynFlags to HscEnv The unit database cache, the home unit and the unit state were stored in DynFlags while they ought to be stored in the compiler session state (HscEnv). This patch fixes this. It introduces a new UnitEnv type that should be used in the future to handle separate unit environments (especially host vs target units). Related to #17957 Bump haddock submodule - - - - - af855ac1 by Andreas Klebinger at 2020-12-14T15:22:13-05:00 Optimize dumping of consecutive whitespace. The naive way of putting out n characters of indent would be something like `hPutStr hdl (replicate n ' ')`. However this is quite inefficient as we allocate an absurd number of strings consisting of simply spaces as we don't cache them. To improve on this we now track if we can simply write ascii spaces via hPutBuf instead. This is the case when running with -ddump-to-file where we force the encoding to be UTF8. This avoids both the cost of going through encoding as well as avoiding allocation churn from all the white space. Instead we simply use hPutBuf on a preallocated unlifted string. When dumping stg like this: > nofib/spectral/simple/Main.hs -fforce-recomp -ddump-stg-final -ddump-to-file -c +RTS -s Allocations went from 1,778 MB to 1,702MB. About a 4% reduction of allocation! I did not measure the difference in runtime but expect it to be similar. Bumps the haddock submodule since the interface of GHC's Pretty slightly changed. ------------------------- Metric Decrease: T12227 ------------------------- - - - - - dad87210 by Ben Gamari at 2020-12-14T15:22:29-05:00 Optimise nullary type constructor usage During the compilation of programs GHC very frequently deals with the `Type` type, which is a synonym of `TYPE 'LiftedRep`. This patch teaches GHC to avoid expanding the `Type` synonym (and other nullary type synonyms) during type comparisons, saving a good amount of work. This optimisation is described in `Note [Comparing nullary type synonyms]`. To maximize the impact of this optimisation, we introduce a few special-cases to reduce `TYPE 'LiftedRep` to `Type`. See `Note [Prefer Type over TYPE 'LiftedPtrRep]`. Closes #17958. Metric Decrease: T18698b T1969 T12227 T12545 T12707 T14683 T3064 T5631 T5642 T9020 T9630 T9872a T13035 haddock.Cabal haddock.base - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - + compiler/GHC/Builtin/Types/Prim.hs-boot - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Parser/Monad.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Env.hs - compiler/GHC/Driver/Hooks.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/MakeFile.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Monad.hs - compiler/GHC/Driver/Ppr.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Driver/Session.hs-boot - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Usage.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Make.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/795ff28d72a83b0f4dad9087b82d0cd825c84c4b...dad87210efffce9cfc2d17dc088a71d9dea14535 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/795ff28d72a83b0f4dad9087b82d0cd825c84c4b...dad87210efffce9cfc2d17dc088a71d9dea14535 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Dec 14 21:12:45 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 14 Dec 2020 16:12:45 -0500 Subject: [Git][ghc/ghc][wip/backports-8.10] users guide: Add release notes for 8.10.3 Message-ID: <5fd7d54dc8de5_6b2174471c157509f@gitlab.mail> Ben Gamari pushed to branch wip/backports-8.10 at Glasgow Haskell Compiler / GHC Commits: 7bb343c2 by Ben Gamari at 2020-12-14T16:12:19-05:00 users guide: Add release notes for 8.10.3 - - - - - 2 changed files: - + docs/users_guide/8.10.3-notes.rst - docs/users_guide/index.rst Changes: ===================================== docs/users_guide/8.10.3-notes.rst ===================================== @@ -0,0 +1,141 @@ +.. _release-8-10-3: + +Release notes for version 8.10.3 +================================ + +The significant changes to the various parts of the compiler are listed in the +following sections. + +Like previous releases in the 8.10 series, the :ghc-flag:`LLVM backend <-fllvm>` +of this release is to be used with LLVM 9. + +Highlights +---------- + +- Numerous stability improvements on Windows. + +- GHC now has far more robust support for architectures with weak memory + ordering guarantees. + +- GHC can split up dynamic objects to mitigate the macOS ``RPATH`` size + limitation when building large projects (:ghc-ticket:`14444`). + +- Several significant correctness bugs in the low-latency garbage collector have + been fixed. Users of :rts-flag:`--nonmoving-gc` are strongly encouraged to + upgrade promptly. + + +Full details +------------ + +Compiler +~~~~~~~~ + +* A compiler crash triggered by a :pragma:`SPECIALISE` pragma on a binding with + no unfolding has been fixed (:ghc-ticket:`18118`). + +* GHC now supports a command-line flag, :ghc-flag:`-pgmc-supports-no-pie`, + allowing the user to indicate that the C compiler supplied via + :ghc-flag:`-pgmc ⟨cmd⟩` supports ``-no-pie``. + +* A pair of flags, :ghc-flag:`-pgmlm ⟨cmd⟩` and :ghc-flag:`-optlm ⟨option⟩`, + allowing the user to override the linker used to be join GHCi object files + has been added. + +* A regression in the treatment of the :ghc-flag:`-fbyte-code` flag has been + fixed (:ghc-ticket:`18955`). + +- A bug in the determination of source spans of post-qualified imports has been + fixed :ghc-ticket:`19014`. + + +Runtime system +~~~~~~~~~~~~~~ + +- GHC is now more careful to respect address space limits set via `ulimit`` + when allocating its heap (:ghc-ticket:`18623`). + +- Numerous fixes on Windows. These include a bug in stack allocation + triggering Windows' stack verifier (:ghc-ticket:`18601`), various linker bugs + (:ghc-ticket:`15808`, :ghc-ticket:`18991`), and a bug where ``libc`` may be + called during image initialization resulting in undefined behavior + (:ghc-ticket:`18548`). + +- GHC's linker is now able to load macOS frameworks on Big Sur + (:ghc-ticket:`18446`). + +- A soundness bug affecting programs relying on heavy mutation of ``MVar``\ s + has been fixed (:ghc-ticket:`18919`). + +- The internal linker's code unloading logic has been reenabled and now tracks + object file dependencies, fixing a soundness bug (:ghc-ticket:`16525`). + +- A linker bug relying in the misalignment of loaded ``.rodata`` sections has + been fixed. + + +Known issues +------------ + +- A long-standing bug (:ghc-ticket:`16893`) which can cause some applications + of ``unsafeCoerce`` to segmentation fault is only partially fixed in this + release. This release only avoids this issue in the uses of ``unsafeCoerce`` + in ``Data.Typeable.Internal``, which was the proximate cause of + :ghc-ticket:`16893`. + + However, it is possible that this bug could manifest in user-code using + ``unsafeCoerce`` to perform dynamic type checks. See the :ghc-ticket:`ticket + <16893>` for details. + + We expect that this issue will be fixed in the next major release of GHC. + +- A long-standing bug (:ghc-ticket:`17760`) where some uses of the ``touch#`` + primop can be dropped by the simplifier is present in this release. This bug + will be fixed in GHC 9.0.1. In the meantime, see the :ghc-ticket:`ticket + <17760>` for mitigations. + + +Included libraries +------------------ + +The package database provided with this distribution also contains a number of +packages other than GHC itself. See the changelogs provided with these packages +for further change information. + +.. ghc-package-list:: + + libraries/array/array.cabal: Dependency of ``ghc`` library + libraries/base/base.cabal: Core library + libraries/binary/binary.cabal: Dependency of ``ghc`` library + libraries/bytestring/bytestring.cabal: Dependency of ``ghc`` library + libraries/Cabal/Cabal/Cabal.cabal: Dependency of ``ghc-pkg`` utility + libraries/containers/containers/containers.cabal: Dependency of ``ghc`` library + libraries/deepseq/deepseq.cabal: Dependency of ``ghc`` library + libraries/directory/directory.cabal: Dependency of ``ghc`` library + libraries/exceptions/exceptions.cabal: Dependency of ``haskeline`` library + libraries/filepath/filepath.cabal: Dependency of ``ghc`` library + compiler/ghc.cabal: The compiler itself + libraries/ghci/ghci.cabal: The REPL interface + libraries/ghc-boot/ghc-boot.cabal: Internal compiler library + libraries/ghc-boot-th/ghc-boot-th.cabal: Internal compiler library + libraries/ghc-compact/ghc-compact.cabal: Core library + libraries/ghc-heap/ghc-heap.cabal: GHC heap-walking library + libraries/ghc-prim/ghc-prim.cabal: Core library + libraries/haskeline/haskeline.cabal: Dependency of ``ghci`` executable + libraries/hpc/hpc.cabal: Dependency of ``hpc`` executable + libraries/integer-gmp/integer-gmp.cabal: Core library + libraries/libiserv/libiserv.cabal: Internal compiler library + libraries/mtl/mtl.cabal: Dependency of ``Cabal`` library + libraries/parsec/parsec.cabal: Dependency of ``Cabal`` library + libraries/pretty/pretty.cabal: Dependency of ``ghc`` library + libraries/process/process.cabal: Dependency of ``ghc`` library + libraries/stm/stm.cabal: Dependency of ``haskeline`` library + libraries/template-haskell/template-haskell.cabal: Core library + libraries/terminfo/terminfo.cabal: Dependency of ``haskeline`` library + libraries/text/text.cabal: Dependency of ``Cabal`` library + libraries/time/time.cabal: Dependency of ``ghc`` library + libraries/transformers/transformers.cabal: Dependency of ``ghc`` library + libraries/unix/unix.cabal: Dependency of ``ghc`` library + libraries/Win32/Win32.cabal: Dependency of ``ghc`` library + libraries/xhtml/xhtml.cabal: Dependency of ``haddock`` executable + ===================================== docs/users_guide/index.rst ===================================== @@ -14,6 +14,7 @@ Contents: intro 8.10.1-notes 8.10.2-notes + 8.10.3-notes ghci runghc usage View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7bb343c2a27028932e29276f7956c04ef04aba0a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7bb343c2a27028932e29276f7956c04ef04aba0a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Dec 14 21:13:06 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 14 Dec 2020 16:13:06 -0500 Subject: [Git][ghc/ghc][wip/backports-8.10] 5 commits: Disable deprecation warnings in Cabal build Message-ID: <5fd7d56246bf7_6b21725c11c157561b@gitlab.mail> Ben Gamari pushed to branch wip/backports-8.10 at Glasgow Haskell Compiler / GHC Commits: 4c8bea6e by Ben Gamari at 2020-12-14T16:12:59-05:00 Disable deprecation warnings in Cabal build - - - - - fa91e719 by Ben Gamari at 2020-12-14T16:12:59-05:00 hadrian: Reindent Settings.Warnings The previous state was quite illegible. - - - - - 73c583fb by Ben Gamari at 2020-12-14T16:13:00-05:00 hadrian: Pass -Werror before other arguments Previously we would append -Werror to the argument list. However, this ended up overriding the -Wno-error=... flags in Settings.Warnings. - - - - - c343f7c3 by Ben Gamari at 2020-12-14T16:13:00-05:00 users guide: Add release notes for 8.10.3 - - - - - b1593746 by Ben Gamari at 2020-12-14T16:13:00-05:00 configure: Release 8.10.3 - - - - - 6 changed files: - configure.ac - + docs/users_guide/8.10.3-notes.rst - docs/users_guide/index.rst - hadrian/src/Flavour.hs - hadrian/src/Settings/Warnings.hs - mk/warnings.mk Changes: ===================================== configure.ac ===================================== @@ -13,10 +13,10 @@ dnl # see what flags are available. (Better yet, read the documentation!) # -AC_INIT([The Glorious Glasgow Haskell Compilation System], [8.10.2], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) +AC_INIT([The Glorious Glasgow Haskell Compilation System], [8.10.3], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) # Set this to YES for a released version, otherwise NO -: ${RELEASE=NO} +: ${RELEASE=YES} # The primary version (e.g. 7.5, 7.4.1) is set in the AC_INIT line # above. If this is not a released version, then we will append the ===================================== docs/users_guide/8.10.3-notes.rst ===================================== @@ -0,0 +1,141 @@ +.. _release-8-10-3: + +Release notes for version 8.10.3 +================================ + +The significant changes to the various parts of the compiler are listed in the +following sections. + +Like previous releases in the 8.10 series, the :ghc-flag:`LLVM backend <-fllvm>` +of this release is to be used with LLVM 9. + +Highlights +---------- + +- Numerous stability improvements on Windows. + +- GHC now has far more robust support for architectures with weak memory + ordering guarantees. + +- GHC can split up dynamic objects to mitigate the macOS ``RPATH`` size + limitation when building large projects (:ghc-ticket:`14444`). + +- Several significant correctness bugs in the low-latency garbage collector have + been fixed. Users of :rts-flag:`--nonmoving-gc` are strongly encouraged to + upgrade promptly. + + +Full details +------------ + +Compiler +~~~~~~~~ + +* A compiler crash triggered by a :pragma:`SPECIALISE` pragma on a binding with + no unfolding has been fixed (:ghc-ticket:`18118`). + +* GHC now supports a command-line flag, :ghc-flag:`-pgmc-supports-no-pie`, + allowing the user to indicate that the C compiler supplied via + :ghc-flag:`-pgmc ⟨cmd⟩` supports ``-no-pie``. + +* A pair of flags, :ghc-flag:`-pgmlm ⟨cmd⟩` and :ghc-flag:`-optlm ⟨option⟩`, + allowing the user to override the linker used to be join GHCi object files + has been added. + +* A regression in the treatment of the :ghc-flag:`-fbyte-code` flag has been + fixed (:ghc-ticket:`18955`). + +- A bug in the determination of source spans of post-qualified imports has been + fixed :ghc-ticket:`19014`. + + +Runtime system +~~~~~~~~~~~~~~ + +- GHC is now more careful to respect address space limits set via `ulimit`` + when allocating its heap (:ghc-ticket:`18623`). + +- Numerous fixes on Windows. These include a bug in stack allocation + triggering Windows' stack verifier (:ghc-ticket:`18601`), various linker bugs + (:ghc-ticket:`15808`, :ghc-ticket:`18991`), and a bug where ``libc`` may be + called during image initialization resulting in undefined behavior + (:ghc-ticket:`18548`). + +- GHC's linker is now able to load macOS frameworks on Big Sur + (:ghc-ticket:`18446`). + +- A soundness bug affecting programs relying on heavy mutation of ``MVar``\ s + has been fixed (:ghc-ticket:`18919`). + +- The internal linker's code unloading logic has been reenabled and now tracks + object file dependencies, fixing a soundness bug (:ghc-ticket:`16525`). + +- A linker bug relying in the misalignment of loaded ``.rodata`` sections has + been fixed. + + +Known issues +------------ + +- A long-standing bug (:ghc-ticket:`16893`) which can cause some applications + of ``unsafeCoerce`` to segmentation fault is only partially fixed in this + release. This release only avoids this issue in the uses of ``unsafeCoerce`` + in ``Data.Typeable.Internal``, which was the proximate cause of + :ghc-ticket:`16893`. + + However, it is possible that this bug could manifest in user-code using + ``unsafeCoerce`` to perform dynamic type checks. See the :ghc-ticket:`ticket + <16893>` for details. + + We expect that this issue will be fixed in the next major release of GHC. + +- A long-standing bug (:ghc-ticket:`17760`) where some uses of the ``touch#`` + primop can be dropped by the simplifier is present in this release. This bug + will be fixed in GHC 9.0.1. In the meantime, see the :ghc-ticket:`ticket + <17760>` for mitigations. + + +Included libraries +------------------ + +The package database provided with this distribution also contains a number of +packages other than GHC itself. See the changelogs provided with these packages +for further change information. + +.. ghc-package-list:: + + libraries/array/array.cabal: Dependency of ``ghc`` library + libraries/base/base.cabal: Core library + libraries/binary/binary.cabal: Dependency of ``ghc`` library + libraries/bytestring/bytestring.cabal: Dependency of ``ghc`` library + libraries/Cabal/Cabal/Cabal.cabal: Dependency of ``ghc-pkg`` utility + libraries/containers/containers/containers.cabal: Dependency of ``ghc`` library + libraries/deepseq/deepseq.cabal: Dependency of ``ghc`` library + libraries/directory/directory.cabal: Dependency of ``ghc`` library + libraries/exceptions/exceptions.cabal: Dependency of ``haskeline`` library + libraries/filepath/filepath.cabal: Dependency of ``ghc`` library + compiler/ghc.cabal: The compiler itself + libraries/ghci/ghci.cabal: The REPL interface + libraries/ghc-boot/ghc-boot.cabal: Internal compiler library + libraries/ghc-boot-th/ghc-boot-th.cabal: Internal compiler library + libraries/ghc-compact/ghc-compact.cabal: Core library + libraries/ghc-heap/ghc-heap.cabal: GHC heap-walking library + libraries/ghc-prim/ghc-prim.cabal: Core library + libraries/haskeline/haskeline.cabal: Dependency of ``ghci`` executable + libraries/hpc/hpc.cabal: Dependency of ``hpc`` executable + libraries/integer-gmp/integer-gmp.cabal: Core library + libraries/libiserv/libiserv.cabal: Internal compiler library + libraries/mtl/mtl.cabal: Dependency of ``Cabal`` library + libraries/parsec/parsec.cabal: Dependency of ``Cabal`` library + libraries/pretty/pretty.cabal: Dependency of ``ghc`` library + libraries/process/process.cabal: Dependency of ``ghc`` library + libraries/stm/stm.cabal: Dependency of ``haskeline`` library + libraries/template-haskell/template-haskell.cabal: Core library + libraries/terminfo/terminfo.cabal: Dependency of ``haskeline`` library + libraries/text/text.cabal: Dependency of ``Cabal`` library + libraries/time/time.cabal: Dependency of ``ghc`` library + libraries/transformers/transformers.cabal: Dependency of ``ghc`` library + libraries/unix/unix.cabal: Dependency of ``ghc`` library + libraries/Win32/Win32.cabal: Dependency of ``ghc`` library + libraries/xhtml/xhtml.cabal: Dependency of ``haddock`` executable + ===================================== docs/users_guide/index.rst ===================================== @@ -14,6 +14,7 @@ Contents: intro 8.10.1-notes 8.10.2-notes + 8.10.3-notes ghci runghc usage ===================================== hadrian/src/Flavour.hs ===================================== @@ -2,7 +2,7 @@ module Flavour ( Flavour (..), werror , DocTargets, DocTarget(..) -- * Flavour transformers - , addArgs + , addArgs, addArgsBefore , splitSections, splitSectionsIf , enableThreadSanitizer , enableDebugInfo, enableTickyGhc @@ -71,10 +71,15 @@ data DocTarget = Haddocks | SphinxHTML | SphinxPDFs | SphinxMan | SphinxInfo addArgs :: Args -> Flavour -> Flavour addArgs args' fl = fl { args = args fl <> args' } +addArgsBefore :: Args -> Flavour -> Flavour +addArgsBefore args' fl = fl { args = args' <> args fl } + -- | Turn on -Werror for packages built with the stage1 compiler. -- It mimics the CI settings so is useful to turn on when developing. werror :: Flavour -> Flavour -werror = addArgs (builder Ghc ? notStage0 ? arg "-Werror") +werror = addArgsBefore (builder Ghc ? notStage0 ? arg "-Werror") + -- N.B. We add this flag *before* the others to ensure that we don't override + -- the -Wno-error flags defined in "Settings.Warnings". -- | Build C and Haskell objects with debugging information. enableDebugInfo :: Flavour -> Flavour ===================================== hadrian/src/Settings/Warnings.hs ===================================== @@ -20,35 +20,39 @@ ghcWarningsArgs = do isIntegerSimple <- (== integerSimple) <$> getIntegerPackage mconcat [ stage0 ? mconcat - [ libraryPackage ? pure [ "-fno-warn-deprecated-flags" ] - , package terminfo ? pure [ "-fno-warn-unused-imports" ] - , package transformers ? pure [ "-fno-warn-unused-matches" - , "-fno-warn-unused-imports" ] ] + [ libraryPackage ? pure [ "-fno-warn-deprecated-flags" ] + , package terminfo ? pure [ "-fno-warn-unused-imports" ] + , package transformers ? pure [ "-fno-warn-unused-matches" + , "-fno-warn-unused-imports" ] ] , notStage0 ? mconcat - [ libraryPackage ? pure [ "-Wno-deprecated-flags" ] - , package base ? pure [ "-Wno-trustworthy-safe" ] - , package binary ? pure [ "-Wno-deprecations" ] - , package bytestring ? pure [ "-Wno-inline-rule-shadowing" ] - , package compiler ? pure [ "-Wcpp-undef" ] - , package directory ? pure [ "-Wno-unused-imports" ] - , package ghc ? pure [ "-Wcpp-undef" ] - , package ghcPrim ? pure [ "-Wno-trustworthy-safe" ] - , package haddock ? pure [ "-Wno-unused-imports" - , "-Wno-deprecations" ] - , package haskeline ? pure [ "-Wno-deprecations" - , "-Wno-unused-imports" - , "-Wno-redundant-constraints" - , "-Wno-simplifiable-class-constraints" ] - , package pretty ? pure [ "-Wno-unused-imports" ] - , package primitive ? pure [ "-Wno-unused-imports" - , "-Wno-deprecations" ] - , package rts ? pure [ "-Wcpp-undef" ] - , package terminfo ? pure [ "-Wno-unused-imports" ] - , isIntegerSimple ? - package text ? pure [ "-Wno-unused-imports" ] - , package transformers ? pure [ "-Wno-unused-matches" - , "-Wno-unused-imports" - , "-Wno-redundant-constraints" - , "-Wno-orphans" ] - , package win32 ? pure [ "-Wno-trustworthy-safe" ] - , package xhtml ? pure [ "-Wno-unused-imports" ] ] ] + [ libraryPackage ? pure [ "-Wno-deprecated-flags" ] + , package base ? pure [ "-Wno-trustworthy-safe" ] + , package binary ? pure [ "-Wno-deprecations" ] + , package bytestring ? pure [ "-Wno-inline-rule-shadowing" ] + , package compiler ? pure [ "-Wcpp-undef" ] + , package directory ? pure [ "-Wno-unused-imports" ] + , package ghc ? pure [ "-Wcpp-undef" ] + , package ghcPrim ? pure [ "-Wno-trustworthy-safe" ] + , package haddock ? pure [ "-Wno-unused-imports" + , "-Wno-deprecations" ] + , package haskeline ? pure [ "-Wno-deprecations" + , "-Wno-unused-imports" + , "-Wno-redundant-constraints" + , "-Wno-simplifiable-class-constraints" ] + , package pretty ? pure [ "-Wno-unused-imports" ] + , package primitive ? pure [ "-Wno-unused-imports" + , "-Wno-deprecations" ] + , package rts ? pure [ "-Wcpp-undef" ] + , package terminfo ? pure [ "-Wno-unused-imports" ] + , isIntegerSimple ? + package text ? pure [ "-Wno-unused-imports" ] + , package transformers ? pure [ "-Wno-unused-matches" + , "-Wno-unused-imports" + , "-Wno-redundant-constraints" + , "-Wno-orphans" ] + , package win32 ? pure [ "-Wno-trustworthy-safe" ] + , package xhtml ? pure [ "-Wno-unused-imports" ] + ] + , mconcat + [ package cabal ? pure [ "-Wno-error=deprecations" ] ] + ] ===================================== mk/warnings.mk ===================================== @@ -80,6 +80,8 @@ libraries/haskeline_dist-install_EXTRA_HC_OPTS += -Wno-unused-imports libraries/haskeline_dist-install_EXTRA_HC_OPTS += -Wno-redundant-constraints libraries/haskeline_dist-install_EXTRA_HC_OPTS += -Wno-simplifiable-class-constraints +# Due to deprecation warning +libraries/Cabal_dist-install_EXTRA_HC_OPTS += -Wno-error=deprecations # temporarily turn off unused-imports warnings for pretty libraries/pretty_dist-install_EXTRA_HC_OPTS += -Wno-unused-imports View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7bb343c2a27028932e29276f7956c04ef04aba0a...b1593746a6774448640c235bcf520ef641f62fbc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7bb343c2a27028932e29276f7956c04ef04aba0a...b1593746a6774448640c235bcf520ef641f62fbc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Dec 14 22:50:00 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 14 Dec 2020 17:50:00 -0500 Subject: [Git][ghc/ghc] Deleted branch wip/backports-9.0 Message-ID: <5fd7ec1877110_6b21725db841580680@gitlab.mail> Ben Gamari deleted branch wip/backports-9.0 at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Dec 14 22:50:01 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 14 Dec 2020 17:50:01 -0500 Subject: [Git][ghc/ghc][ghc-9.0] 3 commits: Bump Cabal submodule to 3.4.0.0-rc5 Message-ID: <5fd7ec1986f1d_6b2174471c15808df@gitlab.mail> Ben Gamari pushed to branch ghc-9.0 at Glasgow Haskell Compiler / GHC Commits: 3a1af9bf by Ben Gamari at 2020-12-14T10:31:58-05:00 Bump Cabal submodule to 3.4.0.0-rc5 - - - - - f081501e by Andreas Klebinger at 2020-12-14T10:31:58-05:00 RegAlloc: Add missing raPlatformfield to RegAllocStatsSpill Fixes #18994 Co-Author: Benjamin Maurer <maurer.benjamin at gmail.com> (cherry picked from commit 3e3555cc9c2a9f5246895f151259fd2a81621f38) - - - - - ca506ea7 by Shayne Fletcher at 2020-12-14T10:31:58-05:00 Fix bad span calculations of post qualified imports (cherry picked from commit 4a437bc19d2026845948356a932b2cac2417eb12) - - - - - 7 changed files: - compiler/GHC/CmmToAsm/Reg/Graph.hs - compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs - compiler/GHC/Parser.y - libraries/Cabal - testsuite/tests/module/all.T - + testsuite/tests/module/mod185.hs - + testsuite/tests/module/mod185.stderr Changes: ===================================== compiler/GHC/CmmToAsm/Reg/Graph.hs ===================================== @@ -278,7 +278,8 @@ regAlloc_spin config spinCount triv regsFree slotsFree slotsCount debug_codeGrap , raCoalesced = rmCoalesce , raSpillStats = spillStats , raSpillCosts = spillCosts - , raSpilled = code_spilled } + , raSpilled = code_spilled + , raPlatform = platform } -- Bundle up all the register allocator statistics. -- .. but make sure to drop them on the floor if they're not ===================================== compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs ===================================== @@ -73,7 +73,11 @@ data RegAllocStats statics instr , raSpillCosts :: SpillCostInfo -- | Code with spill instructions added. - , raSpilled :: [LiveCmmDecl statics instr] } + , raSpilled :: [LiveCmmDecl statics instr] + + -- | Target platform + , raPlatform :: !Platform + } -- a successful coloring ===================================== compiler/GHC/Parser.y ===================================== @@ -967,18 +967,20 @@ importdecls_semi importdecl :: { LImportDecl GhcPs } : 'import' maybe_src maybe_safe optqualified maybe_pkg modid optqualified maybeas maybeimpspec {% do { - ; checkImportDecl $4 $7 - ; ams (L (comb4 $1 $6 (snd $8) $9) $ + ; let { ; mPreQual = unLoc $4 + ; mPostQual = unLoc $7 } + ; checkImportDecl mPreQual mPostQual + ; ams (L (comb5 $1 $6 $7 (snd $8) $9) $ ImportDecl { ideclExt = noExtField , ideclSourceSrc = snd $ fst $2 , ideclName = $6, ideclPkgQual = snd $5 , ideclSource = snd $2, ideclSafe = snd $3 - , ideclQualified = importDeclQualifiedStyle $4 $7 + , ideclQualified = importDeclQualifiedStyle mPreQual mPostQual , ideclImplicit = False , ideclAs = unLoc (snd $8) , ideclHiding = unLoc $9 }) - (mj AnnImport $1 : fst (fst $2) ++ fst $3 ++ fmap (mj AnnQualified) (maybeToList $4) - ++ fst $5 ++ fmap (mj AnnQualified) (maybeToList $7) ++ fst $8) + (mj AnnImport $1 : fst (fst $2) ++ fst $3 ++ fmap (mj AnnQualified) (maybeToList mPreQual) + ++ fst $5 ++ fmap (mj AnnQualified) (maybeToList mPostQual) ++ fst $8) } } @@ -1002,9 +1004,9 @@ maybe_pkg :: { ([AddAnn],Maybe StringLiteral) } ; return ([mj AnnPackageName $1], Just (StringLiteral (getSTRINGs $1) pkgFS)) } } | {- empty -} { ([],Nothing) } -optqualified :: { Maybe (Located Token) } - : 'qualified' { Just $1 } - | {- empty -} { Nothing } +optqualified :: { Located (Maybe (Located Token)) } + : 'qualified' { sL1 $1 (Just $1) } + | {- empty -} { noLoc Nothing } maybeas :: { ([AddAnn],Located (Maybe (Located ModuleName))) } : 'as' modid { ([mj AnnAs $1] @@ -3754,6 +3756,11 @@ comb4 a b c d = a `seq` b `seq` c `seq` d `seq` (combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $ combineSrcSpans (getLoc c) (getLoc d)) +comb5 :: Located a -> Located b -> Located c -> Located d -> Located e -> SrcSpan +comb5 a b c d e = a `seq` b `seq` c `seq` d `seq` e `seq` + (combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $ + combineSrcSpans (getLoc c) $ combineSrcSpans (getLoc d) (getLoc e)) + -- strict constructor version: {-# INLINE sL #-} sL :: SrcSpan -> a -> Located a ===================================== libraries/Cabal ===================================== @@ -1 +1 @@ -Subproject commit 5aea8a4b8463e1ae95272e190a1022764164294f +Subproject commit 7907a676ada3a5944cfa3b45e23deda7496767cf ===================================== testsuite/tests/module/all.T ===================================== @@ -268,6 +268,7 @@ test('mod181', normal, compile, ['']) test('mod182', normal, compile_fail, ['']) test('mod183', normal, compile_fail, ['']) test('mod184', normal, compile, ['-Wprepositive-qualified-module']) +test('mod185', normal, compile, ['-ddump-parsed-ast']) test('T1148', normal, compile, ['']) test('T1074', normal, compile, ['']) ===================================== testsuite/tests/module/mod185.hs ===================================== @@ -0,0 +1,5 @@ +{-# LANGUAGE ImportQualifiedPost #-} +-- The span of the import decl should include the 'qualified' keyword. +import Prelude qualified + +main = Prelude.undefined ===================================== testsuite/tests/module/mod185.stderr ===================================== @@ -0,0 +1,62 @@ +==================== Parser AST ==================== + +({ mod185.hs:1:1 } + (HsModule + (VirtualBraces + (1)) + (Nothing) + (Nothing) + [({ mod185.hs:3:1-24 } + (ImportDecl + (NoExtField) + (NoSourceText) + ({ mod185.hs:3:8-14 } + {ModuleName: Prelude}) + (Nothing) + (NotBoot) + (False) + (QualifiedPost) + (False) + (Nothing) + (Nothing)))] + [({ mod185.hs:5:1-24 } + (ValD + (NoExtField) + (FunBind + (NoExtField) + ({ mod185.hs:5:1-4 } + (Unqual + {OccName: main})) + (MG + (NoExtField) + ({ mod185.hs:5:1-24 } + [({ mod185.hs:5:1-24 } + (Match + (NoExtField) + (FunRhs + ({ mod185.hs:5:1-4 } + (Unqual + {OccName: main})) + (Prefix) + (NoSrcStrict)) + [] + (GRHSs + (NoExtField) + [({ mod185.hs:5:6-24 } + (GRHS + (NoExtField) + [] + ({ mod185.hs:5:8-24 } + (HsVar + (NoExtField) + ({ mod185.hs:5:8-24 } + (Qual + {ModuleName: Prelude} + {OccName: undefined}))))))] + ({ } + (EmptyLocalBinds + (NoExtField))))))]) + (FromSource)) + [])))] + (Nothing) + (Nothing))) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/00f07ca5a7f6b51fd94508a8da3a4cbf1ee3b73c...ca506ea7457df6ff971abb65a4f94025813bb737 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/00f07ca5a7f6b51fd94508a8da3a4cbf1ee3b73c...ca506ea7457df6ff971abb65a4f94025813bb737 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Dec 14 23:49:07 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 14 Dec 2020 18:49:07 -0500 Subject: [Git][ghc/ghc][wip/boxed-rep] 148 commits: nativeGen: Make makeImportsDoc take an NCGConfig rather than DynFlags Message-ID: <5fd7f9f38ebfd_6b21725bd701585218@gitlab.mail> Ben Gamari pushed to branch wip/boxed-rep at Glasgow Haskell Compiler / GHC Commits: fcfda909 by Ben Gamari at 2020-11-11T03:19:59-05:00 nativeGen: Make makeImportsDoc take an NCGConfig rather than DynFlags It appears this was an oversight as there is no reason the full DynFlags is necessary. - - - - - 6e23695e by Ben Gamari at 2020-11-11T03:19:59-05:00 Move this_module into NCGConfig In various places in the NCG we need the Module currently being compiled. Let's move this into the environment instead of chewing threw another register. - - - - - c6264a2d by Ben Gamari at 2020-11-11T03:20:00-05:00 codeGen: Produce local symbols for module-internal functions It turns out that some important native debugging/profiling tools (e.g. perf) rely only on symbol tables for function name resolution (as opposed to using DWARF DIEs). However, previously GHC would emit temporary symbols (e.g. `.La42b`) to identify module-internal entities. Such symbols are dropped during linking and therefore not visible to runtime tools (in addition to having rather un-helpful unique names). For instance, `perf report` would often end up attributing all cost to the libc `frame_dummy` symbol since Haskell code was no covered by any proper symbol (see #17605). We now rather follow the model of C compilers and emit descriptively-named local symbols for module internal things. Since this will increase object file size this behavior can be disabled with the `-fno-expose-internal-symbols` flag. With this `perf record` can finally be used against Haskell executables. Even more, with `-g3` `perf annotate` provides inline source code. - - - - - 584058dd by Ben Gamari at 2020-11-11T03:20:00-05:00 Enable -fexpose-internal-symbols when debug level >=2 This seems like a reasonable default as the object file size increases by around 5%. - - - - - c34a4b98 by Ömer Sinan Ağacan at 2020-11-11T03:20:35-05:00 Fix and enable object unloading in GHCi Fixes #16525 by tracking dependencies between object file symbols and marking symbol liveness during garbage collection See Note [Object unloading] in CheckUnload.c for details. - - - - - 2782487f by Ray Shih at 2020-11-11T03:20:35-05:00 Add loadNativeObj and unloadNativeObj (This change is originally written by niteria) This adds two functions: * `loadNativeObj` * `unloadNativeObj` and implements them for Linux. They are useful if you want to load a shared object with Haskell code using the system linker and have GHC call dlclose() after the code is no longer referenced from the heap. Using the system linker allows you to load the shared object above outside the low-mem region. It also loads the DWARF sections in a way that `perf` understands. `dl_iterate_phdr` is what makes this implementation Linux specific. - - - - - 7a65f9e1 by GHC GitLab CI at 2020-11-11T03:20:35-05:00 rts: Introduce highMemDynamic - - - - - e9e1b2e7 by GHC GitLab CI at 2020-11-11T03:20:35-05:00 Introduce test for dynamic library unloading This uses the highMemDynamic flag introduced earlier to verify that dynamic objects are properly unloaded. - - - - - 5506f134 by Krzysztof Gogolewski at 2020-11-11T03:21:14-05:00 Force argument in setIdMult (#18925) - - - - - 787e93ae by Ben Gamari at 2020-11-11T23:14:11-05:00 testsuite: Add testcase for #18733 - - - - - 5353fd50 by Ben Gamari at 2020-11-12T10:05:30-05:00 compiler: Fix recompilation checking In ticket #18733 we noticed a rather serious deficiency in the current fingerprinting logic for recursive groups. I have described the old fingerprinting story and its problems in Note [Fingerprinting recursive groups] and have reworked the story accordingly to avoid these issues. Fixes #18733. - - - - - 63fa3997 by Sebastian Graf at 2020-11-13T14:29:39-05:00 Arity: Rework `ArityType` to fix monotonicity (#18870) As we found out in #18870, `andArityType` is not monotone, with potentially severe consequences for termination of fixed-point iteration. That showed in an abundance of "Exciting arity" DEBUG messages that are emitted whenever we do more than one step in fixed-point iteration. The solution necessitates also recording `OneShotInfo` info for `ABot` arity type. Thus we get the following definition for `ArityType`: ``` data ArityType = AT [OneShotInfo] Divergence ``` The majority of changes in this patch are the result of refactoring use sites of `ArityType` to match the new definition. The regression test `T18870` asserts that we indeed don't emit any DEBUG output anymore for a function where we previously would have. Similarly, there's a regression test `T18937` for #18937, which we expect to be broken for now. Fixes #18870. - - - - - 197d59fa by Sebastian Graf at 2020-11-13T14:29:39-05:00 Arity: Emit "Exciting arity" warning only after second iteration (#18937) See Note [Exciting arity] why we emit the warning at all and why we only do after the second iteration now. Fixes #18937. - - - - - de7ec9dd by David Eichmann at 2020-11-13T14:30:16-05:00 Add rts_listThreads and rts_listMiscRoots to RtsAPI.h These are used to find the current roots of the garbage collector. Co-authored-by: Sven Tennie's avatarSven Tennie <sven.tennie at gmail.com> Co-authored-by: Matthew Pickering's avatarMatthew Pickering <matthewtpickering at gmail.com> Co-authored-by: default avatarBen Gamari <bgamari.foss at gmail.com> - - - - - 24a86f09 by Ben Gamari at 2020-11-13T14:30:51-05:00 gitlab-ci: Cache cabal store in linting job - - - - - 0a7e592c by Ben Gamari at 2020-11-15T03:35:45-05:00 nativeGen/dwarf: Fix procedure end addresses Previously the `.debug_aranges` and `.debug_info` (DIE) DWARF information would claim that procedures (represented with a `DW_TAG_subprogram` DIE) would only span the range covered by their entry block. This omitted all of the continuation blocks (represented by `DW_TAG_lexical_block` DIEs), confusing `perf`. Fix this by introducing a end-of-procedure label and using this as the `DW_AT_high_pc` of procedure `DW_TAG_subprogram` DIEs Fixes #17605. - - - - - 1e19183d by Ben Gamari at 2020-11-15T03:35:45-05:00 nativeGen/dwarf: Only produce DW_AT_source_note DIEs in -g3 Standard debugging tools don't know how to understand these so let's not produce them unless asked. - - - - - ad73370f by Ben Gamari at 2020-11-15T03:35:45-05:00 nativeGen/dwarf: Use DW_AT_linkage instead of DW_AT_MIPS_linkage - - - - - a2539650 by Ben Gamari at 2020-11-15T03:35:45-05:00 gitlab-ci: Add DWARF release jobs for Debian 10, Fedora27 - - - - - d61adb3d by Ryan Scott at 2020-11-15T03:36:21-05:00 Name (tc)SplitForAll- functions more consistently There is a zoo of `splitForAll-` functions in `GHC.Core.Type` (as well as `tcSplitForAll-` functions in `GHC.Tc.Utils.TcType`) that all do very similar things, but vary in the particular form of type variable that they return. To make things worse, the names of these functions are often quite misleading. Some particularly egregious examples: * `splitForAllTys` returns `TyCoVar`s, but `splitSomeForAllTys` returns `VarBndr`s. * `splitSomeForAllTys` returns `VarBndr`s, but `tcSplitSomeForAllTys` returns `TyVar`s. * `splitForAllTys` returns `TyCoVar`s, but `splitForAllTysInvis` returns `InvisTVBinder`s. (This in particular arose in the context of #18939, and this finally motivated me to bite the bullet and improve the status quo vis-à-vis how we name these functions.) In an attempt to bring some sanity to how these functions are named, I have opted to rename most of these functions en masse to use consistent suffixes that describe the particular form of type variable that each function returns. In concrete terms, this amounts to: * Functions that return a `TyVar` now use the suffix `-TyVar`. This caused the following functions to be renamed: * `splitTyVarForAllTys` -> `splitForAllTyVars` * `splitForAllTy_ty_maybe` -> `splitForAllTyVar_maybe` * `tcSplitForAllTys` -> `tcSplitForAllTyVars` * `tcSplitSomeForAllTys` -> `tcSplitSomeForAllTyVars` * Functions that return a `CoVar` now use the suffix `-CoVar`. This caused the following functions to be renamed: * `splitForAllTy_co_maybe` -> `splitForAllCoVar_maybe` * Functions that return a `TyCoVar` now use the suffix `-TyCoVar`. This caused the following functions to be renamed: * `splitForAllTy` -> `splitForAllTyCoVar` * `splitForAllTys` -> `splitForAllTyCoVars` * `splitForAllTys'` -> `splitForAllTyCoVars'` * `splitForAllTy_maybe` -> `splitForAllTyCoVar_maybe` * Functions that return a `VarBndr` now use the suffix corresponding to the most relevant type synonym. This caused the following functions to be renamed: * `splitForAllVarBndrs` -> `splitForAllTyCoVarBinders` * `splitForAllTysInvis` -> `splitForAllInvisTVBinders` * `splitForAllTysReq` -> `splitForAllReqTVBinders` * `splitSomeForAllTys` -> `splitSomeForAllTyCoVarBndrs` * `tcSplitForAllVarBndrs` -> `tcSplitForAllTyVarBinders` * `tcSplitForAllTysInvis` -> `tcSplitForAllInvisTVBinders` * `tcSplitForAllTysReq` -> `tcSplitForAllReqTVBinders` * `tcSplitForAllTy_maybe` -> `tcSplitForAllTyVarBinder_maybe` Note that I left the following functions alone: * Functions that split apart things besides `ForAllTy`s, such as `splitFunTys` or `splitPiTys`. Thankfully, there are far fewer of these functions than there are functions that split apart `ForAllTy`s, so there isn't much of a pressing need to apply the new naming convention elsewhere. * Functions that split apart `ForAllCo`s in `Coercion`s, such as `GHC.Core.Coercion.splitForAllCo_maybe`. We could theoretically apply the new naming convention here, but then we'd have to figure out how to disambiguate `Type`-splitting functions from `Coercion`-splitting functions. Ultimately, the `Coercion`-splitting functions aren't used nearly as much as the `Type`-splitting functions, so I decided to leave the former alone. This is purely refactoring and should cause no change in behavior. - - - - - 645444af by Ryan Scott at 2020-11-15T03:36:21-05:00 Use tcSplitForAllInvisTyVars (not tcSplitForAllTyVars) in more places The use of `tcSplitForAllTyVars` in `tcDataFamInstHeader` was the immediate cause of #18939, and replacing it with a new `tcSplitForAllInvisTyVars` function (which behaves like `tcSplitForAllTyVars` but only splits invisible type variables) fixes the issue. However, this led me to realize that _most_ uses of `tcSplitForAllTyVars` in GHC really ought to be `tcSplitForAllInvisTyVars` instead. While I was in town, I opted to replace most uses of `tcSplitForAllTys` with `tcSplitForAllTysInvis` to reduce the likelihood of such bugs in the future. I say "most uses" above since there is one notable place where we _do_ want to use `tcSplitForAllTyVars`: in `GHC.Tc.Validity.forAllTyErr`, which produces the "`Illegal polymorphic type`" error message if you try to use a higher-rank `forall` without having `RankNTypes` enabled. Here, we really do want to split all `forall`s, not just invisible ones, or we run the risk of giving an inaccurate error message in the newly added `T18939_Fail` test case. I debated at some length whether I wanted to name the new function `tcSplitForAllInvisTyVars` or `tcSplitForAllTyVarsInvisible`, but in the end, I decided that I liked the former better. For consistency's sake, I opted to rename the existing `splitPiTysInvisible` and `splitPiTysInvisibleN` functions to `splitInvisPiTys` and `splitPiTysInvisN`, respectively, so that they use the same naming convention. As a consequence, this ended up requiring a `haddock` submodule bump. Fixes #18939. - - - - - 8887102f by Moritz Angermann at 2020-11-15T03:36:56-05:00 AArch64/arm64 adjustments This addes the necessary logic to support aarch64 on elf, as well as aarch64 on mach-o, which Apple calls arm64. We change architecture name to AArch64, which is the official arm naming scheme. - - - - - fc644b1a by Ben Gamari at 2020-11-15T03:37:31-05:00 ghc-bin: Build with eventlogging by default We now have all sorts of great facilities using the eventlog which were previously unavailable without building a custom GHC. Fix this by linking with `-eventlog` by default. - - - - - 52114fa0 by Sylvain Henry at 2020-11-16T11:48:47+01:00 Add Addr# atomic primops (#17751) This reuses the codegen used for ByteArray#'s atomic primops. - - - - - 8150f654 by Sebastian Graf at 2020-11-18T23:38:40-05:00 PmCheck: Print types of uncovered patterns (#18932) In order to avoid confusion as in #18932, we display the type of the match variables in the non-exhaustiveness warning, e.g. ``` T18932.hs:14:1: warning: [-Wincomplete-patterns] Pattern match(es) are non-exhaustive In an equation for ‘g’: Patterns of type ‘T a’, ‘T a’, ‘T a’ not matched: (MkT2 _) (MkT1 _) (MkT1 _) (MkT2 _) (MkT1 _) (MkT2 _) (MkT2 _) (MkT2 _) (MkT1 _) (MkT2 _) (MkT2 _) (MkT2 _) ... | 14 | g (MkT1 x) (MkT1 _) (MkT1 _) = x | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ``` It also allows us to omit the type signature on wildcard matches which we previously showed in only some situations, particularly `-XEmptyCase`. Fixes #18932. - - - - - 165352a2 by Krzysztof Gogolewski at 2020-11-20T02:08:36-05:00 Export indexError from GHC.Ix (#18579) - - - - - b57845c3 by Kamil Dworakowski at 2020-11-20T02:09:16-05:00 Clarify interruptible FFI wrt masking state - - - - - 321d1bd8 by Sebastian Graf at 2020-11-20T02:09:51-05:00 Fix strictness signatures of `prefetchValue*#` primops Their strictness signatures said the primops are strict in their first argument, which is wrong: Handing it a thunk will prefetch the pointer to the thunk, but not evaluate it. Hence not strict. The regression test `T8256` actually tests for laziness in the first argument, so GHC apparently never exploited the strictness signature. See also https://gitlab.haskell.org/ghc/ghc/-/issues/8256#note_310867, where this came up. - - - - - 0aec78b6 by Sebastian Graf at 2020-11-20T02:09:51-05:00 Demand: Interleave usage and strictness demands (#18903) As outlined in #18903, interleaving usage and strictness demands not only means a more compact demand representation, but also allows us to express demands that we weren't easily able to express before. Call demands are *relative* in the sense that a call demand `Cn(cd)` on `g` says "`g` is called `n` times. *Whenever `g` is called*, the result is used according to `cd`". Example from #18903: ```hs h :: Int -> Int h m = let g :: Int -> (Int,Int) g 1 = (m, 0) g n = (2 * n, 2 `div` n) {-# NOINLINE g #-} in case m of 1 -> 0 2 -> snd (g m) _ -> uncurry (+) (g m) ``` Without the interleaved representation, we would just get `L` for the strictness demand on `g`. Now we are able to express that whenever `g` is called, its second component is used strictly in denoting `g` by `1C1(P(1P(U),SP(U)))`. This would allow Nested CPR to unbox the division, for example. Fixes #18903. While fixing regressions, I also discovered and fixed #18957. Metric Decrease: T13253-spj - - - - - 3a55b3a2 by Sebastian Graf at 2020-11-20T02:09:51-05:00 Update user's guide entry on demand analysis and worker/wrapper The demand signature notation has been undocumented for a long time. The only source to understand it, apart from reading the `Outputable` instance, has been an outdated wiki page. Since the previous commits have reworked the demand lattice, I took it as an opportunity to also write some documentation about notation. - - - - - fc963932 by Greg Steuck at 2020-11-20T02:10:31-05:00 Find hadrian location more reliably in cabal-install output Fix #18944 - - - - - 9f40cf6c by Ben Gamari at 2020-11-20T02:11:07-05:00 rts/linker: Align bssSize to page size when mapping symbol extras We place symbol_extras right after bss. We also need to ensure that symbol_extras can be mprotect'd independently from the rest of the image. To ensure this we round up the size of bss to a page boundary, thus ensuring that symbol_extras is also page-aligned. - - - - - b739c319 by Ben Gamari at 2020-11-20T02:11:43-05:00 gitlab-ci: Add usage message to ci.sh - - - - - 802e9180 by Ben Gamari at 2020-11-20T02:11:43-05:00 gitlab-ci: Add VERBOSE environment variable And change the make build system's default behavior to V=0, greatly reducing build log sizes. - - - - - 2a8a979c by Ben Gamari at 2020-11-21T01:13:26-05:00 users-guide: A bit of clean-up in profiling flag documentation - - - - - 56804e33 by Ben Gamari at 2020-11-21T01:13:26-05:00 testsuite: Refactor CountParserDeps - - - - - 53ad67ea by Ben Gamari at 2020-11-21T01:13:26-05:00 Introduce -fprof-callers flag This introducing a new compiler flag to provide a convenient way to introduce profiler cost-centers on all occurrences of the named identifier. Closes #18566. - - - - - ecfd0278 by Sylvain Henry at 2020-11-21T01:14:09-05:00 Move Plugins into HscEnv (#17957) Loaded plugins have nothing to do in DynFlags so this patch moves them into HscEnv (session state). "DynFlags plugins" become "Driver plugins" to still be able to register static plugins. Bump haddock submodule - - - - - 72f2257c by Sylvain Henry at 2020-11-21T01:14:09-05:00 Don't initialize plugins in the Core2Core pipeline Some plugins can be added via TH (cf addCorePlugin). Initialize them in the driver instead of in the Core2Core pipeline. - - - - - ddbeeb3c by Ryan Scott at 2020-11-21T01:14:44-05:00 Add regression test for #10504 This issue was fixed at some point between GHC 8.0 and 8.2. Let's add a regression test to ensure that it stays fixed. Fixes #10504. - - - - - a4a6dc2a by Ben Gamari at 2020-11-21T01:15:21-05:00 dwarf: Apply info table offset consistently Previously we failed to apply the info table offset to the aranges and DIEs, meaning that we often failed to unwind in gdb. For some reason this only seemed to manifest in the RTS's Cmm closures. Nevertheless, now we can unwind completely up to `main` - - - - - 69bfbc21 by Ben Gamari at 2020-11-21T01:15:56-05:00 hadrian: Disable stripping when debug information is enabled - - - - - 7e93ae8b by Ben Gamari at 2020-11-21T13:13:29-05:00 rts: Post ticky entry counts to the eventlog We currently only post the entry counters, not the other global counters as in my experience the former are more useful. We use the heap profiler's census period to decide when to dump. Also spruces up the documentation surrounding ticky-ticky a bit. - - - - - bc9c3916 by Ben Gamari at 2020-11-22T06:28:10-05:00 Implement -ddump-c-backend argument To dump output of the C backend. - - - - - 901bc220 by Ben Gamari at 2020-11-22T12:39:02-05:00 Bump time submodule to 1.11.1 Also bumps directory, Cabal, hpc, time, and unix submodules. Closes #18847. - - - - - 92c0afbf by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Dump STG when ticky is enabled This changes the "ticky" modifier to enable dumping of final STG as this is generally needed to make sense of the ticky profiles. - - - - - d23fef68 by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Introduce notion of flavour transformers This extends Hadrian's notion of "flavour", as described in #18942. - - - - - 179d0bec by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Add a viaLlvmBackend modifier Note that this also slightly changes the semantics of these flavours as we only use LLVM for >= stage1 builds. - - - - - d4d95e51 by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Add profiled_ghc and no_dynamic_ghc modifiers - - - - - 6815603f by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Drop redundant flavour definitions Drop the profiled, LLVM, and ThreadSanitizer flavour definitions as these can now be realized with flavour transformers. - - - - - f88f4339 by Ben Gamari at 2020-11-24T02:43:20-05:00 rts: Flush eventlog buffers from flushEventLog As noted in #18043, flushTrace failed flush anything beyond the writer. This means that a significant amount of data sitting in capability-local event buffers may never get flushed, despite the users' pleads for us to flush. Fix this by making flushEventLog flush all of the event buffers before flushing the writer. Fixes #18043. - - - - - 7c03cc50 by Ben Gamari at 2020-11-24T02:43:55-05:00 gitlab-ci: Run LLVM job on appropriately-labelled MRs Namely, those marked with the ~"LLVM backend" label - - - - - 9b95d815 by Ben Gamari at 2020-11-24T02:43:55-05:00 gitlab-ci: Run LLVM builds on Debian 10 The current Debian 9 image doesn't provide LLVM 7. - - - - - 2ed3e6c0 by Ben Gamari at 2020-11-24T02:43:55-05:00 CmmToLlvm: Declare signature for memcmp Otherwise `opt` fails with: error: use of undefined value '@memcmp$def' - - - - - be5d74ca by Moritz Angermann at 2020-11-26T16:00:32-05:00 [Sized Cmm] properly retain sizes. This replaces all Word<N> = W<N># Word# and Int<N> = I<N># Int# with Word<N> = W<N># Word<N># and Int<N> = I<N># Int<N>#, thus providing us with properly sized primitives in the codegenerator instead of pretending they are all full machine words. This came up when implementing darwinpcs for arm64. The darwinpcs reqires us to pack function argugments in excess of registers on the stack. While most procedure call standards (pcs) assume arguments are just passed in 8 byte slots; and thus the caller does not know the exact signature to make the call, darwinpcs requires us to adhere to the prototype, and thus have the correct sizes. If we specify CInt in the FFI call, it should correspond to the C int, and not just be Word sized, when it's only half the size. This does change the expected output of T16402 but the new result is no less correct as it eliminates the narrowing (instead of the `and` as was previously done). Bumps the array, bytestring, text, and binary submodules. Co-Authored-By: Ben Gamari <ben at well-typed.com> Metric Increase: T13701 T14697 - - - - - a84e53f9 by Andreas Klebinger at 2020-11-26T16:00:32-05:00 RTS: Fix failed inlining of copy_tag. On windows using gcc-10 gcc failed to inline copy_tag into evacuate. To fix this we now set the always_inline attribute for the various copy* functions in Evac.c. The main motivation here is not the overhead of the function call, but rather that this allows the code to "specialize" for the size of the closure we copy which is often known at compile time. An earlier commit also tried to avoid evacuate_large inlining. But didn't quite succeed. So I also marked evacuate_large as noinline. Fixes #12416 - - - - - cdbd16f5 by Sylvain Henry at 2020-11-26T16:00:33-05:00 Fix toArgRep to support 64-bit reps on all systems [This is @Ericson2314 writing a commit message for @hsyl20's patch.] (Progress towards #11953, #17377, #17375) `Int64Rep` and `Word64Rep` are currently broken on 64-bit systems. This is because they should use "native arg rep" but instead use "large arg rep" as they do on 32-bit systems, which is either a non-concept or a 128-bit rep depending on one's vantage point. Now, these reps currently aren't used during 64-bit compilation, so the brokenness isn't observed, but I don't think that constitutes reasons not to fix it. Firstly, the linked issues there is a clearly expressed desire to use explicit-bitwidth constructs in more places. Secondly, per [1], there are other bugs that *do* manifest from not threading explicit-bitwidth information all the way through the compilation pipeline. One can therefore view this as one piece of the larger effort to do that, improve ergnomics, and squash remaining bugs. Also, this is needed for !3658. I could just merge this as part of that, but I'm keen on merging fixes "as they are ready" so the fixes that aren't ready are isolated and easier to debug. [1]: https://mail.haskell.org/pipermail/ghc-devs/2020-October/019332.html - - - - - a9378e69 by Tim Barnes at 2020-11-26T16:00:34-05:00 Set dynamic users-guide TOC spacing (fixes #18554) - - - - - 86a59d93 by Ben Gamari at 2020-11-26T16:00:34-05:00 rts: Use RTS_LIKELY in CHECK Most compilers probably already infer that `barf` diverges but it nevertheless doesn't hurt to be explicit. - - - - - 5757e82b by Matthew Pickering at 2020-11-26T16:00:35-05:00 Remove special case for GHC.ByteCode.Instr This was added in https://github.com/nomeata/ghc-heap-view/commit/34935206e51b9c86902481d84d2f368a6fd93423 GHC.ByteCode.Instr.BreakInfo no longer exists so the special case is dead code. Any check like this can be easily dealt with in client code. - - - - - d9c8b5b4 by Matthew Pickering at 2020-11-26T16:00:35-05:00 Split Up getClosureDataFromHeapRep Motivation 1. Don't enforce the repeated decoding of an info table, when the client can cache it (ghc-debug) 2. Allow the constructor information decoding to be overridden, this casues segfaults in ghc-debug - - - - - 3e3555cc by Andreas Klebinger at 2020-11-26T16:00:35-05:00 RegAlloc: Add missing raPlatformfield to RegAllocStatsSpill Fixes #18994 Co-Author: Benjamin Maurer <maurer.benjamin at gmail.com> - - - - - a1a75aa9 by Ben Gamari at 2020-11-27T06:20:41-05:00 rts: Allocate MBlocks with MAP_TOP_DOWN on Windows As noted in #18991, we would previously allocate heap in low memory. Due to this the linker, which typically *needs* low memory, would end up competing with the heap. In longer builds we end up running out of low memory entirely, leading to linking failures. - - - - - 75fc1ed5 by Sylvain Henry at 2020-11-28T15:40:23-05:00 Hadrian: fix detection of ghc-pkg for cross-compilers - - - - - 7cb5df96 by Sylvain Henry at 2020-11-28T15:40:23-05:00 hadrian: fix ghc-pkg uses (#17601) Make sure ghc-pkg doesn't read the compiler "settings" file by passing --no-user-package-db. - - - - - e3fd4226 by Ben Gamari at 2020-11-28T15:40:23-05:00 gitlab-ci: Introduce a nightly cross-compilation job This adds a job to test cross-compilation from x86-64 to AArch64 with Hadrian. Fixes #18234 - - - - - 698d3d96 by Ben Gamari at 2020-11-28T15:41:00-05:00 gitlab-ci: Only deploy GitLab Pages in ghc/ghc> The deployments are quite large and yet are currently only served for the ghc/ghc> project. - - - - - 625726f9 by David Eichmann at 2020-11-28T15:41:37-05:00 ghc-heap: partial TSO/STACK decoding Co-authored-by: Sven Tennie <sven.tennie at gmail.com> Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> Co-authored-by: Ben Gamari <bgamari.foss at gmail.com> - - - - - 22ea9c29 by Andreas Klebinger at 2020-11-28T15:42:13-05:00 Small optimization to CmmSink. Inside `regsUsedIn` we can avoid some thunks by specializing the recursion. In particular we avoid the thunk for `(f e z)` in the MachOp/Load branches, where we know this will evaluate to z. Reduces allocations for T3294 by ~1%. - - - - - bba42c62 by John Ericson at 2020-11-28T15:42:49-05:00 Make primop handler indentation more consistent - - - - - c82bc8e9 by John Ericson at 2020-11-28T15:42:49-05:00 Cleanup some primop constructor names Harmonize the internal (big sum type) names of the native vs fixed-sized number primops a bit. (Mainly by renaming the former.) No user-facing names are changed. - - - - - ae14f160 by Ben Gamari at 2020-11-28T15:43:25-05:00 testsuite: Mark T14702 as fragile on Windows Due to #18953. - - - - - 1bc104b0 by Ben Gamari at 2020-11-29T15:33:18-05:00 withTimings: Emit allocations counter This will allow us to back out the allocations per compiler pass from the eventlog. Note that we dump the allocation counter rather than the difference since this will allow us to determine how much work is done *between* `withTiming` blocks. - - - - - e992ea84 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 ThreadPaused: Don't zero slop until free vars are pushed When threadPaused blackholes a thunk it calls `OVERWRITING_CLOSURE` to zero the slop for the benefit of the sanity checker. Previously this was done *before* pushing the thunk's free variables to the update remembered set. Consequently we would pull zero'd pointers to the update remembered set. - - - - - e82cd140 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Fix regression from TSAN work The TSAN rework (specifically aad1f803) introduced a subtle regression in GC.c, swapping `g0` in place of `gen`. Whoops! Fixes #18997. - - - - - 35a5207e by GHC GitLab CI at 2020-11-29T15:33:54-05:00 rts/Messages: Add missing write barrier in THROWTO message update After a THROWTO message has been handle the message closure is overwritten by a NULL message. We must ensure that the original closure's pointers continue to be visible to the nonmoving GC. - - - - - 0120829f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Add missing write barrier in shrinkSmallByteArray - - - - - 8a4d8fb6 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 Updates: Don't zero slop until closure has been pushed Ensure that the the free variables have been pushed to the update remembered set before we zero the slop. - - - - - 2793cfdc by GHC GitLab CI at 2020-11-29T15:33:54-05:00 OSThreads: Fix error code checking pthread_join returns its error code and apparently doesn't set errno. - - - - - e391a16f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Don't join to mark_thread on shutdown The mark thread is not joinable as we detach from it on creation. - - - - - 60d088ab by Ben Gamari at 2020-11-29T15:33:54-05:00 nonmoving: Add reference to Ueno 2016 - - - - - 3aa60362 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Ensure that evacuated large objects are marked See Note [Non-moving GC: Marking evacuated objects]. - - - - - 8d304a99 by Ben Gamari at 2020-11-30T10:15:22-05:00 rts/m32: Refactor handling of allocator seeding Previously, in an attempt to reduce fragmentation, each new allocator would map a region of M32_MAX_PAGES fresh pages to seed itself. However, this ends up being extremely wasteful since it turns out that we often use fewer than this. Consequently, these pages end up getting freed which, ends up fragmenting our address space more than than we would have if we had naively allocated pages on-demand. Here we refactor m32 to avoid this waste while achieving the fragmentation mitigation previously desired. In particular, we move all page allocation into the global m32_alloc_page, which will pull a page from the free page pool. If the free page pool is empty we then refill it by allocating a region of M32_MAP_PAGES and adding them to the pool. Furthermore, we do away with the initial seeding entirely. That is, the allocator starts with no active pages: pages are rather allocated on an as-needed basis. On the whole this ends up being a pleasingly simple change, simultaneously making m32 more efficient, more robust, and simpler. Fixes #18980. - - - - - b6629289 by Ben Gamari at 2020-11-30T10:15:58-05:00 rts: Use CHECK instead of assert Use the GHC wrappers instead of <assert.h>. - - - - - 9f4efa6a by Ben Gamari at 2020-11-30T10:15:58-05:00 rts/linker: Replace some ASSERTs with CHECK In the past some people have confused ASSERT, which is for checking internal invariants, which CHECK, which should be used when checking things that might fail due to bad input (and therefore should be enabled even in the release compiler). Change some of these cases in the linker to use CHECK. - - - - - 0f8a4655 by Ryan Scott at 2020-11-30T10:16:34-05:00 Allow deploy:pages job to fail See #18973. - - - - - 49ebe369 by chessai at 2020-11-30T19:47:40-05:00 Optimisations in Data.Foldable (T17867) This PR concerns the following functions from `Data.Foldable`: * minimum * maximum * sum * product * minimumBy * maximumBy - Default implementations of these functions now use `foldl'` or `foldMap'`. - All have been marked with INLINEABLE to make room for further optimisations. - - - - - 4d79ef65 by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - 6af074ce by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - ab334262 by Viktor Dukhovni at 2020-11-30T19:48:17-05:00 dirty MVAR after mutating TSO queue head While the original head and tail of the TSO queue may be in the same generation as the MVAR, interior elements of the queue could be younger after a GC run and may then be exposed by putMVar operation that updates the queue head. Resolves #18919 - - - - - 5eb163f3 by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Don't allow shared libraries to be loaded multiple times - - - - - 490aa14d by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Initialise CCSs from native shared objects - - - - - 6ac3db5f by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Move shared library loading logic into Elf.c - - - - - b6698d73 by GHC GitLab CI at 2020-11-30T19:48:53-05:00 rts/linker: Don't declare dynamic objects with image_mapped This previously resulted in warnings due to spurious unmap failures. - - - - - b94a65af by jneira at 2020-11-30T19:49:31-05:00 Include tried paths in findToolDir error - - - - - 72a87fbc by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Move core flattening algorithm to Core.Unify This sets the stage for a later change, where this algorithm will be needed from GHC.Core.InstEnv. This commit also splits GHC.Core.Map into GHC.Core.Map.Type and GHC.Core.Map.Expr, in order to avoid module import cycles with GHC.Core. - - - - - 0dd45d0a by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Bump the # of commits searched for perf baseline The previous value of 75 meant that a feature branch with more than 75 commits would get spurious CI passes. This affects #18692, but does not fix that ticket, because if a baseline cannot be found, we should fail, not succeed. - - - - - 8bb52d91 by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Remove flattening variables This patch redesigns the flattener to simplify type family applications directly instead of using flattening meta-variables and skolems. The key new innovation is the CanEqLHS type and the new CEqCan constraint (Ct). A CanEqLHS is either a type variable or exactly-saturated type family application; either can now be rewritten using a CEqCan constraint in the inert set. Because the flattener no longer reduces all type family applications to variables, there was some performance degradation if a lengthy type family application is now flattened over and over (not making progress). To compensate, this patch contains some extra optimizations in the flattener, leading to a number of performance improvements. Close #18875. Close #18910. There are many extra parts of the compiler that had to be affected in writing this patch: * The family-application cache (formerly the flat-cache) sometimes stores coercions built from Given inerts. When these inerts get kicked out, we must kick out from the cache as well. (This was, I believe, true previously, but somehow never caused trouble.) Kicking out from the cache requires adding a filterTM function to TrieMap. * This patch obviates the need to distinguish "blocking" coercion holes from non-blocking ones (which, previously, arose from CFunEqCans). There is thus some simplification around coercion holes. * Extra commentary throughout parts of the code I read through, to preserve the knowledge I gained while working. * A change in the pure unifier around unifying skolems with other types. Unifying a skolem now leads to SurelyApart, not MaybeApart, as documented in Note [Binding when looking up instances] in GHC.Core.InstEnv. * Some more use of MCoercion where appropriate. * Previously, class-instance lookup automatically noticed that e.g. C Int was a "unifier" to a target [W] C (F Bool), because the F Bool was flattened to a variable. Now, a little more care must be taken around checking for unifying instances. * Previously, tcSplitTyConApp_maybe would split (Eq a => a). This is silly, because (=>) is not a tycon in Haskell. Fixed now, but there are some knock-on changes in e.g. TrieMap code and in the canonicaliser. * New function anyFreeVarsOf{Type,Co} to check whether a free variable satisfies a certain predicate. * Type synonyms now remember whether or not they are "forgetful"; a forgetful synonym drops at least one argument. This is useful when flattening; see flattenView. * The pattern-match completeness checker invokes the solver. This invocation might need to look through newtypes when checking representational equality. Thus, the desugarer needs to keep track of the in-scope variables to know what newtype constructors are in scope. I bet this bug was around before but never noticed. * Extra-constraints wildcards are no longer simplified before printing. See Note [Do not simplify ConstraintHoles] in GHC.Tc.Solver. * Whether or not there are Given equalities has become slightly subtler. See the new HasGivenEqs datatype. * Note [Type variable cycles in Givens] in GHC.Tc.Solver.Canonical explains a significant new wrinkle in the new approach. * See Note [What might match later?] in GHC.Tc.Solver.Interact, which explains the fix to #18910. * The inert_count field of InertCans wasn't actually used, so I removed it. Though I (Richard) did the implementation, Simon PJ was very involved in design and review. This updates the Haddock submodule to avoid #18932 by adding a type signature. ------------------------- Metric Decrease: T12227 T5030 T9872a T9872b T9872c Metric Increase: T9872d ------------------------- - - - - - d66660ba by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Rename the flattener to become the rewriter. Now that flattening doesn't produce flattening variables, it's not really flattening anything: it's rewriting. This change also means that the rewriter can no longer be confused the core flattener (in GHC.Core.Unify), which is sometimes used during type-checking. - - - - - add0aeae by Ben Gamari at 2020-12-01T19:58:17-05:00 rts: Introduce mmapAnonForLinker Previously most of the uses of mmapForLinker were mapping anonymous memory, resulting in a great deal of unnecessary repetition. Factor this out into a new helper. Also fixes a few places where error checking was missing or suboptimal. - - - - - 97d71646 by Ben Gamari at 2020-12-01T19:58:17-05:00 rts/linker: Introduce munmapForLinker Consolidates munmap calls to ensure consistent error handling. - - - - - d8872af0 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/Linker: Introduce Windows implementations for mmapForLinker, et al. - - - - - c35d0e03 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/m32: Introduce NEEDS_M32 macro Instead of relying on RTS_LINKER_USE_MMAP - - - - - 41c64eb5 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/linker: Use m32 to allocate symbol extras in PEi386 - - - - - e0b08c5f by Ben Gamari at 2020-12-03T13:01:47-05:00 gitlab-ci: Fix copy-paste error Also be more consistent in quoting. - - - - - 33ec3a06 by Ben Gamari at 2020-12-03T23:11:31-05:00 gitlab-ci: Run linters through ci.sh Ensuring that the right toolchain is used. - - - - - 4a437bc1 by Shayne Fletcher at 2020-12-05T09:06:38-05:00 Fix bad span calculations of post qualified imports - - - - - 8fac4b93 by Ben Gamari at 2020-12-05T09:07:13-05:00 testsuite: Add a test for #18923 - - - - - 62ed6957 by Simon Peyton Jones at 2020-12-08T15:31:41-05:00 Fix kind inference for data types. Again. This patch fixes several aspects of kind inference for data type declarations, especially data /instance/ declarations Specifically 1. In kcConDecls/kcConDecl make it clear that the tc_res_kind argument is only used in the H98 case; and in that case there is no result kind signature; and hence no need for the disgusting splitPiTys in kcConDecls (now thankfully gone). The GADT case is a bit different to before, and much nicer. This is what fixes #18891. See Note [kcConDecls: kind-checking data type decls] 2. Do not look at the constructor decls of a data/newtype instance in tcDataFamInstanceHeader. See GHC.Tc.TyCl.Instance Note [Kind inference for data family instances]. This was a new realisation that arose when doing (1) This causes a few knock-on effects in the tests suite, because we require more information than before in the instance /header/. New user-manual material about this in "Kind inference in data type declarations" and "Kind inference for data/newtype instance declarations". 3. Minor improvement in kcTyClDecl, combining GADT and H98 cases 4. Fix #14111 and #8707 by allowing the header of a data instance to affect kind inferece for the the data constructor signatures; as described at length in Note [GADT return types] in GHC.Tc.TyCl This led to a modest refactoring of the arguments (and argument order) of tcConDecl/tcConDecls. 5. Fix #19000 by inverting the sense of the test in new_locs in GHC.Tc.Solver.Canonical.canDecomposableTyConAppOK. - - - - - 0abe3ddf by Adam Sandberg Ericsson at 2020-12-08T15:32:19-05:00 hadrian: build the _l and _thr_l rts flavours in the develN flavours The ghc binary requires the eventlog rts since fc644b1a643128041cfec25db84e417851e28bab - - - - - 51e3bb6d by Andreas Klebinger at 2020-12-08T22:43:21-05:00 CodeGen: Make folds User/DefinerOfRegs INLINEABLE. Reduces allocation for the test case I was looking at by about 1.2%. Mostly from avoiding allocation of some folding functions which turn into let-no-escape bindings which just reuse their environment instead. We also force inlining in a few key places in CmmSink which helps a bit more. - - - - - 69ae10c3 by Andreas Klebinger at 2020-12-08T22:43:21-05:00 CmmSink: Force inlining of foldRegsDefd Helps avoid allocating the folding function. Improves perf for T3294 by about 1%. - - - - - 6e3da800 by Andreas Klebinger at 2020-12-08T22:43:21-05:00 Cmm: Make a few types and utility function slightly stricter. About 0.6% reduction in allocations for the code I was looking at. Not a huge difference but no need to throw away performance. - - - - - aef44d7f by Andreas Klebinger at 2020-12-08T22:43:21-05:00 Cmm.Sink: Optimize retaining of assignments, live sets. Sinking requires us to track live local regs after each cmm statement. We used to do this via "Set LocalReg". However we can replace this with a solution based on IntSet which is overall more efficient without losing much. The thing we lose is width of the variables, which isn't used by the sinking pass anyway. I also reworked how we keep assignments to regs mentioned in skipped assignments. I put the details into Note [Keeping assignemnts mentioned in skipped RHSs]. The gist of it is instead of keeping track of it via the use count which is a `IntMap Int` we now use the live regs set (IntSet) which is quite a bit faster. I think it also matches the semantics a lot better. The skipped (not discarded) assignment does in fact keep the regs on it's rhs alive so keeping track of this in the live set seems like the clearer solution as well. Improves allocations for T3294 by yet another 1%. - - - - - 59f2249b by Andreas Klebinger at 2020-12-08T22:43:21-05:00 GHC.Cmm.Opt: Be stricter in results. Optimization either returns Nothing if nothing is to be done or `Just <cmmExpr>` otherwise. There is no point in being lazy in `cmmExpr`. We usually inspect this element so the thunk gets forced not long after. We might eliminate it as dead code once in a blue moon but that's not a case worth optimizing for. Overall the impact of this is rather low. As Cmm.Opt doesn't allocate much (compared to the rest of GHC) to begin with. - - - - - 54b88eac by Andreas Klebinger at 2020-12-08T22:43:57-05:00 Bump time submodule. This should fix #19002. - - - - - 35e7b0c6 by Kirill Elagin at 2020-12-10T01:45:54-05:00 doc: Clarify the default for -fomit-yields “Yield points enabled” is confusing (and probably wrong? I am not 100% sure what it means). Change it to a simple “on”. Undo this change from 2c23fff2e03e77187dc4d01f325f5f43a0e7cad2. - - - - - 3551c554 by Kirill Elagin at 2020-12-10T01:45:54-05:00 doc: Extra-clarify -fomit-yields Be more clear on what this optimisation being on by default means in terms of yields. - - - - - 6484f0d7 by Sergei Trofimovich at 2020-12-10T01:46:33-05:00 rts/linker/Elf.c: add missing <dlfcn.h> include (musl support) The change fixes build failure on musl: ``` rts/linker/Elf.c:2031:3: error: warning: implicit declaration of function 'dlclose'; did you mean 'close'? [-Wimplicit-function-declaration] 2031 | dlclose(nc->dlopen_handle); | ^~~~~~~ | close ``` Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - ab24ed9b by Ben Gamari at 2020-12-11T03:55:51-05:00 users guide: Fix syntax errors Fixes errors introduced by 3a55b3a2574f913d046f3a6f82db48d7f6df32e3. - - - - - d3a24d31 by Ben Gamari at 2020-12-11T03:55:51-05:00 users guide: Describe GC lifecycle events Every time I am asked about how to interpret these events I need to figure it out from scratch. It's well past time that the users guide properly documents these. - - - - - 741309b9 by Ben Gamari at 2020-12-11T03:56:27-05:00 gitlab-ci: Fix incorrect Docker image for nightly cross job Also refactor the job definition to eliminate the bug by construction. - - - - - 19703bc8 by Ben Gamari at 2020-12-11T03:56:27-05:00 gitlab-ci: Fix name of flavour in ThreadSanitizer job It looks like I neglected to update this after introduce flavour transformers. - - - - - 381eb660 by Sylvain Henry at 2020-12-11T12:57:35-05:00 Display FFI labels (fix #18539) - - - - - 4548d1f8 by Aaron Allen at 2020-12-11T12:58:14-05:00 Elide extraneous messages for :doc command (#15784) Do not print `<has no documentation>` alongside a valid doc. Additionally, if two matching symbols lack documentation then the message will only be printed once. Hence, `<has no documentation>` will be printed at most once and only if all matching symbols are lacking docs. - - - - - 5eba91b6 by Aaron Allen at 2020-12-11T12:58:14-05:00 Add :doc test case for duplicate record fields Tests that the output of the `:doc` command is correct for duplicate record fields defined using -XDuplicateRecordFields. - - - - - 5feb9b2d by Ryan Scott at 2020-12-11T22:39:29-05:00 Delete outdated Note [Kind-checking tyvar binders for associated types] This Note has severely bitrotted, as it has no references anywhere in the codebase, and none of the functions that it mentions exist anymore. Let's just delete this. While I was in town, I deleted some outdated comments from `checkFamPatBinders` of a similar caliber. Fixes #19008. [ci skip] - - - - - f9f9f030 by Sylvain Henry at 2020-12-11T22:40:08-05:00 Arrows: correctly query arrow methods (#17423) Consider the following code: proc (C x y) -> ... Before this patch, the evidence binding for the Arrow dictionary was attached to the C pattern: proc (C x y) { $dArrow = ... } -> ... But then when we desugar this, we use arrow operations ("arr", ">>>"...) specialised for this arrow: let arr_xy = arr $dArrow -- <-- Not in scope! ... in arr_xy (\(C x y) { $dArrow = ... } -> ...) This patch allows arrow operations to be type-checked before the proc itself, avoiding this issue. Fix #17423 - - - - - aaa8f00f by Sylvain Henry at 2020-12-11T22:40:48-05:00 Validate script: fix configure command when using stack - - - - - b4a929a1 by Sylvain Henry at 2020-12-11T22:41:30-05:00 Hadrian: fix libffi tarball parsing Fix parsing of "libffi-3.3.tar.gz". NB: switch to a newer libffi isn't done in this patch - - - - - 690c8946 by Sylvain Henry at 2020-12-11T22:42:09-05:00 Parser: move parser utils into their own module Move code unrelated to runtime evaluation out of GHC.Runtime.Eval - - - - - 76be0e32 by Sylvain Henry at 2020-12-11T22:42:48-05:00 Move SizedSeq into ghc-boot - - - - - 3a16d764 by Sylvain Henry at 2020-12-11T22:42:48-05:00 ghci: don't compile unneeded modules - - - - - 2895fa60 by Sylvain Henry at 2020-12-11T22:42:48-05:00 ghci: reuse Arch from ghc-boot - - - - - 480a38d4 by Sylvain Henry at 2020-12-11T22:43:30-05:00 rts: don't use siginterrupt (#19019) - - - - - 4af6126d by Sylvain Henry at 2020-12-11T22:44:11-05:00 Use static array in zeroCount - - - - - 5bd71bfd by Sebastian Graf at 2020-12-12T04:45:09-05:00 DmdAnal: Annotate top-level function bindings with demands (#18894) It's useful to annotate a non-exported top-level function like `g` in ```hs module Lib (h) where g :: Int -> Int -> (Int,Int) g m 1 = (m, 0) g m n = (2 * m, 2 `div` n) {-# NOINLINE g #-} h :: Int -> Int h 1 = 0 h m | odd m = snd (g m 2) | otherwise = uncurry (+) (g 2 m) ``` with its demand `UCU(CS(P(1P(U),SP(U))`, which tells us that whenever `g` was called, the second component of the returned pair was evaluated strictly. Since #18903 we do so for local functions, where we can see all calls. For top-level functions, we can assume that all *exported* functions are demanded according to `topDmd` and thus get sound demands for non-exported top-level functions. The demand on `g` is crucial information for Nested CPR, which may the go on and unbox `g` for the second pair component. That is true even if that pair component may diverge, as is the case for the call site `g 13 0`, which throws a div-by-zero exception. In `T18894b`, you can even see the new demand annotation enabling us to eta-expand a function that we wouldn't be able to eta-expand without Call Arity. We only track bindings of function type in order not to risk huge compile-time regressions, see `isInterestingTopLevelFn`. There was a CoreLint check that rejected strict demand annotations on recursive or top-level bindings, which seems completely unjustified. All the cases I investigated were fine, so I removed it. Fixes #18894. - - - - - 3aae036e by Sebastian Graf at 2020-12-12T04:45:09-05:00 Demand: Simplify `CU(U)` to `U` (#19005) Both sub-demands encode the same information. This is a trivial change and already affects a few regression tests (e.g. `T5075`), so no separate regression test is necessary. - - - - - c6477639 by Adam Sandberg Ericsson at 2020-12-12T04:45:48-05:00 hadrian: correctly copy the docs dir into the bindist #18669 - - - - - e033dd05 by Adam Sandberg Ericsson at 2020-12-12T10:52:19+00:00 mkDocs: support hadrian bindists #18973 - - - - - 78580ba3 by John Ericson at 2020-12-13T07:14:50-05:00 Remove old .travis.yml - - - - - c696bb2f by Cale Gibbard at 2020-12-14T13:37:09-05:00 Implement type applications in patterns The haddock submodule is also updated so that it understands the changes to patterns. - - - - - 7e9debd4 by Ben Gamari at 2020-12-14T13:37:09-05:00 Optimise nullary type constructor usage During the compilation of programs GHC very frequently deals with the `Type` type, which is a synonym of `TYPE 'LiftedRep`. This patch teaches GHC to avoid expanding the `Type` synonym (and other nullary type synonyms) during type comparisons, saving a good amount of work. This optimisation is described in `Note [Comparing nullary type synonyms]`. To maximize the impact of this optimisation, we introduce a few special-cases to reduce `TYPE 'LiftedRep` to `Type`. See `Note [Prefer Type over TYPE 'LiftedPtrRep]`. Closes #17958. Metric Decrease: T18698b T1969 T12227 T12545 T12707 T14683 T3064 T5631 T5642 T9020 T9630 T9872a T13035 haddock.Cabal haddock.base - - - - - 92377c27 by Ben Gamari at 2020-12-14T13:41:58-05:00 Revert "Optimise nullary type constructor usage" This was inadvertently merged. This reverts commit 7e9debd4ceb068effe8ac81892d2cabcb8f55850. - - - - - d0e8c10d by Sylvain Henry at 2020-12-14T19:45:13+01:00 Move Unit related fields from DynFlags to HscEnv The unit database cache, the home unit and the unit state were stored in DynFlags while they ought to be stored in the compiler session state (HscEnv). This patch fixes this. It introduces a new UnitEnv type that should be used in the future to handle separate unit environments (especially host vs target units). Related to #17957 Bump haddock submodule - - - - - af855ac1 by Andreas Klebinger at 2020-12-14T15:22:13-05:00 Optimize dumping of consecutive whitespace. The naive way of putting out n characters of indent would be something like `hPutStr hdl (replicate n ' ')`. However this is quite inefficient as we allocate an absurd number of strings consisting of simply spaces as we don't cache them. To improve on this we now track if we can simply write ascii spaces via hPutBuf instead. This is the case when running with -ddump-to-file where we force the encoding to be UTF8. This avoids both the cost of going through encoding as well as avoiding allocation churn from all the white space. Instead we simply use hPutBuf on a preallocated unlifted string. When dumping stg like this: > nofib/spectral/simple/Main.hs -fforce-recomp -ddump-stg-final -ddump-to-file -c +RTS -s Allocations went from 1,778 MB to 1,702MB. About a 4% reduction of allocation! I did not measure the difference in runtime but expect it to be similar. Bumps the haddock submodule since the interface of GHC's Pretty slightly changed. ------------------------- Metric Decrease: T12227 ------------------------- - - - - - dad87210 by Ben Gamari at 2020-12-14T15:22:29-05:00 Optimise nullary type constructor usage During the compilation of programs GHC very frequently deals with the `Type` type, which is a synonym of `TYPE 'LiftedRep`. This patch teaches GHC to avoid expanding the `Type` synonym (and other nullary type synonyms) during type comparisons, saving a good amount of work. This optimisation is described in `Note [Comparing nullary type synonyms]`. To maximize the impact of this optimisation, we introduce a few special-cases to reduce `TYPE 'LiftedRep` to `Type`. See `Note [Prefer Type over TYPE 'LiftedPtrRep]`. Closes #17958. Metric Decrease: T18698b T1969 T12227 T12545 T12707 T14683 T3064 T5631 T5642 T9020 T9630 T9872a T13035 haddock.Cabal haddock.base - - - - - 6c2eb223 by Andrew Martin at 2020-12-14T18:48:51-05:00 Implement BoxedRep proposal This implements the BoxedRep proposal, refacoring the `RuntimeRep` hierarchy from: ```haskell data RuntimeRep = LiftedPtrRep | UnliftedPtrRep | ... ``` to ```haskell data RuntimeRep = BoxedRep Levity | ... data Levity = Lifted | Unlifted ``` Closes #17526. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - − .travis.yml - aclocal.m4 - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Types/Prim.hs - + compiler/GHC/Builtin/Types/Prim.hs-boot - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Info/Build.hs - + compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Liveness.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Parser/Monad.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/185a01b0a2522b8197710e339b21179267d4245a...6c2eb2232b39ff4720fda0a4a009fb6afbc9dcea -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/185a01b0a2522b8197710e339b21179267d4245a...6c2eb2232b39ff4720fda0a4a009fb6afbc9dcea You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Dec 14 23:56:05 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 14 Dec 2020 18:56:05 -0500 Subject: [Git][ghc/ghc][wip/backports-8.10] 2 commits: users guide: Add release notes for 8.10.3 Message-ID: <5fd7fb95454bb_6b21725c11c15878d0@gitlab.mail> Ben Gamari pushed to branch wip/backports-8.10 at Glasgow Haskell Compiler / GHC Commits: fc3dfc07 by Ben Gamari at 2020-12-14T18:55:42-05:00 users guide: Add release notes for 8.10.3 - - - - - e2ed44af by Ben Gamari at 2020-12-14T18:55:42-05:00 configure: Release 8.10.3 - - - - - 3 changed files: - configure.ac - + docs/users_guide/8.10.3-notes.rst - docs/users_guide/index.rst Changes: ===================================== configure.ac ===================================== @@ -13,10 +13,10 @@ dnl # see what flags are available. (Better yet, read the documentation!) # -AC_INIT([The Glorious Glasgow Haskell Compilation System], [8.10.2], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) +AC_INIT([The Glorious Glasgow Haskell Compilation System], [8.10.3], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) # Set this to YES for a released version, otherwise NO -: ${RELEASE=NO} +: ${RELEASE=YES} # The primary version (e.g. 7.5, 7.4.1) is set in the AC_INIT line # above. If this is not a released version, then we will append the ===================================== docs/users_guide/8.10.3-notes.rst ===================================== @@ -0,0 +1,141 @@ +.. _release-8-10-3: + +Release notes for version 8.10.3 +================================ + +The significant changes to the various parts of the compiler are listed in the +following sections. + +Like previous releases in the 8.10 series, the :ghc-flag:`LLVM backend <-fllvm>` +of this release is to be used with LLVM 9. + +Highlights +---------- + +- Numerous stability improvements on Windows. + +- GHC now has far more robust support for architectures with weak memory + ordering guarantees. + +- GHC can split up dynamic objects to mitigate the macOS ``RPATH`` size + limitation when building large projects (:ghc-ticket:`14444`). + +- Several significant correctness bugs in the low-latency garbage collector have + been fixed. Users of :rts-flag:`--nonmoving-gc` are strongly encouraged to + upgrade promptly. + + +Full details +------------ + +Compiler +~~~~~~~~ + +* A compiler crash triggered by a ``SPECIALISE`` pragma on a binding with + no unfolding has been fixed (:ghc-ticket:`18118`). + +* GHC now supports a command-line flag, :ghc-flag:`-pgmc-supports-no-pie`, + allowing the user to indicate that the C compiler supplied via + :ghc-flag:`-pgmc ⟨cmd⟩` supports ``-no-pie``. + +* A pair of flags, :ghc-flag:`-pgmlm ⟨cmd⟩` and :ghc-flag:`-optlm ⟨option⟩`, + allowing the user to override the linker used to be join GHCi object files + has been added. + +* A regression in the treatment of the :ghc-flag:`-fbyte-code` flag has been + fixed (:ghc-ticket:`18955`). + +- A bug in the determination of source spans of post-qualified imports has been + fixed :ghc-ticket:`19014`. + + +Runtime system +~~~~~~~~~~~~~~ + +- GHC is now more careful to respect address space limits set via `ulimit`` + when allocating its heap (:ghc-ticket:`18623`). + +- Numerous fixes on Windows. These include a bug in stack allocation + triggering Windows' stack verifier (:ghc-ticket:`18601`), various linker bugs + (:ghc-ticket:`15808`, :ghc-ticket:`18991`), and a bug where ``libc`` may be + called during image initialization resulting in undefined behavior + (:ghc-ticket:`18548`). + +- GHC's linker is now able to load macOS frameworks on Big Sur + (:ghc-ticket:`18446`). + +- A soundness bug affecting programs relying on heavy mutation of ``MVar``\ s + has been fixed (:ghc-ticket:`18919`). + +- The internal linker's code unloading logic has been reenabled and now tracks + object file dependencies, fixing a soundness bug (:ghc-ticket:`16525`). + +- A linker bug relying in the misalignment of loaded ``.rodata`` sections has + been fixed. + + +Known issues +------------ + +- A long-standing bug (:ghc-ticket:`16893`) which can cause some applications + of ``unsafeCoerce`` to segmentation fault is only partially fixed in this + release. This release only avoids this issue in the uses of ``unsafeCoerce`` + in ``Data.Typeable.Internal``, which was the proximate cause of + :ghc-ticket:`16893`. + + However, it is possible that this bug could manifest in user-code using + ``unsafeCoerce`` to perform dynamic type checks. See the :ghc-ticket:`ticket + <16893>` for details. + + We expect that this issue will be fixed in the next major release of GHC. + +- A long-standing bug (:ghc-ticket:`17760`) where some uses of the ``touch#`` + primop can be dropped by the simplifier is present in this release. This bug + will be fixed in GHC 9.0.1. In the meantime, see the :ghc-ticket:`ticket + <17760>` for mitigations. + + +Included libraries +------------------ + +The package database provided with this distribution also contains a number of +packages other than GHC itself. See the changelogs provided with these packages +for further change information. + +.. ghc-package-list:: + + libraries/array/array.cabal: Dependency of ``ghc`` library + libraries/base/base.cabal: Core library + libraries/binary/binary.cabal: Dependency of ``ghc`` library + libraries/bytestring/bytestring.cabal: Dependency of ``ghc`` library + libraries/Cabal/Cabal/Cabal.cabal: Dependency of ``ghc-pkg`` utility + libraries/containers/containers/containers.cabal: Dependency of ``ghc`` library + libraries/deepseq/deepseq.cabal: Dependency of ``ghc`` library + libraries/directory/directory.cabal: Dependency of ``ghc`` library + libraries/exceptions/exceptions.cabal: Dependency of ``haskeline`` library + libraries/filepath/filepath.cabal: Dependency of ``ghc`` library + compiler/ghc.cabal: The compiler itself + libraries/ghci/ghci.cabal: The REPL interface + libraries/ghc-boot/ghc-boot.cabal: Internal compiler library + libraries/ghc-boot-th/ghc-boot-th.cabal: Internal compiler library + libraries/ghc-compact/ghc-compact.cabal: Core library + libraries/ghc-heap/ghc-heap.cabal: GHC heap-walking library + libraries/ghc-prim/ghc-prim.cabal: Core library + libraries/haskeline/haskeline.cabal: Dependency of ``ghci`` executable + libraries/hpc/hpc.cabal: Dependency of ``hpc`` executable + libraries/integer-gmp/integer-gmp.cabal: Core library + libraries/libiserv/libiserv.cabal: Internal compiler library + libraries/mtl/mtl.cabal: Dependency of ``Cabal`` library + libraries/parsec/parsec.cabal: Dependency of ``Cabal`` library + libraries/pretty/pretty.cabal: Dependency of ``ghc`` library + libraries/process/process.cabal: Dependency of ``ghc`` library + libraries/stm/stm.cabal: Dependency of ``haskeline`` library + libraries/template-haskell/template-haskell.cabal: Core library + libraries/terminfo/terminfo.cabal: Dependency of ``haskeline`` library + libraries/text/text.cabal: Dependency of ``Cabal`` library + libraries/time/time.cabal: Dependency of ``ghc`` library + libraries/transformers/transformers.cabal: Dependency of ``ghc`` library + libraries/unix/unix.cabal: Dependency of ``ghc`` library + libraries/Win32/Win32.cabal: Dependency of ``ghc`` library + libraries/xhtml/xhtml.cabal: Dependency of ``haddock`` executable + ===================================== docs/users_guide/index.rst ===================================== @@ -14,6 +14,7 @@ Contents: intro 8.10.1-notes 8.10.2-notes + 8.10.3-notes ghci runghc usage View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b1593746a6774448640c235bcf520ef641f62fbc...e2ed44afc883f8e791184f8037a672b6f06fe7e6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b1593746a6774448640c235bcf520ef641f62fbc...e2ed44afc883f8e791184f8037a672b6f06fe7e6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 15 05:24:27 2020 From: gitlab at gitlab.haskell.org (John Ericson) Date: Tue, 15 Dec 2020 00:24:27 -0500 Subject: [Git][ghc/ghc][wip/primop-naming-consistency] 6 commits: mkDocs: support hadrian bindists #18973 Message-ID: <5fd8488b25825_6b21725ac4015954e@gitlab.mail> John Ericson pushed to branch wip/primop-naming-consistency at Glasgow Haskell Compiler / GHC Commits: e033dd05 by Adam Sandberg Ericsson at 2020-12-12T10:52:19+00:00 mkDocs: support hadrian bindists #18973 - - - - - 78580ba3 by John Ericson at 2020-12-13T07:14:50-05:00 Remove old .travis.yml - - - - - c696bb2f by Cale Gibbard at 2020-12-14T13:37:09-05:00 Implement type applications in patterns The haddock submodule is also updated so that it understands the changes to patterns. - - - - - 7e9debd4 by Ben Gamari at 2020-12-14T13:37:09-05:00 Optimise nullary type constructor usage During the compilation of programs GHC very frequently deals with the `Type` type, which is a synonym of `TYPE 'LiftedRep`. This patch teaches GHC to avoid expanding the `Type` synonym (and other nullary type synonyms) during type comparisons, saving a good amount of work. This optimisation is described in `Note [Comparing nullary type synonyms]`. To maximize the impact of this optimisation, we introduce a few special-cases to reduce `TYPE 'LiftedRep` to `Type`. See `Note [Prefer Type over TYPE 'LiftedPtrRep]`. Closes #17958. Metric Decrease: T18698b T1969 T12227 T12545 T12707 T14683 T3064 T5631 T5642 T9020 T9630 T9872a T13035 haddock.Cabal haddock.base - - - - - 92377c27 by Ben Gamari at 2020-12-14T13:41:58-05:00 Revert "Optimise nullary type constructor usage" This was inadvertently merged. This reverts commit 7e9debd4ceb068effe8ac81892d2cabcb8f55850. - - - - - 5ca56568 by Sylvain Henry at 2020-12-15T05:23:27+00:00 Fix array and cleanup conversion primops (#19026) The first change makes the array ones use the proper fixed-size types, which also means that just like before, they can be used without explicit conversions with the boxed sized types. (Before, it was Int# / Word# on both sides, now it is fixed sized on both sides). For the second change, don't use "extend" or "narrow" in some of the user-facing primops names for conversions. - Names like `narrowInt32#` are misleading when `Int` is 32-bits. - Names like `extendInt64#` are flat-out wrong when `Int is 32-bits. - `narrow{Int,Word}<N>#` however map a type to itself, and so don't suffer from this problem. They are left as-is. These changes are batched together because Alex happend to use the array ops. We can only use released versions of Alex at this time, sadly, and I don't want to have to have a release thatwon't work for the final GHC 9.2. So by combining these we get all the changes for Alex done at once. Bump minimum Alex version Bump Cabal, array, bytestring, text, and binary submodules - - - - - 30 changed files: - − .travis.yml - aclocal.m4 - compiler/GHC/Builtin/bytearray-ops.txt.pp - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Data/FastString.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Errors.hs - compiler/GHC/Parser/Errors/Ppr.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Parser/PostProcess/Haddock.hs - compiler/GHC/Parser/Types.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Utils.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dc7171ee7d5e26c2b2fe57b4cdf99cd5d58e1e88...5ca56568384d9c2d08aea2d91fa8464bf565d6e4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dc7171ee7d5e26c2b2fe57b4cdf99cd5d58e1e88...5ca56568384d9c2d08aea2d91fa8464bf565d6e4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 15 12:22:26 2020 From: gitlab at gitlab.haskell.org (David Eichmann) Date: Tue, 15 Dec 2020 07:22:26 -0500 Subject: [Git][ghc/ghc][wip/con-info] 133 commits: Add Addr# atomic primops (#17751) Message-ID: <5fd8aa82d6c44_6b2167418541611340@gitlab.mail> David Eichmann pushed to branch wip/con-info at Glasgow Haskell Compiler / GHC Commits: 52114fa0 by Sylvain Henry at 2020-11-16T11:48:47+01:00 Add Addr# atomic primops (#17751) This reuses the codegen used for ByteArray#'s atomic primops. - - - - - 8150f654 by Sebastian Graf at 2020-11-18T23:38:40-05:00 PmCheck: Print types of uncovered patterns (#18932) In order to avoid confusion as in #18932, we display the type of the match variables in the non-exhaustiveness warning, e.g. ``` T18932.hs:14:1: warning: [-Wincomplete-patterns] Pattern match(es) are non-exhaustive In an equation for ‘g’: Patterns of type ‘T a’, ‘T a’, ‘T a’ not matched: (MkT2 _) (MkT1 _) (MkT1 _) (MkT2 _) (MkT1 _) (MkT2 _) (MkT2 _) (MkT2 _) (MkT1 _) (MkT2 _) (MkT2 _) (MkT2 _) ... | 14 | g (MkT1 x) (MkT1 _) (MkT1 _) = x | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ``` It also allows us to omit the type signature on wildcard matches which we previously showed in only some situations, particularly `-XEmptyCase`. Fixes #18932. - - - - - 165352a2 by Krzysztof Gogolewski at 2020-11-20T02:08:36-05:00 Export indexError from GHC.Ix (#18579) - - - - - b57845c3 by Kamil Dworakowski at 2020-11-20T02:09:16-05:00 Clarify interruptible FFI wrt masking state - - - - - 321d1bd8 by Sebastian Graf at 2020-11-20T02:09:51-05:00 Fix strictness signatures of `prefetchValue*#` primops Their strictness signatures said the primops are strict in their first argument, which is wrong: Handing it a thunk will prefetch the pointer to the thunk, but not evaluate it. Hence not strict. The regression test `T8256` actually tests for laziness in the first argument, so GHC apparently never exploited the strictness signature. See also https://gitlab.haskell.org/ghc/ghc/-/issues/8256#note_310867, where this came up. - - - - - 0aec78b6 by Sebastian Graf at 2020-11-20T02:09:51-05:00 Demand: Interleave usage and strictness demands (#18903) As outlined in #18903, interleaving usage and strictness demands not only means a more compact demand representation, but also allows us to express demands that we weren't easily able to express before. Call demands are *relative* in the sense that a call demand `Cn(cd)` on `g` says "`g` is called `n` times. *Whenever `g` is called*, the result is used according to `cd`". Example from #18903: ```hs h :: Int -> Int h m = let g :: Int -> (Int,Int) g 1 = (m, 0) g n = (2 * n, 2 `div` n) {-# NOINLINE g #-} in case m of 1 -> 0 2 -> snd (g m) _ -> uncurry (+) (g m) ``` Without the interleaved representation, we would just get `L` for the strictness demand on `g`. Now we are able to express that whenever `g` is called, its second component is used strictly in denoting `g` by `1C1(P(1P(U),SP(U)))`. This would allow Nested CPR to unbox the division, for example. Fixes #18903. While fixing regressions, I also discovered and fixed #18957. Metric Decrease: T13253-spj - - - - - 3a55b3a2 by Sebastian Graf at 2020-11-20T02:09:51-05:00 Update user's guide entry on demand analysis and worker/wrapper The demand signature notation has been undocumented for a long time. The only source to understand it, apart from reading the `Outputable` instance, has been an outdated wiki page. Since the previous commits have reworked the demand lattice, I took it as an opportunity to also write some documentation about notation. - - - - - fc963932 by Greg Steuck at 2020-11-20T02:10:31-05:00 Find hadrian location more reliably in cabal-install output Fix #18944 - - - - - 9f40cf6c by Ben Gamari at 2020-11-20T02:11:07-05:00 rts/linker: Align bssSize to page size when mapping symbol extras We place symbol_extras right after bss. We also need to ensure that symbol_extras can be mprotect'd independently from the rest of the image. To ensure this we round up the size of bss to a page boundary, thus ensuring that symbol_extras is also page-aligned. - - - - - b739c319 by Ben Gamari at 2020-11-20T02:11:43-05:00 gitlab-ci: Add usage message to ci.sh - - - - - 802e9180 by Ben Gamari at 2020-11-20T02:11:43-05:00 gitlab-ci: Add VERBOSE environment variable And change the make build system's default behavior to V=0, greatly reducing build log sizes. - - - - - 2a8a979c by Ben Gamari at 2020-11-21T01:13:26-05:00 users-guide: A bit of clean-up in profiling flag documentation - - - - - 56804e33 by Ben Gamari at 2020-11-21T01:13:26-05:00 testsuite: Refactor CountParserDeps - - - - - 53ad67ea by Ben Gamari at 2020-11-21T01:13:26-05:00 Introduce -fprof-callers flag This introducing a new compiler flag to provide a convenient way to introduce profiler cost-centers on all occurrences of the named identifier. Closes #18566. - - - - - ecfd0278 by Sylvain Henry at 2020-11-21T01:14:09-05:00 Move Plugins into HscEnv (#17957) Loaded plugins have nothing to do in DynFlags so this patch moves them into HscEnv (session state). "DynFlags plugins" become "Driver plugins" to still be able to register static plugins. Bump haddock submodule - - - - - 72f2257c by Sylvain Henry at 2020-11-21T01:14:09-05:00 Don't initialize plugins in the Core2Core pipeline Some plugins can be added via TH (cf addCorePlugin). Initialize them in the driver instead of in the Core2Core pipeline. - - - - - ddbeeb3c by Ryan Scott at 2020-11-21T01:14:44-05:00 Add regression test for #10504 This issue was fixed at some point between GHC 8.0 and 8.2. Let's add a regression test to ensure that it stays fixed. Fixes #10504. - - - - - a4a6dc2a by Ben Gamari at 2020-11-21T01:15:21-05:00 dwarf: Apply info table offset consistently Previously we failed to apply the info table offset to the aranges and DIEs, meaning that we often failed to unwind in gdb. For some reason this only seemed to manifest in the RTS's Cmm closures. Nevertheless, now we can unwind completely up to `main` - - - - - 69bfbc21 by Ben Gamari at 2020-11-21T01:15:56-05:00 hadrian: Disable stripping when debug information is enabled - - - - - 7e93ae8b by Ben Gamari at 2020-11-21T13:13:29-05:00 rts: Post ticky entry counts to the eventlog We currently only post the entry counters, not the other global counters as in my experience the former are more useful. We use the heap profiler's census period to decide when to dump. Also spruces up the documentation surrounding ticky-ticky a bit. - - - - - bc9c3916 by Ben Gamari at 2020-11-22T06:28:10-05:00 Implement -ddump-c-backend argument To dump output of the C backend. - - - - - 901bc220 by Ben Gamari at 2020-11-22T12:39:02-05:00 Bump time submodule to 1.11.1 Also bumps directory, Cabal, hpc, time, and unix submodules. Closes #18847. - - - - - 92c0afbf by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Dump STG when ticky is enabled This changes the "ticky" modifier to enable dumping of final STG as this is generally needed to make sense of the ticky profiles. - - - - - d23fef68 by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Introduce notion of flavour transformers This extends Hadrian's notion of "flavour", as described in #18942. - - - - - 179d0bec by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Add a viaLlvmBackend modifier Note that this also slightly changes the semantics of these flavours as we only use LLVM for >= stage1 builds. - - - - - d4d95e51 by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Add profiled_ghc and no_dynamic_ghc modifiers - - - - - 6815603f by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Drop redundant flavour definitions Drop the profiled, LLVM, and ThreadSanitizer flavour definitions as these can now be realized with flavour transformers. - - - - - f88f4339 by Ben Gamari at 2020-11-24T02:43:20-05:00 rts: Flush eventlog buffers from flushEventLog As noted in #18043, flushTrace failed flush anything beyond the writer. This means that a significant amount of data sitting in capability-local event buffers may never get flushed, despite the users' pleads for us to flush. Fix this by making flushEventLog flush all of the event buffers before flushing the writer. Fixes #18043. - - - - - 7c03cc50 by Ben Gamari at 2020-11-24T02:43:55-05:00 gitlab-ci: Run LLVM job on appropriately-labelled MRs Namely, those marked with the ~"LLVM backend" label - - - - - 9b95d815 by Ben Gamari at 2020-11-24T02:43:55-05:00 gitlab-ci: Run LLVM builds on Debian 10 The current Debian 9 image doesn't provide LLVM 7. - - - - - 2ed3e6c0 by Ben Gamari at 2020-11-24T02:43:55-05:00 CmmToLlvm: Declare signature for memcmp Otherwise `opt` fails with: error: use of undefined value '@memcmp$def' - - - - - be5d74ca by Moritz Angermann at 2020-11-26T16:00:32-05:00 [Sized Cmm] properly retain sizes. This replaces all Word<N> = W<N># Word# and Int<N> = I<N># Int# with Word<N> = W<N># Word<N># and Int<N> = I<N># Int<N>#, thus providing us with properly sized primitives in the codegenerator instead of pretending they are all full machine words. This came up when implementing darwinpcs for arm64. The darwinpcs reqires us to pack function argugments in excess of registers on the stack. While most procedure call standards (pcs) assume arguments are just passed in 8 byte slots; and thus the caller does not know the exact signature to make the call, darwinpcs requires us to adhere to the prototype, and thus have the correct sizes. If we specify CInt in the FFI call, it should correspond to the C int, and not just be Word sized, when it's only half the size. This does change the expected output of T16402 but the new result is no less correct as it eliminates the narrowing (instead of the `and` as was previously done). Bumps the array, bytestring, text, and binary submodules. Co-Authored-By: Ben Gamari <ben at well-typed.com> Metric Increase: T13701 T14697 - - - - - a84e53f9 by Andreas Klebinger at 2020-11-26T16:00:32-05:00 RTS: Fix failed inlining of copy_tag. On windows using gcc-10 gcc failed to inline copy_tag into evacuate. To fix this we now set the always_inline attribute for the various copy* functions in Evac.c. The main motivation here is not the overhead of the function call, but rather that this allows the code to "specialize" for the size of the closure we copy which is often known at compile time. An earlier commit also tried to avoid evacuate_large inlining. But didn't quite succeed. So I also marked evacuate_large as noinline. Fixes #12416 - - - - - cdbd16f5 by Sylvain Henry at 2020-11-26T16:00:33-05:00 Fix toArgRep to support 64-bit reps on all systems [This is @Ericson2314 writing a commit message for @hsyl20's patch.] (Progress towards #11953, #17377, #17375) `Int64Rep` and `Word64Rep` are currently broken on 64-bit systems. This is because they should use "native arg rep" but instead use "large arg rep" as they do on 32-bit systems, which is either a non-concept or a 128-bit rep depending on one's vantage point. Now, these reps currently aren't used during 64-bit compilation, so the brokenness isn't observed, but I don't think that constitutes reasons not to fix it. Firstly, the linked issues there is a clearly expressed desire to use explicit-bitwidth constructs in more places. Secondly, per [1], there are other bugs that *do* manifest from not threading explicit-bitwidth information all the way through the compilation pipeline. One can therefore view this as one piece of the larger effort to do that, improve ergnomics, and squash remaining bugs. Also, this is needed for !3658. I could just merge this as part of that, but I'm keen on merging fixes "as they are ready" so the fixes that aren't ready are isolated and easier to debug. [1]: https://mail.haskell.org/pipermail/ghc-devs/2020-October/019332.html - - - - - a9378e69 by Tim Barnes at 2020-11-26T16:00:34-05:00 Set dynamic users-guide TOC spacing (fixes #18554) - - - - - 86a59d93 by Ben Gamari at 2020-11-26T16:00:34-05:00 rts: Use RTS_LIKELY in CHECK Most compilers probably already infer that `barf` diverges but it nevertheless doesn't hurt to be explicit. - - - - - 5757e82b by Matthew Pickering at 2020-11-26T16:00:35-05:00 Remove special case for GHC.ByteCode.Instr This was added in https://github.com/nomeata/ghc-heap-view/commit/34935206e51b9c86902481d84d2f368a6fd93423 GHC.ByteCode.Instr.BreakInfo no longer exists so the special case is dead code. Any check like this can be easily dealt with in client code. - - - - - d9c8b5b4 by Matthew Pickering at 2020-11-26T16:00:35-05:00 Split Up getClosureDataFromHeapRep Motivation 1. Don't enforce the repeated decoding of an info table, when the client can cache it (ghc-debug) 2. Allow the constructor information decoding to be overridden, this casues segfaults in ghc-debug - - - - - 3e3555cc by Andreas Klebinger at 2020-11-26T16:00:35-05:00 RegAlloc: Add missing raPlatformfield to RegAllocStatsSpill Fixes #18994 Co-Author: Benjamin Maurer <maurer.benjamin at gmail.com> - - - - - a1a75aa9 by Ben Gamari at 2020-11-27T06:20:41-05:00 rts: Allocate MBlocks with MAP_TOP_DOWN on Windows As noted in #18991, we would previously allocate heap in low memory. Due to this the linker, which typically *needs* low memory, would end up competing with the heap. In longer builds we end up running out of low memory entirely, leading to linking failures. - - - - - 75fc1ed5 by Sylvain Henry at 2020-11-28T15:40:23-05:00 Hadrian: fix detection of ghc-pkg for cross-compilers - - - - - 7cb5df96 by Sylvain Henry at 2020-11-28T15:40:23-05:00 hadrian: fix ghc-pkg uses (#17601) Make sure ghc-pkg doesn't read the compiler "settings" file by passing --no-user-package-db. - - - - - e3fd4226 by Ben Gamari at 2020-11-28T15:40:23-05:00 gitlab-ci: Introduce a nightly cross-compilation job This adds a job to test cross-compilation from x86-64 to AArch64 with Hadrian. Fixes #18234 - - - - - 698d3d96 by Ben Gamari at 2020-11-28T15:41:00-05:00 gitlab-ci: Only deploy GitLab Pages in ghc/ghc> The deployments are quite large and yet are currently only served for the ghc/ghc> project. - - - - - 625726f9 by David Eichmann at 2020-11-28T15:41:37-05:00 ghc-heap: partial TSO/STACK decoding Co-authored-by: Sven Tennie <sven.tennie at gmail.com> Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> Co-authored-by: Ben Gamari <bgamari.foss at gmail.com> - - - - - 22ea9c29 by Andreas Klebinger at 2020-11-28T15:42:13-05:00 Small optimization to CmmSink. Inside `regsUsedIn` we can avoid some thunks by specializing the recursion. In particular we avoid the thunk for `(f e z)` in the MachOp/Load branches, where we know this will evaluate to z. Reduces allocations for T3294 by ~1%. - - - - - bba42c62 by John Ericson at 2020-11-28T15:42:49-05:00 Make primop handler indentation more consistent - - - - - c82bc8e9 by John Ericson at 2020-11-28T15:42:49-05:00 Cleanup some primop constructor names Harmonize the internal (big sum type) names of the native vs fixed-sized number primops a bit. (Mainly by renaming the former.) No user-facing names are changed. - - - - - ae14f160 by Ben Gamari at 2020-11-28T15:43:25-05:00 testsuite: Mark T14702 as fragile on Windows Due to #18953. - - - - - 1bc104b0 by Ben Gamari at 2020-11-29T15:33:18-05:00 withTimings: Emit allocations counter This will allow us to back out the allocations per compiler pass from the eventlog. Note that we dump the allocation counter rather than the difference since this will allow us to determine how much work is done *between* `withTiming` blocks. - - - - - e992ea84 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 ThreadPaused: Don't zero slop until free vars are pushed When threadPaused blackholes a thunk it calls `OVERWRITING_CLOSURE` to zero the slop for the benefit of the sanity checker. Previously this was done *before* pushing the thunk's free variables to the update remembered set. Consequently we would pull zero'd pointers to the update remembered set. - - - - - e82cd140 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Fix regression from TSAN work The TSAN rework (specifically aad1f803) introduced a subtle regression in GC.c, swapping `g0` in place of `gen`. Whoops! Fixes #18997. - - - - - 35a5207e by GHC GitLab CI at 2020-11-29T15:33:54-05:00 rts/Messages: Add missing write barrier in THROWTO message update After a THROWTO message has been handle the message closure is overwritten by a NULL message. We must ensure that the original closure's pointers continue to be visible to the nonmoving GC. - - - - - 0120829f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Add missing write barrier in shrinkSmallByteArray - - - - - 8a4d8fb6 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 Updates: Don't zero slop until closure has been pushed Ensure that the the free variables have been pushed to the update remembered set before we zero the slop. - - - - - 2793cfdc by GHC GitLab CI at 2020-11-29T15:33:54-05:00 OSThreads: Fix error code checking pthread_join returns its error code and apparently doesn't set errno. - - - - - e391a16f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Don't join to mark_thread on shutdown The mark thread is not joinable as we detach from it on creation. - - - - - 60d088ab by Ben Gamari at 2020-11-29T15:33:54-05:00 nonmoving: Add reference to Ueno 2016 - - - - - 3aa60362 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Ensure that evacuated large objects are marked See Note [Non-moving GC: Marking evacuated objects]. - - - - - 8d304a99 by Ben Gamari at 2020-11-30T10:15:22-05:00 rts/m32: Refactor handling of allocator seeding Previously, in an attempt to reduce fragmentation, each new allocator would map a region of M32_MAX_PAGES fresh pages to seed itself. However, this ends up being extremely wasteful since it turns out that we often use fewer than this. Consequently, these pages end up getting freed which, ends up fragmenting our address space more than than we would have if we had naively allocated pages on-demand. Here we refactor m32 to avoid this waste while achieving the fragmentation mitigation previously desired. In particular, we move all page allocation into the global m32_alloc_page, which will pull a page from the free page pool. If the free page pool is empty we then refill it by allocating a region of M32_MAP_PAGES and adding them to the pool. Furthermore, we do away with the initial seeding entirely. That is, the allocator starts with no active pages: pages are rather allocated on an as-needed basis. On the whole this ends up being a pleasingly simple change, simultaneously making m32 more efficient, more robust, and simpler. Fixes #18980. - - - - - b6629289 by Ben Gamari at 2020-11-30T10:15:58-05:00 rts: Use CHECK instead of assert Use the GHC wrappers instead of <assert.h>. - - - - - 9f4efa6a by Ben Gamari at 2020-11-30T10:15:58-05:00 rts/linker: Replace some ASSERTs with CHECK In the past some people have confused ASSERT, which is for checking internal invariants, which CHECK, which should be used when checking things that might fail due to bad input (and therefore should be enabled even in the release compiler). Change some of these cases in the linker to use CHECK. - - - - - 0f8a4655 by Ryan Scott at 2020-11-30T10:16:34-05:00 Allow deploy:pages job to fail See #18973. - - - - - 49ebe369 by chessai at 2020-11-30T19:47:40-05:00 Optimisations in Data.Foldable (T17867) This PR concerns the following functions from `Data.Foldable`: * minimum * maximum * sum * product * minimumBy * maximumBy - Default implementations of these functions now use `foldl'` or `foldMap'`. - All have been marked with INLINEABLE to make room for further optimisations. - - - - - 4d79ef65 by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - 6af074ce by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - ab334262 by Viktor Dukhovni at 2020-11-30T19:48:17-05:00 dirty MVAR after mutating TSO queue head While the original head and tail of the TSO queue may be in the same generation as the MVAR, interior elements of the queue could be younger after a GC run and may then be exposed by putMVar operation that updates the queue head. Resolves #18919 - - - - - 5eb163f3 by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Don't allow shared libraries to be loaded multiple times - - - - - 490aa14d by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Initialise CCSs from native shared objects - - - - - 6ac3db5f by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Move shared library loading logic into Elf.c - - - - - b6698d73 by GHC GitLab CI at 2020-11-30T19:48:53-05:00 rts/linker: Don't declare dynamic objects with image_mapped This previously resulted in warnings due to spurious unmap failures. - - - - - b94a65af by jneira at 2020-11-30T19:49:31-05:00 Include tried paths in findToolDir error - - - - - 72a87fbc by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Move core flattening algorithm to Core.Unify This sets the stage for a later change, where this algorithm will be needed from GHC.Core.InstEnv. This commit also splits GHC.Core.Map into GHC.Core.Map.Type and GHC.Core.Map.Expr, in order to avoid module import cycles with GHC.Core. - - - - - 0dd45d0a by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Bump the # of commits searched for perf baseline The previous value of 75 meant that a feature branch with more than 75 commits would get spurious CI passes. This affects #18692, but does not fix that ticket, because if a baseline cannot be found, we should fail, not succeed. - - - - - 8bb52d91 by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Remove flattening variables This patch redesigns the flattener to simplify type family applications directly instead of using flattening meta-variables and skolems. The key new innovation is the CanEqLHS type and the new CEqCan constraint (Ct). A CanEqLHS is either a type variable or exactly-saturated type family application; either can now be rewritten using a CEqCan constraint in the inert set. Because the flattener no longer reduces all type family applications to variables, there was some performance degradation if a lengthy type family application is now flattened over and over (not making progress). To compensate, this patch contains some extra optimizations in the flattener, leading to a number of performance improvements. Close #18875. Close #18910. There are many extra parts of the compiler that had to be affected in writing this patch: * The family-application cache (formerly the flat-cache) sometimes stores coercions built from Given inerts. When these inerts get kicked out, we must kick out from the cache as well. (This was, I believe, true previously, but somehow never caused trouble.) Kicking out from the cache requires adding a filterTM function to TrieMap. * This patch obviates the need to distinguish "blocking" coercion holes from non-blocking ones (which, previously, arose from CFunEqCans). There is thus some simplification around coercion holes. * Extra commentary throughout parts of the code I read through, to preserve the knowledge I gained while working. * A change in the pure unifier around unifying skolems with other types. Unifying a skolem now leads to SurelyApart, not MaybeApart, as documented in Note [Binding when looking up instances] in GHC.Core.InstEnv. * Some more use of MCoercion where appropriate. * Previously, class-instance lookup automatically noticed that e.g. C Int was a "unifier" to a target [W] C (F Bool), because the F Bool was flattened to a variable. Now, a little more care must be taken around checking for unifying instances. * Previously, tcSplitTyConApp_maybe would split (Eq a => a). This is silly, because (=>) is not a tycon in Haskell. Fixed now, but there are some knock-on changes in e.g. TrieMap code and in the canonicaliser. * New function anyFreeVarsOf{Type,Co} to check whether a free variable satisfies a certain predicate. * Type synonyms now remember whether or not they are "forgetful"; a forgetful synonym drops at least one argument. This is useful when flattening; see flattenView. * The pattern-match completeness checker invokes the solver. This invocation might need to look through newtypes when checking representational equality. Thus, the desugarer needs to keep track of the in-scope variables to know what newtype constructors are in scope. I bet this bug was around before but never noticed. * Extra-constraints wildcards are no longer simplified before printing. See Note [Do not simplify ConstraintHoles] in GHC.Tc.Solver. * Whether or not there are Given equalities has become slightly subtler. See the new HasGivenEqs datatype. * Note [Type variable cycles in Givens] in GHC.Tc.Solver.Canonical explains a significant new wrinkle in the new approach. * See Note [What might match later?] in GHC.Tc.Solver.Interact, which explains the fix to #18910. * The inert_count field of InertCans wasn't actually used, so I removed it. Though I (Richard) did the implementation, Simon PJ was very involved in design and review. This updates the Haddock submodule to avoid #18932 by adding a type signature. ------------------------- Metric Decrease: T12227 T5030 T9872a T9872b T9872c Metric Increase: T9872d ------------------------- - - - - - d66660ba by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Rename the flattener to become the rewriter. Now that flattening doesn't produce flattening variables, it's not really flattening anything: it's rewriting. This change also means that the rewriter can no longer be confused the core flattener (in GHC.Core.Unify), which is sometimes used during type-checking. - - - - - add0aeae by Ben Gamari at 2020-12-01T19:58:17-05:00 rts: Introduce mmapAnonForLinker Previously most of the uses of mmapForLinker were mapping anonymous memory, resulting in a great deal of unnecessary repetition. Factor this out into a new helper. Also fixes a few places where error checking was missing or suboptimal. - - - - - 97d71646 by Ben Gamari at 2020-12-01T19:58:17-05:00 rts/linker: Introduce munmapForLinker Consolidates munmap calls to ensure consistent error handling. - - - - - d8872af0 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/Linker: Introduce Windows implementations for mmapForLinker, et al. - - - - - c35d0e03 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/m32: Introduce NEEDS_M32 macro Instead of relying on RTS_LINKER_USE_MMAP - - - - - 41c64eb5 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/linker: Use m32 to allocate symbol extras in PEi386 - - - - - e0b08c5f by Ben Gamari at 2020-12-03T13:01:47-05:00 gitlab-ci: Fix copy-paste error Also be more consistent in quoting. - - - - - 33ec3a06 by Ben Gamari at 2020-12-03T23:11:31-05:00 gitlab-ci: Run linters through ci.sh Ensuring that the right toolchain is used. - - - - - 4a437bc1 by Shayne Fletcher at 2020-12-05T09:06:38-05:00 Fix bad span calculations of post qualified imports - - - - - 8fac4b93 by Ben Gamari at 2020-12-05T09:07:13-05:00 testsuite: Add a test for #18923 - - - - - 62ed6957 by Simon Peyton Jones at 2020-12-08T15:31:41-05:00 Fix kind inference for data types. Again. This patch fixes several aspects of kind inference for data type declarations, especially data /instance/ declarations Specifically 1. In kcConDecls/kcConDecl make it clear that the tc_res_kind argument is only used in the H98 case; and in that case there is no result kind signature; and hence no need for the disgusting splitPiTys in kcConDecls (now thankfully gone). The GADT case is a bit different to before, and much nicer. This is what fixes #18891. See Note [kcConDecls: kind-checking data type decls] 2. Do not look at the constructor decls of a data/newtype instance in tcDataFamInstanceHeader. See GHC.Tc.TyCl.Instance Note [Kind inference for data family instances]. This was a new realisation that arose when doing (1) This causes a few knock-on effects in the tests suite, because we require more information than before in the instance /header/. New user-manual material about this in "Kind inference in data type declarations" and "Kind inference for data/newtype instance declarations". 3. Minor improvement in kcTyClDecl, combining GADT and H98 cases 4. Fix #14111 and #8707 by allowing the header of a data instance to affect kind inferece for the the data constructor signatures; as described at length in Note [GADT return types] in GHC.Tc.TyCl This led to a modest refactoring of the arguments (and argument order) of tcConDecl/tcConDecls. 5. Fix #19000 by inverting the sense of the test in new_locs in GHC.Tc.Solver.Canonical.canDecomposableTyConAppOK. - - - - - 0abe3ddf by Adam Sandberg Ericsson at 2020-12-08T15:32:19-05:00 hadrian: build the _l and _thr_l rts flavours in the develN flavours The ghc binary requires the eventlog rts since fc644b1a643128041cfec25db84e417851e28bab - - - - - 51e3bb6d by Andreas Klebinger at 2020-12-08T22:43:21-05:00 CodeGen: Make folds User/DefinerOfRegs INLINEABLE. Reduces allocation for the test case I was looking at by about 1.2%. Mostly from avoiding allocation of some folding functions which turn into let-no-escape bindings which just reuse their environment instead. We also force inlining in a few key places in CmmSink which helps a bit more. - - - - - 69ae10c3 by Andreas Klebinger at 2020-12-08T22:43:21-05:00 CmmSink: Force inlining of foldRegsDefd Helps avoid allocating the folding function. Improves perf for T3294 by about 1%. - - - - - 6e3da800 by Andreas Klebinger at 2020-12-08T22:43:21-05:00 Cmm: Make a few types and utility function slightly stricter. About 0.6% reduction in allocations for the code I was looking at. Not a huge difference but no need to throw away performance. - - - - - aef44d7f by Andreas Klebinger at 2020-12-08T22:43:21-05:00 Cmm.Sink: Optimize retaining of assignments, live sets. Sinking requires us to track live local regs after each cmm statement. We used to do this via "Set LocalReg". However we can replace this with a solution based on IntSet which is overall more efficient without losing much. The thing we lose is width of the variables, which isn't used by the sinking pass anyway. I also reworked how we keep assignments to regs mentioned in skipped assignments. I put the details into Note [Keeping assignemnts mentioned in skipped RHSs]. The gist of it is instead of keeping track of it via the use count which is a `IntMap Int` we now use the live regs set (IntSet) which is quite a bit faster. I think it also matches the semantics a lot better. The skipped (not discarded) assignment does in fact keep the regs on it's rhs alive so keeping track of this in the live set seems like the clearer solution as well. Improves allocations for T3294 by yet another 1%. - - - - - 59f2249b by Andreas Klebinger at 2020-12-08T22:43:21-05:00 GHC.Cmm.Opt: Be stricter in results. Optimization either returns Nothing if nothing is to be done or `Just <cmmExpr>` otherwise. There is no point in being lazy in `cmmExpr`. We usually inspect this element so the thunk gets forced not long after. We might eliminate it as dead code once in a blue moon but that's not a case worth optimizing for. Overall the impact of this is rather low. As Cmm.Opt doesn't allocate much (compared to the rest of GHC) to begin with. - - - - - 54b88eac by Andreas Klebinger at 2020-12-08T22:43:57-05:00 Bump time submodule. This should fix #19002. - - - - - 35e7b0c6 by Kirill Elagin at 2020-12-10T01:45:54-05:00 doc: Clarify the default for -fomit-yields “Yield points enabled” is confusing (and probably wrong? I am not 100% sure what it means). Change it to a simple “on”. Undo this change from 2c23fff2e03e77187dc4d01f325f5f43a0e7cad2. - - - - - 3551c554 by Kirill Elagin at 2020-12-10T01:45:54-05:00 doc: Extra-clarify -fomit-yields Be more clear on what this optimisation being on by default means in terms of yields. - - - - - 6484f0d7 by Sergei Trofimovich at 2020-12-10T01:46:33-05:00 rts/linker/Elf.c: add missing <dlfcn.h> include (musl support) The change fixes build failure on musl: ``` rts/linker/Elf.c:2031:3: error: warning: implicit declaration of function 'dlclose'; did you mean 'close'? [-Wimplicit-function-declaration] 2031 | dlclose(nc->dlopen_handle); | ^~~~~~~ | close ``` Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - ab24ed9b by Ben Gamari at 2020-12-11T03:55:51-05:00 users guide: Fix syntax errors Fixes errors introduced by 3a55b3a2574f913d046f3a6f82db48d7f6df32e3. - - - - - d3a24d31 by Ben Gamari at 2020-12-11T03:55:51-05:00 users guide: Describe GC lifecycle events Every time I am asked about how to interpret these events I need to figure it out from scratch. It's well past time that the users guide properly documents these. - - - - - 741309b9 by Ben Gamari at 2020-12-11T03:56:27-05:00 gitlab-ci: Fix incorrect Docker image for nightly cross job Also refactor the job definition to eliminate the bug by construction. - - - - - 19703bc8 by Ben Gamari at 2020-12-11T03:56:27-05:00 gitlab-ci: Fix name of flavour in ThreadSanitizer job It looks like I neglected to update this after introduce flavour transformers. - - - - - 381eb660 by Sylvain Henry at 2020-12-11T12:57:35-05:00 Display FFI labels (fix #18539) - - - - - 4548d1f8 by Aaron Allen at 2020-12-11T12:58:14-05:00 Elide extraneous messages for :doc command (#15784) Do not print `<has no documentation>` alongside a valid doc. Additionally, if two matching symbols lack documentation then the message will only be printed once. Hence, `<has no documentation>` will be printed at most once and only if all matching symbols are lacking docs. - - - - - 5eba91b6 by Aaron Allen at 2020-12-11T12:58:14-05:00 Add :doc test case for duplicate record fields Tests that the output of the `:doc` command is correct for duplicate record fields defined using -XDuplicateRecordFields. - - - - - 5feb9b2d by Ryan Scott at 2020-12-11T22:39:29-05:00 Delete outdated Note [Kind-checking tyvar binders for associated types] This Note has severely bitrotted, as it has no references anywhere in the codebase, and none of the functions that it mentions exist anymore. Let's just delete this. While I was in town, I deleted some outdated comments from `checkFamPatBinders` of a similar caliber. Fixes #19008. [ci skip] - - - - - f9f9f030 by Sylvain Henry at 2020-12-11T22:40:08-05:00 Arrows: correctly query arrow methods (#17423) Consider the following code: proc (C x y) -> ... Before this patch, the evidence binding for the Arrow dictionary was attached to the C pattern: proc (C x y) { $dArrow = ... } -> ... But then when we desugar this, we use arrow operations ("arr", ">>>"...) specialised for this arrow: let arr_xy = arr $dArrow -- <-- Not in scope! ... in arr_xy (\(C x y) { $dArrow = ... } -> ...) This patch allows arrow operations to be type-checked before the proc itself, avoiding this issue. Fix #17423 - - - - - aaa8f00f by Sylvain Henry at 2020-12-11T22:40:48-05:00 Validate script: fix configure command when using stack - - - - - b4a929a1 by Sylvain Henry at 2020-12-11T22:41:30-05:00 Hadrian: fix libffi tarball parsing Fix parsing of "libffi-3.3.tar.gz". NB: switch to a newer libffi isn't done in this patch - - - - - 690c8946 by Sylvain Henry at 2020-12-11T22:42:09-05:00 Parser: move parser utils into their own module Move code unrelated to runtime evaluation out of GHC.Runtime.Eval - - - - - 76be0e32 by Sylvain Henry at 2020-12-11T22:42:48-05:00 Move SizedSeq into ghc-boot - - - - - 3a16d764 by Sylvain Henry at 2020-12-11T22:42:48-05:00 ghci: don't compile unneeded modules - - - - - 2895fa60 by Sylvain Henry at 2020-12-11T22:42:48-05:00 ghci: reuse Arch from ghc-boot - - - - - 480a38d4 by Sylvain Henry at 2020-12-11T22:43:30-05:00 rts: don't use siginterrupt (#19019) - - - - - 4af6126d by Sylvain Henry at 2020-12-11T22:44:11-05:00 Use static array in zeroCount - - - - - 5bd71bfd by Sebastian Graf at 2020-12-12T04:45:09-05:00 DmdAnal: Annotate top-level function bindings with demands (#18894) It's useful to annotate a non-exported top-level function like `g` in ```hs module Lib (h) where g :: Int -> Int -> (Int,Int) g m 1 = (m, 0) g m n = (2 * m, 2 `div` n) {-# NOINLINE g #-} h :: Int -> Int h 1 = 0 h m | odd m = snd (g m 2) | otherwise = uncurry (+) (g 2 m) ``` with its demand `UCU(CS(P(1P(U),SP(U))`, which tells us that whenever `g` was called, the second component of the returned pair was evaluated strictly. Since #18903 we do so for local functions, where we can see all calls. For top-level functions, we can assume that all *exported* functions are demanded according to `topDmd` and thus get sound demands for non-exported top-level functions. The demand on `g` is crucial information for Nested CPR, which may the go on and unbox `g` for the second pair component. That is true even if that pair component may diverge, as is the case for the call site `g 13 0`, which throws a div-by-zero exception. In `T18894b`, you can even see the new demand annotation enabling us to eta-expand a function that we wouldn't be able to eta-expand without Call Arity. We only track bindings of function type in order not to risk huge compile-time regressions, see `isInterestingTopLevelFn`. There was a CoreLint check that rejected strict demand annotations on recursive or top-level bindings, which seems completely unjustified. All the cases I investigated were fine, so I removed it. Fixes #18894. - - - - - 3aae036e by Sebastian Graf at 2020-12-12T04:45:09-05:00 Demand: Simplify `CU(U)` to `U` (#19005) Both sub-demands encode the same information. This is a trivial change and already affects a few regression tests (e.g. `T5075`), so no separate regression test is necessary. - - - - - c6477639 by Adam Sandberg Ericsson at 2020-12-12T04:45:48-05:00 hadrian: correctly copy the docs dir into the bindist #18669 - - - - - e033dd05 by Adam Sandberg Ericsson at 2020-12-12T10:52:19+00:00 mkDocs: support hadrian bindists #18973 - - - - - 78580ba3 by John Ericson at 2020-12-13T07:14:50-05:00 Remove old .travis.yml - - - - - c696bb2f by Cale Gibbard at 2020-12-14T13:37:09-05:00 Implement type applications in patterns The haddock submodule is also updated so that it understands the changes to patterns. - - - - - 7e9debd4 by Ben Gamari at 2020-12-14T13:37:09-05:00 Optimise nullary type constructor usage During the compilation of programs GHC very frequently deals with the `Type` type, which is a synonym of `TYPE 'LiftedRep`. This patch teaches GHC to avoid expanding the `Type` synonym (and other nullary type synonyms) during type comparisons, saving a good amount of work. This optimisation is described in `Note [Comparing nullary type synonyms]`. To maximize the impact of this optimisation, we introduce a few special-cases to reduce `TYPE 'LiftedRep` to `Type`. See `Note [Prefer Type over TYPE 'LiftedPtrRep]`. Closes #17958. Metric Decrease: T18698b T1969 T12227 T12545 T12707 T14683 T3064 T5631 T5642 T9020 T9630 T9872a T13035 haddock.Cabal haddock.base - - - - - 92377c27 by Ben Gamari at 2020-12-14T13:41:58-05:00 Revert "Optimise nullary type constructor usage" This was inadvertently merged. This reverts commit 7e9debd4ceb068effe8ac81892d2cabcb8f55850. - - - - - d6f20832 by Matthew Pickering at 2020-12-15T11:39:53+00:00 Fix haddock parse error - - - - - 0fb8c7f8 by Matthew Pickering at 2020-12-15T11:39:53+00:00 Revert "Remove GHC.Types.Unique.Map module" This reverts commit 1c7c6f1afc8e7f7ba5d256780bc9d5bb5f3e7601. - - - - - ae10b28c by Matthew Pickering at 2020-12-15T11:39:54+00:00 Profiling by info table mode (-hi) This profiling mode creates bands by the address of the info table for each closure. This provides a much more fine-grained profiling output than any of the other profiling modes. The `-hi` profiling mode does not require a profiling build. - - - - - f28c76fb by Matthew Pickering at 2020-12-15T11:46:56+00:00 Add -finfo-table-map which maps info tables to source positions This new flag embeds a lookup table from the address of an info table to information about that info table. The main interface for consulting the map is the `lookupIPE` C function > InfoProvEnt * lookupIPE(StgInfoTable *info) The `InfoProvEnt` has the following structure: > typedef struct InfoProv_{ > char * table_name; > char * closure_desc; > char * ty_desc; > char * label; > char * module; > char * srcloc; > } InfoProv; > > typedef struct InfoProvEnt_ { > StgInfoTable * info; > InfoProv prov; > struct InfoProvEnt_ *link; > } InfoProvEnt; The source positions are approximated in a similar way to the source positions for DWARF debugging information. They are only approximate but in our experience provide a good enough hint about where the problem might be. It is therefore recommended to use this flag in conjunction with `-g<n>` for more accurate locations. The lookup table is also emitted into the eventlog when it is available as it is intended to be used with the `-hi` profiling mode. Using this flag will significantly increase the size of the resulting object file but only by a factor of 2-3x in our experience. - - - - - 9190cef2 by Matthew Pickering at 2020-12-15T11:48:20+00:00 Add option to give each usage of a data constructor its own info table The `-fdistinct-constructor-tables` flag will generate a fresh info table for the usage of any data constructor. This is useful for debugging as now by inspecting the info table, you can determine which usage of a constructor caused that allocation rather than the old situation where the info table always mapped to the definition site of the data constructor which is useless. In conjunction with `-hi` and `-finfo-table-map` this gives a more fine grained understanding of where constructor allocations arise from in a program. - - - - - 6e6da5e1 by Matthew Pickering at 2020-12-15T11:48:21+00:00 Add whereFrom and whereFrom# primop The `whereFrom` function provides a Haskell interface for using the information created by `-finfo-table-map`. Given a Haskell value, the info table address will be passed to the `lookupIPE` function in order to attempt to find the source location information for that particular closure. At the moment it's not possible to distinguish the absense of the map and a failed lookup. - - - - - 6f56bdfe by Matthew Pickering at 2020-12-15T11:48:21+00:00 Add test for whereFrom# - - - - - 578d868b by Matthew Pickering at 2020-12-15T11:49:21+00:00 Add release notes for -hi, -finfo-table-map and -fdistinct-constructor-tables - - - - - 17974840 by Matthew Pickering at 2020-12-15T11:49:23+00:00 Turn on SourceNotes without -g - - - - - 2d77b598 by Matthew Pickering at 2020-12-15T11:49:23+00:00 release notes - - - - - dd8d216a by Matthew Pickering at 2020-12-15T11:49:23+00:00 debug info docs - - - - - 86ba334b by Matthew Pickering at 2020-12-15T11:49:23+00:00 Some more comments - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - − .travis.yml - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Expr.hs - + compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Liveness.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/Reg/Graph.hs - compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/10d7be0129954b5e44e3d05552a4aa8f9da16fac...86ba334b8c11d076ebf591974e4e330dabcec4aa -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/10d7be0129954b5e44e3d05552a4aa8f9da16fac...86ba334b8c11d076ebf591974e4e330dabcec4aa You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 15 15:54:24 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 15 Dec 2020 10:54:24 -0500 Subject: [Git][ghc/ghc][master] 6 commits: Move Unit related fields from DynFlags to HscEnv Message-ID: <5fd8dc30d8f6c_6b21725d3a0166084e@gitlab.mail> Ben Gamari pushed to branch master at Glasgow Haskell Compiler / GHC Commits: d0e8c10d by Sylvain Henry at 2020-12-14T19:45:13+01:00 Move Unit related fields from DynFlags to HscEnv The unit database cache, the home unit and the unit state were stored in DynFlags while they ought to be stored in the compiler session state (HscEnv). This patch fixes this. It introduces a new UnitEnv type that should be used in the future to handle separate unit environments (especially host vs target units). Related to #17957 Bump haddock submodule - - - - - af855ac1 by Andreas Klebinger at 2020-12-14T15:22:13-05:00 Optimize dumping of consecutive whitespace. The naive way of putting out n characters of indent would be something like `hPutStr hdl (replicate n ' ')`. However this is quite inefficient as we allocate an absurd number of strings consisting of simply spaces as we don't cache them. To improve on this we now track if we can simply write ascii spaces via hPutBuf instead. This is the case when running with -ddump-to-file where we force the encoding to be UTF8. This avoids both the cost of going through encoding as well as avoiding allocation churn from all the white space. Instead we simply use hPutBuf on a preallocated unlifted string. When dumping stg like this: > nofib/spectral/simple/Main.hs -fforce-recomp -ddump-stg-final -ddump-to-file -c +RTS -s Allocations went from 1,778 MB to 1,702MB. About a 4% reduction of allocation! I did not measure the difference in runtime but expect it to be similar. Bumps the haddock submodule since the interface of GHC's Pretty slightly changed. ------------------------- Metric Decrease: T12227 ------------------------- - - - - - dad87210 by Ben Gamari at 2020-12-14T15:22:29-05:00 Optimise nullary type constructor usage During the compilation of programs GHC very frequently deals with the `Type` type, which is a synonym of `TYPE 'LiftedRep`. This patch teaches GHC to avoid expanding the `Type` synonym (and other nullary type synonyms) during type comparisons, saving a good amount of work. This optimisation is described in `Note [Comparing nullary type synonyms]`. To maximize the impact of this optimisation, we introduce a few special-cases to reduce `TYPE 'LiftedRep` to `Type`. See `Note [Prefer Type over TYPE 'LiftedPtrRep]`. Closes #17958. Metric Decrease: T18698b T1969 T12227 T12545 T12707 T14683 T3064 T5631 T5642 T9020 T9630 T9872a T13035 haddock.Cabal haddock.base - - - - - 6c2eb223 by Andrew Martin at 2020-12-14T18:48:51-05:00 Implement BoxedRep proposal This implements the BoxedRep proposal, refacoring the `RuntimeRep` hierarchy from: ```haskell data RuntimeRep = LiftedPtrRep | UnliftedPtrRep | ... ``` to ```haskell data RuntimeRep = BoxedRep Levity | ... data Levity = Lifted | Unlifted ``` Closes #17526. - - - - - 3ee696cc by Sebastian Graf at 2020-12-15T10:53:31-05:00 Add regression test for #19053 - - - - - 535dae66 by Ben Gamari at 2020-12-15T10:53:58-05:00 testsuite: Mark divbyzero, derefnull as fragile Due to #18548. - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Types/Prim.hs - + compiler/GHC/Builtin/Types/Prim.hs-boot - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Parser/Monad.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Env.hs - compiler/GHC/Driver/Hooks.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/MakeFile.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Monad.hs - compiler/GHC/Driver/Ppr.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Driver/Session.hs-boot - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Usage.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/92377c27e1a48d0d3776f65c7074dfeb122b46db...535dae66271af0ce4ab9c0a772614b700bc4c92a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/92377c27e1a48d0d3776f65c7074dfeb122b46db...535dae66271af0ce4ab9c0a772614b700bc4c92a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 15 15:55:36 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 15 Dec 2020 10:55:36 -0500 Subject: [Git][ghc/ghc][wip/T19057] 10 commits: Implement type applications in patterns Message-ID: <5fd8dc78f0c91_6b21725c11c1667060@gitlab.mail> Ben Gamari pushed to branch wip/T19057 at Glasgow Haskell Compiler / GHC Commits: c696bb2f by Cale Gibbard at 2020-12-14T13:37:09-05:00 Implement type applications in patterns The haddock submodule is also updated so that it understands the changes to patterns. - - - - - 7e9debd4 by Ben Gamari at 2020-12-14T13:37:09-05:00 Optimise nullary type constructor usage During the compilation of programs GHC very frequently deals with the `Type` type, which is a synonym of `TYPE 'LiftedRep`. This patch teaches GHC to avoid expanding the `Type` synonym (and other nullary type synonyms) during type comparisons, saving a good amount of work. This optimisation is described in `Note [Comparing nullary type synonyms]`. To maximize the impact of this optimisation, we introduce a few special-cases to reduce `TYPE 'LiftedRep` to `Type`. See `Note [Prefer Type over TYPE 'LiftedPtrRep]`. Closes #17958. Metric Decrease: T18698b T1969 T12227 T12545 T12707 T14683 T3064 T5631 T5642 T9020 T9630 T9872a T13035 haddock.Cabal haddock.base - - - - - 92377c27 by Ben Gamari at 2020-12-14T13:41:58-05:00 Revert "Optimise nullary type constructor usage" This was inadvertently merged. This reverts commit 7e9debd4ceb068effe8ac81892d2cabcb8f55850. - - - - - d0e8c10d by Sylvain Henry at 2020-12-14T19:45:13+01:00 Move Unit related fields from DynFlags to HscEnv The unit database cache, the home unit and the unit state were stored in DynFlags while they ought to be stored in the compiler session state (HscEnv). This patch fixes this. It introduces a new UnitEnv type that should be used in the future to handle separate unit environments (especially host vs target units). Related to #17957 Bump haddock submodule - - - - - af855ac1 by Andreas Klebinger at 2020-12-14T15:22:13-05:00 Optimize dumping of consecutive whitespace. The naive way of putting out n characters of indent would be something like `hPutStr hdl (replicate n ' ')`. However this is quite inefficient as we allocate an absurd number of strings consisting of simply spaces as we don't cache them. To improve on this we now track if we can simply write ascii spaces via hPutBuf instead. This is the case when running with -ddump-to-file where we force the encoding to be UTF8. This avoids both the cost of going through encoding as well as avoiding allocation churn from all the white space. Instead we simply use hPutBuf on a preallocated unlifted string. When dumping stg like this: > nofib/spectral/simple/Main.hs -fforce-recomp -ddump-stg-final -ddump-to-file -c +RTS -s Allocations went from 1,778 MB to 1,702MB. About a 4% reduction of allocation! I did not measure the difference in runtime but expect it to be similar. Bumps the haddock submodule since the interface of GHC's Pretty slightly changed. ------------------------- Metric Decrease: T12227 ------------------------- - - - - - dad87210 by Ben Gamari at 2020-12-14T15:22:29-05:00 Optimise nullary type constructor usage During the compilation of programs GHC very frequently deals with the `Type` type, which is a synonym of `TYPE 'LiftedRep`. This patch teaches GHC to avoid expanding the `Type` synonym (and other nullary type synonyms) during type comparisons, saving a good amount of work. This optimisation is described in `Note [Comparing nullary type synonyms]`. To maximize the impact of this optimisation, we introduce a few special-cases to reduce `TYPE 'LiftedRep` to `Type`. See `Note [Prefer Type over TYPE 'LiftedPtrRep]`. Closes #17958. Metric Decrease: T18698b T1969 T12227 T12545 T12707 T14683 T3064 T5631 T5642 T9020 T9630 T9872a T13035 haddock.Cabal haddock.base - - - - - 6c2eb223 by Andrew Martin at 2020-12-14T18:48:51-05:00 Implement BoxedRep proposal This implements the BoxedRep proposal, refacoring the `RuntimeRep` hierarchy from: ```haskell data RuntimeRep = LiftedPtrRep | UnliftedPtrRep | ... ``` to ```haskell data RuntimeRep = BoxedRep Levity | ... data Levity = Lifted | Unlifted ``` Closes #17526. - - - - - 3ee696cc by Sebastian Graf at 2020-12-15T10:53:31-05:00 Add regression test for #19053 - - - - - 535dae66 by Ben Gamari at 2020-12-15T10:53:58-05:00 testsuite: Mark divbyzero, derefnull as fragile Due to #18548. - - - - - 58ec3598 by Ben Gamari at 2020-12-15T10:55:35-05:00 rts: Fix typo in macro name THREADED_RTS was previously misspelled as THREADEDED_RTS. Fixes #19057. - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Types/Prim.hs - + compiler/GHC/Builtin/Types/Prim.hs-boot - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Parser/Monad.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Env.hs - compiler/GHC/Driver/Hooks.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/MakeFile.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Monad.hs - compiler/GHC/Driver/Ppr.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Driver/Session.hs-boot - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Pat.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5ed9baf135911f5ae217dba2617b3fce6c2fd78b...58ec3598050fd98dc5b874179aaee4aedd2fd255 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5ed9baf135911f5ae217dba2617b3fce6c2fd78b...58ec3598050fd98dc5b874179aaee4aedd2fd255 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 15 15:55:50 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 15 Dec 2020 10:55:50 -0500 Subject: [Git][ghc/ghc][wip/T7275] 32 commits: Display FFI labels (fix #18539) Message-ID: <5fd8dc86782c8_6b2167418541667756@gitlab.mail> Ben Gamari pushed to branch wip/T7275 at Glasgow Haskell Compiler / GHC Commits: 381eb660 by Sylvain Henry at 2020-12-11T12:57:35-05:00 Display FFI labels (fix #18539) - - - - - 4548d1f8 by Aaron Allen at 2020-12-11T12:58:14-05:00 Elide extraneous messages for :doc command (#15784) Do not print `<has no documentation>` alongside a valid doc. Additionally, if two matching symbols lack documentation then the message will only be printed once. Hence, `<has no documentation>` will be printed at most once and only if all matching symbols are lacking docs. - - - - - 5eba91b6 by Aaron Allen at 2020-12-11T12:58:14-05:00 Add :doc test case for duplicate record fields Tests that the output of the `:doc` command is correct for duplicate record fields defined using -XDuplicateRecordFields. - - - - - 5feb9b2d by Ryan Scott at 2020-12-11T22:39:29-05:00 Delete outdated Note [Kind-checking tyvar binders for associated types] This Note has severely bitrotted, as it has no references anywhere in the codebase, and none of the functions that it mentions exist anymore. Let's just delete this. While I was in town, I deleted some outdated comments from `checkFamPatBinders` of a similar caliber. Fixes #19008. [ci skip] - - - - - f9f9f030 by Sylvain Henry at 2020-12-11T22:40:08-05:00 Arrows: correctly query arrow methods (#17423) Consider the following code: proc (C x y) -> ... Before this patch, the evidence binding for the Arrow dictionary was attached to the C pattern: proc (C x y) { $dArrow = ... } -> ... But then when we desugar this, we use arrow operations ("arr", ">>>"...) specialised for this arrow: let arr_xy = arr $dArrow -- <-- Not in scope! ... in arr_xy (\(C x y) { $dArrow = ... } -> ...) This patch allows arrow operations to be type-checked before the proc itself, avoiding this issue. Fix #17423 - - - - - aaa8f00f by Sylvain Henry at 2020-12-11T22:40:48-05:00 Validate script: fix configure command when using stack - - - - - b4a929a1 by Sylvain Henry at 2020-12-11T22:41:30-05:00 Hadrian: fix libffi tarball parsing Fix parsing of "libffi-3.3.tar.gz". NB: switch to a newer libffi isn't done in this patch - - - - - 690c8946 by Sylvain Henry at 2020-12-11T22:42:09-05:00 Parser: move parser utils into their own module Move code unrelated to runtime evaluation out of GHC.Runtime.Eval - - - - - 76be0e32 by Sylvain Henry at 2020-12-11T22:42:48-05:00 Move SizedSeq into ghc-boot - - - - - 3a16d764 by Sylvain Henry at 2020-12-11T22:42:48-05:00 ghci: don't compile unneeded modules - - - - - 2895fa60 by Sylvain Henry at 2020-12-11T22:42:48-05:00 ghci: reuse Arch from ghc-boot - - - - - 480a38d4 by Sylvain Henry at 2020-12-11T22:43:30-05:00 rts: don't use siginterrupt (#19019) - - - - - 4af6126d by Sylvain Henry at 2020-12-11T22:44:11-05:00 Use static array in zeroCount - - - - - 5bd71bfd by Sebastian Graf at 2020-12-12T04:45:09-05:00 DmdAnal: Annotate top-level function bindings with demands (#18894) It's useful to annotate a non-exported top-level function like `g` in ```hs module Lib (h) where g :: Int -> Int -> (Int,Int) g m 1 = (m, 0) g m n = (2 * m, 2 `div` n) {-# NOINLINE g #-} h :: Int -> Int h 1 = 0 h m | odd m = snd (g m 2) | otherwise = uncurry (+) (g 2 m) ``` with its demand `UCU(CS(P(1P(U),SP(U))`, which tells us that whenever `g` was called, the second component of the returned pair was evaluated strictly. Since #18903 we do so for local functions, where we can see all calls. For top-level functions, we can assume that all *exported* functions are demanded according to `topDmd` and thus get sound demands for non-exported top-level functions. The demand on `g` is crucial information for Nested CPR, which may the go on and unbox `g` for the second pair component. That is true even if that pair component may diverge, as is the case for the call site `g 13 0`, which throws a div-by-zero exception. In `T18894b`, you can even see the new demand annotation enabling us to eta-expand a function that we wouldn't be able to eta-expand without Call Arity. We only track bindings of function type in order not to risk huge compile-time regressions, see `isInterestingTopLevelFn`. There was a CoreLint check that rejected strict demand annotations on recursive or top-level bindings, which seems completely unjustified. All the cases I investigated were fine, so I removed it. Fixes #18894. - - - - - 3aae036e by Sebastian Graf at 2020-12-12T04:45:09-05:00 Demand: Simplify `CU(U)` to `U` (#19005) Both sub-demands encode the same information. This is a trivial change and already affects a few regression tests (e.g. `T5075`), so no separate regression test is necessary. - - - - - c6477639 by Adam Sandberg Ericsson at 2020-12-12T04:45:48-05:00 hadrian: correctly copy the docs dir into the bindist #18669 - - - - - e033dd05 by Adam Sandberg Ericsson at 2020-12-12T10:52:19+00:00 mkDocs: support hadrian bindists #18973 - - - - - 78580ba3 by John Ericson at 2020-12-13T07:14:50-05:00 Remove old .travis.yml - - - - - c696bb2f by Cale Gibbard at 2020-12-14T13:37:09-05:00 Implement type applications in patterns The haddock submodule is also updated so that it understands the changes to patterns. - - - - - 7e9debd4 by Ben Gamari at 2020-12-14T13:37:09-05:00 Optimise nullary type constructor usage During the compilation of programs GHC very frequently deals with the `Type` type, which is a synonym of `TYPE 'LiftedRep`. This patch teaches GHC to avoid expanding the `Type` synonym (and other nullary type synonyms) during type comparisons, saving a good amount of work. This optimisation is described in `Note [Comparing nullary type synonyms]`. To maximize the impact of this optimisation, we introduce a few special-cases to reduce `TYPE 'LiftedRep` to `Type`. See `Note [Prefer Type over TYPE 'LiftedPtrRep]`. Closes #17958. Metric Decrease: T18698b T1969 T12227 T12545 T12707 T14683 T3064 T5631 T5642 T9020 T9630 T9872a T13035 haddock.Cabal haddock.base - - - - - 92377c27 by Ben Gamari at 2020-12-14T13:41:58-05:00 Revert "Optimise nullary type constructor usage" This was inadvertently merged. This reverts commit 7e9debd4ceb068effe8ac81892d2cabcb8f55850. - - - - - d0e8c10d by Sylvain Henry at 2020-12-14T19:45:13+01:00 Move Unit related fields from DynFlags to HscEnv The unit database cache, the home unit and the unit state were stored in DynFlags while they ought to be stored in the compiler session state (HscEnv). This patch fixes this. It introduces a new UnitEnv type that should be used in the future to handle separate unit environments (especially host vs target units). Related to #17957 Bump haddock submodule - - - - - af855ac1 by Andreas Klebinger at 2020-12-14T15:22:13-05:00 Optimize dumping of consecutive whitespace. The naive way of putting out n characters of indent would be something like `hPutStr hdl (replicate n ' ')`. However this is quite inefficient as we allocate an absurd number of strings consisting of simply spaces as we don't cache them. To improve on this we now track if we can simply write ascii spaces via hPutBuf instead. This is the case when running with -ddump-to-file where we force the encoding to be UTF8. This avoids both the cost of going through encoding as well as avoiding allocation churn from all the white space. Instead we simply use hPutBuf on a preallocated unlifted string. When dumping stg like this: > nofib/spectral/simple/Main.hs -fforce-recomp -ddump-stg-final -ddump-to-file -c +RTS -s Allocations went from 1,778 MB to 1,702MB. About a 4% reduction of allocation! I did not measure the difference in runtime but expect it to be similar. Bumps the haddock submodule since the interface of GHC's Pretty slightly changed. ------------------------- Metric Decrease: T12227 ------------------------- - - - - - dad87210 by Ben Gamari at 2020-12-14T15:22:29-05:00 Optimise nullary type constructor usage During the compilation of programs GHC very frequently deals with the `Type` type, which is a synonym of `TYPE 'LiftedRep`. This patch teaches GHC to avoid expanding the `Type` synonym (and other nullary type synonyms) during type comparisons, saving a good amount of work. This optimisation is described in `Note [Comparing nullary type synonyms]`. To maximize the impact of this optimisation, we introduce a few special-cases to reduce `TYPE 'LiftedRep` to `Type`. See `Note [Prefer Type over TYPE 'LiftedPtrRep]`. Closes #17958. Metric Decrease: T18698b T1969 T12227 T12545 T12707 T14683 T3064 T5631 T5642 T9020 T9630 T9872a T13035 haddock.Cabal haddock.base - - - - - 6c2eb223 by Andrew Martin at 2020-12-14T18:48:51-05:00 Implement BoxedRep proposal This implements the BoxedRep proposal, refacoring the `RuntimeRep` hierarchy from: ```haskell data RuntimeRep = LiftedPtrRep | UnliftedPtrRep | ... ``` to ```haskell data RuntimeRep = BoxedRep Levity | ... data Levity = Lifted | Unlifted ``` Closes #17526. - - - - - 3ee696cc by Sebastian Graf at 2020-12-15T10:53:31-05:00 Add regression test for #19053 - - - - - 535dae66 by Ben Gamari at 2020-12-15T10:53:58-05:00 testsuite: Mark divbyzero, derefnull as fragile Due to #18548. - - - - - ecf0d6ff by Ben Gamari at 2020-12-15T10:55:47-05:00 rts: Break up census logic Move the logic for taking censuses of "normal" and pinned blocks to their own functions. - - - - - 5b7a9508 by Ben Gamari at 2020-12-15T10:55:47-05:00 rts: Implement heap census support for pinned objects It turns out that this was fairly straightforward to implement since we are now pretty careful about zeroing slop. - - - - - d2adcbf2 by Ben Gamari at 2020-12-15T10:55:47-05:00 Storage: Unconditionally enable zeroing of alignment slop This is necessary since the user may enable `+RTS -hT` at any time. - - - - - a1510342 by Ben Gamari at 2020-12-15T10:55:47-05:00 rts: Zero shrunk array slop in vanilla RTS But only when profiling or DEBUG are enabled. Fixes #17572. - - - - - 49403302 by Ben Gamari at 2020-12-15T10:55:47-05:00 rts: Enforce that mark-region isn't used with -h As noted in #9666, the mark-region GC is not compatible with heap profiling. Also add documentation for this flag. Closes #9666. - - - - - 30 changed files: - − .travis.yml - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Types/Prim.hs - + compiler/GHC/Builtin/Types/Prim.hs-boot - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Parser/Monad.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Env.hs - compiler/GHC/Driver/Hooks.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ff664f40d63a021fb815ec5e794a1c7556968cb8...494033024673f8bf57d612d4cedfa3517939a9d4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ff664f40d63a021fb815ec5e794a1c7556968cb8...494033024673f8bf57d612d4cedfa3517939a9d4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 15 15:56:03 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 15 Dec 2020 10:56:03 -0500 Subject: [Git][ghc/ghc][wip/nonmoving-fixes] 40 commits: doc: Clarify the default for -fomit-yields Message-ID: <5fd8dc93e9e8e_6b21725d3a016684b1@gitlab.mail> Ben Gamari pushed to branch wip/nonmoving-fixes at Glasgow Haskell Compiler / GHC Commits: 35e7b0c6 by Kirill Elagin at 2020-12-10T01:45:54-05:00 doc: Clarify the default for -fomit-yields “Yield points enabled” is confusing (and probably wrong? I am not 100% sure what it means). Change it to a simple “on”. Undo this change from 2c23fff2e03e77187dc4d01f325f5f43a0e7cad2. - - - - - 3551c554 by Kirill Elagin at 2020-12-10T01:45:54-05:00 doc: Extra-clarify -fomit-yields Be more clear on what this optimisation being on by default means in terms of yields. - - - - - 6484f0d7 by Sergei Trofimovich at 2020-12-10T01:46:33-05:00 rts/linker/Elf.c: add missing <dlfcn.h> include (musl support) The change fixes build failure on musl: ``` rts/linker/Elf.c:2031:3: error: warning: implicit declaration of function 'dlclose'; did you mean 'close'? [-Wimplicit-function-declaration] 2031 | dlclose(nc->dlopen_handle); | ^~~~~~~ | close ``` Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - ab24ed9b by Ben Gamari at 2020-12-11T03:55:51-05:00 users guide: Fix syntax errors Fixes errors introduced by 3a55b3a2574f913d046f3a6f82db48d7f6df32e3. - - - - - d3a24d31 by Ben Gamari at 2020-12-11T03:55:51-05:00 users guide: Describe GC lifecycle events Every time I am asked about how to interpret these events I need to figure it out from scratch. It's well past time that the users guide properly documents these. - - - - - 741309b9 by Ben Gamari at 2020-12-11T03:56:27-05:00 gitlab-ci: Fix incorrect Docker image for nightly cross job Also refactor the job definition to eliminate the bug by construction. - - - - - 19703bc8 by Ben Gamari at 2020-12-11T03:56:27-05:00 gitlab-ci: Fix name of flavour in ThreadSanitizer job It looks like I neglected to update this after introduce flavour transformers. - - - - - 381eb660 by Sylvain Henry at 2020-12-11T12:57:35-05:00 Display FFI labels (fix #18539) - - - - - 4548d1f8 by Aaron Allen at 2020-12-11T12:58:14-05:00 Elide extraneous messages for :doc command (#15784) Do not print `<has no documentation>` alongside a valid doc. Additionally, if two matching symbols lack documentation then the message will only be printed once. Hence, `<has no documentation>` will be printed at most once and only if all matching symbols are lacking docs. - - - - - 5eba91b6 by Aaron Allen at 2020-12-11T12:58:14-05:00 Add :doc test case for duplicate record fields Tests that the output of the `:doc` command is correct for duplicate record fields defined using -XDuplicateRecordFields. - - - - - 5feb9b2d by Ryan Scott at 2020-12-11T22:39:29-05:00 Delete outdated Note [Kind-checking tyvar binders for associated types] This Note has severely bitrotted, as it has no references anywhere in the codebase, and none of the functions that it mentions exist anymore. Let's just delete this. While I was in town, I deleted some outdated comments from `checkFamPatBinders` of a similar caliber. Fixes #19008. [ci skip] - - - - - f9f9f030 by Sylvain Henry at 2020-12-11T22:40:08-05:00 Arrows: correctly query arrow methods (#17423) Consider the following code: proc (C x y) -> ... Before this patch, the evidence binding for the Arrow dictionary was attached to the C pattern: proc (C x y) { $dArrow = ... } -> ... But then when we desugar this, we use arrow operations ("arr", ">>>"...) specialised for this arrow: let arr_xy = arr $dArrow -- <-- Not in scope! ... in arr_xy (\(C x y) { $dArrow = ... } -> ...) This patch allows arrow operations to be type-checked before the proc itself, avoiding this issue. Fix #17423 - - - - - aaa8f00f by Sylvain Henry at 2020-12-11T22:40:48-05:00 Validate script: fix configure command when using stack - - - - - b4a929a1 by Sylvain Henry at 2020-12-11T22:41:30-05:00 Hadrian: fix libffi tarball parsing Fix parsing of "libffi-3.3.tar.gz". NB: switch to a newer libffi isn't done in this patch - - - - - 690c8946 by Sylvain Henry at 2020-12-11T22:42:09-05:00 Parser: move parser utils into their own module Move code unrelated to runtime evaluation out of GHC.Runtime.Eval - - - - - 76be0e32 by Sylvain Henry at 2020-12-11T22:42:48-05:00 Move SizedSeq into ghc-boot - - - - - 3a16d764 by Sylvain Henry at 2020-12-11T22:42:48-05:00 ghci: don't compile unneeded modules - - - - - 2895fa60 by Sylvain Henry at 2020-12-11T22:42:48-05:00 ghci: reuse Arch from ghc-boot - - - - - 480a38d4 by Sylvain Henry at 2020-12-11T22:43:30-05:00 rts: don't use siginterrupt (#19019) - - - - - 4af6126d by Sylvain Henry at 2020-12-11T22:44:11-05:00 Use static array in zeroCount - - - - - 5bd71bfd by Sebastian Graf at 2020-12-12T04:45:09-05:00 DmdAnal: Annotate top-level function bindings with demands (#18894) It's useful to annotate a non-exported top-level function like `g` in ```hs module Lib (h) where g :: Int -> Int -> (Int,Int) g m 1 = (m, 0) g m n = (2 * m, 2 `div` n) {-# NOINLINE g #-} h :: Int -> Int h 1 = 0 h m | odd m = snd (g m 2) | otherwise = uncurry (+) (g 2 m) ``` with its demand `UCU(CS(P(1P(U),SP(U))`, which tells us that whenever `g` was called, the second component of the returned pair was evaluated strictly. Since #18903 we do so for local functions, where we can see all calls. For top-level functions, we can assume that all *exported* functions are demanded according to `topDmd` and thus get sound demands for non-exported top-level functions. The demand on `g` is crucial information for Nested CPR, which may the go on and unbox `g` for the second pair component. That is true even if that pair component may diverge, as is the case for the call site `g 13 0`, which throws a div-by-zero exception. In `T18894b`, you can even see the new demand annotation enabling us to eta-expand a function that we wouldn't be able to eta-expand without Call Arity. We only track bindings of function type in order not to risk huge compile-time regressions, see `isInterestingTopLevelFn`. There was a CoreLint check that rejected strict demand annotations on recursive or top-level bindings, which seems completely unjustified. All the cases I investigated were fine, so I removed it. Fixes #18894. - - - - - 3aae036e by Sebastian Graf at 2020-12-12T04:45:09-05:00 Demand: Simplify `CU(U)` to `U` (#19005) Both sub-demands encode the same information. This is a trivial change and already affects a few regression tests (e.g. `T5075`), so no separate regression test is necessary. - - - - - c6477639 by Adam Sandberg Ericsson at 2020-12-12T04:45:48-05:00 hadrian: correctly copy the docs dir into the bindist #18669 - - - - - e033dd05 by Adam Sandberg Ericsson at 2020-12-12T10:52:19+00:00 mkDocs: support hadrian bindists #18973 - - - - - 78580ba3 by John Ericson at 2020-12-13T07:14:50-05:00 Remove old .travis.yml - - - - - c696bb2f by Cale Gibbard at 2020-12-14T13:37:09-05:00 Implement type applications in patterns The haddock submodule is also updated so that it understands the changes to patterns. - - - - - 7e9debd4 by Ben Gamari at 2020-12-14T13:37:09-05:00 Optimise nullary type constructor usage During the compilation of programs GHC very frequently deals with the `Type` type, which is a synonym of `TYPE 'LiftedRep`. This patch teaches GHC to avoid expanding the `Type` synonym (and other nullary type synonyms) during type comparisons, saving a good amount of work. This optimisation is described in `Note [Comparing nullary type synonyms]`. To maximize the impact of this optimisation, we introduce a few special-cases to reduce `TYPE 'LiftedRep` to `Type`. See `Note [Prefer Type over TYPE 'LiftedPtrRep]`. Closes #17958. Metric Decrease: T18698b T1969 T12227 T12545 T12707 T14683 T3064 T5631 T5642 T9020 T9630 T9872a T13035 haddock.Cabal haddock.base - - - - - 92377c27 by Ben Gamari at 2020-12-14T13:41:58-05:00 Revert "Optimise nullary type constructor usage" This was inadvertently merged. This reverts commit 7e9debd4ceb068effe8ac81892d2cabcb8f55850. - - - - - d0e8c10d by Sylvain Henry at 2020-12-14T19:45:13+01:00 Move Unit related fields from DynFlags to HscEnv The unit database cache, the home unit and the unit state were stored in DynFlags while they ought to be stored in the compiler session state (HscEnv). This patch fixes this. It introduces a new UnitEnv type that should be used in the future to handle separate unit environments (especially host vs target units). Related to #17957 Bump haddock submodule - - - - - af855ac1 by Andreas Klebinger at 2020-12-14T15:22:13-05:00 Optimize dumping of consecutive whitespace. The naive way of putting out n characters of indent would be something like `hPutStr hdl (replicate n ' ')`. However this is quite inefficient as we allocate an absurd number of strings consisting of simply spaces as we don't cache them. To improve on this we now track if we can simply write ascii spaces via hPutBuf instead. This is the case when running with -ddump-to-file where we force the encoding to be UTF8. This avoids both the cost of going through encoding as well as avoiding allocation churn from all the white space. Instead we simply use hPutBuf on a preallocated unlifted string. When dumping stg like this: > nofib/spectral/simple/Main.hs -fforce-recomp -ddump-stg-final -ddump-to-file -c +RTS -s Allocations went from 1,778 MB to 1,702MB. About a 4% reduction of allocation! I did not measure the difference in runtime but expect it to be similar. Bumps the haddock submodule since the interface of GHC's Pretty slightly changed. ------------------------- Metric Decrease: T12227 ------------------------- - - - - - dad87210 by Ben Gamari at 2020-12-14T15:22:29-05:00 Optimise nullary type constructor usage During the compilation of programs GHC very frequently deals with the `Type` type, which is a synonym of `TYPE 'LiftedRep`. This patch teaches GHC to avoid expanding the `Type` synonym (and other nullary type synonyms) during type comparisons, saving a good amount of work. This optimisation is described in `Note [Comparing nullary type synonyms]`. To maximize the impact of this optimisation, we introduce a few special-cases to reduce `TYPE 'LiftedRep` to `Type`. See `Note [Prefer Type over TYPE 'LiftedPtrRep]`. Closes #17958. Metric Decrease: T18698b T1969 T12227 T12545 T12707 T14683 T3064 T5631 T5642 T9020 T9630 T9872a T13035 haddock.Cabal haddock.base - - - - - 6c2eb223 by Andrew Martin at 2020-12-14T18:48:51-05:00 Implement BoxedRep proposal This implements the BoxedRep proposal, refacoring the `RuntimeRep` hierarchy from: ```haskell data RuntimeRep = LiftedPtrRep | UnliftedPtrRep | ... ``` to ```haskell data RuntimeRep = BoxedRep Levity | ... data Levity = Lifted | Unlifted ``` Closes #17526. - - - - - 3ee696cc by Sebastian Graf at 2020-12-15T10:53:31-05:00 Add regression test for #19053 - - - - - 535dae66 by Ben Gamari at 2020-12-15T10:53:58-05:00 testsuite: Mark divbyzero, derefnull as fragile Due to #18548. - - - - - 5b9f7d8b by Ben Gamari at 2020-12-15T10:56:01-05:00 nonmoving: Fix small CPP bug Previously an incorrect semicolon meant that we would fail to call busy_wait_nop when spinning. - - - - - 5c8e2ba4 by GHC GitLab CI at 2020-12-15T10:56:01-05:00 nonmoving: Assert deadlock-gc promotion invariant When performing a deadlock-detection GC we must ensure that all objects end up in the non-moving generation. Assert this in scavenge. - - - - - af102371 by GHC GitLab CI at 2020-12-15T10:56:01-05:00 nonmoving: Ensure deadlock detection promotion works Previously the deadlock-detection promotion logic in alloc_for_copy was just plain wrong: it failed to fire when gct->evac_gen_no != oldest_gen->gen_no. The fix is simple: move the - - - - - 28738aea by GHC GitLab CI at 2020-12-15T10:56:01-05:00 nonmoving: Refactor alloc_for_copy Pull the cold non-moving allocation path out of alloc_for_copy. - - - - - c843f309 by Ben Gamari at 2020-12-15T10:56:01-05:00 nonmoving: Don't push objects during deadlock detect GC Previously we would push large objects and compact regions to the mark queue during the deadlock detect GC, resulting in failure to detect deadlocks. - - - - - 2f89479b by GHC GitLab CI at 2020-12-15T10:56:01-05:00 nonmoving: Add comments to nonmovingResurrectThreads - - - - - 30 changed files: - .gitlab-ci.yml - − .travis.yml - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Types/Prim.hs - + compiler/GHC/Builtin/Types/Prim.hs-boot - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Parser/Monad.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Env.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5cc213666d20437cdbbead665a0fd725d8dfb533...2f89479b4220490044807517a2d8c1ed222feb79 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5cc213666d20437cdbbead665a0fd725d8dfb533...2f89479b4220490044807517a2d8c1ed222feb79 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 15 18:26:51 2020 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski) Date: Tue, 15 Dec 2020 13:26:51 -0500 Subject: [Git][ghc/ghc][wip/T18998] 29 commits: doc: Clarify the default for -fomit-yields Message-ID: <5fd8ffeb94ed2_6b21725c11c1704531@gitlab.mail> Krzysztof Gogolewski pushed to branch wip/T18998 at Glasgow Haskell Compiler / GHC Commits: 35e7b0c6 by Kirill Elagin at 2020-12-10T01:45:54-05:00 doc: Clarify the default for -fomit-yields “Yield points enabled” is confusing (and probably wrong? I am not 100% sure what it means). Change it to a simple “on”. Undo this change from 2c23fff2e03e77187dc4d01f325f5f43a0e7cad2. - - - - - 3551c554 by Kirill Elagin at 2020-12-10T01:45:54-05:00 doc: Extra-clarify -fomit-yields Be more clear on what this optimisation being on by default means in terms of yields. - - - - - 6484f0d7 by Sergei Trofimovich at 2020-12-10T01:46:33-05:00 rts/linker/Elf.c: add missing <dlfcn.h> include (musl support) The change fixes build failure on musl: ``` rts/linker/Elf.c:2031:3: error: warning: implicit declaration of function 'dlclose'; did you mean 'close'? [-Wimplicit-function-declaration] 2031 | dlclose(nc->dlopen_handle); | ^~~~~~~ | close ``` Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - ab24ed9b by Ben Gamari at 2020-12-11T03:55:51-05:00 users guide: Fix syntax errors Fixes errors introduced by 3a55b3a2574f913d046f3a6f82db48d7f6df32e3. - - - - - d3a24d31 by Ben Gamari at 2020-12-11T03:55:51-05:00 users guide: Describe GC lifecycle events Every time I am asked about how to interpret these events I need to figure it out from scratch. It's well past time that the users guide properly documents these. - - - - - 741309b9 by Ben Gamari at 2020-12-11T03:56:27-05:00 gitlab-ci: Fix incorrect Docker image for nightly cross job Also refactor the job definition to eliminate the bug by construction. - - - - - 19703bc8 by Ben Gamari at 2020-12-11T03:56:27-05:00 gitlab-ci: Fix name of flavour in ThreadSanitizer job It looks like I neglected to update this after introduce flavour transformers. - - - - - 381eb660 by Sylvain Henry at 2020-12-11T12:57:35-05:00 Display FFI labels (fix #18539) - - - - - 4548d1f8 by Aaron Allen at 2020-12-11T12:58:14-05:00 Elide extraneous messages for :doc command (#15784) Do not print `<has no documentation>` alongside a valid doc. Additionally, if two matching symbols lack documentation then the message will only be printed once. Hence, `<has no documentation>` will be printed at most once and only if all matching symbols are lacking docs. - - - - - 5eba91b6 by Aaron Allen at 2020-12-11T12:58:14-05:00 Add :doc test case for duplicate record fields Tests that the output of the `:doc` command is correct for duplicate record fields defined using -XDuplicateRecordFields. - - - - - 5feb9b2d by Ryan Scott at 2020-12-11T22:39:29-05:00 Delete outdated Note [Kind-checking tyvar binders for associated types] This Note has severely bitrotted, as it has no references anywhere in the codebase, and none of the functions that it mentions exist anymore. Let's just delete this. While I was in town, I deleted some outdated comments from `checkFamPatBinders` of a similar caliber. Fixes #19008. [ci skip] - - - - - f9f9f030 by Sylvain Henry at 2020-12-11T22:40:08-05:00 Arrows: correctly query arrow methods (#17423) Consider the following code: proc (C x y) -> ... Before this patch, the evidence binding for the Arrow dictionary was attached to the C pattern: proc (C x y) { $dArrow = ... } -> ... But then when we desugar this, we use arrow operations ("arr", ">>>"...) specialised for this arrow: let arr_xy = arr $dArrow -- <-- Not in scope! ... in arr_xy (\(C x y) { $dArrow = ... } -> ...) This patch allows arrow operations to be type-checked before the proc itself, avoiding this issue. Fix #17423 - - - - - aaa8f00f by Sylvain Henry at 2020-12-11T22:40:48-05:00 Validate script: fix configure command when using stack - - - - - b4a929a1 by Sylvain Henry at 2020-12-11T22:41:30-05:00 Hadrian: fix libffi tarball parsing Fix parsing of "libffi-3.3.tar.gz". NB: switch to a newer libffi isn't done in this patch - - - - - 690c8946 by Sylvain Henry at 2020-12-11T22:42:09-05:00 Parser: move parser utils into their own module Move code unrelated to runtime evaluation out of GHC.Runtime.Eval - - - - - 76be0e32 by Sylvain Henry at 2020-12-11T22:42:48-05:00 Move SizedSeq into ghc-boot - - - - - 3a16d764 by Sylvain Henry at 2020-12-11T22:42:48-05:00 ghci: don't compile unneeded modules - - - - - 2895fa60 by Sylvain Henry at 2020-12-11T22:42:48-05:00 ghci: reuse Arch from ghc-boot - - - - - 480a38d4 by Sylvain Henry at 2020-12-11T22:43:30-05:00 rts: don't use siginterrupt (#19019) - - - - - 4af6126d by Sylvain Henry at 2020-12-11T22:44:11-05:00 Use static array in zeroCount - - - - - 5bd71bfd by Sebastian Graf at 2020-12-12T04:45:09-05:00 DmdAnal: Annotate top-level function bindings with demands (#18894) It's useful to annotate a non-exported top-level function like `g` in ```hs module Lib (h) where g :: Int -> Int -> (Int,Int) g m 1 = (m, 0) g m n = (2 * m, 2 `div` n) {-# NOINLINE g #-} h :: Int -> Int h 1 = 0 h m | odd m = snd (g m 2) | otherwise = uncurry (+) (g 2 m) ``` with its demand `UCU(CS(P(1P(U),SP(U))`, which tells us that whenever `g` was called, the second component of the returned pair was evaluated strictly. Since #18903 we do so for local functions, where we can see all calls. For top-level functions, we can assume that all *exported* functions are demanded according to `topDmd` and thus get sound demands for non-exported top-level functions. The demand on `g` is crucial information for Nested CPR, which may the go on and unbox `g` for the second pair component. That is true even if that pair component may diverge, as is the case for the call site `g 13 0`, which throws a div-by-zero exception. In `T18894b`, you can even see the new demand annotation enabling us to eta-expand a function that we wouldn't be able to eta-expand without Call Arity. We only track bindings of function type in order not to risk huge compile-time regressions, see `isInterestingTopLevelFn`. There was a CoreLint check that rejected strict demand annotations on recursive or top-level bindings, which seems completely unjustified. All the cases I investigated were fine, so I removed it. Fixes #18894. - - - - - 3aae036e by Sebastian Graf at 2020-12-12T04:45:09-05:00 Demand: Simplify `CU(U)` to `U` (#19005) Both sub-demands encode the same information. This is a trivial change and already affects a few regression tests (e.g. `T5075`), so no separate regression test is necessary. - - - - - c6477639 by Adam Sandberg Ericsson at 2020-12-12T04:45:48-05:00 hadrian: correctly copy the docs dir into the bindist #18669 - - - - - e033dd05 by Adam Sandberg Ericsson at 2020-12-12T10:52:19+00:00 mkDocs: support hadrian bindists #18973 - - - - - 78580ba3 by John Ericson at 2020-12-13T07:14:50-05:00 Remove old .travis.yml - - - - - c696bb2f by Cale Gibbard at 2020-12-14T13:37:09-05:00 Implement type applications in patterns The haddock submodule is also updated so that it understands the changes to patterns. - - - - - 7e9debd4 by Ben Gamari at 2020-12-14T13:37:09-05:00 Optimise nullary type constructor usage During the compilation of programs GHC very frequently deals with the `Type` type, which is a synonym of `TYPE 'LiftedRep`. This patch teaches GHC to avoid expanding the `Type` synonym (and other nullary type synonyms) during type comparisons, saving a good amount of work. This optimisation is described in `Note [Comparing nullary type synonyms]`. To maximize the impact of this optimisation, we introduce a few special-cases to reduce `TYPE 'LiftedRep` to `Type`. See `Note [Prefer Type over TYPE 'LiftedPtrRep]`. Closes #17958. Metric Decrease: T18698b T1969 T12227 T12545 T12707 T14683 T3064 T5631 T5642 T9020 T9630 T9872a T13035 haddock.Cabal haddock.base - - - - - 92377c27 by Ben Gamari at 2020-12-14T13:41:58-05:00 Revert "Optimise nullary type constructor usage" This was inadvertently merged. This reverts commit 7e9debd4ceb068effe8ac81892d2cabcb8f55850. - - - - - fa95af0c by Richard Eisenberg at 2020-12-15T19:25:34+01:00 Unfortunate dirty hack to overcome #18998. See commentary in tcCheckUsage. Close #18998. Test case: typecheck/should_compile/T18998 - - - - - 30 changed files: - .gitlab-ci.yml - − .travis.yml - compiler/GHC.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Errors.hs - compiler/GHC/Parser/Errors/Ppr.hs - compiler/GHC/Parser/PostProcess.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/eb5e44547603513cad06ce6ef0392d15506f5f27...fa95af0c3ec03e647b10b7110268b008ff923505 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/eb5e44547603513cad06ce6ef0392d15506f5f27...fa95af0c3ec03e647b10b7110268b008ff923505 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 15 18:31:52 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 15 Dec 2020 13:31:52 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/doc-fix-92478 Message-ID: <5fd90118b36a_6b21725bd7017051ca@gitlab.mail> Ben Gamari pushed new branch wip/doc-fix-92478 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/doc-fix-92478 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 15 20:37:01 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 15 Dec 2020 15:37:01 -0500 Subject: [Git][ghc/ghc][master] 2 commits: Revert "Implement BoxedRep proposal" Message-ID: <5fd91e6d5eda2_6b217be38c017159e6@gitlab.mail> Ben Gamari pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 331f5568 by Ben Gamari at 2020-12-15T11:21:06-05:00 Revert "Implement BoxedRep proposal" This was inadvertently merged. This reverts commit 6c2eb2232b39ff4720fda0a4a009fb6afbc9dcea. - - - - - 50fae07d by Ben Gamari at 2020-12-15T15:15:16-05:00 Roll-back broken haddock commit Updates haddock submodule to revert a commit that does not build. - - - - - 30 changed files: - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Instance/Typeable.hs - compiler/GHC/Types/RepType.hs - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/Binary/Typeable.hs - docs/users_guide/9.2.1-notes.rst - docs/users_guide/exts/levity_polymorphism.rst - docs/users_guide/exts/typed_holes.rst - libraries/base/Data/Typeable.hs - libraries/base/Data/Typeable/Internal.hs - libraries/base/GHC/Enum.hs - libraries/base/GHC/Exts.hs - libraries/base/GHC/Show.hs - libraries/base/Unsafe/Coerce.hs - libraries/base/tests/T11334a.hs - libraries/base/tests/T11334a.stdout - libraries/binary - libraries/ghc-heap/GHC/Exts/Heap.hs - libraries/ghc-heap/tests/ClosureSizeUtils.hs - libraries/ghc-prim/GHC/Types.hs - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - testsuite/tests/backpack/should_run/T13955.bkp The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/535dae66271af0ce4ab9c0a772614b700bc4c92a...50fae07d48092562048d786685310174ae32d4e8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/535dae66271af0ce4ab9c0a772614b700bc4c92a...50fae07d48092562048d786685310174ae32d4e8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 15 20:40:55 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 15 Dec 2020 15:40:55 -0500 Subject: [Git][ghc/ghc][wip/boxed-rep] 5 commits: Add regression test for #19053 Message-ID: <5fd91f5745aa3_6b217be38c01717682@gitlab.mail> Ben Gamari pushed to branch wip/boxed-rep at Glasgow Haskell Compiler / GHC Commits: 3ee696cc by Sebastian Graf at 2020-12-15T10:53:31-05:00 Add regression test for #19053 - - - - - 535dae66 by Ben Gamari at 2020-12-15T10:53:58-05:00 testsuite: Mark divbyzero, derefnull as fragile Due to #18548. - - - - - 331f5568 by Ben Gamari at 2020-12-15T11:21:06-05:00 Revert "Implement BoxedRep proposal" This was inadvertently merged. This reverts commit 6c2eb2232b39ff4720fda0a4a009fb6afbc9dcea. - - - - - 50fae07d by Ben Gamari at 2020-12-15T15:15:16-05:00 Roll-back broken haddock commit Updates haddock submodule to revert a commit that does not build. - - - - - c11e220c by Andrew Martin at 2020-12-15T15:40:37-05:00 Implement BoxedRep proposal This implements the BoxedRep proposal, refacoring the `RuntimeRep` hierarchy from: ```haskell data RuntimeRep = LiftedPtrRep | UnliftedPtrRep | ... ``` to ```haskell data RuntimeRep = BoxedRep Levity | ... data Levity = Lifted | Unlifted ``` Closes #17526. - - - - - 5 changed files: - libraries/binary - testsuite/tests/rts/all.T - + testsuite/tests/stranal/should_run/T19053.hs - testsuite/tests/stranal/should_run/all.T - utils/haddock Changes: ===================================== libraries/binary ===================================== @@ -1 +1 @@ -Subproject commit f22b3d34bb46f95ec5a23d1ef894e2a05818a781 +Subproject commit b224410161f112dd1133a787ded9831799589ce7 ===================================== testsuite/tests/rts/all.T ===================================== @@ -38,6 +38,7 @@ test('derefnull', when(platform('i386-apple-darwin'), [ignore_stderr, exit_code(139)]), when(platform('x86_64-apple-darwin'), [ignore_stderr, exit_code(139)]), when(opsys('mingw32'), [ignore_stderr, exit_code(11)]), + when(opsys('mingw32'), [fragile(18548)]), # ThreadSanitizer changes the output when(have_thread_sanitizer(), skip), # since these test are supposed to crash the @@ -63,6 +64,7 @@ test('divbyzero', when(platform('powerpc64-unknown-linux'), [ignore_stdout, exit_code(0)]), when(platform('powerpc64le-unknown-linux'), [ignore_stdout, exit_code(0)]), when(opsys('mingw32'), [ignore_stderr, exit_code(8)]), + when(opsys('mingw32'), [fragile(18548)]), # The output under OS X is too unstable to readily compare when(platform('i386-apple-darwin'), [ignore_stderr, exit_code(136)]), when(platform('x86_64-apple-darwin'), [ignore_stderr, exit_code(136)]), ===================================== testsuite/tests/stranal/should_run/T19053.hs ===================================== @@ -0,0 +1,8 @@ +import Data.List (group) +import System.Exit (exitFailure, exitSuccess) + +main :: IO () +main = do + _ <- getContents + if last (group "a") == "a" then exitSuccess else exitFailure + ===================================== testsuite/tests/stranal/should_run/all.T ===================================== @@ -26,3 +26,4 @@ test('T14171', [expect_broken(14171), exit_code(1)], compile_and_run, ['']) test('T14290', normal, compile_and_run, ['']) test('T14285', normal, multimod_compile_and_run, ['T14285', '']) test('T17676', normal, compile_and_run, ['']) +test('T19053', normal, compile_and_run, ['']) ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 4ffb30d8b637ccebecc81ce610f0af451ac8088d +Subproject commit ae66ba1fd78849bd0fd608ad482a17508be722da View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6c2eb2232b39ff4720fda0a4a009fb6afbc9dcea...c11e220cbc75b7c148482dc16683e56cffe6e5c7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6c2eb2232b39ff4720fda0a4a009fb6afbc9dcea...c11e220cbc75b7c148482dc16683e56cffe6e5c7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 15 20:45:27 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 15 Dec 2020 15:45:27 -0500 Subject: [Git][ghc/ghc][wip/boxed-rep] Implement BoxedRep proposal Message-ID: <5fd9206717141_6b21725ac4017213eb@gitlab.mail> Ben Gamari pushed to branch wip/boxed-rep at Glasgow Haskell Compiler / GHC Commits: 37733de6 by Andrew Martin at 2020-12-15T15:45:18-05:00 Implement BoxedRep proposal This implements the BoxedRep proposal, refacoring the `RuntimeRep` hierarchy from: ```haskell data RuntimeRep = LiftedPtrRep | UnliftedPtrRep | ... ``` to ```haskell data RuntimeRep = BoxedRep Levity | ... data Levity = Lifted | Unlifted ``` Closes #17526. - - - - - 30 changed files: - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Instance/Typeable.hs - compiler/GHC/Types/RepType.hs - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/Binary/Typeable.hs - docs/users_guide/9.2.1-notes.rst - docs/users_guide/exts/levity_polymorphism.rst - docs/users_guide/exts/typed_holes.rst - libraries/base/Data/Typeable.hs - libraries/base/Data/Typeable/Internal.hs - libraries/base/GHC/Enum.hs - libraries/base/GHC/Exts.hs - libraries/base/GHC/Show.hs - libraries/base/Unsafe/Coerce.hs - libraries/base/tests/T11334a.hs - libraries/base/tests/T11334a.stdout - libraries/ghc-heap/GHC/Exts/Heap.hs - libraries/ghc-heap/tests/ClosureSizeUtils.hs - libraries/ghc-prim/GHC/Types.hs - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - testsuite/tests/backpack/should_run/T13955.bkp - testsuite/tests/dependent/should_compile/RaeJobTalk.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/37733de6e438749184458f541653db14969b45b4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/37733de6e438749184458f541653db14969b45b4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 15 20:45:41 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 15 Dec 2020 15:45:41 -0500 Subject: [Git][ghc/ghc] Deleted branch wip/tyconapp-opts Message-ID: <5fd92075ce59_6b2174471c17221e8@gitlab.mail> Ben Gamari deleted branch wip/tyconapp-opts at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 15 20:59:26 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 15 Dec 2020 15:59:26 -0500 Subject: [Git][ghc/ghc][master] Revert haddock submodule yet again Message-ID: <5fd923ae7fd6d_6b213272ce01722366@gitlab.mail> Ben Gamari pushed to branch master at Glasgow Haskell Compiler / GHC Commits: e9b18a75 by Ben Gamari at 2020-12-15T15:55:38-05:00 Revert haddock submodule yet again - - - - - 1 changed file: - utils/haddock Changes: ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 46c3db2460cea396fae525f4b9d8f40c34c0680e +Subproject commit c577da9cf5c531a3e5678760823c61db8a3adeb6 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e9b18a75d5ddf24e5b866fbce17a3648570721af -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e9b18a75d5ddf24e5b866fbce17a3648570721af You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 15 21:06:10 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 15 Dec 2020 16:06:10 -0500 Subject: [Git][ghc/ghc][wip/boxed-rep] Implement BoxedRep proposal Message-ID: <5fd9254248de6_6b21725bd7017260c4@gitlab.mail> Ben Gamari pushed to branch wip/boxed-rep at Glasgow Haskell Compiler / GHC Commits: 6f594169 by Andrew Martin at 2020-12-15T16:05:27-05:00 Implement BoxedRep proposal This implements the BoxedRep proposal, refacoring the `RuntimeRep` hierarchy from: ```haskell data RuntimeRep = LiftedPtrRep | UnliftedPtrRep | ... ``` to ```haskell data RuntimeRep = BoxedRep Levity | ... data Levity = Lifted | Unlifted ``` Updates binary, haddock submodules. Closes #17526. - - - - - 30 changed files: - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Instance/Typeable.hs - compiler/GHC/Types/RepType.hs - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/Binary/Typeable.hs - docs/users_guide/9.2.1-notes.rst - docs/users_guide/exts/levity_polymorphism.rst - docs/users_guide/exts/typed_holes.rst - libraries/base/Data/Typeable.hs - libraries/base/Data/Typeable/Internal.hs - libraries/base/GHC/Enum.hs - libraries/base/GHC/Exts.hs - libraries/base/GHC/Show.hs - libraries/base/Unsafe/Coerce.hs - libraries/base/tests/T11334a.hs - libraries/base/tests/T11334a.stdout - libraries/ghc-heap/GHC/Exts/Heap.hs - libraries/ghc-heap/tests/ClosureSizeUtils.hs - libraries/ghc-prim/GHC/Types.hs - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - testsuite/tests/backpack/should_run/T13955.bkp - testsuite/tests/dependent/should_compile/RaeJobTalk.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6f594169ee52401f3e83e91f50681031ac0eae97 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6f594169ee52401f3e83e91f50681031ac0eae97 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Dec 15 22:03:08 2020 From: gitlab at gitlab.haskell.org (Alan Zimmerman) Date: Tue, 15 Dec 2020 17:03:08 -0500 Subject: [Git][ghc/ghc][wip/az/exactprint] 88 commits: [Sized Cmm] properly retain sizes. Message-ID: <5fd9329ce42dc_6b21674185417371af@gitlab.mail> Alan Zimmerman pushed to branch wip/az/exactprint at Glasgow Haskell Compiler / GHC Commits: be5d74ca by Moritz Angermann at 2020-11-26T16:00:32-05:00 [Sized Cmm] properly retain sizes. This replaces all Word<N> = W<N># Word# and Int<N> = I<N># Int# with Word<N> = W<N># Word<N># and Int<N> = I<N># Int<N>#, thus providing us with properly sized primitives in the codegenerator instead of pretending they are all full machine words. This came up when implementing darwinpcs for arm64. The darwinpcs reqires us to pack function argugments in excess of registers on the stack. While most procedure call standards (pcs) assume arguments are just passed in 8 byte slots; and thus the caller does not know the exact signature to make the call, darwinpcs requires us to adhere to the prototype, and thus have the correct sizes. If we specify CInt in the FFI call, it should correspond to the C int, and not just be Word sized, when it's only half the size. This does change the expected output of T16402 but the new result is no less correct as it eliminates the narrowing (instead of the `and` as was previously done). Bumps the array, bytestring, text, and binary submodules. Co-Authored-By: Ben Gamari <ben at well-typed.com> Metric Increase: T13701 T14697 - - - - - a84e53f9 by Andreas Klebinger at 2020-11-26T16:00:32-05:00 RTS: Fix failed inlining of copy_tag. On windows using gcc-10 gcc failed to inline copy_tag into evacuate. To fix this we now set the always_inline attribute for the various copy* functions in Evac.c. The main motivation here is not the overhead of the function call, but rather that this allows the code to "specialize" for the size of the closure we copy which is often known at compile time. An earlier commit also tried to avoid evacuate_large inlining. But didn't quite succeed. So I also marked evacuate_large as noinline. Fixes #12416 - - - - - cdbd16f5 by Sylvain Henry at 2020-11-26T16:00:33-05:00 Fix toArgRep to support 64-bit reps on all systems [This is @Ericson2314 writing a commit message for @hsyl20's patch.] (Progress towards #11953, #17377, #17375) `Int64Rep` and `Word64Rep` are currently broken on 64-bit systems. This is because they should use "native arg rep" but instead use "large arg rep" as they do on 32-bit systems, which is either a non-concept or a 128-bit rep depending on one's vantage point. Now, these reps currently aren't used during 64-bit compilation, so the brokenness isn't observed, but I don't think that constitutes reasons not to fix it. Firstly, the linked issues there is a clearly expressed desire to use explicit-bitwidth constructs in more places. Secondly, per [1], there are other bugs that *do* manifest from not threading explicit-bitwidth information all the way through the compilation pipeline. One can therefore view this as one piece of the larger effort to do that, improve ergnomics, and squash remaining bugs. Also, this is needed for !3658. I could just merge this as part of that, but I'm keen on merging fixes "as they are ready" so the fixes that aren't ready are isolated and easier to debug. [1]: https://mail.haskell.org/pipermail/ghc-devs/2020-October/019332.html - - - - - a9378e69 by Tim Barnes at 2020-11-26T16:00:34-05:00 Set dynamic users-guide TOC spacing (fixes #18554) - - - - - 86a59d93 by Ben Gamari at 2020-11-26T16:00:34-05:00 rts: Use RTS_LIKELY in CHECK Most compilers probably already infer that `barf` diverges but it nevertheless doesn't hurt to be explicit. - - - - - 5757e82b by Matthew Pickering at 2020-11-26T16:00:35-05:00 Remove special case for GHC.ByteCode.Instr This was added in https://github.com/nomeata/ghc-heap-view/commit/34935206e51b9c86902481d84d2f368a6fd93423 GHC.ByteCode.Instr.BreakInfo no longer exists so the special case is dead code. Any check like this can be easily dealt with in client code. - - - - - d9c8b5b4 by Matthew Pickering at 2020-11-26T16:00:35-05:00 Split Up getClosureDataFromHeapRep Motivation 1. Don't enforce the repeated decoding of an info table, when the client can cache it (ghc-debug) 2. Allow the constructor information decoding to be overridden, this casues segfaults in ghc-debug - - - - - 3e3555cc by Andreas Klebinger at 2020-11-26T16:00:35-05:00 RegAlloc: Add missing raPlatformfield to RegAllocStatsSpill Fixes #18994 Co-Author: Benjamin Maurer <maurer.benjamin at gmail.com> - - - - - a1a75aa9 by Ben Gamari at 2020-11-27T06:20:41-05:00 rts: Allocate MBlocks with MAP_TOP_DOWN on Windows As noted in #18991, we would previously allocate heap in low memory. Due to this the linker, which typically *needs* low memory, would end up competing with the heap. In longer builds we end up running out of low memory entirely, leading to linking failures. - - - - - 75fc1ed5 by Sylvain Henry at 2020-11-28T15:40:23-05:00 Hadrian: fix detection of ghc-pkg for cross-compilers - - - - - 7cb5df96 by Sylvain Henry at 2020-11-28T15:40:23-05:00 hadrian: fix ghc-pkg uses (#17601) Make sure ghc-pkg doesn't read the compiler "settings" file by passing --no-user-package-db. - - - - - e3fd4226 by Ben Gamari at 2020-11-28T15:40:23-05:00 gitlab-ci: Introduce a nightly cross-compilation job This adds a job to test cross-compilation from x86-64 to AArch64 with Hadrian. Fixes #18234 - - - - - 698d3d96 by Ben Gamari at 2020-11-28T15:41:00-05:00 gitlab-ci: Only deploy GitLab Pages in ghc/ghc> The deployments are quite large and yet are currently only served for the ghc/ghc> project. - - - - - 625726f9 by David Eichmann at 2020-11-28T15:41:37-05:00 ghc-heap: partial TSO/STACK decoding Co-authored-by: Sven Tennie <sven.tennie at gmail.com> Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> Co-authored-by: Ben Gamari <bgamari.foss at gmail.com> - - - - - 22ea9c29 by Andreas Klebinger at 2020-11-28T15:42:13-05:00 Small optimization to CmmSink. Inside `regsUsedIn` we can avoid some thunks by specializing the recursion. In particular we avoid the thunk for `(f e z)` in the MachOp/Load branches, where we know this will evaluate to z. Reduces allocations for T3294 by ~1%. - - - - - bba42c62 by John Ericson at 2020-11-28T15:42:49-05:00 Make primop handler indentation more consistent - - - - - c82bc8e9 by John Ericson at 2020-11-28T15:42:49-05:00 Cleanup some primop constructor names Harmonize the internal (big sum type) names of the native vs fixed-sized number primops a bit. (Mainly by renaming the former.) No user-facing names are changed. - - - - - ae14f160 by Ben Gamari at 2020-11-28T15:43:25-05:00 testsuite: Mark T14702 as fragile on Windows Due to #18953. - - - - - 1bc104b0 by Ben Gamari at 2020-11-29T15:33:18-05:00 withTimings: Emit allocations counter This will allow us to back out the allocations per compiler pass from the eventlog. Note that we dump the allocation counter rather than the difference since this will allow us to determine how much work is done *between* `withTiming` blocks. - - - - - e992ea84 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 ThreadPaused: Don't zero slop until free vars are pushed When threadPaused blackholes a thunk it calls `OVERWRITING_CLOSURE` to zero the slop for the benefit of the sanity checker. Previously this was done *before* pushing the thunk's free variables to the update remembered set. Consequently we would pull zero'd pointers to the update remembered set. - - - - - e82cd140 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Fix regression from TSAN work The TSAN rework (specifically aad1f803) introduced a subtle regression in GC.c, swapping `g0` in place of `gen`. Whoops! Fixes #18997. - - - - - 35a5207e by GHC GitLab CI at 2020-11-29T15:33:54-05:00 rts/Messages: Add missing write barrier in THROWTO message update After a THROWTO message has been handle the message closure is overwritten by a NULL message. We must ensure that the original closure's pointers continue to be visible to the nonmoving GC. - - - - - 0120829f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Add missing write barrier in shrinkSmallByteArray - - - - - 8a4d8fb6 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 Updates: Don't zero slop until closure has been pushed Ensure that the the free variables have been pushed to the update remembered set before we zero the slop. - - - - - 2793cfdc by GHC GitLab CI at 2020-11-29T15:33:54-05:00 OSThreads: Fix error code checking pthread_join returns its error code and apparently doesn't set errno. - - - - - e391a16f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Don't join to mark_thread on shutdown The mark thread is not joinable as we detach from it on creation. - - - - - 60d088ab by Ben Gamari at 2020-11-29T15:33:54-05:00 nonmoving: Add reference to Ueno 2016 - - - - - 3aa60362 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Ensure that evacuated large objects are marked See Note [Non-moving GC: Marking evacuated objects]. - - - - - 8d304a99 by Ben Gamari at 2020-11-30T10:15:22-05:00 rts/m32: Refactor handling of allocator seeding Previously, in an attempt to reduce fragmentation, each new allocator would map a region of M32_MAX_PAGES fresh pages to seed itself. However, this ends up being extremely wasteful since it turns out that we often use fewer than this. Consequently, these pages end up getting freed which, ends up fragmenting our address space more than than we would have if we had naively allocated pages on-demand. Here we refactor m32 to avoid this waste while achieving the fragmentation mitigation previously desired. In particular, we move all page allocation into the global m32_alloc_page, which will pull a page from the free page pool. If the free page pool is empty we then refill it by allocating a region of M32_MAP_PAGES and adding them to the pool. Furthermore, we do away with the initial seeding entirely. That is, the allocator starts with no active pages: pages are rather allocated on an as-needed basis. On the whole this ends up being a pleasingly simple change, simultaneously making m32 more efficient, more robust, and simpler. Fixes #18980. - - - - - b6629289 by Ben Gamari at 2020-11-30T10:15:58-05:00 rts: Use CHECK instead of assert Use the GHC wrappers instead of <assert.h>. - - - - - 9f4efa6a by Ben Gamari at 2020-11-30T10:15:58-05:00 rts/linker: Replace some ASSERTs with CHECK In the past some people have confused ASSERT, which is for checking internal invariants, which CHECK, which should be used when checking things that might fail due to bad input (and therefore should be enabled even in the release compiler). Change some of these cases in the linker to use CHECK. - - - - - 0f8a4655 by Ryan Scott at 2020-11-30T10:16:34-05:00 Allow deploy:pages job to fail See #18973. - - - - - 49ebe369 by chessai at 2020-11-30T19:47:40-05:00 Optimisations in Data.Foldable (T17867) This PR concerns the following functions from `Data.Foldable`: * minimum * maximum * sum * product * minimumBy * maximumBy - Default implementations of these functions now use `foldl'` or `foldMap'`. - All have been marked with INLINEABLE to make room for further optimisations. - - - - - 4d79ef65 by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - 6af074ce by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - ab334262 by Viktor Dukhovni at 2020-11-30T19:48:17-05:00 dirty MVAR after mutating TSO queue head While the original head and tail of the TSO queue may be in the same generation as the MVAR, interior elements of the queue could be younger after a GC run and may then be exposed by putMVar operation that updates the queue head. Resolves #18919 - - - - - 5eb163f3 by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Don't allow shared libraries to be loaded multiple times - - - - - 490aa14d by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Initialise CCSs from native shared objects - - - - - 6ac3db5f by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Move shared library loading logic into Elf.c - - - - - b6698d73 by GHC GitLab CI at 2020-11-30T19:48:53-05:00 rts/linker: Don't declare dynamic objects with image_mapped This previously resulted in warnings due to spurious unmap failures. - - - - - b94a65af by jneira at 2020-11-30T19:49:31-05:00 Include tried paths in findToolDir error - - - - - 72a87fbc by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Move core flattening algorithm to Core.Unify This sets the stage for a later change, where this algorithm will be needed from GHC.Core.InstEnv. This commit also splits GHC.Core.Map into GHC.Core.Map.Type and GHC.Core.Map.Expr, in order to avoid module import cycles with GHC.Core. - - - - - 0dd45d0a by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Bump the # of commits searched for perf baseline The previous value of 75 meant that a feature branch with more than 75 commits would get spurious CI passes. This affects #18692, but does not fix that ticket, because if a baseline cannot be found, we should fail, not succeed. - - - - - 8bb52d91 by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Remove flattening variables This patch redesigns the flattener to simplify type family applications directly instead of using flattening meta-variables and skolems. The key new innovation is the CanEqLHS type and the new CEqCan constraint (Ct). A CanEqLHS is either a type variable or exactly-saturated type family application; either can now be rewritten using a CEqCan constraint in the inert set. Because the flattener no longer reduces all type family applications to variables, there was some performance degradation if a lengthy type family application is now flattened over and over (not making progress). To compensate, this patch contains some extra optimizations in the flattener, leading to a number of performance improvements. Close #18875. Close #18910. There are many extra parts of the compiler that had to be affected in writing this patch: * The family-application cache (formerly the flat-cache) sometimes stores coercions built from Given inerts. When these inerts get kicked out, we must kick out from the cache as well. (This was, I believe, true previously, but somehow never caused trouble.) Kicking out from the cache requires adding a filterTM function to TrieMap. * This patch obviates the need to distinguish "blocking" coercion holes from non-blocking ones (which, previously, arose from CFunEqCans). There is thus some simplification around coercion holes. * Extra commentary throughout parts of the code I read through, to preserve the knowledge I gained while working. * A change in the pure unifier around unifying skolems with other types. Unifying a skolem now leads to SurelyApart, not MaybeApart, as documented in Note [Binding when looking up instances] in GHC.Core.InstEnv. * Some more use of MCoercion where appropriate. * Previously, class-instance lookup automatically noticed that e.g. C Int was a "unifier" to a target [W] C (F Bool), because the F Bool was flattened to a variable. Now, a little more care must be taken around checking for unifying instances. * Previously, tcSplitTyConApp_maybe would split (Eq a => a). This is silly, because (=>) is not a tycon in Haskell. Fixed now, but there are some knock-on changes in e.g. TrieMap code and in the canonicaliser. * New function anyFreeVarsOf{Type,Co} to check whether a free variable satisfies a certain predicate. * Type synonyms now remember whether or not they are "forgetful"; a forgetful synonym drops at least one argument. This is useful when flattening; see flattenView. * The pattern-match completeness checker invokes the solver. This invocation might need to look through newtypes when checking representational equality. Thus, the desugarer needs to keep track of the in-scope variables to know what newtype constructors are in scope. I bet this bug was around before but never noticed. * Extra-constraints wildcards are no longer simplified before printing. See Note [Do not simplify ConstraintHoles] in GHC.Tc.Solver. * Whether or not there are Given equalities has become slightly subtler. See the new HasGivenEqs datatype. * Note [Type variable cycles in Givens] in GHC.Tc.Solver.Canonical explains a significant new wrinkle in the new approach. * See Note [What might match later?] in GHC.Tc.Solver.Interact, which explains the fix to #18910. * The inert_count field of InertCans wasn't actually used, so I removed it. Though I (Richard) did the implementation, Simon PJ was very involved in design and review. This updates the Haddock submodule to avoid #18932 by adding a type signature. ------------------------- Metric Decrease: T12227 T5030 T9872a T9872b T9872c Metric Increase: T9872d ------------------------- - - - - - d66660ba by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Rename the flattener to become the rewriter. Now that flattening doesn't produce flattening variables, it's not really flattening anything: it's rewriting. This change also means that the rewriter can no longer be confused the core flattener (in GHC.Core.Unify), which is sometimes used during type-checking. - - - - - add0aeae by Ben Gamari at 2020-12-01T19:58:17-05:00 rts: Introduce mmapAnonForLinker Previously most of the uses of mmapForLinker were mapping anonymous memory, resulting in a great deal of unnecessary repetition. Factor this out into a new helper. Also fixes a few places where error checking was missing or suboptimal. - - - - - 97d71646 by Ben Gamari at 2020-12-01T19:58:17-05:00 rts/linker: Introduce munmapForLinker Consolidates munmap calls to ensure consistent error handling. - - - - - d8872af0 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/Linker: Introduce Windows implementations for mmapForLinker, et al. - - - - - c35d0e03 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/m32: Introduce NEEDS_M32 macro Instead of relying on RTS_LINKER_USE_MMAP - - - - - 41c64eb5 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/linker: Use m32 to allocate symbol extras in PEi386 - - - - - e0b08c5f by Ben Gamari at 2020-12-03T13:01:47-05:00 gitlab-ci: Fix copy-paste error Also be more consistent in quoting. - - - - - 33ec3a06 by Ben Gamari at 2020-12-03T23:11:31-05:00 gitlab-ci: Run linters through ci.sh Ensuring that the right toolchain is used. - - - - - 4a437bc1 by Shayne Fletcher at 2020-12-05T09:06:38-05:00 Fix bad span calculations of post qualified imports - - - - - 8fac4b93 by Ben Gamari at 2020-12-05T09:07:13-05:00 testsuite: Add a test for #18923 - - - - - 62ed6957 by Simon Peyton Jones at 2020-12-08T15:31:41-05:00 Fix kind inference for data types. Again. This patch fixes several aspects of kind inference for data type declarations, especially data /instance/ declarations Specifically 1. In kcConDecls/kcConDecl make it clear that the tc_res_kind argument is only used in the H98 case; and in that case there is no result kind signature; and hence no need for the disgusting splitPiTys in kcConDecls (now thankfully gone). The GADT case is a bit different to before, and much nicer. This is what fixes #18891. See Note [kcConDecls: kind-checking data type decls] 2. Do not look at the constructor decls of a data/newtype instance in tcDataFamInstanceHeader. See GHC.Tc.TyCl.Instance Note [Kind inference for data family instances]. This was a new realisation that arose when doing (1) This causes a few knock-on effects in the tests suite, because we require more information than before in the instance /header/. New user-manual material about this in "Kind inference in data type declarations" and "Kind inference for data/newtype instance declarations". 3. Minor improvement in kcTyClDecl, combining GADT and H98 cases 4. Fix #14111 and #8707 by allowing the header of a data instance to affect kind inferece for the the data constructor signatures; as described at length in Note [GADT return types] in GHC.Tc.TyCl This led to a modest refactoring of the arguments (and argument order) of tcConDecl/tcConDecls. 5. Fix #19000 by inverting the sense of the test in new_locs in GHC.Tc.Solver.Canonical.canDecomposableTyConAppOK. - - - - - 0abe3ddf by Adam Sandberg Ericsson at 2020-12-08T15:32:19-05:00 hadrian: build the _l and _thr_l rts flavours in the develN flavours The ghc binary requires the eventlog rts since fc644b1a643128041cfec25db84e417851e28bab - - - - - 51e3bb6d by Andreas Klebinger at 2020-12-08T22:43:21-05:00 CodeGen: Make folds User/DefinerOfRegs INLINEABLE. Reduces allocation for the test case I was looking at by about 1.2%. Mostly from avoiding allocation of some folding functions which turn into let-no-escape bindings which just reuse their environment instead. We also force inlining in a few key places in CmmSink which helps a bit more. - - - - - 69ae10c3 by Andreas Klebinger at 2020-12-08T22:43:21-05:00 CmmSink: Force inlining of foldRegsDefd Helps avoid allocating the folding function. Improves perf for T3294 by about 1%. - - - - - 6e3da800 by Andreas Klebinger at 2020-12-08T22:43:21-05:00 Cmm: Make a few types and utility function slightly stricter. About 0.6% reduction in allocations for the code I was looking at. Not a huge difference but no need to throw away performance. - - - - - aef44d7f by Andreas Klebinger at 2020-12-08T22:43:21-05:00 Cmm.Sink: Optimize retaining of assignments, live sets. Sinking requires us to track live local regs after each cmm statement. We used to do this via "Set LocalReg". However we can replace this with a solution based on IntSet which is overall more efficient without losing much. The thing we lose is width of the variables, which isn't used by the sinking pass anyway. I also reworked how we keep assignments to regs mentioned in skipped assignments. I put the details into Note [Keeping assignemnts mentioned in skipped RHSs]. The gist of it is instead of keeping track of it via the use count which is a `IntMap Int` we now use the live regs set (IntSet) which is quite a bit faster. I think it also matches the semantics a lot better. The skipped (not discarded) assignment does in fact keep the regs on it's rhs alive so keeping track of this in the live set seems like the clearer solution as well. Improves allocations for T3294 by yet another 1%. - - - - - 59f2249b by Andreas Klebinger at 2020-12-08T22:43:21-05:00 GHC.Cmm.Opt: Be stricter in results. Optimization either returns Nothing if nothing is to be done or `Just <cmmExpr>` otherwise. There is no point in being lazy in `cmmExpr`. We usually inspect this element so the thunk gets forced not long after. We might eliminate it as dead code once in a blue moon but that's not a case worth optimizing for. Overall the impact of this is rather low. As Cmm.Opt doesn't allocate much (compared to the rest of GHC) to begin with. - - - - - 54b88eac by Andreas Klebinger at 2020-12-08T22:43:57-05:00 Bump time submodule. This should fix #19002. - - - - - 35e7b0c6 by Kirill Elagin at 2020-12-10T01:45:54-05:00 doc: Clarify the default for -fomit-yields “Yield points enabled” is confusing (and probably wrong? I am not 100% sure what it means). Change it to a simple “on”. Undo this change from 2c23fff2e03e77187dc4d01f325f5f43a0e7cad2. - - - - - 3551c554 by Kirill Elagin at 2020-12-10T01:45:54-05:00 doc: Extra-clarify -fomit-yields Be more clear on what this optimisation being on by default means in terms of yields. - - - - - 6484f0d7 by Sergei Trofimovich at 2020-12-10T01:46:33-05:00 rts/linker/Elf.c: add missing <dlfcn.h> include (musl support) The change fixes build failure on musl: ``` rts/linker/Elf.c:2031:3: error: warning: implicit declaration of function 'dlclose'; did you mean 'close'? [-Wimplicit-function-declaration] 2031 | dlclose(nc->dlopen_handle); | ^~~~~~~ | close ``` Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - ab24ed9b by Ben Gamari at 2020-12-11T03:55:51-05:00 users guide: Fix syntax errors Fixes errors introduced by 3a55b3a2574f913d046f3a6f82db48d7f6df32e3. - - - - - d3a24d31 by Ben Gamari at 2020-12-11T03:55:51-05:00 users guide: Describe GC lifecycle events Every time I am asked about how to interpret these events I need to figure it out from scratch. It's well past time that the users guide properly documents these. - - - - - 741309b9 by Ben Gamari at 2020-12-11T03:56:27-05:00 gitlab-ci: Fix incorrect Docker image for nightly cross job Also refactor the job definition to eliminate the bug by construction. - - - - - 19703bc8 by Ben Gamari at 2020-12-11T03:56:27-05:00 gitlab-ci: Fix name of flavour in ThreadSanitizer job It looks like I neglected to update this after introduce flavour transformers. - - - - - 381eb660 by Sylvain Henry at 2020-12-11T12:57:35-05:00 Display FFI labels (fix #18539) - - - - - 4548d1f8 by Aaron Allen at 2020-12-11T12:58:14-05:00 Elide extraneous messages for :doc command (#15784) Do not print `<has no documentation>` alongside a valid doc. Additionally, if two matching symbols lack documentation then the message will only be printed once. Hence, `<has no documentation>` will be printed at most once and only if all matching symbols are lacking docs. - - - - - 5eba91b6 by Aaron Allen at 2020-12-11T12:58:14-05:00 Add :doc test case for duplicate record fields Tests that the output of the `:doc` command is correct for duplicate record fields defined using -XDuplicateRecordFields. - - - - - 5feb9b2d by Ryan Scott at 2020-12-11T22:39:29-05:00 Delete outdated Note [Kind-checking tyvar binders for associated types] This Note has severely bitrotted, as it has no references anywhere in the codebase, and none of the functions that it mentions exist anymore. Let's just delete this. While I was in town, I deleted some outdated comments from `checkFamPatBinders` of a similar caliber. Fixes #19008. [ci skip] - - - - - f9f9f030 by Sylvain Henry at 2020-12-11T22:40:08-05:00 Arrows: correctly query arrow methods (#17423) Consider the following code: proc (C x y) -> ... Before this patch, the evidence binding for the Arrow dictionary was attached to the C pattern: proc (C x y) { $dArrow = ... } -> ... But then when we desugar this, we use arrow operations ("arr", ">>>"...) specialised for this arrow: let arr_xy = arr $dArrow -- <-- Not in scope! ... in arr_xy (\(C x y) { $dArrow = ... } -> ...) This patch allows arrow operations to be type-checked before the proc itself, avoiding this issue. Fix #17423 - - - - - aaa8f00f by Sylvain Henry at 2020-12-11T22:40:48-05:00 Validate script: fix configure command when using stack - - - - - b4a929a1 by Sylvain Henry at 2020-12-11T22:41:30-05:00 Hadrian: fix libffi tarball parsing Fix parsing of "libffi-3.3.tar.gz". NB: switch to a newer libffi isn't done in this patch - - - - - 690c8946 by Sylvain Henry at 2020-12-11T22:42:09-05:00 Parser: move parser utils into their own module Move code unrelated to runtime evaluation out of GHC.Runtime.Eval - - - - - 76be0e32 by Sylvain Henry at 2020-12-11T22:42:48-05:00 Move SizedSeq into ghc-boot - - - - - 3a16d764 by Sylvain Henry at 2020-12-11T22:42:48-05:00 ghci: don't compile unneeded modules - - - - - 2895fa60 by Sylvain Henry at 2020-12-11T22:42:48-05:00 ghci: reuse Arch from ghc-boot - - - - - 480a38d4 by Sylvain Henry at 2020-12-11T22:43:30-05:00 rts: don't use siginterrupt (#19019) - - - - - 4af6126d by Sylvain Henry at 2020-12-11T22:44:11-05:00 Use static array in zeroCount - - - - - 5bd71bfd by Sebastian Graf at 2020-12-12T04:45:09-05:00 DmdAnal: Annotate top-level function bindings with demands (#18894) It's useful to annotate a non-exported top-level function like `g` in ```hs module Lib (h) where g :: Int -> Int -> (Int,Int) g m 1 = (m, 0) g m n = (2 * m, 2 `div` n) {-# NOINLINE g #-} h :: Int -> Int h 1 = 0 h m | odd m = snd (g m 2) | otherwise = uncurry (+) (g 2 m) ``` with its demand `UCU(CS(P(1P(U),SP(U))`, which tells us that whenever `g` was called, the second component of the returned pair was evaluated strictly. Since #18903 we do so for local functions, where we can see all calls. For top-level functions, we can assume that all *exported* functions are demanded according to `topDmd` and thus get sound demands for non-exported top-level functions. The demand on `g` is crucial information for Nested CPR, which may the go on and unbox `g` for the second pair component. That is true even if that pair component may diverge, as is the case for the call site `g 13 0`, which throws a div-by-zero exception. In `T18894b`, you can even see the new demand annotation enabling us to eta-expand a function that we wouldn't be able to eta-expand without Call Arity. We only track bindings of function type in order not to risk huge compile-time regressions, see `isInterestingTopLevelFn`. There was a CoreLint check that rejected strict demand annotations on recursive or top-level bindings, which seems completely unjustified. All the cases I investigated were fine, so I removed it. Fixes #18894. - - - - - 3aae036e by Sebastian Graf at 2020-12-12T04:45:09-05:00 Demand: Simplify `CU(U)` to `U` (#19005) Both sub-demands encode the same information. This is a trivial change and already affects a few regression tests (e.g. `T5075`), so no separate regression test is necessary. - - - - - c6477639 by Adam Sandberg Ericsson at 2020-12-12T04:45:48-05:00 hadrian: correctly copy the docs dir into the bindist #18669 - - - - - e033dd05 by Adam Sandberg Ericsson at 2020-12-12T10:52:19+00:00 mkDocs: support hadrian bindists #18973 - - - - - 78580ba3 by John Ericson at 2020-12-13T07:14:50-05:00 Remove old .travis.yml - - - - - 22b3f5dc by Alan Zimmerman at 2020-12-15T22:02:41+00:00 Proof of Concept implementation of in-tree API Annotations This MR introduces a possible machinery to introduce API Annotations into the TTG extension points. It is intended to be a concrete example for discussion. It still needs to process comments. Remove LHsLocalBinds Fix up after rebasing to bring in XRec Main thing is to make type instance XRec (GhcPass p) a = GenLocated (Anno a) a type family Anno a = b But this has massive implications. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - − .travis.yml - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Expr.hs - + compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Liveness.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/Reg/Graph.hs - compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs - compiler/GHC/CmmToC.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Axiom.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FVs.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/579d487b4b2e82b748fe58b540b6874b89e1a8d0...22b3f5dc2e9ec4747db6ff9d21930360a18f5de4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/579d487b4b2e82b748fe58b540b6874b89e1a8d0...22b3f5dc2e9ec4747db6ff9d21930360a18f5de4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 16 00:46:05 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 15 Dec 2020 19:46:05 -0500 Subject: [Git][ghc/ghc][wip/backports-8.10] 7 commits: Disable deprecation warnings in Cabal build Message-ID: <5fd958cd1cec9_6b217c5d4541753299@gitlab.mail> Ben Gamari pushed to branch wip/backports-8.10 at Glasgow Haskell Compiler / GHC Commits: cda3d088 by Ben Gamari at 2020-12-15T19:41:00-05:00 Disable deprecation warnings in Cabal build - - - - - 2df2f2e7 by Ben Gamari at 2020-12-15T19:41:00-05:00 hadrian: Reindent Settings.Warnings The previous state was quite illegible. - - - - - b5c6ff4e by Ben Gamari at 2020-12-15T19:41:00-05:00 hadrian: Pass -Werror before other arguments Previously we would append -Werror to the argument list. However, this ended up overriding the -Wno-error=... flags in Settings.Warnings. - - - - - 5cb2e21b by Ben Gamari at 2020-12-15T19:41:00-05:00 users guide: Add release notes for 8.10.3 - - - - - 577a4a1c by Ben Gamari at 2020-12-15T19:45:45-05:00 Bump text submodule to 1.2.4.1-rc1 - - - - - 22097134 by Ben Gamari at 2020-12-15T19:45:45-05:00 Update autoconf scripts Scripts taken from autoconf 90b8cb42ba3b244250a6986b8b78c80f30ed197a - - - - - 2652368b by Ben Gamari at 2020-12-15T19:45:45-05:00 configure: Release 8.10.3 - - - - - 9 changed files: - config.guess - config.sub - configure.ac - + docs/users_guide/8.10.3-notes.rst - docs/users_guide/index.rst - hadrian/src/Flavour.hs - hadrian/src/Settings/Warnings.hs - libraries/base/config.guess - libraries/base/config.sub The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e2ed44afc883f8e791184f8037a672b6f06fe7e6...2652368b4e68550b65a00fee827c8a98e7e466c5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e2ed44afc883f8e791184f8037a672b6f06fe7e6...2652368b4e68550b65a00fee827c8a98e7e466c5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 16 01:10:23 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 15 Dec 2020 20:10:23 -0500 Subject: [Git][ghc/ghc][wip/backports-8.10] 8 commits: Fix bad span calculations of post qualified imports Message-ID: <5fd95e7fcc775_6b2167418541753813@gitlab.mail> Ben Gamari pushed to branch wip/backports-8.10 at Glasgow Haskell Compiler / GHC Commits: 0b9d2fe7 by Shayne Fletcher at 2020-12-15T20:10:03-05:00 Fix bad span calculations of post qualified imports (cherry picked from commit 57f3fdb1fbeb82b5b19bc5e2970d8857c2514fcc) - - - - - 572f9c8f by Ben Gamari at 2020-12-15T20:10:05-05:00 gitlab-ci: Rename RELEASE variable to RELEASE_JOB This interfered with the autoconf variable of the same name, breaking pre-release builds. (cherry picked from commit 15dca84793d5ec4ff922726477923e40caa075eb) (cherry picked from commit 3e55edd97c8eba271f5cb64b9362796791e0e887) - - - - - 9d2276f7 by Ben Gamari at 2020-12-15T20:10:05-05:00 Disable deprecation warnings in Cabal build - - - - - 2fca3a1a by Ben Gamari at 2020-12-15T20:10:05-05:00 hadrian: Reindent Settings.Warnings The previous state was quite illegible. - - - - - 015b4b1e by Ben Gamari at 2020-12-15T20:10:05-05:00 hadrian: Pass -Werror before other arguments Previously we would append -Werror to the argument list. However, this ended up overriding the -Wno-error=... flags in Settings.Warnings. - - - - - a7a70ede by Ben Gamari at 2020-12-15T20:10:05-05:00 users guide: Add release notes for 8.10.3 - - - - - 59a4fd2b by Ben Gamari at 2020-12-15T20:10:09-05:00 Update autoconf scripts Scripts taken from autoconf 90b8cb42ba3b244250a6986b8b78c80f30ed197a - - - - - d44a2492 by Ben Gamari at 2020-12-15T20:10:09-05:00 configure: Release 8.10.3 - - - - - 11 changed files: - .gitlab-ci.yml - compiler/parser/Parser.y - config.guess - config.sub - configure.ac - + docs/users_guide/8.10.3-notes.rst - docs/users_guide/index.rst - hadrian/src/Flavour.hs - hadrian/src/Settings/Warnings.hs - libraries/base/config.guess - libraries/base/config.sub The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2652368b4e68550b65a00fee827c8a98e7e466c5...d44a2492eeaa3488d363bfe58b3e136de142ef1d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2652368b4e68550b65a00fee827c8a98e7e466c5...d44a2492eeaa3488d363bfe58b3e136de142ef1d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 16 10:39:36 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Wed, 16 Dec 2020 05:39:36 -0500 Subject: [Git][ghc/ghc][wip/T17656] Kill floatEqualities completely Message-ID: <5fd9e3e8c00ca_6b21725c11c17966a9@gitlab.mail> Simon Peyton Jones pushed to branch wip/T17656 at Glasgow Haskell Compiler / GHC Commits: a27aa100 by Simon Peyton Jones at 2020-12-16T10:38:46+00:00 Kill floatEqualities completely This patch delivers on #17656, by entirel killing off the complex floatEqualities mechanism. Previously, floatEqualities would float an equality out of an implication, so that it could be solved at an outer level. But now we simply do unification in-place, without floating the constraint, relying on level numbers to determine untouchability. There are a number of important new Notes: * GHC.Tc.Utils.Unify Note [Unification preconditions] describes the preconditions for unification, including both skolem-escape and touchability. * GHC.Tc.Solver.Interact Note [Solve by unification] describes what we do when we do unify * GHC.Tc.Solver.Monad Note [The Unification Level Flag] describes how we control solver iteration under this new scheme * GHC.Tc.Solver.Monad Note [Tracking Given equalities] describes how we track when we have Given equalities * GHC.Tc.Types.Constraint Note [HasGivenEqs] is a new explanation of the ic_given_eqs field of an implication A big raft of subtle Notes in Solver, concerning floatEqualities, disappears. Main code changes: * GHC.Tc.Solver.floatEqualities disappears entirely * GHC.Tc.Solver.Monad: new fields in InertCans, inert_given_eq_lvl and inert_given_eq, updated by updateGivenEqs See Note [Tracking Given equalities]. * In exchange for updateGivenEqa, GHC.Tc.Solver.Monad.getHasGivenEqs is much simpler and more efficient * I found I could kill of metaTyVarUpdateOK entirely One test case T14683 showed a 4.5% decrease in compile-time allocation. Other changes were small Metric Decrease: T14683 - - - - - 19 changed files: - compiler/GHC/Runtime/Heap/Inspect.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Interact.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Utils/Unify.hs - testsuite/tests/ghci.debugger/scripts/break012.stdout - testsuite/tests/partial-sigs/should_compile/T10403.stderr - testsuite/tests/partial-sigs/should_compile/T14715.stderr - testsuite/tests/partial-sigs/should_fail/ScopedNamedWildcardsBad.stderr - testsuite/tests/typecheck/should_fail/ExpandSynsFail2.stderr - testsuite/tests/typecheck/should_fail/T7453.stderr Changes: ===================================== compiler/GHC/Runtime/Heap/Inspect.hs ===================================== @@ -577,7 +577,7 @@ newOpenVar = liftTcM (do { kind <- newOpenTypeKind ~~~~~~~~~~~~~~~~~~~~~~ In the GHCi debugger we use unification variables whose MetaInfo is RuntimeUnkTv. The special property of a RuntimeUnkTv is that it can -unify with a polytype (see GHC.Tc.Utils.Unify.metaTyVarUpdateOK). +unify with a polytype (see GHC.Tc.Utils.Unify.checkTypeEq). If we don't do this `:print ` will fail if the type of has nested `forall`s or `=>`s. ===================================== compiler/GHC/Tc/Errors.hs ===================================== @@ -21,7 +21,7 @@ import GHC.Tc.Utils.Monad import GHC.Tc.Types.Constraint import GHC.Core.Predicate import GHC.Tc.Utils.TcMType -import GHC.Tc.Utils.Unify( occCheckForErrors, MetaTyVarUpdateResult(..) ) +import GHC.Tc.Utils.Unify( occCheckForErrors, CheckTyEqResult(..) ) import GHC.Tc.Utils.Env( tcInitTidyEnv ) import GHC.Tc.Utils.TcType import GHC.Tc.Types.Origin @@ -1482,7 +1482,7 @@ mkTyVarEqErr' dflags ctxt report ct tv1 ty2 , report ] - | MTVU_Occurs <- occ_check_expand + | CTE_Occurs <- occ_check_expand -- We report an "occurs check" even for a ~ F t a, where F is a type -- function; it's not insoluble (because in principle F could reduce) -- but we have certainly been unable to solve it @@ -1503,7 +1503,7 @@ mkTyVarEqErr' dflags ctxt report ct tv1 ty2 ; mkErrorMsgFromCt ctxt ct $ mconcat [headline_msg, extra2, extra3, report] } - | MTVU_Bad <- occ_check_expand + | CTE_Bad <- occ_check_expand = do { let msg = vcat [ text "Cannot instantiate unification variable" <+> quotes (ppr tv1) , hang (text "with a" <+> what <+> text "involving polytypes:") 2 (ppr ty2) ] ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -907,7 +907,7 @@ That is the entire point of qlUnify! Wrinkles: * We must not make an occurs-check; we use occCheckExpand for that. -* metaTyVarUpdateOK also checks for various other things, including +* checkTypeEq also checks for various other things, including - foralls, and predicate types (which we want to allow here) - type families (relates to a very specific and exotic performance question, that is unlikely to bite here) ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -311,7 +311,7 @@ Note [Promotion in signatures] If an unsolved metavariable in a signature is not generalized (because we're not generalizing the construct -- e.g., pattern sig -- or because the metavars are constrained -- see kindGeneralizeSome) -we need to promote to maintain (WantedTvInv) of Note [TcLevel and untouchable type variables] +we need to promote to maintain (WantedTvInv) of Note [TcLevel invariants] in GHC.Tc.Utils.TcType. Note that promotion is identical in effect to generalizing and the reinstantiating with a fresh metavariable at the current level. So in some sense, we generalize *all* variables, but then re-instantiate @@ -329,7 +329,7 @@ the pattern signature (which is not kind-generalized). When we are checking the *body* of foo, though, we need to unify the type of x with the argument type of bar. At this point, the ambient TcLevel is 1, and spotting a matavariable with level 2 would violate the (WantedTvInv) invariant of -Note [TcLevel and untouchable type variables]. So, instead of kind-generalizing, +Note [TcLevel invariants]. So, instead of kind-generalizing, we promote the metavariable to level 1. This is all done in kindGeneralizeNone. -} ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -264,7 +264,7 @@ floatKindEqualities wc = float_wc emptyVarSet wc = Nothing -- A short cut /plus/ we must keep track of IC_BadTelescope | otherwise = do { (simples, holes) <- float_wc new_trapping_tvs wanted - ; when (not (isEmptyBag simples) && given_eqs /= NoGivenEqs) $ + ; when (not (isEmptyBag simples) && given_eqs == MaybeGivenEqs) $ Nothing -- If there are some constraints to float out, but we can't -- because we don't float out past local equalities @@ -1282,7 +1282,8 @@ decideMonoTyVars infer_mode name_taus psigs candidates mr_msg ; traceTc "decideMonoTyVars" $ vcat - [ text "mono_tvs0 =" <+> ppr mono_tvs0 + [ text "infer_mode =" <+> ppr infer_mode + , text "mono_tvs0 =" <+> ppr mono_tvs0 , text "no_quant =" <+> ppr no_quant , text "maybe_quant =" <+> ppr maybe_quant , text "eq_constraints =" <+> ppr eq_constraints @@ -1405,7 +1406,10 @@ decideQuantifiedTyVars name_taus psigs candidates dvs_plus = dv { dv_kvs = pick cand_kvs, dv_tvs = pick cand_tvs } ; traceTc "decideQuantifiedTyVars" (vcat - [ text "candidates =" <+> ppr candidates + [ text "tau_tys =" <+> ppr tau_tys + , text "candidates =" <+> ppr candidates + , text "cand_kvs =" <+> ppr cand_kvs + , text "cand_tvs =" <+> ppr cand_tvs , text "tau_tys =" <+> ppr tau_tys , text "seed_tys =" <+> ppr seed_tys , text "seed_tcvs =" <+> ppr (tyCoVarsOfTypes seed_tys) @@ -1660,22 +1664,14 @@ solveWantedsAndDrop wanted solveWanteds :: WantedConstraints -> TcS WantedConstraints -- so that the inert set doesn't mindlessly propagate. -- NB: wc_simples may be wanted /or/ derived now -solveWanteds wc@(WC { wc_simple = simples, wc_impl = implics, wc_holes = holes }) +solveWanteds wc@(WC { wc_holes = holes }) = do { cur_lvl <- TcS.getTcLevel ; traceTcS "solveWanteds {" $ vcat [ text "Level =" <+> ppr cur_lvl , ppr wc ] - ; wc1 <- solveSimpleWanteds simples - -- Any insoluble constraints are in 'simples' and so get rewritten - -- See Note [Rewrite insolubles] in GHC.Tc.Solver.Monad - - ; (floated_eqs, implics2) <- solveNestedImplications $ - implics `unionBags` wc_impl wc1 - - ; dflags <- getDynFlags - ; solved_wc <- simpl_loop 0 (solverIterations dflags) floated_eqs - (wc1 { wc_impl = implics2 }) + ; dflags <- getDynFlags + ; solved_wc <- simplify_loop 0 (solverIterations dflags) True wc ; holes' <- simplifyHoles holes ; let final_wc = solved_wc { wc_holes = holes' } @@ -1688,9 +1684,44 @@ solveWanteds wc@(WC { wc_simple = simples, wc_impl = implics, wc_holes = holes } ; return final_wc } -simpl_loop :: Int -> IntWithInf -> Cts - -> WantedConstraints -> TcS WantedConstraints -simpl_loop n limit floated_eqs wc@(WC { wc_simple = simples }) +simplify_loop :: Int -> IntWithInf -> Bool + -> WantedConstraints -> TcS WantedConstraints +-- Do a round of solving, and call maybe_simplify_again to iterate +-- The 'definitely_redo_implications' flags is False if the only reason we +-- are iterating is that we have added some new Derived superclasses (from Wanteds) +-- hoping for fundeps to help us; see Note [Superclass iteration] +-- +-- Does not affect wc_holes at all; reason: wc_holes never affects anything +-- else, so we do them once, at the end in solveWanteds +simplify_loop n limit definitely_redo_implications + wc@(WC { wc_simple = simples, wc_impl = implics }) + = do { csTraceTcS $ + text "simplify_loop iteration=" <> int n + <+> (parens $ hsep [ text "definitely_redo =" <+> ppr definitely_redo_implications <> comma + , int (lengthBag simples) <+> text "simples to solve" ]) + ; traceTcS "simplify_loop: wc =" (ppr wc) + + ; (unifs1, wc1) <- reportUnifications $ -- See Note [Superclass iteration] + solveSimpleWanteds simples + -- Any insoluble constraints are in 'simples' and so get rewritten + -- See Note [Rewrite insolubles] in GHC.Tc.Solver.Monad + + ; wc2 <- if not definitely_redo_implications -- See Note [Superclass iteration] + && unifs1 == 0 -- for this conditional + && isEmptyBag (wc_impl wc1) + then return (wc { wc_simple = wc_simple wc1 }) -- Short cut + else do { implics2 <- solveNestedImplications $ + implics `unionBags` (wc_impl wc1) + ; return (wc { wc_simple = wc_simple wc1 + , wc_impl = implics2 }) } + + ; unif_happened <- resetUnificationFlag + -- Note [The Unification Level Flag] in GHC.Tc.Solver.Monad + ; maybe_simplify_again (n+1) limit unif_happened wc2 } + +maybe_simplify_again :: Int -> IntWithInf -> Bool + -> WantedConstraints -> TcS WantedConstraints +maybe_simplify_again n limit unif_happened wc@(WC { wc_simple = simples }) | n `intGtLimit` limit = do { -- Add an error (not a warning) if we blow the limit, -- Typically if we blow the limit we are going to report some other error @@ -1699,17 +1730,12 @@ simpl_loop n limit floated_eqs wc@(WC { wc_simple = simples }) addErrTcS (hang (text "solveWanteds: too many iterations" <+> parens (text "limit =" <+> ppr limit)) 2 (vcat [ text "Unsolved:" <+> ppr wc - , ppUnless (isEmptyBag floated_eqs) $ - text "Floated equalities:" <+> ppr floated_eqs , text "Set limit with -fconstraint-solver-iterations=n; n=0 for no limit" ])) ; return wc } - | not (isEmptyBag floated_eqs) - = simplify_again n limit True (wc { wc_simple = floated_eqs `unionBags` simples }) - -- Put floated_eqs first so they get solved first - -- NB: the floated_eqs may include /derived/ equalities - -- arising from fundeps inside an implication + | unif_happened + = simplify_loop n limit True wc | superClassesMightHelp wc = -- We still have unsolved goals, and apparently no way to solve them, @@ -1722,82 +1748,65 @@ simpl_loop n limit floated_eqs wc@(WC { wc_simple = simples }) do { new_given <- makeSuperClasses pending_given ; new_wanted <- makeSuperClasses pending_wanted ; solveSimpleGivens new_given -- Add the new Givens to the inert set - ; simplify_again n limit (null pending_given) + ; simplify_loop n limit (not (null pending_given)) $ wc { wc_simple = simples1 `unionBags` listToBag new_wanted } } } + -- (not (null pending_given)): see Note [Superclass iteration] | otherwise = return wc -simplify_again :: Int -> IntWithInf -> Bool - -> WantedConstraints -> TcS WantedConstraints --- We have definitely decided to have another go at solving --- the wanted constraints (we have tried at least once already -simplify_again n limit no_new_given_scs - wc@(WC { wc_simple = simples, wc_impl = implics }) - = do { csTraceTcS $ - text "simpl_loop iteration=" <> int n - <+> (parens $ hsep [ text "no new given superclasses =" <+> ppr no_new_given_scs <> comma - , int (lengthBag simples) <+> text "simples to solve" ]) - ; traceTcS "simpl_loop: wc =" (ppr wc) - - ; (unifs1, wc1) <- reportUnifications $ - solveSimpleWanteds $ - simples - - -- See Note [Cutting off simpl_loop] - -- We have already tried to solve the nested implications once - -- Try again only if we have unified some meta-variables - -- (which is a bit like adding more givens), or we have some - -- new Given superclasses - ; let new_implics = wc_impl wc1 - ; if unifs1 == 0 && - no_new_given_scs && - isEmptyBag new_implics - - then -- Do not even try to solve the implications - simpl_loop (n+1) limit emptyBag (wc1 { wc_impl = implics }) - - else -- Try to solve the implications - do { (floated_eqs2, implics2) <- solveNestedImplications $ - implics `unionBags` new_implics - ; simpl_loop (n+1) limit floated_eqs2 (wc1 { wc_impl = implics2 }) - } } +{- Note [Superclass iteration] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider this implication constraint + forall a. + [W] d: C Int beta + forall b. blah +where + class D a b | a -> b + class D a b => C a b +We will expand d's superclasses, giving [D] D Int beta, in the hope of geting +fundeps to unify beta. Doing so is usually fruitless (no useful fundeps), +and if so it seems a pity to waste time iterating the implications (forall b. blah) +(If we add new Given superclasses it's a different matter: it's really worth looking +at the implications.) + +Hence the definitely_redo_implications flag to simplify_loop. It's usually +True, but False in the case where the only reason to iterate is new Derived +superclasses. In that case we check whether the new Deriveds actually led to +any new unifications, and iterate the implications only if so. +-} solveNestedImplications :: Bag Implication - -> TcS (Cts, Bag Implication) + -> TcS (Bag Implication) -- Precondition: the TcS inerts may contain unsolved simples which have -- to be converted to givens before we go inside a nested implication. solveNestedImplications implics | isEmptyBag implics - = return (emptyBag, emptyBag) + = return (emptyBag) | otherwise = do { traceTcS "solveNestedImplications starting {" empty - ; (floated_eqs_s, unsolved_implics) <- mapAndUnzipBagM solveImplication implics - ; let floated_eqs = concatBag floated_eqs_s + ; unsolved_implics <- mapBagM solveImplication implics -- ... and we are back in the original TcS inerts -- Notice that the original includes the _insoluble_simples so it was safe to ignore -- them in the beginning of this function. ; traceTcS "solveNestedImplications end }" $ - vcat [ text "all floated_eqs =" <+> ppr floated_eqs - , text "unsolved_implics =" <+> ppr unsolved_implics ] + vcat [ text "unsolved_implics =" <+> ppr unsolved_implics ] - ; return (floated_eqs, catBagMaybes unsolved_implics) } + ; return (catBagMaybes unsolved_implics) } solveImplication :: Implication -- Wanted - -> TcS (Cts, -- All wanted or derived floated equalities: var = type - Maybe Implication) -- Simplified implication (empty or singleton) + -> TcS (Maybe Implication) -- Simplified implication (empty or singleton) -- Precondition: The TcS monad contains an empty worklist and given-only inerts -- which after trying to solve this implication we must restore to their original value solveImplication imp@(Implic { ic_tclvl = tclvl , ic_binds = ev_binds_var - , ic_skols = skols , ic_given = given_ids , ic_wanted = wanteds , ic_info = info , ic_status = status }) | isSolvedStatus status - = return (emptyCts, Just imp) -- Do nothing + = return (Just imp) -- Do nothing | otherwise -- Even for IC_Insoluble it is worth doing more work -- The insoluble stuff might be in one sub-implication @@ -1819,7 +1828,7 @@ solveImplication imp@(Implic { ic_tclvl = tclvl ; residual_wanted <- solveWanteds wanteds -- solveWanteds, *not* solveWantedsAndDrop, because -- we want to retain derived equalities so we can float - -- them out in floatEqualities + -- them out in floatEqualities. ; (has_eqs, given_insols) <- getHasGivenEqs tclvl -- Call getHasGivenEqs /after/ solveWanteds, because @@ -1828,10 +1837,6 @@ solveImplication imp@(Implic { ic_tclvl = tclvl ; return (has_eqs, given_insols, residual_wanted) } - ; (floated_eqs, residual_wanted) - <- floatEqualities skols given_ids ev_binds_var - has_given_eqs residual_wanted - ; traceTcS "solveImplication 2" (ppr given_insols $$ ppr residual_wanted) ; let final_wanted = residual_wanted `addInsols` given_insols @@ -1845,15 +1850,14 @@ solveImplication imp@(Implic { ic_tclvl = tclvl ; tcvs <- TcS.getTcEvTyCoVars ev_binds_var ; traceTcS "solveImplication end }" $ vcat [ text "has_given_eqs =" <+> ppr has_given_eqs - , text "floated_eqs =" <+> ppr floated_eqs , text "res_implic =" <+> ppr res_implic , text "implication evbinds =" <+> ppr (evBindMapBinds evbinds) , text "implication tvcs =" <+> ppr tcvs ] - ; return (floated_eqs, res_implic) } + ; return res_implic } -- TcLevels must be strictly increasing (see (ImplicInv) in - -- Note [TcLevel and untouchable type variables] in GHC.Tc.Utils.TcType), + -- Note [TcLevel invariants] in GHC.Tc.Utils.TcType), -- and in fact I think they should always increase one level at a time. -- Though sensible, this check causes lots of testsuite failures. It is @@ -2237,49 +2241,8 @@ Consider (see #9939) We report (Eq a) as redundant, whereas actually (Ord a) is. But it's really not easy to detect that! - -Note [Cutting off simpl_loop] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -It is very important not to iterate in simpl_loop unless there is a chance -of progress. #8474 is a classic example: - - * There's a deeply-nested chain of implication constraints. - ?x:alpha => ?y1:beta1 => ... ?yn:betan => [W] ?x:Int - - * From the innermost one we get a [D] alpha ~ Int, - but alpha is untouchable until we get out to the outermost one - - * We float [D] alpha~Int out (it is in floated_eqs), but since alpha - is untouchable, the solveInteract in simpl_loop makes no progress - - * So there is no point in attempting to re-solve - ?yn:betan => [W] ?x:Int - via solveNestedImplications, because we'll just get the - same [D] again - - * If we *do* re-solve, we'll get an infinite loop. It is cut off by - the fixed bound of 10, but solving the next takes 10*10*...*10 (ie - exponentially many) iterations! - -Conclusion: we should call solveNestedImplications only if we did -some unification in solveSimpleWanteds; because that's the only way -we'll get more Givens (a unification is like adding a Given) to -allow the implication to make progress. -} -promoteTyVarTcS :: TcTyVar -> TcS () --- When we float a constraint out of an implication we must restore --- invariant (WantedInv) in Note [TcLevel and untouchable type variables] in GHC.Tc.Utils.TcType --- See Note [Promoting unification variables] --- We don't just call promoteTyVar because we want to use unifyTyVar, --- not writeMetaTyVar -promoteTyVarTcS tv - = do { tclvl <- TcS.getTcLevel - ; when (isFloatedTouchableMetaTyVar tclvl tv) $ - do { cloned_tv <- TcS.cloneMetaTyVar tv - ; let rhs_tv = setMetaTyVarTcLevel cloned_tv tclvl - ; unifyTyVar tv (mkTyVarTy rhs_tv) } } - -- | Like 'defaultTyVar', but in the TcS monad. defaultTyVarTcS :: TcTyVar -> TcS Bool defaultTyVarTcS the_tv @@ -2314,7 +2277,7 @@ approximateWC float_past_equalities wc concatMapBag (float_implic trapping_tvs) implics float_implic :: TcTyCoVarSet -> Implication -> Cts float_implic trapping_tvs imp - | float_past_equalities || ic_given_eqs imp == NoGivenEqs + | float_past_equalities || ic_given_eqs imp /= MaybeGivenEqs = float_wc new_trapping_tvs (ic_wanted imp) | otherwise -- Take care with equalities = emptyCts -- See (1) under Note [ApproximateWC] @@ -2414,7 +2377,7 @@ approximateWC to produce a list of candidate constraints. Then we MUST a) Promote any meta-tyvars that have been floated out by approximateWC, to restore invariant (WantedInv) described in - Note [TcLevel and untouchable type variables] in GHC.Tc.Utils.TcType. + Note [TcLevel invariants] in GHC.Tc.Utils.TcType. b) Default the kind of any meta-tyvars that are not mentioned in in the environment. @@ -2430,8 +2393,7 @@ Note [Promoting unification variables] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When we float an equality out of an implication we must "promote" free unification variables of the equality, in order to maintain Invariant -(WantedInv) from Note [TcLevel and untouchable type variables] in -TcType. for the leftover implication. +(WantedInv) from Note [TcLevel invariants] in GHC.Tc.Types.TcType. This is absolutely necessary. Consider the following example. We start with two implications and a class with a functional dependency. @@ -2468,276 +2430,6 @@ beta! Concrete example is in indexed_types/should_fail/ExtraTcsUntch.hs: in (g1 '3', g2 undefined) - -********************************************************************************* -* * -* Floating equalities * -* * -********************************************************************************* - -Note [Float Equalities out of Implications] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -For ordinary pattern matches (including existentials) we float -equalities out of implications, for instance: - data T where - MkT :: Eq a => a -> T - f x y = case x of MkT _ -> (y::Int) -We get the implication constraint (x::T) (y::alpha): - forall a. [untouchable=alpha] Eq a => alpha ~ Int -We want to float out the equality into a scope where alpha is no -longer untouchable, to solve the implication! - -But we cannot float equalities out of implications whose givens may -yield or contain equalities: - - data T a where - T1 :: T Int - T2 :: T Bool - T3 :: T a - - h :: T a -> a -> Int - - f x y = case x of - T1 -> y::Int - T2 -> y::Bool - T3 -> h x y - -We generate constraint, for (x::T alpha) and (y :: beta): - [untouchables = beta] (alpha ~ Int => beta ~ Int) -- From 1st branch - [untouchables = beta] (alpha ~ Bool => beta ~ Bool) -- From 2nd branch - (alpha ~ beta) -- From 3rd branch - -If we float the equality (beta ~ Int) outside of the first implication and -the equality (beta ~ Bool) out of the second we get an insoluble constraint. -But if we just leave them inside the implications, we unify alpha := beta and -solve everything. - -Principle: - We do not want to float equalities out which may - need the given *evidence* to become soluble. - -Consequence: classes with functional dependencies don't matter (since there is -no evidence for a fundep equality), but equality superclasses do matter (since -they carry evidence). --} - -floatEqualities :: [TcTyVar] -> [EvId] -> EvBindsVar -> HasGivenEqs - -> WantedConstraints - -> TcS (Cts, WantedConstraints) --- Main idea: see Note [Float Equalities out of Implications] --- --- Precondition: the wc_simple of the incoming WantedConstraints are --- fully zonked, so that we can see their free variables --- --- Postcondition: The returned floated constraints (Cts) are only --- Wanted or Derived --- --- Also performs some unifications (via promoteTyVar), adding to --- monadically-carried ty_binds. These will be used when processing --- floated_eqs later --- --- Subtleties: Note [Float equalities from under a skolem binding] --- Note [Skolem escape] --- Note [What prevents a constraint from floating] -floatEqualities skols given_ids ev_binds_var has_given_eqs - wanteds@(WC { wc_simple = simples }) - | MaybeGivenEqs <- has_given_eqs -- There are some given equalities, so don't float - = return (emptyBag, wanteds) -- Note [Float Equalities out of Implications] - - | otherwise - = do { -- First zonk: the inert set (from whence they came) is not - -- necessarily fully zonked; equalities are not kicked out - -- if a unification cannot make progress. See Note - -- [inert_eqs: the inert equalities] in GHC.Tc.Solver.Monad, which - -- describes how the inert set might not actually be inert. - simples <- TcS.zonkSimples simples - ; binds <- TcS.getTcEvBindsMap ev_binds_var - - -- Now we can pick the ones to float - -- The constraints are de-canonicalised - ; let (candidate_eqs, no_float_cts) = partitionBag is_float_eq_candidate simples - - seed_skols = mkVarSet skols `unionVarSet` - mkVarSet given_ids `unionVarSet` - foldr add_non_flt_ct emptyVarSet no_float_cts `unionVarSet` - evBindMapToVarSet binds - -- seed_skols: See Note [What prevents a constraint from floating] (1,2,3) - -- Include the EvIds of any non-floating constraints - - extended_skols = transCloVarSet (add_captured_ev_ids candidate_eqs) seed_skols - -- extended_skols contains the EvIds of all the trapped constraints - -- See Note [What prevents a constraint from floating] (3) - - (flt_eqs, no_flt_eqs) = partitionBag (is_floatable extended_skols) - candidate_eqs - - remaining_simples = no_float_cts `andCts` no_flt_eqs - - -- Promote any unification variables mentioned in the floated equalities - -- See Note [Promoting unification variables] - ; mapM_ promoteTyVarTcS (tyCoVarsOfCtsList flt_eqs) - - ; traceTcS "floatEqualities" (vcat [ text "Skols =" <+> ppr skols - , text "Extended skols =" <+> ppr extended_skols - , text "Simples =" <+> ppr simples - , text "Candidate eqs =" <+> ppr candidate_eqs - , text "Floated eqs =" <+> ppr flt_eqs]) - ; return ( flt_eqs, wanteds { wc_simple = remaining_simples } ) } - - where - add_non_flt_ct :: Ct -> VarSet -> VarSet - add_non_flt_ct ct acc | isDerivedCt ct = acc - | otherwise = extendVarSet acc (ctEvId ct) - - is_floatable :: VarSet -> Ct -> Bool - is_floatable skols ct - | isDerivedCt ct = tyCoVarsOfCt ct `disjointVarSet` skols - | otherwise = not (ctEvId ct `elemVarSet` skols) - - add_captured_ev_ids :: Cts -> VarSet -> VarSet - add_captured_ev_ids cts skols = foldr extra_skol emptyVarSet cts - where - extra_skol ct acc - | isDerivedCt ct = acc - | tyCoVarsOfCt ct `intersectsVarSet` skols = extendVarSet acc (ctEvId ct) - | otherwise = acc - - -- Identify which equalities are candidates for floating - -- Float out alpha ~ ty which might be unified outside - -- See Note [Which equalities to float] - is_float_eq_candidate ct - | pred <- ctPred ct - , EqPred NomEq ty1 ty2 <- classifyPredType pred - , case ct of - CIrredCan {} -> False -- See Note [Do not float blocked constraints] - _ -> True -- See #18855 - = float_eq ty1 ty2 || float_eq ty2 ty1 - | otherwise - = False - - float_eq ty1 ty2 - = case getTyVar_maybe ty1 of - Just tv1 -> isMetaTyVar tv1 - && (not (isTyVarTyVar tv1) || isTyVarTy ty2) - Nothing -> False - -{- Note [Do not float blocked constraints] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -As #18855 showed, we must not float an equality that is blocked. -Consider - forall a[4]. [W] co1: alpha[4] ~ Maybe (a[4] |> bco) - [W] co2: alpha[4] ~ Maybe (beta[4] |> bco]) - [W] bco: kappa[2] ~ Type - -Now co1, co2 are blocked by bco. We will eventually float out bco -and solve it at level 2. But the danger is that we will *also* -float out co2, and that is bad bad bad. Because we'll promote alpha -and beta to level 2, and then fail to unify the promoted beta -with the skolem a[4]. - -Solution: don't float out blocked equalities. Remember: we only want -to float out if we can solve; see Note [Which equalities to float]. - -(Future plan: kill floating altogether.) - -Note [Float equalities from under a skolem binding] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Which of the simple equalities can we float out? Obviously, only -ones that don't mention the skolem-bound variables. But that is -over-eager. Consider - [2] forall a. F a beta[1] ~ gamma[2], G beta[1] gamma[2] ~ Int -The second constraint doesn't mention 'a'. But if we float it, -we'll promote gamma[2] to gamma'[1]. Now suppose that we learn that -beta := Bool, and F a Bool = a, and G Bool _ = Int. Then we'll -we left with the constraint - [2] forall a. a ~ gamma'[1] -which is insoluble because gamma became untouchable. - -Solution: float only constraints that stand a jolly good chance of -being soluble simply by being floated, namely ones of form - a ~ ty -where 'a' is a currently-untouchable unification variable, but may -become touchable by being floated (perhaps by more than one level). - -We had a very complicated rule previously, but this is nice and -simple. (To see the notes, look at this Note in a version of -GHC.Tc.Solver prior to Oct 2014). - -Note [Which equalities to float] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Which equalities should we float? We want to float ones where there -is a decent chance that floating outwards will allow unification to -happen. In particular, float out equalities that are: - -* Of form (alpha ~# ty) or (ty ~# alpha), where - * alpha is a meta-tyvar. - * And 'alpha' is not a TyVarTv with 'ty' being a non-tyvar. In that - case, floating out won't help either, and it may affect grouping - of error messages. - - NB: generally we won't see (ty ~ alpha), with alpha on the right because - of Note [Unification variables on the left] in GHC.Tc.Utils.Unify, - but if we have (F tys ~ alpha) and alpha is untouchable, then it will - appear on the right. Example T4494. - -* Nominal. No point in floating (alpha ~R# ty), because we do not - unify representational equalities even if alpha is touchable. - See Note [Do not unify representational equalities] in GHC.Tc.Solver.Interact. - -Note [Skolem escape] -~~~~~~~~~~~~~~~~~~~~ -You might worry about skolem escape with all this floating. -For example, consider - [2] forall a. (a ~ F beta[2] delta, - Maybe beta[2] ~ gamma[1]) - -The (Maybe beta ~ gamma) doesn't mention 'a', so we float it, and -solve with gamma := beta. But what if later delta:=Int, and - F b Int = b. -Then we'd get a ~ beta[2], and solve to get beta:=a, and now the -skolem has escaped! - -But it's ok: when we float (Maybe beta[2] ~ gamma[1]), we promote beta[2] -to beta[1], and that means the (a ~ beta[1]) will be stuck, as it should be. - -Note [What prevents a constraint from floating] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -What /prevents/ a constraint from floating? If it mentions one of the -"bound variables of the implication". What are they? - -The "bound variables of the implication" are - - 1. The skolem type variables `ic_skols` - - 2. The "given" evidence variables `ic_given`. Example: - forall a. (co :: t1 ~# t2) => [W] co2 : (a ~# b |> co) - Here 'co' is bound - - 3. The binders of all evidence bindings in `ic_binds`. Example - forall a. (d :: t1 ~ t2) - EvBinds { (co :: t1 ~# t2) = superclass-sel d } - => [W] co2 : (a ~# b |> co) - Here `co` is gotten by superclass selection from `d`, and the - wanted constraint co2 must not float. - - 4. And the evidence variable of any equality constraint (incl - Wanted ones) whose type mentions a bound variable. Example: - forall k. [W] co1 :: t1 ~# t2 |> co2 - [W] co2 :: k ~# * - Here, since `k` is bound, so is `co2` and hence so is `co1`. - -Here (1,2,3) are handled by the "seed_skols" calculation, and -(4) is done by the transCloVarSet call. - -The possible dependence on givens, and evidence bindings, is more -subtle than we'd realised at first. See #14584. - -How can (4) arise? Suppose we have (k :: *), (a :: k), and ([G} k ~ *). -Then form an equality like (a ~ Int) we might end up with - [W] co1 :: k ~ * - [W] co2 :: (a |> co1) ~ Int - - ********************************************************************************* * * * Defaulting and disambiguation * ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -4,9 +4,9 @@ module GHC.Tc.Solver.Canonical( canonicalize, - unifyDerived, + unifyDerived, unifyTest, UnifyTestResult(..), makeSuperClasses, - StopOrContinue(..), stopWith, continueWith, + StopOrContinue(..), stopWith, continueWith, andWhenContinue, solveCallStack -- For GHC.Tc.Solver ) where @@ -51,7 +51,8 @@ import GHC.Data.Bag import GHC.Utils.Monad import Control.Monad import Data.Maybe ( isJust, isNothing ) -import Data.List ( zip4 ) +import Data.List ( zip4, partition ) +import GHC.Types.Unique.Set( nonDetEltsUniqSet ) import GHC.Types.Basic import Data.Bifunctor ( bimap ) @@ -2241,10 +2242,10 @@ canEqCanLHS2 ev eq_rel swapped lhs1 ps_xi1 lhs2 ps_xi2 mco -- If we have F a ~ F (F a), we want to swap. swap_for_occurs - | MTVU_OK () <- checkTyFamEq dflags fun_tc2 fun_args2 - (mkTyConApp fun_tc1 fun_args1) - , MTVU_Occurs <- checkTyFamEq dflags fun_tc1 fun_args1 - (mkTyConApp fun_tc2 fun_args2) + | CTE_OK <- checkTyFamEq dflags fun_tc2 fun_args2 + (mkTyConApp fun_tc1 fun_args1) + , CTE_Occurs <- checkTyFamEq dflags fun_tc1 fun_args1 + (mkTyConApp fun_tc2 fun_args2) = True | otherwise @@ -2269,8 +2270,8 @@ canEqCanLHS2 ev eq_rel swapped lhs1 ps_xi1 lhs2 ps_xi2 mco -- This function handles the case where one side is a tyvar and the other is -- a type family application. Which to put on the left? --- If we can unify the variable, put it on the left, as this may be our only --- shot to unify. +-- If the tyvar is a touchable meta-tyvar, put it on the left, as this may +-- be our only shot to unify. -- Otherwise, put the function on the left, because it's generally better to -- rewrite away function calls. This makes types smaller. And it seems necessary: -- [W] F alpha ~ alpha @@ -2278,22 +2279,20 @@ canEqCanLHS2 ev eq_rel swapped lhs1 ps_xi1 lhs2 ps_xi2 mco -- [W] G alpha beta ~ Int ( where we have type instance G a a = a ) -- If we end up with a stuck alpha ~ F alpha, we won't be able to solve this. -- Test case: indexed-types/should_compile/CEqCanOccursCheck --- It would probably work to always put the variable on the left, but we think --- it would be less efficient. canEqTyVarFunEq :: CtEvidence -- :: lhs ~ (rhs |> mco) -- or (rhs |> mco) ~ lhs if swapped -> EqRel -> SwapFlag - -> TyVar -> TcType -- lhs, pretty lhs - -> TyCon -> [Xi] -> TcType -- rhs fun, rhs args, pretty rhs + -> TyVar -> TcType -- lhs (or if swapped rhs), pretty lhs + -> TyCon -> [Xi] -> TcType -- rhs (or if swapped lhs) fun and args, pretty rhs -> MCoercion -- :: kind(rhs) ~N kind(lhs) -> TcS (StopOrContinue Ct) canEqTyVarFunEq ev eq_rel swapped tv1 ps_xi1 fun_tc2 fun_args2 ps_xi2 mco - = do { tclvl <- getTcLevel - ; dflags <- getDynFlags - ; if | isTouchableMetaTyVar tclvl tv1 - , MTVU_OK _ <- checkTyVarEq dflags YesTypeFamilies tv1 (ps_xi2 `mkCastTyMCo` mco) - -> canEqCanLHSFinish ev eq_rel swapped (TyVarLHS tv1) - (ps_xi2 `mkCastTyMCo` mco) + = do { can_unify <- unifyTest ev tv1 rhs + ; dflags <- getDynFlags + ; if | case can_unify of { NoUnify -> False; _ -> True } + , CTE_OK <- checkTyVarEq dflags YesTypeFamilies tv1 rhs + -> canEqCanLHSFinish ev eq_rel swapped (TyVarLHS tv1) rhs + | otherwise -> do { new_ev <- rewriteCastedEquality ev eq_rel swapped (mkTyVarTy tv1) (mkTyConApp fun_tc2 fun_args2) @@ -2303,6 +2302,56 @@ canEqTyVarFunEq ev eq_rel swapped tv1 ps_xi1 fun_tc2 fun_args2 ps_xi2 mco (ps_xi1 `mkCastTyMCo` sym_mco) } } where sym_mco = mkTcSymMCo mco + rhs = ps_xi2 `mkCastTyMCo` mco + +data UnifyTestResult + -- See Note [Solve by unification] in GHC.Tc.Solver.Interact + -- which points out that having UnifySameLevel is just an optimisation; + -- we could manage with UnifyOuterLevel alone (suitably renamed) + = UnifySameLevel + | UnifyOuterLevel [TcTyVar] -- Promote these + TcLevel -- ..to this level + | NoUnify + +instance Outputable UnifyTestResult where + ppr UnifySameLevel = text "UnifySameLevel" + ppr (UnifyOuterLevel tvs lvl) = text "UnifyOuterLevel" <> parens (ppr lvl <+> ppr tvs) + ppr NoUnify = text "NoUnify" + +unifyTest :: CtEvidence -> TcTyVar -> TcType -> TcS UnifyTestResult +-- This is the key test for untouchability: +-- See Note [Unification preconditions] in GHC.Tc.Utils.Unify +-- and Note [Solve by unification] in GHC.Tc.Solver.Interact +unifyTest _ev tv1 rhs + | -- The _ev is because I'd like to test not (isGivenEv), because + -- we never unify in a Given, but that's not quite true yet: #18929 + MetaTv { mtv_tclvl = tv_lvl, mtv_info = info } <- tcTyVarDetails tv1 + , canSolveByUnification info rhs + = do { ambient_lvl <- getTcLevel + ; given_eq_lvl <- getInnermostGivenEqLevel + + ; if | tv_lvl `sameDepthAs` ambient_lvl + -> return UnifySameLevel + + | tv_lvl `deeperThanOrSame` given_eq_lvl -- No intervening given equalities + , all (does_not_escape tv_lvl) free_skols -- No skolem escapes + -> return (UnifyOuterLevel free_metas tv_lvl) + + | otherwise + -> return NoUnify } + | otherwise + = return NoUnify + where + (free_metas, free_skols) = partition isPromotableMetaTyVar $ + filter isTyVar $ + nonDetEltsUniqSet $ + tyCoVarsOfType rhs + -- filter isTyVar: coercion variables are not an escape risk + -- If an implication binds a coercion variable, it'll have equalities, + -- so the "intervening given equalities" test above will catch it + -- Coercion holes get filled with coercions, so again no problem. + + does_not_escape tv_lvl fv = tv_lvl `deeperThanOrSame` tcTyVarLevel fv -- The RHS here is either not CanEqLHS, or it's one that we -- want to rewrite the LHS to (as per e.g. swapOverTyVars) @@ -2422,11 +2471,11 @@ canEqOK :: DynFlags -> EqRel -> CanEqLHS -> Xi -> CanEqOK canEqOK dflags eq_rel lhs rhs = ASSERT( good_rhs ) case checkTypeEq dflags YesTypeFamilies lhs rhs of - MTVU_OK () -> CanEqOK - MTVU_Bad -> CanEqNotOK OtherCIS + CTE_OK -> CanEqOK + CTE_Bad -> CanEqNotOK OtherCIS -- Violation of TyEq:F - MTVU_HoleBlocker -> CanEqNotOK (BlockedCIS holes) + CTE_HoleBlocker -> CanEqNotOK (BlockedCIS holes) where holes = coercionHolesOfType rhs -- This is the case detailed in -- Note [Equalities with incompatible kinds] @@ -2435,7 +2484,7 @@ canEqOK dflags eq_rel lhs rhs -- These are both a violation of TyEq:OC, but we -- want to differentiate for better production of -- error messages - MTVU_Occurs | TyVarLHS tv <- lhs + CTE_Occurs | TyVarLHS tv <- lhs , isInsolubleOccursCheck eq_rel tv rhs -> CanEqNotOK InsolubleCIS -- If we have a ~ [a], it is not canonical, and in particular -- we don't want to rewrite existing inerts with it, otherwise ===================================== compiler/GHC/Tc/Solver/Interact.hs ===================================== @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP, MultiWayIf #-} {-# OPTIONS_GHC -Wno-incomplete-record-updates #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} @@ -14,7 +14,6 @@ import GHC.Prelude import GHC.Types.Basic ( SwapFlag(..), infinity, IntWithInf, intGtLimit ) import GHC.Tc.Solver.Canonical -import GHC.Tc.Utils.Unify( canSolveByUnification ) import GHC.Types.Var.Set import GHC.Core.Type as Type import GHC.Core.InstEnv ( DFunInstType ) @@ -39,6 +38,7 @@ import GHC.Tc.Types import GHC.Tc.Types.Constraint import GHC.Core.Predicate import GHC.Tc.Types.Origin +import GHC.Tc.Utils.TcMType( promoteTyVarTo ) import GHC.Tc.Solver.Monad import GHC.Data.Bag import GHC.Utils.Monad ( concatMapM, foldlM ) @@ -430,12 +430,11 @@ interactWithInertsStage :: WorkItem -> TcS (StopOrContinue Ct) interactWithInertsStage wi = do { inerts <- getTcSInerts - ; lvl <- getTcLevel ; let ics = inert_cans inerts ; case wi of - CEqCan {} -> interactEq lvl ics wi - CIrredCan {} -> interactIrred ics wi - CDictCan {} -> interactDict ics wi + CEqCan {} -> interactEq ics wi + CIrredCan {} -> interactIrred ics wi + CDictCan {} -> interactDict ics wi _ -> pprPanic "interactWithInerts" (ppr wi) } -- CNonCanonical have been canonicalised @@ -1439,8 +1438,8 @@ inertsCanDischarge inerts lhs rhs fr | otherwise = False -- Work item is fully discharged -interactEq :: TcLevel -> InertCans -> Ct -> TcS (StopOrContinue Ct) -interactEq tclvl inerts workItem@(CEqCan { cc_lhs = lhs +interactEq :: InertCans -> Ct -> TcS (StopOrContinue Ct) +interactEq inerts workItem@(CEqCan { cc_lhs = lhs , cc_rhs = rhs , cc_ev = ev , cc_eq_rel = eq_rel }) @@ -1465,24 +1464,43 @@ interactEq tclvl inerts workItem@(CEqCan { cc_lhs = lhs = do { traceTcS "Not unifying representational equality" (ppr workItem) ; continueWith workItem } - -- try improvement, if possible - | TyFamLHS fam_tc fam_args <- lhs - , isImprovable ev - = do { improveLocalFunEqs ev inerts fam_tc fam_args rhs - ; continueWith workItem } - - | TyVarLHS tv <- lhs - , canSolveByUnification tclvl tv rhs - = do { solveByUnification ev tv rhs - ; n_kicked <- kickOutAfterUnification tv - ; return (Stop ev (text "Solved by unification" <+> pprKicked n_kicked)) } - | otherwise - = continueWith workItem - -interactEq _ _ wi = pprPanic "interactEq" (ppr wi) - -solveByUnification :: CtEvidence -> TcTyVar -> Xi -> TcS () + = case lhs of + TyVarLHS tv -> tryToSolveByUnification workItem ev tv rhs + + TyFamLHS tc args -> do { when (isImprovable ev) $ + -- Try improvement, if possible + improveLocalFunEqs ev inerts tc args rhs + ; continueWith workItem } + +interactEq _ wi = pprPanic "interactEq" (ppr wi) + +---------------------- +-- We have a meta-tyvar on the left, and metaTyVarUpateOK has said "yes" +-- So try to solve by unifying. +-- Three reasons why not: +-- Skolem escape +-- Given equalities (GADTs) +-- Unifying a TyVarTv with a non-tyvar type +tryToSolveByUnification :: Ct -> CtEvidence + -> TcTyVar -- LHS tyvar + -> TcType -- RHS + -> TcS (StopOrContinue Ct) +tryToSolveByUnification work_item ev tv rhs + = do { can_unify <- unifyTest ev tv rhs + ; traceTcS "tryToSolveByUnification" (vcat [ ppr tv <+> char '~' <+> ppr rhs + , ppr can_unify ]) + + ; case can_unify of + NoUnify -> continueWith work_item + -- For the latter two cases see Note [Solve by unification] + UnifySameLevel -> solveByUnification ev tv rhs + UnifyOuterLevel free_metas tv_lvl + -> do { wrapTcS $ mapM_ (promoteTyVarTo tv_lvl) free_metas + ; setUnificationFlag tv_lvl + ; solveByUnification ev tv rhs } } + +solveByUnification :: CtEvidence -> TcTyVar -> Xi -> TcS (StopOrContinue Ct) -- Solve with the identity coercion -- Precondition: kind(xi) equals kind(tv) -- Precondition: CtEvidence is Wanted or Derived @@ -1504,9 +1522,10 @@ solveByUnification wd tv xi text "Coercion:" <+> pprEq tv_ty xi, text "Left Kind is:" <+> ppr (tcTypeKind tv_ty), text "Right Kind is:" <+> ppr (tcTypeKind xi) ] - ; unifyTyVar tv xi - ; setEvBindIfWanted wd (evCoercion (mkTcNomReflCo xi)) } + ; setEvBindIfWanted wd (evCoercion (mkTcNomReflCo xi)) + ; n_kicked <- kickOutAfterUnification tv + ; return (Stop wd (text "Solved by unification" <+> pprKicked n_kicked)) } {- Note [Avoid double unifications] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1542,6 +1561,34 @@ and we want to get alpha := N b. See also #15144, which was caused by unifying a representational equality. +Note [Solve by unification] +~~~~~~~~~~~~~~~~~~~~~~~~~~~ +If we solve + alpha[n] ~ ty +by unification, there are two cases to consider + +* UnifySameLevel: if the ambient level is 'n', then + we can simply update alpha := ty, and do nothing else + +* UnifyOuterLevel free_metas n: if the ambient level is greater than + 'n' (the level of alpha), in addition to setting alpha := ty we must + do two other things: + + 1. Promote all the free meta-vars of 'ty' to level n. After all, + alpha[n] is at level n, and so if we set, say, + alpha[n] := Maybe beta[m], + we must ensure that when unifying beta we do skolem-escape checks + etc relevent to level n. Simple way to do that: promote beta to + level n. + + 2. Set the Unification Level Flag to record that a level-n unification has + taken place. See Note [The Unification Level Flag] in GHC.Tc.Solver.Monad + +NB: UnifySameLevel is just an optimisation for UnifyOuterLevel. Promotion +would be a no-op, and setting the unification flag unnecessarily would just +make the solver iterate more often. (We don't need to iterate when unifying +at the ambient level becuase of the kick-out mechanism.) + ************************************************************************ * * ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -17,7 +17,7 @@ module GHC.Tc.Solver.Monad ( -- The TcS monad TcS, runTcS, runTcSDeriveds, runTcSWithEvBinds, runTcSInerts, - failTcS, warnTcS, addErrTcS, + failTcS, warnTcS, addErrTcS, wrapTcS, runTcSEqualities, nestTcS, nestImplicTcS, setEvBindsTcS, emitImplicationTcS, emitTvImplicationTcS, @@ -31,6 +31,7 @@ module GHC.Tc.Solver.Monad ( panicTcS, traceTcS, traceFireTcS, bumpStepCountTcS, csTraceTcS, wrapErrTcS, wrapWarnTcS, + resetUnificationFlag, setUnificationFlag, -- Evidence creation and transformation MaybeNew(..), freshGoals, isFresh, getEvExpr, @@ -60,7 +61,7 @@ module GHC.Tc.Solver.Monad ( updInertTcS, updInertCans, updInertDicts, updInertIrreds, getHasGivenEqs, setInertCans, getInertEqs, getInertCans, getInertGivens, - getInertInsols, + getInertInsols, getInnermostGivenEqLevel, getTcSInerts, setTcSInerts, matchableGivens, prohibitedSuperClassSolve, mightMatchLater, getUnsolvedInerts, @@ -186,7 +187,6 @@ import Control.Monad import GHC.Utils.Monad import Data.IORef import Data.List ( partition, mapAccumL ) -import qualified Data.Semigroup as S import Data.List.NonEmpty ( NonEmpty(..), cons, toList, nonEmpty ) import qualified Data.List.NonEmpty as NE import Control.Arrow ( first ) @@ -418,12 +418,14 @@ instance Outputable InertSet where emptyInertCans :: InertCans emptyInertCans - = IC { inert_eqs = emptyDVarEnv - , inert_dicts = emptyDicts - , inert_safehask = emptyDicts - , inert_funeqs = emptyFunEqs - , inert_insts = [] - , inert_irreds = emptyCts } + = IC { inert_eqs = emptyDVarEnv + , inert_given_eq_lvl = topTcLevel + , inert_given_eqs = False + , inert_dicts = emptyDicts + , inert_safehask = emptyDicts + , inert_funeqs = emptyFunEqs + , inert_insts = [] + , inert_irreds = emptyCts } emptyInert :: InertSet emptyInert @@ -697,6 +699,19 @@ data InertCans -- See Note [Detailed InertCans Invariants] for more -- Irreducible predicates that cannot be made canonical, -- and which don't interact with others (e.g. (c a)) -- and insoluble predicates (e.g. Int ~ Bool, or a ~ [a]) + + , inert_given_eq_lvl :: TcLevel + -- The TcLevel of the innermost implication that has a Given + -- equality of the sort that make a unification variable untouchable + -- (see Note [Unification preconditions] in GHC.Tc.Utils.Unify). + -- See Note [Tracking Given equalities] below + + , inert_given_eqs :: Bool + -- True <=> The inert Givens *at this level* (tcl_tclvl) + -- could includes at least one equality /other than/ a + -- let-bound skolem equality. + -- Reason: report these givens when reporting a failed equality + -- See Note [Tracking Given equalities] } type InertEqs = DTyVarEnv EqualCtList @@ -730,7 +745,126 @@ listToEqualCtList :: [Ct] -> Maybe EqualCtList -- non-empty listToEqualCtList cts = EqualCtList <$> nonEmpty cts -{- Note [Detailed InertCans Invariants] +{- Note [Tracking Given equalities] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +For reasons described in (UNTOUCHABLE) in GHC.Tc.Utils.Unify +Note [Unification preconditions], we can't unify + alpha[2] ~ Int +under a level-4 implication if there are any Given equalities +bound by the implications at level 3 of 4. To that end, the +InertCans tracks + + inert_given_eq_lvl :: TcLevel + -- The TcLevel of the innermost implication that has a Given + -- equality of the sort that make a unification variable untouchable + -- (see Note [Unification preconditions] in GHC.Tc.Utils.Unify). + +We update inert_given_eq_lvl whenever we add a Given to the +inert set, in updateGivenEqs. + +Then a unification variable alpha[n] is untouchable iff + n < inert_given_eq_lvl +that is, if the unification variable was born outside an +enclosing Given equality. + +Exactly which constraints should trigger (UNTOUCHABLE), and hence +should update inert_given_eq_lvl? + +* We do /not/ need to worry about let-bound skolems, such ast + forall[2] a. a ~ [b] => blah + See Note [Let-bound skolems] + +* Consider an implication + forall[2]. beta[1] => alpha[1] ~ Int + where beta is a unification variable that has already been unified + to () in an outer scope. Then alpha[1] is perfectly touchable and + we can unify alpha := Int. So when deciding whether the givens contain + an equality, we should canonicalise first, rather than just looking at + the /original/ givens (#8644). + + * However, we must take account of *potential* equalities. Consider the + same example again, but this time we have /not/ yet unified beta: + forall[2] beta[1] => ...blah... + + Because beta might turn into an equality, updateGivenEqs conservatively + treats it as a potential equality, and updates inert_give_eq_lvl + + * What about something like forall[2] a b. a ~ F b => [W] alpha[1] ~ X y z? + + That Given cannot affect the Wanted, because the Given is entirely + *local*: it mentions only skolems bound in the very same + implication. Such equalities need not make alpha untouchable. (Test + case typecheck/should_compile/LocalGivenEqs has a real-life + motivating example, with some detailed commentary.) + Hence the 'mentionsOuterVar' test in updateGivenEqs. + + However, solely to support better error messages + (see Note [HasGivenEqs] in GHC.Tc.Types.Constraint) we also track + these "local" equalities in the boolean inert_given_eqs field. + This field is used only to set the ic_given_eqs field to LocalGivenEqs; + see the function getHasGivenEqs. + + Here is a simpler case that triggers this behaviour: + + data T where + MkT :: F a ~ G b => a -> b -> T + + f (MkT _ _) = True + + Because of this behaviour around local equality givens, we can infer the + type of f. This is typecheck/should_compile/LocalGivenEqs2. + + * We need not look at the equality relation involved (nominal vs + representational), because representational equalities can still + imply nominal ones. For example, if (G a ~R G b) and G's argument's + role is nominal, then we can deduce a ~N b. + +Note [Let-bound skolems] +~~~~~~~~~~~~~~~~~~~~~~~~ +If * the inert set contains a canonical Given CEqCan (a ~ ty) +and * 'a' is a skolem bound in this very implication, + +then: +a) The Given is pretty much a let-binding, like + f :: (a ~ b->c) => a -> a + Here the equality constraint is like saying + let a = b->c in ... + It is not adding any new, local equality information, + and hence can be ignored by has_given_eqs + +b) 'a' will have been completely substituted out in the inert set, + so we can safely discard it. + +For an example, see #9211. + +See also GHC.Tc.Utils.Unify Note [Deeper level on the left] for how we ensure +that the right variable is on the left of the equality when both are +tyvars. + +You might wonder whether the skolem really needs to be bound "in the +very same implication" as the equuality constraint. +Consider this (c.f. #15009): + + data S a where + MkS :: (a ~ Int) => S a + + g :: forall a. S a -> a -> blah + g x y = let h = \z. ( z :: Int + , case x of + MkS -> [y,z]) + in ... + +From the type signature for `g`, we get `y::a` . Then when we +encounter the `\z`, we'll assign `z :: alpha[1]`, say. Next, from the +body of the lambda we'll get + + [W] alpha[1] ~ Int -- From z::Int + [W] forall[2]. (a ~ Int) => [W] alpha[1] ~ a -- From [y,z] + +Now, unify alpha := a. Now we are stuck with an unsolved alpha~Int! +So we must treat alpha as untouchable under the forall[2] implication. + +Note [Detailed InertCans Invariants] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The InertCans represents a collection of constraints with the following properties: @@ -1027,6 +1161,8 @@ instance Outputable InertCans where ppr (IC { inert_eqs = eqs , inert_funeqs = funeqs, inert_dicts = dicts , inert_safehask = safehask, inert_irreds = irreds + , inert_given_eq_lvl = ge_lvl + , inert_given_eqs = given_eqs , inert_insts = insts }) = braces $ vcat @@ -1043,6 +1179,8 @@ instance Outputable InertCans where text "Irreds =" <+> pprCts irreds , ppUnless (null insts) $ text "Given instances =" <+> vcat (map ppr insts) + , text "Innermost given equalities =" <+> ppr ge_lvl + , text "Given eqs at this level =" <+> ppr given_eqs ] where folder (EqualCtList eqs) rest = nonEmptyToBag eqs `andCts` rest @@ -1456,20 +1594,35 @@ findEq icans (TyFamLHS fun_tc fun_args) addInertForAll :: QCInst -> TcS () -- Add a local Given instance, typically arising from a type signature addInertForAll new_qci - = do { ics <- getInertCans - ; insts' <- add_qci (inert_insts ics) - ; setInertCans (ics { inert_insts = insts' }) } + = do { ics <- getInertCans + ; ics1 <- add_qci ics + + -- Update given equalities. C.f updateGivenEqs + ; tclvl <- getTcLevel + ; let IC { inert_given_eq_lvl = ge_lvl + , inert_given_eqs = geqs } = ics1 + + pred = qci_pred new_qci + not_equality = isClassPred pred && not (isEqPred pred) + -- True <=> definitely not an equality + -- A qci_pred like (f a) might be an equality + + ics2 | not_equality = ics1 + | otherwise = ics1 { inert_given_eq_lvl = tclvl + , inert_given_eqs = True } + + ; setInertCans ics2 } where - add_qci :: [QCInst] -> TcS [QCInst] + add_qci :: InertCans -> TcS InertCans -- See Note [Do not add duplicate quantified instances] - add_qci qcis + add_qci ics@(IC { inert_insts = qcis }) | any same_qci qcis = do { traceTcS "skipping duplicate quantified instance" (ppr new_qci) - ; return qcis } + ; return ics } | otherwise = do { traceTcS "adding new inert quantified instance" (ppr new_qci) - ; return (new_qci : qcis) } + ; return (ics { inert_insts = new_qci : qcis }) } same_qci old_qci = tcEqType (ctEvPred (qci_ev old_qci)) (ctEvPred (qci_ev new_qci)) @@ -1523,7 +1676,8 @@ addInertCan ct ; ics <- getInertCans ; ct <- maybeEmitShadow ics ct ; ics <- maybeKickOut ics ct - ; setInertCans (add_item ics ct) + ; tclvl <- getTcLevel + ; setInertCans (add_item tclvl ics ct) ; traceTcS "addInertCan }" $ empty } @@ -1536,23 +1690,55 @@ maybeKickOut ics ct | otherwise = return ics -add_item :: InertCans -> Ct -> InertCans -add_item ics item@(CEqCan { cc_lhs = TyFamLHS tc tys }) - = ics { inert_funeqs = addCanFunEq (inert_funeqs ics) tc tys item } - -add_item ics item@(CEqCan { cc_lhs = TyVarLHS tv }) - = ics { inert_eqs = addTyEq (inert_eqs ics) tv item } - -add_item ics@(IC { inert_irreds = irreds }) item@(CIrredCan {}) - = ics { inert_irreds = irreds `Bag.snocBag` item } - -add_item ics item@(CDictCan { cc_class = cls, cc_tyargs = tys }) +add_item :: TcLevel -> InertCans -> Ct -> InertCans +add_item tc_lvl + ics@(IC { inert_funeqs = funeqs, inert_eqs = eqs }) + item@(CEqCan { cc_lhs = lhs }) + = updateGivenEqs tc_lvl item $ + case lhs of + TyFamLHS tc tys -> ics { inert_funeqs = addCanFunEq funeqs tc tys item } + TyVarLHS tv -> ics { inert_eqs = addTyEq eqs tv item } + +add_item tc_lvl ics@(IC { inert_irreds = irreds }) item@(CIrredCan {}) + = updateGivenEqs tc_lvl item $ -- An Irred might turn out to be an + -- equality, so we play safe + ics { inert_irreds = irreds `Bag.snocBag` item } + +add_item _ ics item@(CDictCan { cc_class = cls, cc_tyargs = tys }) = ics { inert_dicts = addDict (inert_dicts ics) cls tys item } -add_item _ item +add_item _ _ item = pprPanic "upd_inert set: can't happen! Inserting " $ ppr item -- Can't be CNonCanonical because they only land in inert_irreds +updateGivenEqs :: TcLevel -> Ct -> InertCans -> InertCans +-- Set the inert_given_eq_level to the current level (tclvl) +-- if the constraint is a given equality that should prevent +-- filling in an outer unification variable. +-- See See Note [Tracking Given equalities] +updateGivenEqs tclvl ct inerts@(IC { inert_given_eq_lvl = ge_lvl + , inert_given_eqs = geqs }) + | not (isGivenCt ct) = inerts + | not_equality ct = inerts -- See Note [Let-bound skolems] + | otherwise = inerts { inert_given_eq_lvl = ge_lvl' + , inert_given_eqs = True } + where + ge_lvl' | mentionsOuterVar tclvl (ctEvidence ct) + -- Includes things like (c a), which *might* be an equality + = tclvl + | otherwise + = ge_lvl + + not_equality :: Ct -> Bool + -- True <=> definitely not an equality of any kind + -- except for a let-bound skolem, which doesn't count + -- See Note [Let-bound skolems] + -- NB: no need to spot the boxed CDictCan (a ~ b) because its + -- superclass (a ~# b) will be a CEqCan + not_equality (CEqCan { cc_lhs = TyVarLHS tv }) = not (isOuterTyVar tclvl tv) + not_equality (CDictCan {}) = True + not_equality _ = False + ----------------------------------------- kickOutRewritable :: CtFlavourRole -- Flavour/role of the equality that -- is being added to the inert set @@ -1596,7 +1782,6 @@ kick_out_rewritable :: CtFlavourRole -- Flavour/role of the equality that kick_out_rewritable new_fr new_lhs ics@(IC { inert_eqs = tv_eqs , inert_dicts = dictmap - , inert_safehask = safehask , inert_funeqs = funeqmap , inert_irreds = irreds , inert_insts = old_insts }) @@ -1610,12 +1795,12 @@ kick_out_rewritable new_fr new_lhs | otherwise = (kicked_out, inert_cans_in) where - inert_cans_in = IC { inert_eqs = tv_eqs_in - , inert_dicts = dicts_in - , inert_safehask = safehask -- ?? - , inert_funeqs = feqs_in - , inert_irreds = irs_in - , inert_insts = insts_in } + -- inert_safehask stays unchanged; is that right? + inert_cans_in = ics { inert_eqs = tv_eqs_in + , inert_dicts = dicts_in + , inert_funeqs = feqs_in + , inert_irreds = irs_in + , inert_insts = insts_in } kicked_out :: WorkList -- NB: use extendWorkList to ensure that kicked-out equalities get priority @@ -1968,6 +2153,10 @@ updInertIrreds upd_fn getInertEqs :: TcS (DTyVarEnv EqualCtList) getInertEqs = do { inert <- getInertCans; return (inert_eqs inert) } +getInnermostGivenEqLevel :: TcS TcLevel +getInnermostGivenEqLevel = do { inert <- getInertCans + ; return (inert_given_eq_lvl inert) } + getInertInsols :: TcS Cts -- Returns insoluble equality constraints -- specifically including Givens @@ -2077,63 +2266,46 @@ getUnsolvedInerts getHasGivenEqs :: TcLevel -- TcLevel of this implication -> TcS ( HasGivenEqs -- are there Given equalities? , Cts ) -- Insoluble equalities arising from givens --- See Note [When does an implication have given equalities?] +-- See Note [Tracking Given equalities] getHasGivenEqs tclvl - = do { inerts@(IC { inert_eqs = ieqs, inert_funeqs = funeqs, inert_irreds = irreds }) + = do { inerts@(IC { inert_irreds = irreds + , inert_given_eqs = given_eqs + , inert_given_eq_lvl = ge_lvl }) <- getInertCans - ; let has_given_eqs = foldMap check_local_given_ct irreds - S.<> foldMap (lift_equal_ct_list check_local_given_tv_eq) ieqs - S.<> foldMapFunEqs (lift_equal_ct_list check_local_given_ct) funeqs - insols = filterBag insolubleEqCt irreds + ; let insols = filterBag insolubleEqCt irreds -- Specifically includes ones that originated in some -- outer context but were refined to an insoluble by -- a local equality; so do /not/ add ct_given_here. + -- See Note [HasGivenEqs] in GHC.Tc.Types.Constraint, and + -- Note [Tracking Given equalities] in this module + has_ge | ge_lvl == tclvl = MaybeGivenEqs + | given_eqs = LocalGivenEqs + | otherwise = NoGivenEqs + ; traceTcS "getHasGivenEqs" $ - vcat [ text "has_given_eqs:" <+> ppr has_given_eqs + vcat [ text "given_eqs:" <+> ppr given_eqs + , text "ge_lvl:" <+> ppr ge_lvl + , text "ambient level:" <+> ppr tclvl , text "Inerts:" <+> ppr inerts , text "Insols:" <+> ppr insols] - ; return (has_given_eqs, insols) } - where - check_local_given_ct :: Ct -> HasGivenEqs - check_local_given_ct ct - | given_here ev = if mentions_outer_var ev then MaybeGivenEqs else LocalGivenEqs - | otherwise = NoGivenEqs - where - ev = ctEvidence ct - - lift_equal_ct_list :: (Ct -> HasGivenEqs) -> EqualCtList -> HasGivenEqs - -- returns NoGivenEqs for non-singleton lists, as Given lists are always - -- singletons - lift_equal_ct_list check (EqualCtList (ct :| [])) = check ct - lift_equal_ct_list _ _ = NoGivenEqs - - check_local_given_tv_eq :: Ct -> HasGivenEqs - check_local_given_tv_eq (CEqCan { cc_lhs = TyVarLHS tv, cc_ev = ev}) - | given_here ev - = if is_outer_var tv then MaybeGivenEqs else NoGivenEqs - -- See Note [Let-bound skolems] - | otherwise - = NoGivenEqs - check_local_given_tv_eq other_ct = check_local_given_ct other_ct - - given_here :: CtEvidence -> Bool - -- True for a Given bound by the current implication, - -- i.e. the current level - given_here ev = isGiven ev - && tclvl == ctLocLevel (ctEvLoc ev) - - mentions_outer_var :: CtEvidence -> Bool - mentions_outer_var = anyFreeVarsOfType is_outer_var . ctEvPred - - is_outer_var :: TyCoVar -> Bool - is_outer_var tv - -- NB: a meta-tv alpha[3] may end up unifying with skolem b[2], - -- so treat it as an "outer" var, even at level 3. - -- This will become redundant after fixing #18929. - | isTyVar tv = isTouchableMetaTyVar tclvl tv || - tclvl `strictlyDeeperThan` tcTyVarLevel tv - | otherwise = False + ; return (has_ge, insols) } + +mentionsOuterVar :: TcLevel -> CtEvidence -> Bool +mentionsOuterVar tclvl ev + = anyFreeVarsOfType (isOuterTyVar tclvl) $ + ctEvPred ev + +isOuterTyVar :: TcLevel -> TyCoVar -> Bool +-- True of a type variable that comes from a +-- shallower level than the ambient level (tclvl) +isOuterTyVar tclvl tv + | isTyVar tv = tclvl `strictlyDeeperThan` tcTyVarLevel tv + || isPromotableMetaTyVar tv + -- isPromotable: a meta-tv alpha[3] may end up unifying with skolem b[2], + -- so treat it as an "outer" var, even at level 3. + -- This will become redundant after fixing #18929. + | otherwise = False -- Coercion variables; doesn't much matter -- | Returns Given constraints that might, -- potentially, match the given pred. This is used when checking to see if a @@ -2267,112 +2439,6 @@ Examples: This treatment fixes #18910 and is tested in typecheck/should_compile/InstanceGivenOverlap{,2} -Note [When does an implication have given equalities?] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider an implication - beta => alpha ~ Int -where beta is a unification variable that has already been unified -to () in an outer scope. Then we can float the (alpha ~ Int) out -just fine. So when deciding whether the givens contain an equality, -we should canonicalise first, rather than just looking at the original -givens (#8644). - -So we simply look at the inert, canonical Givens and see if there are -any equalities among them, the calculation of has_given_eqs. There -are some wrinkles: - - * We must know which ones are bound in *this* implication and which - are bound further out. We can find that out from the TcLevel - of the Given, which is itself recorded in the tcl_tclvl field - of the TcLclEnv stored in the Given (ev_given_here). - - What about interactions between inner and outer givens? - - Outer given is rewritten by an inner given, then there must - have been an inner given equality, hence the “given-eq” flag - will be true anyway. - - - Inner given rewritten by outer, retains its level (ie. The inner one) - - * We must take account of *potential* equalities, like the one above: - beta => ...blah... - If we still don't know what beta is, we conservatively treat it as potentially - becoming an equality. Hence including 'irreds' in the calculation or has_given_eqs. - Note that we can't really know what's in an irred, so any irred is considered - a potential equality. - - * What about something like forall a b. a ~ F b => [W] c ~ X y z? That Given - cannot affect the Wanted, because the Given is entirely *local*: it mentions - only skolems bound in the very same implication. Such equalities need not - prevent floating. (Test case typecheck/should_compile/LocalGivenEqs has a - real-life motivating example, with some detailed commentary.) These - equalities are noted with LocalGivenEqs: they do not prevent floating, but - they also are allowed to show up in error messages. See - Note [Suppress redundant givens during error reporting] in GHC.Tc.Errors. - The difference between what stops floating and what is suppressed from - error messages is why we need three options for HasGivenEqs. - - There is also a simpler case that triggers this behaviour: - - data T where - MkT :: F a ~ G b => a -> b -> T - - f (MkT _ _) = True - - Because of this behaviour around local equality givens, we can infer the - type of f. This is typecheck/should_compile/LocalGivenEqs2. - - * See Note [Let-bound skolems] for another wrinkle - - * We need not look at the equality relation involved (nominal vs representational), - because representational equalities can still imply nominal ones. For example, - if (G a ~R G b) and G's argument's role is nominal, then we can deduce a ~N b. - -Note [Let-bound skolems] -~~~~~~~~~~~~~~~~~~~~~~~~ -If * the inert set contains a canonical Given CEqCan (a ~ ty) -and * 'a' is a skolem bound in this very implication, - -then: -a) The Given is pretty much a let-binding, like - f :: (a ~ b->c) => a -> a - Here the equality constraint is like saying - let a = b->c in ... - It is not adding any new, local equality information, - and hence can be ignored by has_given_eqs - -b) 'a' will have been completely substituted out in the inert set, - so we can safely discard it. - -For an example, see #9211. - -See also GHC.Tc.Utils.Unify Note [Deeper level on the left] for how we ensure -that the right variable is on the left of the equality when both are -tyvars. - -You might wonder whether the skokem really needs to be bound "in the -very same implication" as the equuality constraint. -(c.f. #15009) Consider this: - - data S a where - MkS :: (a ~ Int) => S a - - g :: forall a. S a -> a -> blah - g x y = let h = \z. ( z :: Int - , case x of - MkS -> [y,z]) - in ... - -From the type signature for `g`, we get `y::a` . Then when we -encounter the `\z`, we'll assign `z :: alpha[1]`, say. Next, from the -body of the lambda we'll get - - [W] alpha[1] ~ Int -- From z::Int - [W] forall[2]. (a ~ Int) => [W] alpha[1] ~ a -- From [y,z] - -Now, suppose we decide to float `alpha ~ a` out of the implication -and then unify `alpha := a`. Now we are stuck! But if treat -`alpha ~ Int` first, and unify `alpha := Int`, all is fine. -But we absolutely cannot float that equality or we will get stuck. -} removeInertCts :: [Ct] -> InertCans -> InertCans @@ -2552,9 +2618,6 @@ tcAppMapToBag m = foldTcAppMap consBag m emptyBag foldTcAppMap :: (a -> b -> b) -> TcAppMap a -> b -> b foldTcAppMap k m z = foldDTyConEnv (foldTM k) z m -foldMapTcAppMap :: Monoid m => (a -> m) -> TcAppMap a -> m -foldMapTcAppMap f = foldMap (foldMap f) - {- ********************************************************************* * * @@ -2688,9 +2751,6 @@ findFunEqsByTyCon m tc foldFunEqs :: (a -> b -> b) -> FunEqMap a -> b -> b foldFunEqs = foldTcAppMap -foldMapFunEqs :: Monoid m => (a -> m) -> FunEqMap a -> m -foldMapFunEqs = foldMapTcAppMap - insertFunEq :: FunEqMap a -> TyCon -> [Type] -> a -> FunEqMap a insertFunEq m tc tys val = insertTcApp m tc tys val @@ -2723,6 +2783,12 @@ data TcSEnv -- The number of unification variables we have filled -- The important thing is whether it is non-zero + tcs_unif_lvl :: IORef (Maybe TcLevel), + -- The Unification Level Flag + -- Outermost level at which we have unified a meta tyvar + -- Starts at Nothing, then (Just i), then (Just j) where j do { inerts <- TcM.readTcRef old_inert_var - ; let nest_inert = inerts { inert_cycle_breakers = [] } - -- all other InertSet fields are inherited + ; let nest_inert = inerts { inert_cycle_breakers = [] + , inert_cans = (inert_cans inerts) + { inert_given_eqs = False } } + -- All other InertSet fields are inherited ; new_inert_var <- TcM.newTcRef nest_inert ; new_wl_var <- TcM.newTcRef emptyWorkList - ; let nest_env = TcSEnv { tcs_ev_binds = ref + ; let nest_env = TcSEnv { tcs_count = count -- Inherited + , tcs_unif_lvl = unif_lvl -- Inherited + , tcs_ev_binds = ref , tcs_unified = unified_var - , tcs_count = count , tcs_inerts = new_inert_var , tcs_worklist = new_wl_var } ; res <- TcM.setTcLevel inner_tclvl $ @@ -3260,6 +3332,97 @@ pprKicked :: Int -> SDoc pprKicked 0 = empty pprKicked n = parens (int n <+> text "kicked out") +{- ********************************************************************* +* * +* The Unification Level Flag * +* * +********************************************************************* -} + +{- Note [The Unification Level Flag] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider a deep tree of implication constraints + forall[1] a. -- Outer-implic + C alpha[1] -- Simple + forall[2] c. ....(C alpha[1]).... -- Implic-1 + forall[2] b. ....(alpha[1] ~ Int).... -- Implic-2 + +The (C alpha) is insoluble until we know alpha. We solve alpha +by unifying alpha:=Int somewhere deep inside Implic-2. But then we +must try to solve the Outer-implic all over again. This time we can +solve (C alpha) both in Outer-implic, and nested inside Implic-1. + +When should we iterate solving a level-n implication? +Answer: if any unification of a tyvar at level n takes place + in the ic_implics of that implication. + +* What if a unification takes place at level n-1? Then don't iterate + level n, because we'll iterate level n-1, and that will in turn iterate + level n. + +* What if a unification takes place at level n, in the ic_simples of + level n? No need to track this, because the kick-out mechanism deals + with it. (We can't drop kick-out in favour of iteration, becuase kick-out + works for skolem-equalities, not just unifications.) + +So the monad-global Unification Level Flag, kept in tcs_unif_lvl keeps +track of + - Whether any unifications at all have taken place (Nothing => no unifications) + - If so, what is the outermost level that has seen a unification (Just lvl) + +The iteration done in the simplify_loop/maybe_simplify_again loop in GHC.Tc.Solver. + +It helpful not to iterate unless there is a chance of progress. #8474 is +an example: + + * There's a deeply-nested chain of implication constraints. + ?x:alpha => ?y1:beta1 => ... ?yn:betan => [W] ?x:Int + + * From the innermost one we get a [D] alpha[1] ~ Int, + so we can unify. + + * It's better not to iterate the inner implications, but go all the + way out to level 1 before iterating -- because iterating level 1 + will iterate the inner levels anyway. + +(In the olden days when we "floated" thse Derived constraints, this was +much, much more important -- we got exponential behaviour, as each iteration +produced the same Derived constraint.) +-} + + +resetUnificationFlag :: TcS Bool +-- We are at ambient level i +-- If the unification flag = Just i, reset it to Nothing and return True +-- Otherwise leave it unchanged and return False +resetUnificationFlag + = TcS $ \env -> + do { let ref = tcs_unif_lvl env + ; ambient_lvl <- TcM.getTcLevel + ; mb_lvl <- TcM.readTcRef ref + ; TcM.traceTc "resetUnificationFlag" $ + vcat [ text "ambient:" <+> ppr ambient_lvl + , text "unif_lvl:" <+> ppr mb_lvl ] + ; case mb_lvl of + Nothing -> return False + Just unif_lvl | ambient_lvl `strictlyDeeperThan` unif_lvl + -> return False + | otherwise + -> do { TcM.writeTcRef ref Nothing + ; return True } } + +setUnificationFlag :: TcLevel -> TcS () +-- (setUnificationFlag i) sets the unification level to (Just i) +-- unless it already is (Just j) where j <= i +setUnificationFlag lvl + = TcS $ \env -> + do { let ref = tcs_unif_lvl env + ; mb_lvl <- TcM.readTcRef ref + ; case mb_lvl of + Just unif_lvl | lvl `deeperThanOrSame` unif_lvl + -> return () + _ -> TcM.writeTcRef ref (Just lvl) } + + {- ********************************************************************* * * * Instantiation etc. ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -1095,7 +1095,7 @@ Yuk! data Implication = Implic { -- Invariants for a tree of implications: - -- see TcType Note [TcLevel and untouchable type variables] + -- see TcType Note [TcLevel invariants] ic_tclvl :: TcLevel, -- TcLevel of unification variables -- allocated /inside/ this implication @@ -1172,44 +1172,57 @@ data ImplicStatus | IC_Unsolved -- Neither of the above; might go either way --- | Does this implication have Given equalities? --- See Note [When does an implication have given equalities?] in GHC.Tc.Solver.Monad, --- which also explains why we need three options here. Also, see --- Note [Suppress redundant givens during error reporting] in GHC.Tc.Errors --- --- Stops floating | Suppresses Givens in errors --- ----------------------------------------------- --- NoGivenEqs NO | YES --- LocalGivenEqs NO | NO --- MaybeGivenEqs YES | NO --- --- Examples: --- --- NoGivenEqs: Eq a => ... --- (Show a, Num a) => ... --- forall a. a ~ Either Int Bool => ... --- See Note [Let-bound skolems] in GHC.Tc.Solver.Monad for --- that last one --- --- LocalGivenEqs: forall a b. F a ~ G b => ... --- forall a. F a ~ Int => ... --- --- MaybeGivenEqs: (a ~ b) => ... --- forall a. F a ~ b => ... --- --- The check is conservative. A MaybeGivenEqs might not have any equalities. --- A LocalGivenEqs might local equalities, but it definitely does not have non-local --- equalities. A NoGivenEqs definitely does not have equalities (except let-bound --- skolems). -data HasGivenEqs - = NoGivenEqs -- definitely no given equalities, - -- except by Note [Let-bound skolems] in GHC.Tc.Solver.Monad - | LocalGivenEqs -- might have Given equalities that affect only local skolems - -- e.g. forall a b. (a ~ F b) => ...; definitely no others - | MaybeGivenEqs -- might have any kind of Given equalities; no floating out - -- is possible. +data HasGivenEqs -- See Note [HasGivenEqs] + = NoGivenEqs -- Definitely no given equalities, + -- except by Note [Let-bound skolems] in GHC.Tc.Solver.Monad + | LocalGivenEqs -- Might have Given equalities, but only ones that affect only + -- local skolems e.g. forall a b. (a ~ F b) => ... + | MaybeGivenEqs -- Might have any kind of Given equalities; no floating out + -- is possible. deriving Eq +{- Note [HasGivenEqs] +~~~~~~~~~~~~~~~~~~~~~ +The GivenEqs data type describes the Given constraints of an implication constraint: + +* NoGivenEqs: definitely no Given equalities, except perhaps let-bound skolems + which don't count: see Note [Let-bound skolems] in GHC.Tc.Solver.Monad + Examples: forall a. Eq a => ... + forall a. (Show a, Num a) => ... + forall a. a ~ Either Int Bool => ... -- Let-bound skolem + +* LocalGivenEqs: definitely no Given equalities that would affect principal + types. But may have equalities that affect only skolems of this implication + (and hence do not affect princial types) + Examples: forall a. F a ~ Int => ... + forall a b. F a ~ G b => ... + +* MaybeGivenEqs: may have Given equalities that would affect principal + types + Examples: forall. (a ~ b) => ... + forall a. F a ~ b => ... + forall a. c a => ... -- The 'c' might be instantiated to (b ~) + forall a. C a b => .... + where class x~y => C a b + so there is an equality in the superclass of a Given + +The HasGivenEqs classifications affect two things: + +* Suppressing redundant givens during error reporting; see GHC.Tc.Errors + Note [Suppress redundant givens during error reporting] + +* Floating in approximateWC. + +Specifically, here's how it goes: + + Stops floating | Suppresses Givens in errors + in approximateWC | + ----------------------------------------------- + NoGivenEqs NO | YES + LocalGivenEqs NO | NO + MaybeGivenEqs YES | NO +-} + instance Outputable Implication where ppr (Implic { ic_tclvl = tclvl, ic_skols = skols , ic_given = given, ic_given_eqs = given_eqs ===================================== compiler/GHC/Tc/Utils/Monad.hs ===================================== @@ -1867,7 +1867,7 @@ It's distressingly delicate though: class constraints mentioned above. But we may /also/ end up taking constraints built at some inner level, and emitting them at some outer level, and then breaking the TcLevel invariants - See Note [TcLevel and untouchable type variables] in GHC.Tc.Utils.TcType + See Note [TcLevel invariants] in GHC.Tc.Utils.TcType So dropMisleading has a horridly ad-hoc structure. It keeps only /insoluble/ flat constraints (which are unlikely to very visibly trip ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -80,7 +80,7 @@ module GHC.Tc.Utils.TcMType ( --------------------------------- -- Promotion, defaulting, skolemisation - defaultTyVar, promoteTyVar, promoteTyVarSet, + defaultTyVar, promoteTyVarTo, promoteTyVarSet, quantifyTyVars, isQuantifiableTv, skolemiseUnboundMetaTyVar, zonkAndSkolemise, skolemiseQuantifiedTyVar, @@ -965,12 +965,18 @@ writeMetaTyVarRef tyvar ref ty ; writeTcRef ref (Indirect ty) } -- Everything from here on only happens if DEBUG is on + -- Need to zonk 'ty' because we may only recently have promoted + -- its free meta-tyvars (see Solver.Interact.tryToSolveByUnification) | otherwise = do { meta_details <- readMutVar ref; -- Zonk kinds to allow the error check to work ; zonked_tv_kind <- zonkTcType tv_kind - ; zonked_ty_kind <- zonkTcType ty_kind - ; let kind_check_ok = tcIsConstraintKind zonked_tv_kind + ; zonked_ty <- zonkTcType ty + ; let zonked_ty_kind = tcTypeKind zonked_ty + zonked_ty_lvl = tcTypeLevel zonked_ty + level_check_ok = not (zonked_ty_lvl `strictlyDeeperThan` tv_lvl) + level_check_msg = ppr zonked_ty_lvl $$ ppr tv_lvl $$ ppr tyvar $$ ppr ty + kind_check_ok = tcIsConstraintKind zonked_tv_kind || tcEqKind zonked_ty_kind zonked_tv_kind -- Hack alert! tcIsConstraintKind: see GHC.Tc.Gen.HsType -- Note [Extra-constraint holes in partial type signatures] @@ -995,13 +1001,9 @@ writeMetaTyVarRef tyvar ref ty ; writeMutVar ref (Indirect ty) } where tv_kind = tyVarKind tyvar - ty_kind = tcTypeKind ty tv_lvl = tcTyVarLevel tyvar - ty_lvl = tcTypeLevel ty - level_check_ok = not (ty_lvl `strictlyDeeperThan` tv_lvl) - level_check_msg = ppr ty_lvl $$ ppr tv_lvl $$ ppr tyvar $$ ppr ty double_upd_msg details = hang (text "Double update of meta tyvar") 2 (ppr tyvar $$ ppr details) @@ -1570,8 +1572,8 @@ than the ambient level (see Note [Use level numbers of quantification]). Note [Use level numbers for quantification] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The level numbers assigned to metavariables are very useful. Not only -do they track touchability (Note [TcLevel and untouchable type variables] -in GHC.Tc.Utils.TcType), but they also allow us to determine which variables to +do they track touchability (Note [TcLevel invariants] in GHC.Tc.Utils.TcType), +but they also allow us to determine which variables to generalise. The rule is this: When generalising, quantify only metavariables with a TcLevel greater @@ -2005,29 +2007,29 @@ a \/\a in the final result but all the occurrences of a will be zonked to () * * ********************************************************************* -} -promoteTyVar :: TcTyVar -> TcM Bool +promoteTyVarTo :: TcLevel -> TcTyVar -> TcM Bool -- When we float a constraint out of an implication we must restore --- invariant (WantedInv) in Note [TcLevel and untouchable type variables] in GHC.Tc.Utils.TcType +-- invariant (WantedInv) in Note [TcLevel invariants] in GHC.Tc.Utils.TcType -- Return True <=> we did some promotion -- Also returns either the original tyvar (no promotion) or the new one -- See Note [Promoting unification variables] -promoteTyVar tv - = do { tclvl <- getTcLevel - ; if (isFloatedTouchableMetaTyVar tclvl tv) - then do { cloned_tv <- cloneMetaTyVar tv - ; let rhs_tv = setMetaTyVarTcLevel cloned_tv tclvl - ; writeMetaTyVar tv (mkTyVarTy rhs_tv) - ; traceTc "promoteTyVar" (ppr tv <+> text "-->" <+> ppr rhs_tv) - ; return True } - else do { traceTc "promoteTyVar: no" (ppr tv) - ; return False } } +promoteTyVarTo tclvl tv + | isFloatedTouchableMetaTyVar tclvl tv + = do { cloned_tv <- cloneMetaTyVar tv + ; let rhs_tv = setMetaTyVarTcLevel cloned_tv tclvl + ; writeMetaTyVar tv (mkTyVarTy rhs_tv) + ; traceTc "promoteTyVar" (ppr tv <+> text "-->" <+> ppr rhs_tv) + ; return True } + | otherwise + = do { traceTc "promoteTyVar: no" (ppr tv) + ; return False } -- Returns whether or not *any* tyvar is defaulted promoteTyVarSet :: TcTyVarSet -> TcM Bool promoteTyVarSet tvs - = do { bools <- mapM promoteTyVar (nonDetEltsUniqSet tvs) + = do { tclvl <- getTcLevel + ; bools <- mapM (promoteTyVarTo tclvl) (nonDetEltsUniqSet tvs) -- Non-determinism is OK because order of promotion doesn't matter - ; return (or bools) } ===================================== compiler/GHC/Tc/Utils/TcType.hs ===================================== @@ -33,7 +33,7 @@ module GHC.Tc.Utils.TcType ( -- TcLevel TcLevel(..), topTcLevel, pushTcLevel, isTopTcLevel, - strictlyDeeperThan, sameDepthAs, + strictlyDeeperThan, deeperThanOrSame, sameDepthAs, tcTypeLevel, tcTyVarLevel, maxTcLevel, promoteSkolem, promoteSkolemX, promoteSkolemsX, -------------------------------- @@ -45,7 +45,7 @@ module GHC.Tc.Utils.TcType ( isAmbiguousTyVar, isCycleBreakerTyVar, metaTyVarRef, metaTyVarInfo, isFlexi, isIndirect, isRuntimeUnkSkol, metaTyVarTcLevel, setMetaTyVarTcLevel, metaTyVarTcLevel_maybe, - isTouchableMetaTyVar, + isTouchableMetaTyVar, isPromotableMetaTyVar, isFloatedTouchableMetaTyVar, findDupTyVarTvs, mkTyVarNamePairs, @@ -516,7 +516,7 @@ data TcTyVarDetails | MetaTv { mtv_info :: MetaInfo , mtv_ref :: IORef MetaDetails - , mtv_tclvl :: TcLevel } -- See Note [TcLevel and untouchable type variables] + , mtv_tclvl :: TcLevel } -- See Note [TcLevel invariants] vanillaSkolemTv, superSkolemTv :: TcTyVarDetails -- See Note [Binding when looking up instances] in GHC.Core.InstEnv @@ -574,13 +574,14 @@ instance Outputable MetaInfo where ********************************************************************* -} newtype TcLevel = TcLevel Int deriving( Eq, Ord ) - -- See Note [TcLevel and untouchable type variables] for what this Int is + -- See Note [TcLevel invariants] for what this Int is -- See also Note [TcLevel assignment] {- -Note [TcLevel and untouchable type variables] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [TcLevel invariants] +~~~~~~~~~~~~~~~~~~~~~~~~~ * Each unification variable (MetaTv) + and skolem (SkolemTv) and each Implication has a level number (of type TcLevel) @@ -602,9 +603,8 @@ Note [TcLevel and untouchable type variables] LESS THAN OR EQUAL TO the ic_tclvl of I See Note [WantedInv] -* A unification variable is *touchable* if its level number - is EQUAL TO that of its immediate parent implication, - and it is a TauTv or TyVarTv (but /not/ CycleBreakerTv) +The level of a MetaTyVar also governs its untouchability. See +Note [Unification preconditions] in GHC.Tc.Utils.Unify. Note [WantedInv] ~~~~~~~~~~~~~~~~ @@ -679,13 +679,17 @@ strictlyDeeperThan :: TcLevel -> TcLevel -> Bool strictlyDeeperThan (TcLevel tv_tclvl) (TcLevel ctxt_tclvl) = tv_tclvl > ctxt_tclvl +deeperThanOrSame :: TcLevel -> TcLevel -> Bool +deeperThanOrSame (TcLevel tv_tclvl) (TcLevel ctxt_tclvl) + = tv_tclvl >= ctxt_tclvl + sameDepthAs :: TcLevel -> TcLevel -> Bool sameDepthAs (TcLevel ctxt_tclvl) (TcLevel tv_tclvl) = ctxt_tclvl == tv_tclvl -- NB: invariant ctxt_tclvl >= tv_tclvl -- So <= would be equivalent checkTcLevelInvariant :: TcLevel -> TcLevel -> Bool --- Checks (WantedInv) from Note [TcLevel and untouchable type variables] +-- Checks (WantedInv) from Note [TcLevel invariants] checkTcLevelInvariant (TcLevel ctxt_tclvl) (TcLevel tv_tclvl) = ctxt_tclvl >= tv_tclvl @@ -998,6 +1002,15 @@ tcIsTcTyVar :: TcTyVar -> Bool -- See Note [TcTyVars and TyVars in the typechecker] tcIsTcTyVar tv = isTyVar tv +isPromotableMetaTyVar :: TcTyVar -> Bool +-- True is this is a meta-tyvar that can be +-- promoted to an outer level +isPromotableMetaTyVar tv + | MetaTv { mtv_info = info } <- tcTyVarDetails tv + = isTouchableInfo info -- Can't promote cycle breakers + | otherwise + = False + isTouchableMetaTyVar :: TcLevel -> TcTyVar -> Bool isTouchableMetaTyVar ctxt_tclvl tv | isTyVar tv -- See Note [Coercion variables in free variable lists] ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -37,7 +37,7 @@ module GHC.Tc.Utils.Unify ( matchExpectedFunKind, matchActualFunTySigma, matchActualFunTysRho, - metaTyVarUpdateOK, occCheckForErrors, MetaTyVarUpdateResult(..), + occCheckForErrors, CheckTyEqResult(..), checkTyVarEq, checkTyFamEq, checkTypeEq, AreTypeFamiliesOK(..) ) where @@ -78,6 +78,7 @@ import GHC.Utils.Panic import GHC.Exts ( inline ) import Control.Monad import Control.Arrow ( second ) +import qualified Data.Semigroup as S {- ********************************************************************* @@ -1169,17 +1170,17 @@ uType t_or_k origin orig_ty1 orig_ty2 -- so that type variables tend to get filled in with -- the most informative version of the type go (TyVarTy tv1) ty2 - = do { lookup_res <- lookupTcTyVar tv1 + = do { lookup_res <- isFilledMetaTyVar_maybe tv1 ; case lookup_res of - Filled ty1 -> do { traceTc "found filled tyvar" (ppr tv1 <+> text ":->" <+> ppr ty1) - ; go ty1 ty2 } - Unfilled _ -> uUnfilledVar origin t_or_k NotSwapped tv1 ty2 } + Just ty1 -> do { traceTc "found filled tyvar" (ppr tv1 <+> text ":->" <+> ppr ty1) + ; go ty1 ty2 } + Nothing -> uUnfilledVar origin t_or_k NotSwapped tv1 ty2 } go ty1 (TyVarTy tv2) - = do { lookup_res <- lookupTcTyVar tv2 + = do { lookup_res <- isFilledMetaTyVar_maybe tv2 ; case lookup_res of - Filled ty2 -> do { traceTc "found filled tyvar" (ppr tv2 <+> text ":->" <+> ppr ty2) - ; go ty1 ty2 } - Unfilled _ -> uUnfilledVar origin t_or_k IsSwapped tv2 ty1 } + Just ty2 -> do { traceTc "found filled tyvar" (ppr tv2 <+> text ":->" <+> ppr ty2) + ; go ty1 ty2 } + Nothing -> uUnfilledVar origin t_or_k IsSwapped tv2 ty1 } -- See Note [Expanding synonyms during unification] go ty1@(TyConApp tc1 []) (TyConApp tc2 []) @@ -1433,10 +1434,11 @@ uUnfilledVar2 origin t_or_k swapped tv1 ty2 ; go dflags cur_lvl } where go dflags cur_lvl - | canSolveByUnification cur_lvl tv1 ty2 + | isTouchableMetaTyVar cur_lvl tv1 + , canSolveByUnification (metaTyVarInfo tv1) ty2 + , CTE_OK <- checkTyVarEq dflags NoTypeFamilies tv1 ty2 -- See Note [Prevent unification with type families] about the NoTypeFamilies: - , MTVU_OK ty2' <- metaTyVarUpdateOK dflags NoTypeFamilies tv1 ty2 - = do { co_k <- uType KindLevel kind_origin (tcTypeKind ty2') (tyVarKind tv1) + = do { co_k <- uType KindLevel kind_origin (tcTypeKind ty2) (tyVarKind tv1) ; traceTc "uUnfilledVar2 ok" $ vcat [ ppr tv1 <+> dcolon <+> ppr (tyVarKind tv1) , ppr ty2 <+> dcolon <+> ppr (tcTypeKind ty2) @@ -1446,8 +1448,8 @@ uUnfilledVar2 origin t_or_k swapped tv1 ty2 -- Only proceed if the kinds match -- NB: tv1 should still be unfilled, despite the kind unification -- because tv1 is not free in ty2 (or, hence, in its kind) - then do { writeMetaTyVar tv1 ty2' - ; return (mkTcNomReflCo ty2') } + then do { writeMetaTyVar tv1 ty2 + ; return (mkTcNomReflCo ty2) } else defer } -- This cannot be solved now. See GHC.Tc.Solver.Canonical -- Note [Equalities with incompatible kinds] @@ -1464,6 +1466,22 @@ uUnfilledVar2 origin t_or_k swapped tv1 ty2 defer = unSwap swapped (uType_defer t_or_k origin) ty1 ty2 +canSolveByUnification :: MetaInfo -> TcType -> Bool +-- See Note [Unification preconditions, (TYVAR-TV)] +canSolveByUnification info xi + = case info of + CycleBreakerTv -> False + TyVarTv -> case tcGetTyVar_maybe xi of + Nothing -> False + Just tv -> case tcTyVarDetails tv of + MetaTv { mtv_info = info } + -> case info of + TyVarTv -> True + _ -> False + SkolemTv {} -> True + RuntimeUnk -> True + _ -> True + swapOverTyVars :: Bool -> TcTyVar -> TcTyVar -> Bool swapOverTyVars is_given tv1 tv2 -- See Note [Unification variables on the left] @@ -1507,8 +1525,94 @@ lhsPriority tv TauTv -> 2 RuntimeUnkTv -> 3 -{- Note [TyVar/TyVar orientation] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [Unification preconditions] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Question: given a homogeneous equality (alpha ~# ty), when is it OK to +unify alpha := ty? + +This note only applied to /homogeneous/ equalities, in which both +sides have the same kind. + +There are three reasons not to unify: + +1. (SKOL-ESC) Skolem-escape + Consider the constraint + forall[2] a[2]. alpha[1] ~ Maybe a[2] + If we unify alpha := Maybe a, the skolem 'a' may escape its scope. + The level alpha[1] says that alpha may be used outside this constraint, + where 'a' is not in scope at all. So we must not unify. + + Bottom line: when looking at a constraint alpha[n] := ty, do not unify + if any free variable of 'ty' has level deeper (greater) than n + +2. (UNTOUCHABLE) Untouchable unification variables + Consider the constraint + forall[2] a[2]. b[1] ~ Int => alpha[1] ~ Int + There is no (SKOL-ESC) problem with unifying alpha := Int, but it might + not be the principal solution. Perhaps the "right" solution is alpha := b. + We simply can't tell. See "OutsideIn(X): modular type inference with local + assumptions", section 2.2. We say that alpha[1] is "untouchable" inside + this implication. + + Bottom line: at amibient level 'l', when looking at a constraint + alpha[n] ~ ty, do not unify alpha := ty if there are any given equalities + between levels 'n' and 'l'. + + Exactly what is a "given equality" for the purpose of (UNTOUCHABLE)? + Answer: see Note [Tracking Given equalities] in GHC.Tc.Solver.Monad + +3. (TYVAR-TV) Unifying TyVarTvs and CycleBreakerTvs + This precondition looks at the MetaInfo of the unification variable: + + * TyVarTv: When considering alpha{tyv} ~ ty, if alpha{tyv} is a + TyVarTv it can only unify with a type variable, not with a + structured type. So if 'ty' is a structured type, such as (Maybe x), + don't unify. + + * CycleBreakerTv: never unified, except by restoreTyVarCycles. + + +Needless to say, all three have wrinkles: + +* (SKOL-ESC) Promotion. Given alpha[n] ~ ty, what if beta[k] is free + in 'ty', where beta is a unification variable, and k>n? 'beta' + stands for a monotype, and since it is part of a level-n type + (equal to alpha[n]), we must /promote/ beta to level n. Just make + up a fresh gamma[n], and unify beta[k] := gamma[n]. + +* (TYVAR-TV) Unification variables. Suppose alpha[tyv,n] is a level-n + TyVarTv (see Note [Signature skolems] in GHC.Tc.Types.TcType)? Now + consider alpha[tyv,n] ~ Bool. We don't want to unify because that + would break the TyVarTv invariant. + + What about alpha[tyv,n] ~ beta[tau,n], where beta is an ordinary + TauTv? Again, don't unify, because beta might later be unified + with, say Bool. (If levels permit, we reverse the orientation here; + see Note [TyVar/TyVar orientation].) + +* (UNTOUCHABLE) Untouchability. When considering (alpha[n] ~ ty), how + do we know whether there are any given equalities between level n + and the ambient level? We answer in two ways: + + * In the eager unifier, we only unify if l=n. If not, alpha may be + untouchable, and defer to the constraint solver. This check is + made in GHC.Tc.Utils.uUnifilledVar2, in the guard + isTouchableMetaTyVar. + + * In the constraint solver, we track where Given equalities occur + and use that to guard unification in GHC.Tc.Solver.Canonical.unifyTest + More details in Note [Tracking Given equalities] in GHC.Tc.Solver.Monad + + Historical note: in the olden days (pre 2021) the constraint solver + also used to unify only if l=n. Equalities were "floated" out of the + implication in a separate step, so that they would become touchable. + But the float/don't-float question turned out to be very delicate, + as you can see if you look at the long series of Notes associated with + GHC.Tc.Solver.floatEqualities, around Nov 2020. It's much easier + to unify in-place, with no floating. + +Note [TyVar/TyVar orientation] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Given (a ~ b), should we orient the CEqCan as (a~b) or (b~a)? This is a surprisingly tricky question! This is invariant (TyEq:TV). @@ -1616,8 +1720,8 @@ inert guy, so we get inert item: c ~ a And now the cycle just repeats -Note [Eliminate younger unification variables] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Historical Note [Eliminate younger unification variables] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Given a choice of unifying alpha := beta or beta := alpha we try, if possible, to eliminate the "younger" one, as determined @@ -1631,36 +1735,11 @@ This is a performance optimisation only. It turns out to fix It's simple to implement (see nicer_to_update_tv2 in swapOverTyVars). But, to my surprise, it didn't seem to make any significant difference to the compiler's performance, so I didn't take it any further. Still -it seemed to too nice to discard altogether, so I'm leaving these +it seemed too nice to discard altogether, so I'm leaving these notes. SLPJ Jan 18. --} --- @trySpontaneousSolve wi@ solves equalities where one side is a --- touchable unification variable. --- Returns True <=> spontaneous solve happened -canSolveByUnification :: TcLevel -> TcTyVar -> TcType -> Bool -canSolveByUnification tclvl tv xi - | isTouchableMetaTyVar tclvl tv - = case metaTyVarInfo tv of - TyVarTv -> is_tyvar xi - _ -> True - - | otherwise -- Untouchable - = False - where - is_tyvar xi - = case tcGetTyVar_maybe xi of - Nothing -> False - Just tv -> case tcTyVarDetails tv of - MetaTv { mtv_info = info } - -> case info of - TyVarTv -> True - _ -> False - SkolemTv {} -> True - RuntimeUnk -> True - -{- Note [Prevent unification with type families] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [Prevent unification with type families] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We prevent unification with type families because of an uneasy compromise. It's perfectly sound to unify with type families, and it even improves the error messages in the testsuite. It also modestly improves performance, at @@ -1764,35 +1843,6 @@ type-checking (with wrappers, etc.). Types get desugared very differently, causing this wibble in behavior seen here. -} -data LookupTyVarResult -- The result of a lookupTcTyVar call - = Unfilled TcTyVarDetails -- SkolemTv or virgin MetaTv - | Filled TcType - -lookupTcTyVar :: TcTyVar -> TcM LookupTyVarResult -lookupTcTyVar tyvar - | MetaTv { mtv_ref = ref } <- details - = do { meta_details <- readMutVar ref - ; case meta_details of - Indirect ty -> return (Filled ty) - Flexi -> do { is_touchable <- isTouchableTcM tyvar - -- Note [Unifying untouchables] - ; if is_touchable then - return (Unfilled details) - else - return (Unfilled vanillaSkolemTv) } } - | otherwise - = return (Unfilled details) - where - details = tcTyVarDetails tyvar - -{- -Note [Unifying untouchables] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We treat an untouchable type variable as if it was a skolem. That -ensures it won't unify with anything. It's a slight hack, because -we return a made-up TcTyVarDetails, but I think it works smoothly. --} - -- | Breaks apart a function kind into its pieces. matchExpectedFunKind :: Outputable fun @@ -1871,44 +1921,38 @@ with (forall k. k->*) -} -data MetaTyVarUpdateResult a - = MTVU_OK a - | MTVU_Bad -- Forall, predicate, or type family - | MTVU_HoleBlocker -- Blocking coercion hole +data CheckTyEqResult + = CTE_OK + | CTE_Bad -- Forall, predicate, or type family + | CTE_HoleBlocker -- Blocking coercion hole -- See Note [Equalities with incompatible kinds] in "GHC.Tc.Solver.Canonical" - | MTVU_Occurs - deriving (Functor) - -instance Applicative MetaTyVarUpdateResult where - pure = MTVU_OK - (<*>) = ap - -instance Monad MetaTyVarUpdateResult where - MTVU_OK x >>= k = k x - MTVU_Bad >>= _ = MTVU_Bad - MTVU_HoleBlocker >>= _ = MTVU_HoleBlocker - MTVU_Occurs >>= _ = MTVU_Occurs - -instance Outputable a => Outputable (MetaTyVarUpdateResult a) where - ppr (MTVU_OK a) = text "MTVU_OK" <+> ppr a - ppr MTVU_Bad = text "MTVU_Bad" - ppr MTVU_HoleBlocker = text "MTVU_HoleBlocker" - ppr MTVU_Occurs = text "MTVU_Occurs" - -occCheckForErrors :: DynFlags -> TcTyVar -> Type -> MetaTyVarUpdateResult () --- Just for error-message generation; so we return MetaTyVarUpdateResult + | CTE_Occurs + +instance S.Semigroup CheckTyEqResult where + CTE_OK <> x = x + x <> _ = x + +instance Monoid CheckTyEqResult where + mempty = CTE_OK + +instance Outputable CheckTyEqResult where + ppr CTE_OK = text "CTE_OK" + ppr CTE_Bad = text "CTE_Bad" + ppr CTE_HoleBlocker = text "CTE_HoleBlocker" + ppr CTE_Occurs = text "CTE_Occurs" + +occCheckForErrors :: DynFlags -> TcTyVar -> Type -> CheckTyEqResult +-- Just for error-message generation; so we return CheckTyEqResult -- so the caller can report the right kind of error -- Check whether -- a) the given variable occurs in the given type. -- b) there is a forall in the type (unless we have -XImpredicativeTypes) occCheckForErrors dflags tv ty = case checkTyVarEq dflags YesTypeFamilies tv ty of - MTVU_OK _ -> MTVU_OK () - MTVU_Bad -> MTVU_Bad - MTVU_HoleBlocker -> MTVU_HoleBlocker - MTVU_Occurs -> case occCheckExpand [tv] ty of - Nothing -> MTVU_Occurs - Just _ -> MTVU_OK () + CTE_Occurs -> case occCheckExpand [tv] ty of + Nothing -> CTE_Occurs + Just _ -> CTE_OK + other -> other ---------------- data AreTypeFamiliesOK = YesTypeFamilies @@ -1919,52 +1963,7 @@ instance Outputable AreTypeFamiliesOK where ppr YesTypeFamilies = text "YesTypeFamilies" ppr NoTypeFamilies = text "NoTypeFamilies" -metaTyVarUpdateOK :: DynFlags - -> AreTypeFamiliesOK -- allow type families in RHS? - -> TcTyVar -- tv :: k1 - -> TcType -- ty :: k2 - -> MetaTyVarUpdateResult TcType -- possibly-expanded ty --- (metaTyVarUpdateOK tv ty) --- Checks that the equality tv~ty is OK to be used to rewrite --- other equalities. Equivalently, checks the conditions for CEqCan --- (a) that tv doesn't occur in ty (occurs check) --- (b) that ty does not have any foralls or (perhaps) type functions --- (c) that ty does not have any blocking coercion holes --- See Note [Equalities with incompatible kinds] in "GHC.Tc.Solver.Canonical" --- --- Used in two places: --- - In the eager unifier: uUnfilledVar2 --- - In the canonicaliser: GHC.Tc.Solver.Canonical.canEqTyVar2 --- Note that in the latter case tv is not necessarily a meta-tyvar, --- despite the name of this function. - --- We have two possible outcomes: --- (1) Return the type to update the type variable with, --- [we know the update is ok] --- (2) Return Nothing, --- [the update might be dodgy] --- --- Note that "Nothing" does not mean "definite error". For example --- type family F a --- type instance F Int = Int --- consider --- a ~ F a --- This is perfectly reasonable, if we later get a ~ Int. For now, though, --- we return Nothing, leaving it to the later constraint simplifier to --- sort matters out. --- --- See Note [Refactoring hazard: metaTyVarUpdateOK] - -metaTyVarUpdateOK dflags ty_fam_ok tv ty - = case checkTyVarEq dflags ty_fam_ok tv ty of - MTVU_OK _ -> MTVU_OK ty - MTVU_Bad -> MTVU_Bad -- forall, predicate, type function - MTVU_HoleBlocker -> MTVU_HoleBlocker -- coercion hole - MTVU_Occurs -> case occCheckExpand [tv] ty of - Just expanded_ty -> MTVU_OK expanded_ty - Nothing -> MTVU_Occurs - -checkTyVarEq :: DynFlags -> AreTypeFamiliesOK -> TcTyVar -> TcType -> MetaTyVarUpdateResult () +checkTyVarEq :: DynFlags -> AreTypeFamiliesOK -> TcTyVar -> TcType -> CheckTyEqResult checkTyVarEq dflags ty_fam_ok tv ty = inline checkTypeEq dflags ty_fam_ok (TyVarLHS tv) ty -- inline checkTypeEq so that the `case`s over the CanEqLHS get blasted away @@ -1973,13 +1972,13 @@ checkTyFamEq :: DynFlags -> TyCon -- type function -> [TcType] -- args, exactly saturated -> TcType -- RHS - -> MetaTyVarUpdateResult () + -> CheckTyEqResult checkTyFamEq dflags fun_tc fun_args ty = inline checkTypeEq dflags YesTypeFamilies (TyFamLHS fun_tc fun_args) ty -- inline checkTypeEq so that the `case`s over the CanEqLHS get blasted away checkTypeEq :: DynFlags -> AreTypeFamiliesOK -> CanEqLHS -> TcType - -> MetaTyVarUpdateResult () + -> CheckTyEqResult -- Checks the invariants for CEqCan. In particular: -- (a) a forall type (forall a. blah) -- (b) a predicate type (c => ty) @@ -1987,6 +1986,14 @@ checkTypeEq :: DynFlags -> AreTypeFamiliesOK -> CanEqLHS -> TcType -- (d) a blocking coercion hole -- (e) an occurrence of the LHS (occurs check) -- +-- Note that an occurs-check does not mean "definite error". For example +-- type family F a +-- type instance F Int = Int +-- consider +-- b0 ~ F b0 +-- This is perfectly reasonable, if we later get b0 ~ Int. But we +-- certainly can't unify b0 := F b0 +-- -- For (a), (b), and (c) we check only the top level of the type, NOT -- inside the kinds of variables it mentions. For (d) we look deeply -- in coercions when the LHS is a tyvar (but skip coercions for type family @@ -1994,14 +2001,11 @@ checkTypeEq :: DynFlags -> AreTypeFamiliesOK -> CanEqLHS -> TcType -- -- checkTypeEq is called from -- * checkTyFamEq, checkTyVarEq (which inline it to specialise away the --- case-analysis on 'lhs' +-- case-analysis on 'lhs') -- * checkEqCanLHSFinish, which does not know the form of 'lhs' checkTypeEq dflags ty_fam_ok lhs ty = go ty where - ok :: MetaTyVarUpdateResult () - ok = MTVU_OK () - -- The GHCi runtime debugger does its type-matching with -- unification variables that can unify with a polytype -- or a TyCon that would usually be disallowed by bad_tc @@ -2014,71 +2018,70 @@ checkTypeEq dflags ty_fam_ok lhs ty | otherwise = False - go :: TcType -> MetaTyVarUpdateResult () + go :: TcType -> CheckTyEqResult go (TyVarTy tv') = go_tv tv' go (TyConApp tc tys) = go_tc tc tys - go (LitTy {}) = ok + go (LitTy {}) = CTE_OK go (FunTy{ft_af = af, ft_mult = w, ft_arg = a, ft_res = r}) | InvisArg <- af - , not ghci_tv = MTVU_Bad - | otherwise = go w >> go a >> go r - go (AppTy fun arg) = go fun >> go arg - go (CastTy ty co) = go ty >> go_co co + , not ghci_tv = CTE_Bad + | otherwise = go w S.<> go a S.<> go r + go (AppTy fun arg) = go fun S.<> go arg + go (CastTy ty co) = go ty S.<> go_co co go (CoercionTy co) = go_co co go (ForAllTy (Bndr tv' _) ty) - | not ghci_tv = MTVU_Bad + | not ghci_tv = CTE_Bad | otherwise = case lhs of - TyVarLHS tv | tv == tv' -> ok - | otherwise -> do { go_occ tv (tyVarKind tv') - ; go ty } + TyVarLHS tv | tv == tv' -> CTE_OK + | otherwise -> go_occ tv (tyVarKind tv') S.<> go ty _ -> go ty - go_tv :: TcTyVar -> MetaTyVarUpdateResult () + go_tv :: TcTyVar -> CheckTyEqResult -- this slightly peculiar way of defining this means -- we don't have to evaluate this `case` at every variable -- occurrence go_tv = case lhs of TyVarLHS tv -> \ tv' -> if tv == tv' - then MTVU_Occurs + then CTE_Occurs else go_occ tv (tyVarKind tv') - TyFamLHS {} -> \ _tv' -> ok + TyFamLHS {} -> \ _tv' -> CTE_OK -- See Note [Occurrence checking: look inside kinds] in GHC.Core.Type -- For kinds, we only do an occurs check; we do not worry -- about type families or foralls -- See Note [Checking for foralls] - go_occ tv k | tv `elemVarSet` tyCoVarsOfType k = MTVU_Occurs - | otherwise = ok + go_occ tv k | tv `elemVarSet` tyCoVarsOfType k = CTE_Occurs + | otherwise = CTE_OK - go_tc :: TyCon -> [TcType] -> MetaTyVarUpdateResult () + go_tc :: TyCon -> [TcType] -> CheckTyEqResult -- this slightly peculiar way of defining this means -- we don't have to evaluate this `case` at every tyconapp go_tc = case lhs of TyVarLHS {} -> \ tc tys -> - if | good_tc tc -> mapM go tys >> ok - | otherwise -> MTVU_Bad + if | good_tc tc -> mconcat (map go tys) + | otherwise -> CTE_Bad TyFamLHS fam_tc fam_args -> \ tc tys -> - if | tcEqTyConApps fam_tc fam_args tc tys -> MTVU_Occurs - | good_tc tc -> mapM go tys >> ok - | otherwise -> MTVU_Bad + if | tcEqTyConApps fam_tc fam_args tc tys -> CTE_Occurs + | good_tc tc -> mconcat (map go tys) + | otherwise -> CTE_Bad -- no bother about impredicativity in coercions, as they're -- inferred go_co co | not (gopt Opt_DeferTypeErrors dflags) , hasCoercionHoleCo co - = MTVU_HoleBlocker -- Wrinkle (2) in GHC.Tc.Solver.Canonical + = CTE_HoleBlocker -- Wrinkle (2) in GHC.Tc.Solver.Canonical -- See GHC.Tc.Solver.Canonical Note [Equalities with incompatible kinds] -- Wrinkle (2) about this case in general, Wrinkle (4b) about the check for -- deferred type errors. | TyVarLHS tv <- lhs , tv `elemVarSet` tyCoVarsOfCo co - = MTVU_Occurs + = CTE_Occurs -- Don't check coercions for type families; see commentary at top of function | otherwise - = ok + = CTE_OK good_tc :: TyCon -> Bool good_tc ===================================== testsuite/tests/ghci.debugger/scripts/break012.stdout ===================================== @@ -1,14 +1,14 @@ Stopped in Main.g, break012.hs:5:10-18 -_result :: (p, a1 -> a1, (), a -> a -> a) = _ -a :: p = _ -b :: a2 -> a2 = _ +_result :: (a1, a2 -> a2, (), a -> a -> a) = _ +a :: a1 = _ +b :: a3 -> a3 = _ c :: () = _ d :: a -> a -> a = _ -a :: p -b :: a2 -> a2 +a :: a1 +b :: a3 -> a3 c :: () d :: a -> a -> a -a = (_t1::p) -b = (_t2::a2 -> a2) +a = (_t1::a1) +b = (_t2::a3 -> a3) c = (_t3::()) d = (_t4::a -> a -> a) ===================================== testsuite/tests/partial-sigs/should_compile/T10403.stderr ===================================== @@ -14,35 +14,18 @@ T10403.hs:15:12: warning: [-Wpartial-type-signatures (in -Wdefault)] • In the type signature: h1 :: _ => _ T10403.hs:19:7: warning: [-Wpartial-type-signatures (in -Wdefault)] - • Found type wildcard ‘_’ standing for ‘(a -> a1) -> f0 a -> H f0’ - Where: ‘f0’ is an ambiguous type variable + • Found type wildcard ‘_’ + standing for ‘(a -> a1) -> B t0 a -> H (B t0)’ + Where: ‘t0’ is an ambiguous type variable ‘a1’, ‘a’ are rigid type variables bound by - the inferred type of h2 :: (a -> a1) -> f0 a -> H f0 + the inferred type of h2 :: (a -> a1) -> B t0 a -> H (B t0) at T10403.hs:22:1-41 • In the type signature: h2 :: _ -T10403.hs:22:15: warning: [-Wdeferred-type-errors (in -Wdefault)] - • Ambiguous type variable ‘f0’ arising from a use of ‘fmap’ - prevents the constraint ‘(Functor f0)’ from being solved. - Relevant bindings include - b :: f0 a (bound at T10403.hs:22:6) - h2 :: (a -> a1) -> f0 a -> H f0 (bound at T10403.hs:22:1) - Probable fix: use a type annotation to specify what ‘f0’ should be. - These potential instances exist: - instance Functor IO -- Defined in ‘GHC.Base’ - instance Functor (B t) -- Defined at T10403.hs:10:10 - instance Functor I -- Defined at T10403.hs:6:10 - ...plus five others - ...plus two instances involving out-of-scope types - (use -fprint-potential-instances to see them all) - • In the second argument of ‘(.)’, namely ‘fmap (const ())’ - In the expression: (H . fmap (const ())) (fmap f b) - In an equation for ‘h2’: h2 f b = (H . fmap (const ())) (fmap f b) - T10403.hs:28:8: warning: [-Wdeferred-type-errors (in -Wdefault)] - • Couldn't match type ‘f0’ with ‘B t’ + • Couldn't match type ‘t0’ with ‘t’ Expected: H (B t) - Actual: H f0 + Actual: H (B t0) because type variable ‘t’ would escape its scope This (rigid, skolem) type variable is bound by the type signature for: ===================================== testsuite/tests/partial-sigs/should_compile/T14715.stderr ===================================== @@ -1,12 +1,11 @@ T14715.hs:13:53: warning: [-Wpartial-type-signatures (in -Wdefault)] - • Found extra-constraints wildcard standing for - ‘Reduce (LiftOf zq) zq’ - Where: ‘zq’ is a rigid type variable bound by + • Found extra-constraints wildcard standing for ‘Reduce z zq’ + Where: ‘z’, ‘zq’ are rigid type variables bound by the inferred type of - bench_mulPublic :: (z ~ LiftOf zq, Reduce (LiftOf zq) zq) => + bench_mulPublic :: (z ~ LiftOf zq, Reduce z zq) => Cyc zp -> Cyc z -> IO (zp, zq) - at T14715.hs:13:32-33 + at T14715.hs:13:27-33 • In the type signature: - bench_mulPublic :: forall z zp zq. - (z ~ LiftOf zq, _) => Cyc zp -> Cyc z -> IO (zp, zq) + bench_mulPublic :: forall z zp zq. (z ~ LiftOf zq, _) => + Cyc zp -> Cyc z -> IO (zp, zq) ===================================== testsuite/tests/partial-sigs/should_fail/ScopedNamedWildcardsBad.stderr ===================================== @@ -1,6 +1,11 @@ -ScopedNamedWildcardsBad.hs:8:21: error: +ScopedNamedWildcardsBad.hs:11:15: error: • Couldn't match expected type ‘Bool’ with actual type ‘Char’ - • In the first argument of ‘not’, namely ‘x’ - In the expression: not x - In an equation for ‘v’: v = not x + • In the first argument of ‘g’, namely ‘'x'’ + In the expression: g 'x' + In the expression: + let + v = not x + g :: _a -> _a + g x = x + in (g 'x') ===================================== testsuite/tests/typecheck/should_fail/ExpandSynsFail2.stderr ===================================== @@ -1,6 +1,6 @@ ExpandSynsFail2.hs:19:37: error: - • Couldn't match type ‘Int’ with ‘Bool’ + • Couldn't match type ‘Bool’ with ‘Int’ Expected: ST s Foo Actual: MyBarST s Type synonyms expanded: ===================================== testsuite/tests/typecheck/should_fail/T7453.stderr ===================================== @@ -1,6 +1,8 @@ -T7453.hs:10:30: error: - • Couldn't match expected type ‘t’ with actual type ‘p’ +T7453.hs:9:15: error: + • Couldn't match type ‘t’ with ‘p’ + Expected: Id t + Actual: Id p ‘t’ is a rigid type variable bound by the type signature for: z :: forall t. Id t @@ -8,17 +10,29 @@ T7453.hs:10:30: error: ‘p’ is a rigid type variable bound by the inferred type of cast1 :: p -> a at T7453.hs:(7,1)-(10,30) - • In the first argument of ‘Id’, namely ‘v’ - In the expression: Id v - In an equation for ‘aux’: aux = Id v + • In the expression: aux + In an equation for ‘z’: + z = aux + where + aux = Id v + In an equation for ‘cast1’: + cast1 v + = runId z + where + z :: Id t + z = aux + where + aux = Id v • Relevant bindings include - aux :: Id t (bound at T7453.hs:10:21) + aux :: Id p (bound at T7453.hs:10:21) z :: Id t (bound at T7453.hs:9:11) v :: p (bound at T7453.hs:7:7) cast1 :: p -> a (bound at T7453.hs:7:1) -T7453.hs:16:33: error: - • Couldn't match expected type ‘t1’ with actual type ‘p’ +T7453.hs:15:15: error: + • Couldn't match type ‘t1’ with ‘p’ + Expected: () -> t1 + Actual: () -> p ‘t1’ is a rigid type variable bound by the type signature for: z :: forall t1. () -> t1 @@ -26,11 +40,21 @@ T7453.hs:16:33: error: ‘p’ is a rigid type variable bound by the inferred type of cast2 :: p -> t at T7453.hs:(13,1)-(16,33) - • In the first argument of ‘const’, namely ‘v’ - In the expression: const v - In an equation for ‘aux’: aux = const v + • In the expression: aux + In an equation for ‘z’: + z = aux + where + aux = const v + In an equation for ‘cast2’: + cast2 v + = z () + where + z :: () -> t + z = aux + where + aux = const v • Relevant bindings include - aux :: b -> t1 (bound at T7453.hs:16:21) + aux :: forall {b}. b -> p (bound at T7453.hs:16:21) z :: () -> t1 (bound at T7453.hs:15:11) v :: p (bound at T7453.hs:13:7) cast2 :: p -> t (bound at T7453.hs:13:1) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a27aa1006668b3342ba0f98ae71317142e6de8d1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a27aa1006668b3342ba0f98ae71317142e6de8d1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 16 11:11:54 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Wed, 16 Dec 2020 06:11:54 -0500 Subject: [Git][ghc/ghc][wip/T17656] Kill floatEqualities completely Message-ID: <5fd9eb7ad0e66_6b216741854180332f@gitlab.mail> Simon Peyton Jones pushed to branch wip/T17656 at Glasgow Haskell Compiler / GHC Commits: 4273e231 by Simon Peyton Jones at 2020-12-16T11:10:36+00:00 Kill floatEqualities completely This patch delivers on #17656, by entirel killing off the complex floatEqualities mechanism. Previously, floatEqualities would float an equality out of an implication, so that it could be solved at an outer level. But now we simply do unification in-place, without floating the constraint, relying on level numbers to determine untouchability. There are a number of important new Notes: * GHC.Tc.Utils.Unify Note [Unification preconditions] describes the preconditions for unification, including both skolem-escape and touchability. * GHC.Tc.Solver.Interact Note [Solve by unification] describes what we do when we do unify * GHC.Tc.Solver.Monad Note [The Unification Level Flag] describes how we control solver iteration under this new scheme * GHC.Tc.Solver.Monad Note [Tracking Given equalities] describes how we track when we have Given equalities * GHC.Tc.Types.Constraint Note [HasGivenEqs] is a new explanation of the ic_given_eqs field of an implication A big raft of subtle Notes in Solver, concerning floatEqualities, disappears. Main code changes: * GHC.Tc.Solver.floatEqualities disappears entirely * GHC.Tc.Solver.Monad: new fields in InertCans, inert_given_eq_lvl and inert_given_eq, updated by updateGivenEqs See Note [Tracking Given equalities]. * In exchange for updateGivenEqa, GHC.Tc.Solver.Monad.getHasGivenEqs is much simpler and more efficient * I found I could kill of metaTyVarUpdateOK entirely One test case T14683 showed a 4.5% decrease in compile-time allocation. Other changes were small Metric Decrease: T14683 - - - - - 19 changed files: - compiler/GHC/Runtime/Heap/Inspect.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Interact.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Utils/Unify.hs - testsuite/tests/ghci.debugger/scripts/break012.stdout - testsuite/tests/partial-sigs/should_compile/T10403.stderr - testsuite/tests/partial-sigs/should_compile/T14715.stderr - testsuite/tests/partial-sigs/should_fail/ScopedNamedWildcardsBad.stderr - testsuite/tests/typecheck/should_fail/ExpandSynsFail2.stderr - testsuite/tests/typecheck/should_fail/T7453.stderr Changes: ===================================== compiler/GHC/Runtime/Heap/Inspect.hs ===================================== @@ -577,7 +577,7 @@ newOpenVar = liftTcM (do { kind <- newOpenTypeKind ~~~~~~~~~~~~~~~~~~~~~~ In the GHCi debugger we use unification variables whose MetaInfo is RuntimeUnkTv. The special property of a RuntimeUnkTv is that it can -unify with a polytype (see GHC.Tc.Utils.Unify.metaTyVarUpdateOK). +unify with a polytype (see GHC.Tc.Utils.Unify.checkTypeEq). If we don't do this `:print ` will fail if the type of has nested `forall`s or `=>`s. ===================================== compiler/GHC/Tc/Errors.hs ===================================== @@ -21,7 +21,7 @@ import GHC.Tc.Utils.Monad import GHC.Tc.Types.Constraint import GHC.Core.Predicate import GHC.Tc.Utils.TcMType -import GHC.Tc.Utils.Unify( occCheckForErrors, MetaTyVarUpdateResult(..) ) +import GHC.Tc.Utils.Unify( occCheckForErrors, CheckTyEqResult(..) ) import GHC.Tc.Utils.Env( tcInitTidyEnv ) import GHC.Tc.Utils.TcType import GHC.Tc.Types.Origin @@ -1482,7 +1482,7 @@ mkTyVarEqErr' dflags ctxt report ct tv1 ty2 , report ] - | MTVU_Occurs <- occ_check_expand + | CTE_Occurs <- occ_check_expand -- We report an "occurs check" even for a ~ F t a, where F is a type -- function; it's not insoluble (because in principle F could reduce) -- but we have certainly been unable to solve it @@ -1503,7 +1503,7 @@ mkTyVarEqErr' dflags ctxt report ct tv1 ty2 ; mkErrorMsgFromCt ctxt ct $ mconcat [headline_msg, extra2, extra3, report] } - | MTVU_Bad <- occ_check_expand + | CTE_Bad <- occ_check_expand = do { let msg = vcat [ text "Cannot instantiate unification variable" <+> quotes (ppr tv1) , hang (text "with a" <+> what <+> text "involving polytypes:") 2 (ppr ty2) ] ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -907,7 +907,7 @@ That is the entire point of qlUnify! Wrinkles: * We must not make an occurs-check; we use occCheckExpand for that. -* metaTyVarUpdateOK also checks for various other things, including +* checkTypeEq also checks for various other things, including - foralls, and predicate types (which we want to allow here) - type families (relates to a very specific and exotic performance question, that is unlikely to bite here) ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -311,7 +311,7 @@ Note [Promotion in signatures] If an unsolved metavariable in a signature is not generalized (because we're not generalizing the construct -- e.g., pattern sig -- or because the metavars are constrained -- see kindGeneralizeSome) -we need to promote to maintain (WantedTvInv) of Note [TcLevel and untouchable type variables] +we need to promote to maintain (WantedTvInv) of Note [TcLevel invariants] in GHC.Tc.Utils.TcType. Note that promotion is identical in effect to generalizing and the reinstantiating with a fresh metavariable at the current level. So in some sense, we generalize *all* variables, but then re-instantiate @@ -329,7 +329,7 @@ the pattern signature (which is not kind-generalized). When we are checking the *body* of foo, though, we need to unify the type of x with the argument type of bar. At this point, the ambient TcLevel is 1, and spotting a matavariable with level 2 would violate the (WantedTvInv) invariant of -Note [TcLevel and untouchable type variables]. So, instead of kind-generalizing, +Note [TcLevel invariants]. So, instead of kind-generalizing, we promote the metavariable to level 1. This is all done in kindGeneralizeNone. -} ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -264,7 +264,7 @@ floatKindEqualities wc = float_wc emptyVarSet wc = Nothing -- A short cut /plus/ we must keep track of IC_BadTelescope | otherwise = do { (simples, holes) <- float_wc new_trapping_tvs wanted - ; when (not (isEmptyBag simples) && given_eqs /= NoGivenEqs) $ + ; when (not (isEmptyBag simples) && given_eqs == MaybeGivenEqs) $ Nothing -- If there are some constraints to float out, but we can't -- because we don't float out past local equalities @@ -1282,7 +1282,8 @@ decideMonoTyVars infer_mode name_taus psigs candidates mr_msg ; traceTc "decideMonoTyVars" $ vcat - [ text "mono_tvs0 =" <+> ppr mono_tvs0 + [ text "infer_mode =" <+> ppr infer_mode + , text "mono_tvs0 =" <+> ppr mono_tvs0 , text "no_quant =" <+> ppr no_quant , text "maybe_quant =" <+> ppr maybe_quant , text "eq_constraints =" <+> ppr eq_constraints @@ -1405,7 +1406,10 @@ decideQuantifiedTyVars name_taus psigs candidates dvs_plus = dv { dv_kvs = pick cand_kvs, dv_tvs = pick cand_tvs } ; traceTc "decideQuantifiedTyVars" (vcat - [ text "candidates =" <+> ppr candidates + [ text "tau_tys =" <+> ppr tau_tys + , text "candidates =" <+> ppr candidates + , text "cand_kvs =" <+> ppr cand_kvs + , text "cand_tvs =" <+> ppr cand_tvs , text "tau_tys =" <+> ppr tau_tys , text "seed_tys =" <+> ppr seed_tys , text "seed_tcvs =" <+> ppr (tyCoVarsOfTypes seed_tys) @@ -1660,22 +1664,14 @@ solveWantedsAndDrop wanted solveWanteds :: WantedConstraints -> TcS WantedConstraints -- so that the inert set doesn't mindlessly propagate. -- NB: wc_simples may be wanted /or/ derived now -solveWanteds wc@(WC { wc_simple = simples, wc_impl = implics, wc_holes = holes }) +solveWanteds wc@(WC { wc_holes = holes }) = do { cur_lvl <- TcS.getTcLevel ; traceTcS "solveWanteds {" $ vcat [ text "Level =" <+> ppr cur_lvl , ppr wc ] - ; wc1 <- solveSimpleWanteds simples - -- Any insoluble constraints are in 'simples' and so get rewritten - -- See Note [Rewrite insolubles] in GHC.Tc.Solver.Monad - - ; (floated_eqs, implics2) <- solveNestedImplications $ - implics `unionBags` wc_impl wc1 - - ; dflags <- getDynFlags - ; solved_wc <- simpl_loop 0 (solverIterations dflags) floated_eqs - (wc1 { wc_impl = implics2 }) + ; dflags <- getDynFlags + ; solved_wc <- simplify_loop 0 (solverIterations dflags) True wc ; holes' <- simplifyHoles holes ; let final_wc = solved_wc { wc_holes = holes' } @@ -1688,9 +1684,44 @@ solveWanteds wc@(WC { wc_simple = simples, wc_impl = implics, wc_holes = holes } ; return final_wc } -simpl_loop :: Int -> IntWithInf -> Cts - -> WantedConstraints -> TcS WantedConstraints -simpl_loop n limit floated_eqs wc@(WC { wc_simple = simples }) +simplify_loop :: Int -> IntWithInf -> Bool + -> WantedConstraints -> TcS WantedConstraints +-- Do a round of solving, and call maybe_simplify_again to iterate +-- The 'definitely_redo_implications' flags is False if the only reason we +-- are iterating is that we have added some new Derived superclasses (from Wanteds) +-- hoping for fundeps to help us; see Note [Superclass iteration] +-- +-- Does not affect wc_holes at all; reason: wc_holes never affects anything +-- else, so we do them once, at the end in solveWanteds +simplify_loop n limit definitely_redo_implications + wc@(WC { wc_simple = simples, wc_impl = implics }) + = do { csTraceTcS $ + text "simplify_loop iteration=" <> int n + <+> (parens $ hsep [ text "definitely_redo =" <+> ppr definitely_redo_implications <> comma + , int (lengthBag simples) <+> text "simples to solve" ]) + ; traceTcS "simplify_loop: wc =" (ppr wc) + + ; (unifs1, wc1) <- reportUnifications $ -- See Note [Superclass iteration] + solveSimpleWanteds simples + -- Any insoluble constraints are in 'simples' and so get rewritten + -- See Note [Rewrite insolubles] in GHC.Tc.Solver.Monad + + ; wc2 <- if not definitely_redo_implications -- See Note [Superclass iteration] + && unifs1 == 0 -- for this conditional + && isEmptyBag (wc_impl wc1) + then return (wc { wc_simple = wc_simple wc1 }) -- Short cut + else do { implics2 <- solveNestedImplications $ + implics `unionBags` (wc_impl wc1) + ; return (wc { wc_simple = wc_simple wc1 + , wc_impl = implics2 }) } + + ; unif_happened <- resetUnificationFlag + -- Note [The Unification Level Flag] in GHC.Tc.Solver.Monad + ; maybe_simplify_again (n+1) limit unif_happened wc2 } + +maybe_simplify_again :: Int -> IntWithInf -> Bool + -> WantedConstraints -> TcS WantedConstraints +maybe_simplify_again n limit unif_happened wc@(WC { wc_simple = simples }) | n `intGtLimit` limit = do { -- Add an error (not a warning) if we blow the limit, -- Typically if we blow the limit we are going to report some other error @@ -1699,17 +1730,12 @@ simpl_loop n limit floated_eqs wc@(WC { wc_simple = simples }) addErrTcS (hang (text "solveWanteds: too many iterations" <+> parens (text "limit =" <+> ppr limit)) 2 (vcat [ text "Unsolved:" <+> ppr wc - , ppUnless (isEmptyBag floated_eqs) $ - text "Floated equalities:" <+> ppr floated_eqs , text "Set limit with -fconstraint-solver-iterations=n; n=0 for no limit" ])) ; return wc } - | not (isEmptyBag floated_eqs) - = simplify_again n limit True (wc { wc_simple = floated_eqs `unionBags` simples }) - -- Put floated_eqs first so they get solved first - -- NB: the floated_eqs may include /derived/ equalities - -- arising from fundeps inside an implication + | unif_happened + = simplify_loop n limit True wc | superClassesMightHelp wc = -- We still have unsolved goals, and apparently no way to solve them, @@ -1722,82 +1748,65 @@ simpl_loop n limit floated_eqs wc@(WC { wc_simple = simples }) do { new_given <- makeSuperClasses pending_given ; new_wanted <- makeSuperClasses pending_wanted ; solveSimpleGivens new_given -- Add the new Givens to the inert set - ; simplify_again n limit (null pending_given) + ; simplify_loop n limit (not (null pending_given)) $ wc { wc_simple = simples1 `unionBags` listToBag new_wanted } } } + -- (not (null pending_given)): see Note [Superclass iteration] | otherwise = return wc -simplify_again :: Int -> IntWithInf -> Bool - -> WantedConstraints -> TcS WantedConstraints --- We have definitely decided to have another go at solving --- the wanted constraints (we have tried at least once already -simplify_again n limit no_new_given_scs - wc@(WC { wc_simple = simples, wc_impl = implics }) - = do { csTraceTcS $ - text "simpl_loop iteration=" <> int n - <+> (parens $ hsep [ text "no new given superclasses =" <+> ppr no_new_given_scs <> comma - , int (lengthBag simples) <+> text "simples to solve" ]) - ; traceTcS "simpl_loop: wc =" (ppr wc) - - ; (unifs1, wc1) <- reportUnifications $ - solveSimpleWanteds $ - simples - - -- See Note [Cutting off simpl_loop] - -- We have already tried to solve the nested implications once - -- Try again only if we have unified some meta-variables - -- (which is a bit like adding more givens), or we have some - -- new Given superclasses - ; let new_implics = wc_impl wc1 - ; if unifs1 == 0 && - no_new_given_scs && - isEmptyBag new_implics - - then -- Do not even try to solve the implications - simpl_loop (n+1) limit emptyBag (wc1 { wc_impl = implics }) - - else -- Try to solve the implications - do { (floated_eqs2, implics2) <- solveNestedImplications $ - implics `unionBags` new_implics - ; simpl_loop (n+1) limit floated_eqs2 (wc1 { wc_impl = implics2 }) - } } +{- Note [Superclass iteration] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider this implication constraint + forall a. + [W] d: C Int beta + forall b. blah +where + class D a b | a -> b + class D a b => C a b +We will expand d's superclasses, giving [D] D Int beta, in the hope of geting +fundeps to unify beta. Doing so is usually fruitless (no useful fundeps), +and if so it seems a pity to waste time iterating the implications (forall b. blah) +(If we add new Given superclasses it's a different matter: it's really worth looking +at the implications.) + +Hence the definitely_redo_implications flag to simplify_loop. It's usually +True, but False in the case where the only reason to iterate is new Derived +superclasses. In that case we check whether the new Deriveds actually led to +any new unifications, and iterate the implications only if so. +-} solveNestedImplications :: Bag Implication - -> TcS (Cts, Bag Implication) + -> TcS (Bag Implication) -- Precondition: the TcS inerts may contain unsolved simples which have -- to be converted to givens before we go inside a nested implication. solveNestedImplications implics | isEmptyBag implics - = return (emptyBag, emptyBag) + = return (emptyBag) | otherwise = do { traceTcS "solveNestedImplications starting {" empty - ; (floated_eqs_s, unsolved_implics) <- mapAndUnzipBagM solveImplication implics - ; let floated_eqs = concatBag floated_eqs_s + ; unsolved_implics <- mapBagM solveImplication implics -- ... and we are back in the original TcS inerts -- Notice that the original includes the _insoluble_simples so it was safe to ignore -- them in the beginning of this function. ; traceTcS "solveNestedImplications end }" $ - vcat [ text "all floated_eqs =" <+> ppr floated_eqs - , text "unsolved_implics =" <+> ppr unsolved_implics ] + vcat [ text "unsolved_implics =" <+> ppr unsolved_implics ] - ; return (floated_eqs, catBagMaybes unsolved_implics) } + ; return (catBagMaybes unsolved_implics) } solveImplication :: Implication -- Wanted - -> TcS (Cts, -- All wanted or derived floated equalities: var = type - Maybe Implication) -- Simplified implication (empty or singleton) + -> TcS (Maybe Implication) -- Simplified implication (empty or singleton) -- Precondition: The TcS monad contains an empty worklist and given-only inerts -- which after trying to solve this implication we must restore to their original value solveImplication imp@(Implic { ic_tclvl = tclvl , ic_binds = ev_binds_var - , ic_skols = skols , ic_given = given_ids , ic_wanted = wanteds , ic_info = info , ic_status = status }) | isSolvedStatus status - = return (emptyCts, Just imp) -- Do nothing + = return (Just imp) -- Do nothing | otherwise -- Even for IC_Insoluble it is worth doing more work -- The insoluble stuff might be in one sub-implication @@ -1819,7 +1828,7 @@ solveImplication imp@(Implic { ic_tclvl = tclvl ; residual_wanted <- solveWanteds wanteds -- solveWanteds, *not* solveWantedsAndDrop, because -- we want to retain derived equalities so we can float - -- them out in floatEqualities + -- them out in floatEqualities. ; (has_eqs, given_insols) <- getHasGivenEqs tclvl -- Call getHasGivenEqs /after/ solveWanteds, because @@ -1828,10 +1837,6 @@ solveImplication imp@(Implic { ic_tclvl = tclvl ; return (has_eqs, given_insols, residual_wanted) } - ; (floated_eqs, residual_wanted) - <- floatEqualities skols given_ids ev_binds_var - has_given_eqs residual_wanted - ; traceTcS "solveImplication 2" (ppr given_insols $$ ppr residual_wanted) ; let final_wanted = residual_wanted `addInsols` given_insols @@ -1845,15 +1850,14 @@ solveImplication imp@(Implic { ic_tclvl = tclvl ; tcvs <- TcS.getTcEvTyCoVars ev_binds_var ; traceTcS "solveImplication end }" $ vcat [ text "has_given_eqs =" <+> ppr has_given_eqs - , text "floated_eqs =" <+> ppr floated_eqs , text "res_implic =" <+> ppr res_implic , text "implication evbinds =" <+> ppr (evBindMapBinds evbinds) , text "implication tvcs =" <+> ppr tcvs ] - ; return (floated_eqs, res_implic) } + ; return res_implic } -- TcLevels must be strictly increasing (see (ImplicInv) in - -- Note [TcLevel and untouchable type variables] in GHC.Tc.Utils.TcType), + -- Note [TcLevel invariants] in GHC.Tc.Utils.TcType), -- and in fact I think they should always increase one level at a time. -- Though sensible, this check causes lots of testsuite failures. It is @@ -2237,49 +2241,8 @@ Consider (see #9939) We report (Eq a) as redundant, whereas actually (Ord a) is. But it's really not easy to detect that! - -Note [Cutting off simpl_loop] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -It is very important not to iterate in simpl_loop unless there is a chance -of progress. #8474 is a classic example: - - * There's a deeply-nested chain of implication constraints. - ?x:alpha => ?y1:beta1 => ... ?yn:betan => [W] ?x:Int - - * From the innermost one we get a [D] alpha ~ Int, - but alpha is untouchable until we get out to the outermost one - - * We float [D] alpha~Int out (it is in floated_eqs), but since alpha - is untouchable, the solveInteract in simpl_loop makes no progress - - * So there is no point in attempting to re-solve - ?yn:betan => [W] ?x:Int - via solveNestedImplications, because we'll just get the - same [D] again - - * If we *do* re-solve, we'll get an infinite loop. It is cut off by - the fixed bound of 10, but solving the next takes 10*10*...*10 (ie - exponentially many) iterations! - -Conclusion: we should call solveNestedImplications only if we did -some unification in solveSimpleWanteds; because that's the only way -we'll get more Givens (a unification is like adding a Given) to -allow the implication to make progress. -} -promoteTyVarTcS :: TcTyVar -> TcS () --- When we float a constraint out of an implication we must restore --- invariant (WantedInv) in Note [TcLevel and untouchable type variables] in GHC.Tc.Utils.TcType --- See Note [Promoting unification variables] --- We don't just call promoteTyVar because we want to use unifyTyVar, --- not writeMetaTyVar -promoteTyVarTcS tv - = do { tclvl <- TcS.getTcLevel - ; when (isFloatedTouchableMetaTyVar tclvl tv) $ - do { cloned_tv <- TcS.cloneMetaTyVar tv - ; let rhs_tv = setMetaTyVarTcLevel cloned_tv tclvl - ; unifyTyVar tv (mkTyVarTy rhs_tv) } } - -- | Like 'defaultTyVar', but in the TcS monad. defaultTyVarTcS :: TcTyVar -> TcS Bool defaultTyVarTcS the_tv @@ -2314,7 +2277,7 @@ approximateWC float_past_equalities wc concatMapBag (float_implic trapping_tvs) implics float_implic :: TcTyCoVarSet -> Implication -> Cts float_implic trapping_tvs imp - | float_past_equalities || ic_given_eqs imp == NoGivenEqs + | float_past_equalities || ic_given_eqs imp /= MaybeGivenEqs = float_wc new_trapping_tvs (ic_wanted imp) | otherwise -- Take care with equalities = emptyCts -- See (1) under Note [ApproximateWC] @@ -2414,7 +2377,7 @@ approximateWC to produce a list of candidate constraints. Then we MUST a) Promote any meta-tyvars that have been floated out by approximateWC, to restore invariant (WantedInv) described in - Note [TcLevel and untouchable type variables] in GHC.Tc.Utils.TcType. + Note [TcLevel invariants] in GHC.Tc.Utils.TcType. b) Default the kind of any meta-tyvars that are not mentioned in in the environment. @@ -2430,8 +2393,7 @@ Note [Promoting unification variables] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When we float an equality out of an implication we must "promote" free unification variables of the equality, in order to maintain Invariant -(WantedInv) from Note [TcLevel and untouchable type variables] in -TcType. for the leftover implication. +(WantedInv) from Note [TcLevel invariants] in GHC.Tc.Types.TcType. This is absolutely necessary. Consider the following example. We start with two implications and a class with a functional dependency. @@ -2468,276 +2430,6 @@ beta! Concrete example is in indexed_types/should_fail/ExtraTcsUntch.hs: in (g1 '3', g2 undefined) - -********************************************************************************* -* * -* Floating equalities * -* * -********************************************************************************* - -Note [Float Equalities out of Implications] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -For ordinary pattern matches (including existentials) we float -equalities out of implications, for instance: - data T where - MkT :: Eq a => a -> T - f x y = case x of MkT _ -> (y::Int) -We get the implication constraint (x::T) (y::alpha): - forall a. [untouchable=alpha] Eq a => alpha ~ Int -We want to float out the equality into a scope where alpha is no -longer untouchable, to solve the implication! - -But we cannot float equalities out of implications whose givens may -yield or contain equalities: - - data T a where - T1 :: T Int - T2 :: T Bool - T3 :: T a - - h :: T a -> a -> Int - - f x y = case x of - T1 -> y::Int - T2 -> y::Bool - T3 -> h x y - -We generate constraint, for (x::T alpha) and (y :: beta): - [untouchables = beta] (alpha ~ Int => beta ~ Int) -- From 1st branch - [untouchables = beta] (alpha ~ Bool => beta ~ Bool) -- From 2nd branch - (alpha ~ beta) -- From 3rd branch - -If we float the equality (beta ~ Int) outside of the first implication and -the equality (beta ~ Bool) out of the second we get an insoluble constraint. -But if we just leave them inside the implications, we unify alpha := beta and -solve everything. - -Principle: - We do not want to float equalities out which may - need the given *evidence* to become soluble. - -Consequence: classes with functional dependencies don't matter (since there is -no evidence for a fundep equality), but equality superclasses do matter (since -they carry evidence). --} - -floatEqualities :: [TcTyVar] -> [EvId] -> EvBindsVar -> HasGivenEqs - -> WantedConstraints - -> TcS (Cts, WantedConstraints) --- Main idea: see Note [Float Equalities out of Implications] --- --- Precondition: the wc_simple of the incoming WantedConstraints are --- fully zonked, so that we can see their free variables --- --- Postcondition: The returned floated constraints (Cts) are only --- Wanted or Derived --- --- Also performs some unifications (via promoteTyVar), adding to --- monadically-carried ty_binds. These will be used when processing --- floated_eqs later --- --- Subtleties: Note [Float equalities from under a skolem binding] --- Note [Skolem escape] --- Note [What prevents a constraint from floating] -floatEqualities skols given_ids ev_binds_var has_given_eqs - wanteds@(WC { wc_simple = simples }) - | MaybeGivenEqs <- has_given_eqs -- There are some given equalities, so don't float - = return (emptyBag, wanteds) -- Note [Float Equalities out of Implications] - - | otherwise - = do { -- First zonk: the inert set (from whence they came) is not - -- necessarily fully zonked; equalities are not kicked out - -- if a unification cannot make progress. See Note - -- [inert_eqs: the inert equalities] in GHC.Tc.Solver.Monad, which - -- describes how the inert set might not actually be inert. - simples <- TcS.zonkSimples simples - ; binds <- TcS.getTcEvBindsMap ev_binds_var - - -- Now we can pick the ones to float - -- The constraints are de-canonicalised - ; let (candidate_eqs, no_float_cts) = partitionBag is_float_eq_candidate simples - - seed_skols = mkVarSet skols `unionVarSet` - mkVarSet given_ids `unionVarSet` - foldr add_non_flt_ct emptyVarSet no_float_cts `unionVarSet` - evBindMapToVarSet binds - -- seed_skols: See Note [What prevents a constraint from floating] (1,2,3) - -- Include the EvIds of any non-floating constraints - - extended_skols = transCloVarSet (add_captured_ev_ids candidate_eqs) seed_skols - -- extended_skols contains the EvIds of all the trapped constraints - -- See Note [What prevents a constraint from floating] (3) - - (flt_eqs, no_flt_eqs) = partitionBag (is_floatable extended_skols) - candidate_eqs - - remaining_simples = no_float_cts `andCts` no_flt_eqs - - -- Promote any unification variables mentioned in the floated equalities - -- See Note [Promoting unification variables] - ; mapM_ promoteTyVarTcS (tyCoVarsOfCtsList flt_eqs) - - ; traceTcS "floatEqualities" (vcat [ text "Skols =" <+> ppr skols - , text "Extended skols =" <+> ppr extended_skols - , text "Simples =" <+> ppr simples - , text "Candidate eqs =" <+> ppr candidate_eqs - , text "Floated eqs =" <+> ppr flt_eqs]) - ; return ( flt_eqs, wanteds { wc_simple = remaining_simples } ) } - - where - add_non_flt_ct :: Ct -> VarSet -> VarSet - add_non_flt_ct ct acc | isDerivedCt ct = acc - | otherwise = extendVarSet acc (ctEvId ct) - - is_floatable :: VarSet -> Ct -> Bool - is_floatable skols ct - | isDerivedCt ct = tyCoVarsOfCt ct `disjointVarSet` skols - | otherwise = not (ctEvId ct `elemVarSet` skols) - - add_captured_ev_ids :: Cts -> VarSet -> VarSet - add_captured_ev_ids cts skols = foldr extra_skol emptyVarSet cts - where - extra_skol ct acc - | isDerivedCt ct = acc - | tyCoVarsOfCt ct `intersectsVarSet` skols = extendVarSet acc (ctEvId ct) - | otherwise = acc - - -- Identify which equalities are candidates for floating - -- Float out alpha ~ ty which might be unified outside - -- See Note [Which equalities to float] - is_float_eq_candidate ct - | pred <- ctPred ct - , EqPred NomEq ty1 ty2 <- classifyPredType pred - , case ct of - CIrredCan {} -> False -- See Note [Do not float blocked constraints] - _ -> True -- See #18855 - = float_eq ty1 ty2 || float_eq ty2 ty1 - | otherwise - = False - - float_eq ty1 ty2 - = case getTyVar_maybe ty1 of - Just tv1 -> isMetaTyVar tv1 - && (not (isTyVarTyVar tv1) || isTyVarTy ty2) - Nothing -> False - -{- Note [Do not float blocked constraints] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -As #18855 showed, we must not float an equality that is blocked. -Consider - forall a[4]. [W] co1: alpha[4] ~ Maybe (a[4] |> bco) - [W] co2: alpha[4] ~ Maybe (beta[4] |> bco]) - [W] bco: kappa[2] ~ Type - -Now co1, co2 are blocked by bco. We will eventually float out bco -and solve it at level 2. But the danger is that we will *also* -float out co2, and that is bad bad bad. Because we'll promote alpha -and beta to level 2, and then fail to unify the promoted beta -with the skolem a[4]. - -Solution: don't float out blocked equalities. Remember: we only want -to float out if we can solve; see Note [Which equalities to float]. - -(Future plan: kill floating altogether.) - -Note [Float equalities from under a skolem binding] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Which of the simple equalities can we float out? Obviously, only -ones that don't mention the skolem-bound variables. But that is -over-eager. Consider - [2] forall a. F a beta[1] ~ gamma[2], G beta[1] gamma[2] ~ Int -The second constraint doesn't mention 'a'. But if we float it, -we'll promote gamma[2] to gamma'[1]. Now suppose that we learn that -beta := Bool, and F a Bool = a, and G Bool _ = Int. Then we'll -we left with the constraint - [2] forall a. a ~ gamma'[1] -which is insoluble because gamma became untouchable. - -Solution: float only constraints that stand a jolly good chance of -being soluble simply by being floated, namely ones of form - a ~ ty -where 'a' is a currently-untouchable unification variable, but may -become touchable by being floated (perhaps by more than one level). - -We had a very complicated rule previously, but this is nice and -simple. (To see the notes, look at this Note in a version of -GHC.Tc.Solver prior to Oct 2014). - -Note [Which equalities to float] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Which equalities should we float? We want to float ones where there -is a decent chance that floating outwards will allow unification to -happen. In particular, float out equalities that are: - -* Of form (alpha ~# ty) or (ty ~# alpha), where - * alpha is a meta-tyvar. - * And 'alpha' is not a TyVarTv with 'ty' being a non-tyvar. In that - case, floating out won't help either, and it may affect grouping - of error messages. - - NB: generally we won't see (ty ~ alpha), with alpha on the right because - of Note [Unification variables on the left] in GHC.Tc.Utils.Unify, - but if we have (F tys ~ alpha) and alpha is untouchable, then it will - appear on the right. Example T4494. - -* Nominal. No point in floating (alpha ~R# ty), because we do not - unify representational equalities even if alpha is touchable. - See Note [Do not unify representational equalities] in GHC.Tc.Solver.Interact. - -Note [Skolem escape] -~~~~~~~~~~~~~~~~~~~~ -You might worry about skolem escape with all this floating. -For example, consider - [2] forall a. (a ~ F beta[2] delta, - Maybe beta[2] ~ gamma[1]) - -The (Maybe beta ~ gamma) doesn't mention 'a', so we float it, and -solve with gamma := beta. But what if later delta:=Int, and - F b Int = b. -Then we'd get a ~ beta[2], and solve to get beta:=a, and now the -skolem has escaped! - -But it's ok: when we float (Maybe beta[2] ~ gamma[1]), we promote beta[2] -to beta[1], and that means the (a ~ beta[1]) will be stuck, as it should be. - -Note [What prevents a constraint from floating] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -What /prevents/ a constraint from floating? If it mentions one of the -"bound variables of the implication". What are they? - -The "bound variables of the implication" are - - 1. The skolem type variables `ic_skols` - - 2. The "given" evidence variables `ic_given`. Example: - forall a. (co :: t1 ~# t2) => [W] co2 : (a ~# b |> co) - Here 'co' is bound - - 3. The binders of all evidence bindings in `ic_binds`. Example - forall a. (d :: t1 ~ t2) - EvBinds { (co :: t1 ~# t2) = superclass-sel d } - => [W] co2 : (a ~# b |> co) - Here `co` is gotten by superclass selection from `d`, and the - wanted constraint co2 must not float. - - 4. And the evidence variable of any equality constraint (incl - Wanted ones) whose type mentions a bound variable. Example: - forall k. [W] co1 :: t1 ~# t2 |> co2 - [W] co2 :: k ~# * - Here, since `k` is bound, so is `co2` and hence so is `co1`. - -Here (1,2,3) are handled by the "seed_skols" calculation, and -(4) is done by the transCloVarSet call. - -The possible dependence on givens, and evidence bindings, is more -subtle than we'd realised at first. See #14584. - -How can (4) arise? Suppose we have (k :: *), (a :: k), and ([G} k ~ *). -Then form an equality like (a ~ Int) we might end up with - [W] co1 :: k ~ * - [W] co2 :: (a |> co1) ~ Int - - ********************************************************************************* * * * Defaulting and disambiguation * ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -4,9 +4,9 @@ module GHC.Tc.Solver.Canonical( canonicalize, - unifyDerived, + unifyDerived, unifyTest, UnifyTestResult(..), makeSuperClasses, - StopOrContinue(..), stopWith, continueWith, + StopOrContinue(..), stopWith, continueWith, andWhenContinue, solveCallStack -- For GHC.Tc.Solver ) where @@ -51,7 +51,8 @@ import GHC.Data.Bag import GHC.Utils.Monad import Control.Monad import Data.Maybe ( isJust, isNothing ) -import Data.List ( zip4 ) +import Data.List ( zip4, partition ) +import GHC.Types.Unique.Set( nonDetEltsUniqSet ) import GHC.Types.Basic import Data.Bifunctor ( bimap ) @@ -2241,10 +2242,10 @@ canEqCanLHS2 ev eq_rel swapped lhs1 ps_xi1 lhs2 ps_xi2 mco -- If we have F a ~ F (F a), we want to swap. swap_for_occurs - | MTVU_OK () <- checkTyFamEq dflags fun_tc2 fun_args2 - (mkTyConApp fun_tc1 fun_args1) - , MTVU_Occurs <- checkTyFamEq dflags fun_tc1 fun_args1 - (mkTyConApp fun_tc2 fun_args2) + | CTE_OK <- checkTyFamEq dflags fun_tc2 fun_args2 + (mkTyConApp fun_tc1 fun_args1) + , CTE_Occurs <- checkTyFamEq dflags fun_tc1 fun_args1 + (mkTyConApp fun_tc2 fun_args2) = True | otherwise @@ -2269,8 +2270,8 @@ canEqCanLHS2 ev eq_rel swapped lhs1 ps_xi1 lhs2 ps_xi2 mco -- This function handles the case where one side is a tyvar and the other is -- a type family application. Which to put on the left? --- If we can unify the variable, put it on the left, as this may be our only --- shot to unify. +-- If the tyvar is a touchable meta-tyvar, put it on the left, as this may +-- be our only shot to unify. -- Otherwise, put the function on the left, because it's generally better to -- rewrite away function calls. This makes types smaller. And it seems necessary: -- [W] F alpha ~ alpha @@ -2278,22 +2279,20 @@ canEqCanLHS2 ev eq_rel swapped lhs1 ps_xi1 lhs2 ps_xi2 mco -- [W] G alpha beta ~ Int ( where we have type instance G a a = a ) -- If we end up with a stuck alpha ~ F alpha, we won't be able to solve this. -- Test case: indexed-types/should_compile/CEqCanOccursCheck --- It would probably work to always put the variable on the left, but we think --- it would be less efficient. canEqTyVarFunEq :: CtEvidence -- :: lhs ~ (rhs |> mco) -- or (rhs |> mco) ~ lhs if swapped -> EqRel -> SwapFlag - -> TyVar -> TcType -- lhs, pretty lhs - -> TyCon -> [Xi] -> TcType -- rhs fun, rhs args, pretty rhs + -> TyVar -> TcType -- lhs (or if swapped rhs), pretty lhs + -> TyCon -> [Xi] -> TcType -- rhs (or if swapped lhs) fun and args, pretty rhs -> MCoercion -- :: kind(rhs) ~N kind(lhs) -> TcS (StopOrContinue Ct) canEqTyVarFunEq ev eq_rel swapped tv1 ps_xi1 fun_tc2 fun_args2 ps_xi2 mco - = do { tclvl <- getTcLevel - ; dflags <- getDynFlags - ; if | isTouchableMetaTyVar tclvl tv1 - , MTVU_OK _ <- checkTyVarEq dflags YesTypeFamilies tv1 (ps_xi2 `mkCastTyMCo` mco) - -> canEqCanLHSFinish ev eq_rel swapped (TyVarLHS tv1) - (ps_xi2 `mkCastTyMCo` mco) + = do { can_unify <- unifyTest ev tv1 rhs + ; dflags <- getDynFlags + ; if | case can_unify of { NoUnify -> False; _ -> True } + , CTE_OK <- checkTyVarEq dflags YesTypeFamilies tv1 rhs + -> canEqCanLHSFinish ev eq_rel swapped (TyVarLHS tv1) rhs + | otherwise -> do { new_ev <- rewriteCastedEquality ev eq_rel swapped (mkTyVarTy tv1) (mkTyConApp fun_tc2 fun_args2) @@ -2303,6 +2302,56 @@ canEqTyVarFunEq ev eq_rel swapped tv1 ps_xi1 fun_tc2 fun_args2 ps_xi2 mco (ps_xi1 `mkCastTyMCo` sym_mco) } } where sym_mco = mkTcSymMCo mco + rhs = ps_xi2 `mkCastTyMCo` mco + +data UnifyTestResult + -- See Note [Solve by unification] in GHC.Tc.Solver.Interact + -- which points out that having UnifySameLevel is just an optimisation; + -- we could manage with UnifyOuterLevel alone (suitably renamed) + = UnifySameLevel + | UnifyOuterLevel [TcTyVar] -- Promote these + TcLevel -- ..to this level + | NoUnify + +instance Outputable UnifyTestResult where + ppr UnifySameLevel = text "UnifySameLevel" + ppr (UnifyOuterLevel tvs lvl) = text "UnifyOuterLevel" <> parens (ppr lvl <+> ppr tvs) + ppr NoUnify = text "NoUnify" + +unifyTest :: CtEvidence -> TcTyVar -> TcType -> TcS UnifyTestResult +-- This is the key test for untouchability: +-- See Note [Unification preconditions] in GHC.Tc.Utils.Unify +-- and Note [Solve by unification] in GHC.Tc.Solver.Interact +unifyTest _ev tv1 rhs + | -- The _ev is because I'd like to test not (isGivenEv), because + -- we never unify in a Given, but that's not quite true yet: #18929 + MetaTv { mtv_tclvl = tv_lvl, mtv_info = info } <- tcTyVarDetails tv1 + , canSolveByUnification info rhs + = do { ambient_lvl <- getTcLevel + ; given_eq_lvl <- getInnermostGivenEqLevel + + ; if | tv_lvl `sameDepthAs` ambient_lvl + -> return UnifySameLevel + + | tv_lvl `deeperThanOrSame` given_eq_lvl -- No intervening given equalities + , all (does_not_escape tv_lvl) free_skols -- No skolem escapes + -> return (UnifyOuterLevel free_metas tv_lvl) + + | otherwise + -> return NoUnify } + | otherwise + = return NoUnify + where + (free_metas, free_skols) = partition isPromotableMetaTyVar $ + filter isTyVar $ + nonDetEltsUniqSet $ + tyCoVarsOfType rhs + -- filter isTyVar: coercion variables are not an escape risk + -- If an implication binds a coercion variable, it'll have equalities, + -- so the "intervening given equalities" test above will catch it + -- Coercion holes get filled with coercions, so again no problem. + + does_not_escape tv_lvl fv = tv_lvl `deeperThanOrSame` tcTyVarLevel fv -- The RHS here is either not CanEqLHS, or it's one that we -- want to rewrite the LHS to (as per e.g. swapOverTyVars) @@ -2422,11 +2471,11 @@ canEqOK :: DynFlags -> EqRel -> CanEqLHS -> Xi -> CanEqOK canEqOK dflags eq_rel lhs rhs = ASSERT( good_rhs ) case checkTypeEq dflags YesTypeFamilies lhs rhs of - MTVU_OK () -> CanEqOK - MTVU_Bad -> CanEqNotOK OtherCIS + CTE_OK -> CanEqOK + CTE_Bad -> CanEqNotOK OtherCIS -- Violation of TyEq:F - MTVU_HoleBlocker -> CanEqNotOK (BlockedCIS holes) + CTE_HoleBlocker -> CanEqNotOK (BlockedCIS holes) where holes = coercionHolesOfType rhs -- This is the case detailed in -- Note [Equalities with incompatible kinds] @@ -2435,7 +2484,7 @@ canEqOK dflags eq_rel lhs rhs -- These are both a violation of TyEq:OC, but we -- want to differentiate for better production of -- error messages - MTVU_Occurs | TyVarLHS tv <- lhs + CTE_Occurs | TyVarLHS tv <- lhs , isInsolubleOccursCheck eq_rel tv rhs -> CanEqNotOK InsolubleCIS -- If we have a ~ [a], it is not canonical, and in particular -- we don't want to rewrite existing inerts with it, otherwise ===================================== compiler/GHC/Tc/Solver/Interact.hs ===================================== @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP, MultiWayIf #-} {-# OPTIONS_GHC -Wno-incomplete-record-updates #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} @@ -14,7 +14,6 @@ import GHC.Prelude import GHC.Types.Basic ( SwapFlag(..), infinity, IntWithInf, intGtLimit ) import GHC.Tc.Solver.Canonical -import GHC.Tc.Utils.Unify( canSolveByUnification ) import GHC.Types.Var.Set import GHC.Core.Type as Type import GHC.Core.InstEnv ( DFunInstType ) @@ -39,6 +38,7 @@ import GHC.Tc.Types import GHC.Tc.Types.Constraint import GHC.Core.Predicate import GHC.Tc.Types.Origin +import GHC.Tc.Utils.TcMType( promoteTyVarTo ) import GHC.Tc.Solver.Monad import GHC.Data.Bag import GHC.Utils.Monad ( concatMapM, foldlM ) @@ -430,12 +430,11 @@ interactWithInertsStage :: WorkItem -> TcS (StopOrContinue Ct) interactWithInertsStage wi = do { inerts <- getTcSInerts - ; lvl <- getTcLevel ; let ics = inert_cans inerts ; case wi of - CEqCan {} -> interactEq lvl ics wi - CIrredCan {} -> interactIrred ics wi - CDictCan {} -> interactDict ics wi + CEqCan {} -> interactEq ics wi + CIrredCan {} -> interactIrred ics wi + CDictCan {} -> interactDict ics wi _ -> pprPanic "interactWithInerts" (ppr wi) } -- CNonCanonical have been canonicalised @@ -1439,8 +1438,8 @@ inertsCanDischarge inerts lhs rhs fr | otherwise = False -- Work item is fully discharged -interactEq :: TcLevel -> InertCans -> Ct -> TcS (StopOrContinue Ct) -interactEq tclvl inerts workItem@(CEqCan { cc_lhs = lhs +interactEq :: InertCans -> Ct -> TcS (StopOrContinue Ct) +interactEq inerts workItem@(CEqCan { cc_lhs = lhs , cc_rhs = rhs , cc_ev = ev , cc_eq_rel = eq_rel }) @@ -1465,24 +1464,43 @@ interactEq tclvl inerts workItem@(CEqCan { cc_lhs = lhs = do { traceTcS "Not unifying representational equality" (ppr workItem) ; continueWith workItem } - -- try improvement, if possible - | TyFamLHS fam_tc fam_args <- lhs - , isImprovable ev - = do { improveLocalFunEqs ev inerts fam_tc fam_args rhs - ; continueWith workItem } - - | TyVarLHS tv <- lhs - , canSolveByUnification tclvl tv rhs - = do { solveByUnification ev tv rhs - ; n_kicked <- kickOutAfterUnification tv - ; return (Stop ev (text "Solved by unification" <+> pprKicked n_kicked)) } - | otherwise - = continueWith workItem - -interactEq _ _ wi = pprPanic "interactEq" (ppr wi) - -solveByUnification :: CtEvidence -> TcTyVar -> Xi -> TcS () + = case lhs of + TyVarLHS tv -> tryToSolveByUnification workItem ev tv rhs + + TyFamLHS tc args -> do { when (isImprovable ev) $ + -- Try improvement, if possible + improveLocalFunEqs ev inerts tc args rhs + ; continueWith workItem } + +interactEq _ wi = pprPanic "interactEq" (ppr wi) + +---------------------- +-- We have a meta-tyvar on the left, and metaTyVarUpateOK has said "yes" +-- So try to solve by unifying. +-- Three reasons why not: +-- Skolem escape +-- Given equalities (GADTs) +-- Unifying a TyVarTv with a non-tyvar type +tryToSolveByUnification :: Ct -> CtEvidence + -> TcTyVar -- LHS tyvar + -> TcType -- RHS + -> TcS (StopOrContinue Ct) +tryToSolveByUnification work_item ev tv rhs + = do { can_unify <- unifyTest ev tv rhs + ; traceTcS "tryToSolveByUnification" (vcat [ ppr tv <+> char '~' <+> ppr rhs + , ppr can_unify ]) + + ; case can_unify of + NoUnify -> continueWith work_item + -- For the latter two cases see Note [Solve by unification] + UnifySameLevel -> solveByUnification ev tv rhs + UnifyOuterLevel free_metas tv_lvl + -> do { wrapTcS $ mapM_ (promoteTyVarTo tv_lvl) free_metas + ; setUnificationFlag tv_lvl + ; solveByUnification ev tv rhs } } + +solveByUnification :: CtEvidence -> TcTyVar -> Xi -> TcS (StopOrContinue Ct) -- Solve with the identity coercion -- Precondition: kind(xi) equals kind(tv) -- Precondition: CtEvidence is Wanted or Derived @@ -1504,9 +1522,10 @@ solveByUnification wd tv xi text "Coercion:" <+> pprEq tv_ty xi, text "Left Kind is:" <+> ppr (tcTypeKind tv_ty), text "Right Kind is:" <+> ppr (tcTypeKind xi) ] - ; unifyTyVar tv xi - ; setEvBindIfWanted wd (evCoercion (mkTcNomReflCo xi)) } + ; setEvBindIfWanted wd (evCoercion (mkTcNomReflCo xi)) + ; n_kicked <- kickOutAfterUnification tv + ; return (Stop wd (text "Solved by unification" <+> pprKicked n_kicked)) } {- Note [Avoid double unifications] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1542,6 +1561,34 @@ and we want to get alpha := N b. See also #15144, which was caused by unifying a representational equality. +Note [Solve by unification] +~~~~~~~~~~~~~~~~~~~~~~~~~~~ +If we solve + alpha[n] ~ ty +by unification, there are two cases to consider + +* UnifySameLevel: if the ambient level is 'n', then + we can simply update alpha := ty, and do nothing else + +* UnifyOuterLevel free_metas n: if the ambient level is greater than + 'n' (the level of alpha), in addition to setting alpha := ty we must + do two other things: + + 1. Promote all the free meta-vars of 'ty' to level n. After all, + alpha[n] is at level n, and so if we set, say, + alpha[n] := Maybe beta[m], + we must ensure that when unifying beta we do skolem-escape checks + etc relevent to level n. Simple way to do that: promote beta to + level n. + + 2. Set the Unification Level Flag to record that a level-n unification has + taken place. See Note [The Unification Level Flag] in GHC.Tc.Solver.Monad + +NB: UnifySameLevel is just an optimisation for UnifyOuterLevel. Promotion +would be a no-op, and setting the unification flag unnecessarily would just +make the solver iterate more often. (We don't need to iterate when unifying +at the ambient level becuase of the kick-out mechanism.) + ************************************************************************ * * ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -17,7 +17,7 @@ module GHC.Tc.Solver.Monad ( -- The TcS monad TcS, runTcS, runTcSDeriveds, runTcSWithEvBinds, runTcSInerts, - failTcS, warnTcS, addErrTcS, + failTcS, warnTcS, addErrTcS, wrapTcS, runTcSEqualities, nestTcS, nestImplicTcS, setEvBindsTcS, emitImplicationTcS, emitTvImplicationTcS, @@ -31,6 +31,7 @@ module GHC.Tc.Solver.Monad ( panicTcS, traceTcS, traceFireTcS, bumpStepCountTcS, csTraceTcS, wrapErrTcS, wrapWarnTcS, + resetUnificationFlag, setUnificationFlag, -- Evidence creation and transformation MaybeNew(..), freshGoals, isFresh, getEvExpr, @@ -60,7 +61,7 @@ module GHC.Tc.Solver.Monad ( updInertTcS, updInertCans, updInertDicts, updInertIrreds, getHasGivenEqs, setInertCans, getInertEqs, getInertCans, getInertGivens, - getInertInsols, + getInertInsols, getInnermostGivenEqLevel, getTcSInerts, setTcSInerts, matchableGivens, prohibitedSuperClassSolve, mightMatchLater, getUnsolvedInerts, @@ -186,7 +187,6 @@ import Control.Monad import GHC.Utils.Monad import Data.IORef import Data.List ( partition, mapAccumL ) -import qualified Data.Semigroup as S import Data.List.NonEmpty ( NonEmpty(..), cons, toList, nonEmpty ) import qualified Data.List.NonEmpty as NE import Control.Arrow ( first ) @@ -418,12 +418,14 @@ instance Outputable InertSet where emptyInertCans :: InertCans emptyInertCans - = IC { inert_eqs = emptyDVarEnv - , inert_dicts = emptyDicts - , inert_safehask = emptyDicts - , inert_funeqs = emptyFunEqs - , inert_insts = [] - , inert_irreds = emptyCts } + = IC { inert_eqs = emptyDVarEnv + , inert_given_eq_lvl = topTcLevel + , inert_given_eqs = False + , inert_dicts = emptyDicts + , inert_safehask = emptyDicts + , inert_funeqs = emptyFunEqs + , inert_insts = [] + , inert_irreds = emptyCts } emptyInert :: InertSet emptyInert @@ -697,6 +699,19 @@ data InertCans -- See Note [Detailed InertCans Invariants] for more -- Irreducible predicates that cannot be made canonical, -- and which don't interact with others (e.g. (c a)) -- and insoluble predicates (e.g. Int ~ Bool, or a ~ [a]) + + , inert_given_eq_lvl :: TcLevel + -- The TcLevel of the innermost implication that has a Given + -- equality of the sort that make a unification variable untouchable + -- (see Note [Unification preconditions] in GHC.Tc.Utils.Unify). + -- See Note [Tracking Given equalities] below + + , inert_given_eqs :: Bool + -- True <=> The inert Givens *at this level* (tcl_tclvl) + -- could includes at least one equality /other than/ a + -- let-bound skolem equality. + -- Reason: report these givens when reporting a failed equality + -- See Note [Tracking Given equalities] } type InertEqs = DTyVarEnv EqualCtList @@ -730,7 +745,126 @@ listToEqualCtList :: [Ct] -> Maybe EqualCtList -- non-empty listToEqualCtList cts = EqualCtList <$> nonEmpty cts -{- Note [Detailed InertCans Invariants] +{- Note [Tracking Given equalities] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +For reasons described in (UNTOUCHABLE) in GHC.Tc.Utils.Unify +Note [Unification preconditions], we can't unify + alpha[2] ~ Int +under a level-4 implication if there are any Given equalities +bound by the implications at level 3 of 4. To that end, the +InertCans tracks + + inert_given_eq_lvl :: TcLevel + -- The TcLevel of the innermost implication that has a Given + -- equality of the sort that make a unification variable untouchable + -- (see Note [Unification preconditions] in GHC.Tc.Utils.Unify). + +We update inert_given_eq_lvl whenever we add a Given to the +inert set, in updateGivenEqs. + +Then a unification variable alpha[n] is untouchable iff + n < inert_given_eq_lvl +that is, if the unification variable was born outside an +enclosing Given equality. + +Exactly which constraints should trigger (UNTOUCHABLE), and hence +should update inert_given_eq_lvl? + +* We do /not/ need to worry about let-bound skolems, such ast + forall[2] a. a ~ [b] => blah + See Note [Let-bound skolems] + +* Consider an implication + forall[2]. beta[1] => alpha[1] ~ Int + where beta is a unification variable that has already been unified + to () in an outer scope. Then alpha[1] is perfectly touchable and + we can unify alpha := Int. So when deciding whether the givens contain + an equality, we should canonicalise first, rather than just looking at + the /original/ givens (#8644). + + * However, we must take account of *potential* equalities. Consider the + same example again, but this time we have /not/ yet unified beta: + forall[2] beta[1] => ...blah... + + Because beta might turn into an equality, updateGivenEqs conservatively + treats it as a potential equality, and updates inert_give_eq_lvl + + * What about something like forall[2] a b. a ~ F b => [W] alpha[1] ~ X y z? + + That Given cannot affect the Wanted, because the Given is entirely + *local*: it mentions only skolems bound in the very same + implication. Such equalities need not make alpha untouchable. (Test + case typecheck/should_compile/LocalGivenEqs has a real-life + motivating example, with some detailed commentary.) + Hence the 'mentionsOuterVar' test in updateGivenEqs. + + However, solely to support better error messages + (see Note [HasGivenEqs] in GHC.Tc.Types.Constraint) we also track + these "local" equalities in the boolean inert_given_eqs field. + This field is used only to set the ic_given_eqs field to LocalGivenEqs; + see the function getHasGivenEqs. + + Here is a simpler case that triggers this behaviour: + + data T where + MkT :: F a ~ G b => a -> b -> T + + f (MkT _ _) = True + + Because of this behaviour around local equality givens, we can infer the + type of f. This is typecheck/should_compile/LocalGivenEqs2. + + * We need not look at the equality relation involved (nominal vs + representational), because representational equalities can still + imply nominal ones. For example, if (G a ~R G b) and G's argument's + role is nominal, then we can deduce a ~N b. + +Note [Let-bound skolems] +~~~~~~~~~~~~~~~~~~~~~~~~ +If * the inert set contains a canonical Given CEqCan (a ~ ty) +and * 'a' is a skolem bound in this very implication, + +then: +a) The Given is pretty much a let-binding, like + f :: (a ~ b->c) => a -> a + Here the equality constraint is like saying + let a = b->c in ... + It is not adding any new, local equality information, + and hence can be ignored by has_given_eqs + +b) 'a' will have been completely substituted out in the inert set, + so we can safely discard it. + +For an example, see #9211. + +See also GHC.Tc.Utils.Unify Note [Deeper level on the left] for how we ensure +that the right variable is on the left of the equality when both are +tyvars. + +You might wonder whether the skolem really needs to be bound "in the +very same implication" as the equuality constraint. +Consider this (c.f. #15009): + + data S a where + MkS :: (a ~ Int) => S a + + g :: forall a. S a -> a -> blah + g x y = let h = \z. ( z :: Int + , case x of + MkS -> [y,z]) + in ... + +From the type signature for `g`, we get `y::a` . Then when we +encounter the `\z`, we'll assign `z :: alpha[1]`, say. Next, from the +body of the lambda we'll get + + [W] alpha[1] ~ Int -- From z::Int + [W] forall[2]. (a ~ Int) => [W] alpha[1] ~ a -- From [y,z] + +Now, unify alpha := a. Now we are stuck with an unsolved alpha~Int! +So we must treat alpha as untouchable under the forall[2] implication. + +Note [Detailed InertCans Invariants] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The InertCans represents a collection of constraints with the following properties: @@ -1027,6 +1161,8 @@ instance Outputable InertCans where ppr (IC { inert_eqs = eqs , inert_funeqs = funeqs, inert_dicts = dicts , inert_safehask = safehask, inert_irreds = irreds + , inert_given_eq_lvl = ge_lvl + , inert_given_eqs = given_eqs , inert_insts = insts }) = braces $ vcat @@ -1043,6 +1179,8 @@ instance Outputable InertCans where text "Irreds =" <+> pprCts irreds , ppUnless (null insts) $ text "Given instances =" <+> vcat (map ppr insts) + , text "Innermost given equalities =" <+> ppr ge_lvl + , text "Given eqs at this level =" <+> ppr given_eqs ] where folder (EqualCtList eqs) rest = nonEmptyToBag eqs `andCts` rest @@ -1456,20 +1594,32 @@ findEq icans (TyFamLHS fun_tc fun_args) addInertForAll :: QCInst -> TcS () -- Add a local Given instance, typically arising from a type signature addInertForAll new_qci - = do { ics <- getInertCans - ; insts' <- add_qci (inert_insts ics) - ; setInertCans (ics { inert_insts = insts' }) } + = do { ics <- getInertCans + ; ics1 <- add_qci ics + + -- Update given equalities. C.f updateGivenEqs + ; tclvl <- getTcLevel + ; let pred = qci_pred new_qci + not_equality = isClassPred pred && not (isEqPred pred) + -- True <=> definitely not an equality + -- A qci_pred like (f a) might be an equality + + ics2 | not_equality = ics1 + | otherwise = ics1 { inert_given_eq_lvl = tclvl + , inert_given_eqs = True } + + ; setInertCans ics2 } where - add_qci :: [QCInst] -> TcS [QCInst] + add_qci :: InertCans -> TcS InertCans -- See Note [Do not add duplicate quantified instances] - add_qci qcis + add_qci ics@(IC { inert_insts = qcis }) | any same_qci qcis = do { traceTcS "skipping duplicate quantified instance" (ppr new_qci) - ; return qcis } + ; return ics } | otherwise = do { traceTcS "adding new inert quantified instance" (ppr new_qci) - ; return (new_qci : qcis) } + ; return (ics { inert_insts = new_qci : qcis }) } same_qci old_qci = tcEqType (ctEvPred (qci_ev old_qci)) (ctEvPred (qci_ev new_qci)) @@ -1523,7 +1673,8 @@ addInertCan ct ; ics <- getInertCans ; ct <- maybeEmitShadow ics ct ; ics <- maybeKickOut ics ct - ; setInertCans (add_item ics ct) + ; tclvl <- getTcLevel + ; setInertCans (add_item tclvl ics ct) ; traceTcS "addInertCan }" $ empty } @@ -1536,23 +1687,54 @@ maybeKickOut ics ct | otherwise = return ics -add_item :: InertCans -> Ct -> InertCans -add_item ics item@(CEqCan { cc_lhs = TyFamLHS tc tys }) - = ics { inert_funeqs = addCanFunEq (inert_funeqs ics) tc tys item } - -add_item ics item@(CEqCan { cc_lhs = TyVarLHS tv }) - = ics { inert_eqs = addTyEq (inert_eqs ics) tv item } - -add_item ics@(IC { inert_irreds = irreds }) item@(CIrredCan {}) - = ics { inert_irreds = irreds `Bag.snocBag` item } - -add_item ics item@(CDictCan { cc_class = cls, cc_tyargs = tys }) +add_item :: TcLevel -> InertCans -> Ct -> InertCans +add_item tc_lvl + ics@(IC { inert_funeqs = funeqs, inert_eqs = eqs }) + item@(CEqCan { cc_lhs = lhs }) + = updateGivenEqs tc_lvl item $ + case lhs of + TyFamLHS tc tys -> ics { inert_funeqs = addCanFunEq funeqs tc tys item } + TyVarLHS tv -> ics { inert_eqs = addTyEq eqs tv item } + +add_item tc_lvl ics@(IC { inert_irreds = irreds }) item@(CIrredCan {}) + = updateGivenEqs tc_lvl item $ -- An Irred might turn out to be an + -- equality, so we play safe + ics { inert_irreds = irreds `Bag.snocBag` item } + +add_item _ ics item@(CDictCan { cc_class = cls, cc_tyargs = tys }) = ics { inert_dicts = addDict (inert_dicts ics) cls tys item } -add_item _ item +add_item _ _ item = pprPanic "upd_inert set: can't happen! Inserting " $ ppr item -- Can't be CNonCanonical because they only land in inert_irreds +updateGivenEqs :: TcLevel -> Ct -> InertCans -> InertCans +-- Set the inert_given_eq_level to the current level (tclvl) +-- if the constraint is a given equality that should prevent +-- filling in an outer unification variable. +-- See See Note [Tracking Given equalities] +updateGivenEqs tclvl ct inerts@(IC { inert_given_eq_lvl = ge_lvl }) + | not (isGivenCt ct) = inerts + | not_equality ct = inerts -- See Note [Let-bound skolems] + | otherwise = inerts { inert_given_eq_lvl = ge_lvl' + , inert_given_eqs = True } + where + ge_lvl' | mentionsOuterVar tclvl (ctEvidence ct) + -- Includes things like (c a), which *might* be an equality + = tclvl + | otherwise + = ge_lvl + + not_equality :: Ct -> Bool + -- True <=> definitely not an equality of any kind + -- except for a let-bound skolem, which doesn't count + -- See Note [Let-bound skolems] + -- NB: no need to spot the boxed CDictCan (a ~ b) because its + -- superclass (a ~# b) will be a CEqCan + not_equality (CEqCan { cc_lhs = TyVarLHS tv }) = not (isOuterTyVar tclvl tv) + not_equality (CDictCan {}) = True + not_equality _ = False + ----------------------------------------- kickOutRewritable :: CtFlavourRole -- Flavour/role of the equality that -- is being added to the inert set @@ -1596,7 +1778,6 @@ kick_out_rewritable :: CtFlavourRole -- Flavour/role of the equality that kick_out_rewritable new_fr new_lhs ics@(IC { inert_eqs = tv_eqs , inert_dicts = dictmap - , inert_safehask = safehask , inert_funeqs = funeqmap , inert_irreds = irreds , inert_insts = old_insts }) @@ -1610,12 +1791,12 @@ kick_out_rewritable new_fr new_lhs | otherwise = (kicked_out, inert_cans_in) where - inert_cans_in = IC { inert_eqs = tv_eqs_in - , inert_dicts = dicts_in - , inert_safehask = safehask -- ?? - , inert_funeqs = feqs_in - , inert_irreds = irs_in - , inert_insts = insts_in } + -- inert_safehask stays unchanged; is that right? + inert_cans_in = ics { inert_eqs = tv_eqs_in + , inert_dicts = dicts_in + , inert_funeqs = feqs_in + , inert_irreds = irs_in + , inert_insts = insts_in } kicked_out :: WorkList -- NB: use extendWorkList to ensure that kicked-out equalities get priority @@ -1968,6 +2149,10 @@ updInertIrreds upd_fn getInertEqs :: TcS (DTyVarEnv EqualCtList) getInertEqs = do { inert <- getInertCans; return (inert_eqs inert) } +getInnermostGivenEqLevel :: TcS TcLevel +getInnermostGivenEqLevel = do { inert <- getInertCans + ; return (inert_given_eq_lvl inert) } + getInertInsols :: TcS Cts -- Returns insoluble equality constraints -- specifically including Givens @@ -2077,63 +2262,46 @@ getUnsolvedInerts getHasGivenEqs :: TcLevel -- TcLevel of this implication -> TcS ( HasGivenEqs -- are there Given equalities? , Cts ) -- Insoluble equalities arising from givens --- See Note [When does an implication have given equalities?] +-- See Note [Tracking Given equalities] getHasGivenEqs tclvl - = do { inerts@(IC { inert_eqs = ieqs, inert_funeqs = funeqs, inert_irreds = irreds }) + = do { inerts@(IC { inert_irreds = irreds + , inert_given_eqs = given_eqs + , inert_given_eq_lvl = ge_lvl }) <- getInertCans - ; let has_given_eqs = foldMap check_local_given_ct irreds - S.<> foldMap (lift_equal_ct_list check_local_given_tv_eq) ieqs - S.<> foldMapFunEqs (lift_equal_ct_list check_local_given_ct) funeqs - insols = filterBag insolubleEqCt irreds + ; let insols = filterBag insolubleEqCt irreds -- Specifically includes ones that originated in some -- outer context but were refined to an insoluble by -- a local equality; so do /not/ add ct_given_here. + -- See Note [HasGivenEqs] in GHC.Tc.Types.Constraint, and + -- Note [Tracking Given equalities] in this module + has_ge | ge_lvl == tclvl = MaybeGivenEqs + | given_eqs = LocalGivenEqs + | otherwise = NoGivenEqs + ; traceTcS "getHasGivenEqs" $ - vcat [ text "has_given_eqs:" <+> ppr has_given_eqs + vcat [ text "given_eqs:" <+> ppr given_eqs + , text "ge_lvl:" <+> ppr ge_lvl + , text "ambient level:" <+> ppr tclvl , text "Inerts:" <+> ppr inerts , text "Insols:" <+> ppr insols] - ; return (has_given_eqs, insols) } - where - check_local_given_ct :: Ct -> HasGivenEqs - check_local_given_ct ct - | given_here ev = if mentions_outer_var ev then MaybeGivenEqs else LocalGivenEqs - | otherwise = NoGivenEqs - where - ev = ctEvidence ct - - lift_equal_ct_list :: (Ct -> HasGivenEqs) -> EqualCtList -> HasGivenEqs - -- returns NoGivenEqs for non-singleton lists, as Given lists are always - -- singletons - lift_equal_ct_list check (EqualCtList (ct :| [])) = check ct - lift_equal_ct_list _ _ = NoGivenEqs - - check_local_given_tv_eq :: Ct -> HasGivenEqs - check_local_given_tv_eq (CEqCan { cc_lhs = TyVarLHS tv, cc_ev = ev}) - | given_here ev - = if is_outer_var tv then MaybeGivenEqs else NoGivenEqs - -- See Note [Let-bound skolems] - | otherwise - = NoGivenEqs - check_local_given_tv_eq other_ct = check_local_given_ct other_ct - - given_here :: CtEvidence -> Bool - -- True for a Given bound by the current implication, - -- i.e. the current level - given_here ev = isGiven ev - && tclvl == ctLocLevel (ctEvLoc ev) - - mentions_outer_var :: CtEvidence -> Bool - mentions_outer_var = anyFreeVarsOfType is_outer_var . ctEvPred - - is_outer_var :: TyCoVar -> Bool - is_outer_var tv - -- NB: a meta-tv alpha[3] may end up unifying with skolem b[2], - -- so treat it as an "outer" var, even at level 3. - -- This will become redundant after fixing #18929. - | isTyVar tv = isTouchableMetaTyVar tclvl tv || - tclvl `strictlyDeeperThan` tcTyVarLevel tv - | otherwise = False + ; return (has_ge, insols) } + +mentionsOuterVar :: TcLevel -> CtEvidence -> Bool +mentionsOuterVar tclvl ev + = anyFreeVarsOfType (isOuterTyVar tclvl) $ + ctEvPred ev + +isOuterTyVar :: TcLevel -> TyCoVar -> Bool +-- True of a type variable that comes from a +-- shallower level than the ambient level (tclvl) +isOuterTyVar tclvl tv + | isTyVar tv = tclvl `strictlyDeeperThan` tcTyVarLevel tv + || isPromotableMetaTyVar tv + -- isPromotable: a meta-tv alpha[3] may end up unifying with skolem b[2], + -- so treat it as an "outer" var, even at level 3. + -- This will become redundant after fixing #18929. + | otherwise = False -- Coercion variables; doesn't much matter -- | Returns Given constraints that might, -- potentially, match the given pred. This is used when checking to see if a @@ -2267,112 +2435,6 @@ Examples: This treatment fixes #18910 and is tested in typecheck/should_compile/InstanceGivenOverlap{,2} -Note [When does an implication have given equalities?] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider an implication - beta => alpha ~ Int -where beta is a unification variable that has already been unified -to () in an outer scope. Then we can float the (alpha ~ Int) out -just fine. So when deciding whether the givens contain an equality, -we should canonicalise first, rather than just looking at the original -givens (#8644). - -So we simply look at the inert, canonical Givens and see if there are -any equalities among them, the calculation of has_given_eqs. There -are some wrinkles: - - * We must know which ones are bound in *this* implication and which - are bound further out. We can find that out from the TcLevel - of the Given, which is itself recorded in the tcl_tclvl field - of the TcLclEnv stored in the Given (ev_given_here). - - What about interactions between inner and outer givens? - - Outer given is rewritten by an inner given, then there must - have been an inner given equality, hence the “given-eq” flag - will be true anyway. - - - Inner given rewritten by outer, retains its level (ie. The inner one) - - * We must take account of *potential* equalities, like the one above: - beta => ...blah... - If we still don't know what beta is, we conservatively treat it as potentially - becoming an equality. Hence including 'irreds' in the calculation or has_given_eqs. - Note that we can't really know what's in an irred, so any irred is considered - a potential equality. - - * What about something like forall a b. a ~ F b => [W] c ~ X y z? That Given - cannot affect the Wanted, because the Given is entirely *local*: it mentions - only skolems bound in the very same implication. Such equalities need not - prevent floating. (Test case typecheck/should_compile/LocalGivenEqs has a - real-life motivating example, with some detailed commentary.) These - equalities are noted with LocalGivenEqs: they do not prevent floating, but - they also are allowed to show up in error messages. See - Note [Suppress redundant givens during error reporting] in GHC.Tc.Errors. - The difference between what stops floating and what is suppressed from - error messages is why we need three options for HasGivenEqs. - - There is also a simpler case that triggers this behaviour: - - data T where - MkT :: F a ~ G b => a -> b -> T - - f (MkT _ _) = True - - Because of this behaviour around local equality givens, we can infer the - type of f. This is typecheck/should_compile/LocalGivenEqs2. - - * See Note [Let-bound skolems] for another wrinkle - - * We need not look at the equality relation involved (nominal vs representational), - because representational equalities can still imply nominal ones. For example, - if (G a ~R G b) and G's argument's role is nominal, then we can deduce a ~N b. - -Note [Let-bound skolems] -~~~~~~~~~~~~~~~~~~~~~~~~ -If * the inert set contains a canonical Given CEqCan (a ~ ty) -and * 'a' is a skolem bound in this very implication, - -then: -a) The Given is pretty much a let-binding, like - f :: (a ~ b->c) => a -> a - Here the equality constraint is like saying - let a = b->c in ... - It is not adding any new, local equality information, - and hence can be ignored by has_given_eqs - -b) 'a' will have been completely substituted out in the inert set, - so we can safely discard it. - -For an example, see #9211. - -See also GHC.Tc.Utils.Unify Note [Deeper level on the left] for how we ensure -that the right variable is on the left of the equality when both are -tyvars. - -You might wonder whether the skokem really needs to be bound "in the -very same implication" as the equuality constraint. -(c.f. #15009) Consider this: - - data S a where - MkS :: (a ~ Int) => S a - - g :: forall a. S a -> a -> blah - g x y = let h = \z. ( z :: Int - , case x of - MkS -> [y,z]) - in ... - -From the type signature for `g`, we get `y::a` . Then when we -encounter the `\z`, we'll assign `z :: alpha[1]`, say. Next, from the -body of the lambda we'll get - - [W] alpha[1] ~ Int -- From z::Int - [W] forall[2]. (a ~ Int) => [W] alpha[1] ~ a -- From [y,z] - -Now, suppose we decide to float `alpha ~ a` out of the implication -and then unify `alpha := a`. Now we are stuck! But if treat -`alpha ~ Int` first, and unify `alpha := Int`, all is fine. -But we absolutely cannot float that equality or we will get stuck. -} removeInertCts :: [Ct] -> InertCans -> InertCans @@ -2552,9 +2614,6 @@ tcAppMapToBag m = foldTcAppMap consBag m emptyBag foldTcAppMap :: (a -> b -> b) -> TcAppMap a -> b -> b foldTcAppMap k m z = foldDTyConEnv (foldTM k) z m -foldMapTcAppMap :: Monoid m => (a -> m) -> TcAppMap a -> m -foldMapTcAppMap f = foldMap (foldMap f) - {- ********************************************************************* * * @@ -2688,9 +2747,6 @@ findFunEqsByTyCon m tc foldFunEqs :: (a -> b -> b) -> FunEqMap a -> b -> b foldFunEqs = foldTcAppMap -foldMapFunEqs :: Monoid m => (a -> m) -> FunEqMap a -> m -foldMapFunEqs = foldMapTcAppMap - insertFunEq :: FunEqMap a -> TyCon -> [Type] -> a -> FunEqMap a insertFunEq m tc tys val = insertTcApp m tc tys val @@ -2723,6 +2779,12 @@ data TcSEnv -- The number of unification variables we have filled -- The important thing is whether it is non-zero + tcs_unif_lvl :: IORef (Maybe TcLevel), + -- The Unification Level Flag + -- Outermost level at which we have unified a meta tyvar + -- Starts at Nothing, then (Just i), then (Just j) where j do { inerts <- TcM.readTcRef old_inert_var - ; let nest_inert = inerts { inert_cycle_breakers = [] } - -- all other InertSet fields are inherited + ; let nest_inert = inerts { inert_cycle_breakers = [] + , inert_cans = (inert_cans inerts) + { inert_given_eqs = False } } + -- All other InertSet fields are inherited ; new_inert_var <- TcM.newTcRef nest_inert ; new_wl_var <- TcM.newTcRef emptyWorkList - ; let nest_env = TcSEnv { tcs_ev_binds = ref + ; let nest_env = TcSEnv { tcs_count = count -- Inherited + , tcs_unif_lvl = unif_lvl -- Inherited + , tcs_ev_binds = ref , tcs_unified = unified_var - , tcs_count = count , tcs_inerts = new_inert_var , tcs_worklist = new_wl_var } ; res <- TcM.setTcLevel inner_tclvl $ @@ -3260,6 +3328,97 @@ pprKicked :: Int -> SDoc pprKicked 0 = empty pprKicked n = parens (int n <+> text "kicked out") +{- ********************************************************************* +* * +* The Unification Level Flag * +* * +********************************************************************* -} + +{- Note [The Unification Level Flag] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider a deep tree of implication constraints + forall[1] a. -- Outer-implic + C alpha[1] -- Simple + forall[2] c. ....(C alpha[1]).... -- Implic-1 + forall[2] b. ....(alpha[1] ~ Int).... -- Implic-2 + +The (C alpha) is insoluble until we know alpha. We solve alpha +by unifying alpha:=Int somewhere deep inside Implic-2. But then we +must try to solve the Outer-implic all over again. This time we can +solve (C alpha) both in Outer-implic, and nested inside Implic-1. + +When should we iterate solving a level-n implication? +Answer: if any unification of a tyvar at level n takes place + in the ic_implics of that implication. + +* What if a unification takes place at level n-1? Then don't iterate + level n, because we'll iterate level n-1, and that will in turn iterate + level n. + +* What if a unification takes place at level n, in the ic_simples of + level n? No need to track this, because the kick-out mechanism deals + with it. (We can't drop kick-out in favour of iteration, becuase kick-out + works for skolem-equalities, not just unifications.) + +So the monad-global Unification Level Flag, kept in tcs_unif_lvl keeps +track of + - Whether any unifications at all have taken place (Nothing => no unifications) + - If so, what is the outermost level that has seen a unification (Just lvl) + +The iteration done in the simplify_loop/maybe_simplify_again loop in GHC.Tc.Solver. + +It helpful not to iterate unless there is a chance of progress. #8474 is +an example: + + * There's a deeply-nested chain of implication constraints. + ?x:alpha => ?y1:beta1 => ... ?yn:betan => [W] ?x:Int + + * From the innermost one we get a [D] alpha[1] ~ Int, + so we can unify. + + * It's better not to iterate the inner implications, but go all the + way out to level 1 before iterating -- because iterating level 1 + will iterate the inner levels anyway. + +(In the olden days when we "floated" thse Derived constraints, this was +much, much more important -- we got exponential behaviour, as each iteration +produced the same Derived constraint.) +-} + + +resetUnificationFlag :: TcS Bool +-- We are at ambient level i +-- If the unification flag = Just i, reset it to Nothing and return True +-- Otherwise leave it unchanged and return False +resetUnificationFlag + = TcS $ \env -> + do { let ref = tcs_unif_lvl env + ; ambient_lvl <- TcM.getTcLevel + ; mb_lvl <- TcM.readTcRef ref + ; TcM.traceTc "resetUnificationFlag" $ + vcat [ text "ambient:" <+> ppr ambient_lvl + , text "unif_lvl:" <+> ppr mb_lvl ] + ; case mb_lvl of + Nothing -> return False + Just unif_lvl | ambient_lvl `strictlyDeeperThan` unif_lvl + -> return False + | otherwise + -> do { TcM.writeTcRef ref Nothing + ; return True } } + +setUnificationFlag :: TcLevel -> TcS () +-- (setUnificationFlag i) sets the unification level to (Just i) +-- unless it already is (Just j) where j <= i +setUnificationFlag lvl + = TcS $ \env -> + do { let ref = tcs_unif_lvl env + ; mb_lvl <- TcM.readTcRef ref + ; case mb_lvl of + Just unif_lvl | lvl `deeperThanOrSame` unif_lvl + -> return () + _ -> TcM.writeTcRef ref (Just lvl) } + + {- ********************************************************************* * * * Instantiation etc. ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -1095,7 +1095,7 @@ Yuk! data Implication = Implic { -- Invariants for a tree of implications: - -- see TcType Note [TcLevel and untouchable type variables] + -- see TcType Note [TcLevel invariants] ic_tclvl :: TcLevel, -- TcLevel of unification variables -- allocated /inside/ this implication @@ -1172,44 +1172,57 @@ data ImplicStatus | IC_Unsolved -- Neither of the above; might go either way --- | Does this implication have Given equalities? --- See Note [When does an implication have given equalities?] in GHC.Tc.Solver.Monad, --- which also explains why we need three options here. Also, see --- Note [Suppress redundant givens during error reporting] in GHC.Tc.Errors --- --- Stops floating | Suppresses Givens in errors --- ----------------------------------------------- --- NoGivenEqs NO | YES --- LocalGivenEqs NO | NO --- MaybeGivenEqs YES | NO --- --- Examples: --- --- NoGivenEqs: Eq a => ... --- (Show a, Num a) => ... --- forall a. a ~ Either Int Bool => ... --- See Note [Let-bound skolems] in GHC.Tc.Solver.Monad for --- that last one --- --- LocalGivenEqs: forall a b. F a ~ G b => ... --- forall a. F a ~ Int => ... --- --- MaybeGivenEqs: (a ~ b) => ... --- forall a. F a ~ b => ... --- --- The check is conservative. A MaybeGivenEqs might not have any equalities. --- A LocalGivenEqs might local equalities, but it definitely does not have non-local --- equalities. A NoGivenEqs definitely does not have equalities (except let-bound --- skolems). -data HasGivenEqs - = NoGivenEqs -- definitely no given equalities, - -- except by Note [Let-bound skolems] in GHC.Tc.Solver.Monad - | LocalGivenEqs -- might have Given equalities that affect only local skolems - -- e.g. forall a b. (a ~ F b) => ...; definitely no others - | MaybeGivenEqs -- might have any kind of Given equalities; no floating out - -- is possible. +data HasGivenEqs -- See Note [HasGivenEqs] + = NoGivenEqs -- Definitely no given equalities, + -- except by Note [Let-bound skolems] in GHC.Tc.Solver.Monad + | LocalGivenEqs -- Might have Given equalities, but only ones that affect only + -- local skolems e.g. forall a b. (a ~ F b) => ... + | MaybeGivenEqs -- Might have any kind of Given equalities; no floating out + -- is possible. deriving Eq +{- Note [HasGivenEqs] +~~~~~~~~~~~~~~~~~~~~~ +The GivenEqs data type describes the Given constraints of an implication constraint: + +* NoGivenEqs: definitely no Given equalities, except perhaps let-bound skolems + which don't count: see Note [Let-bound skolems] in GHC.Tc.Solver.Monad + Examples: forall a. Eq a => ... + forall a. (Show a, Num a) => ... + forall a. a ~ Either Int Bool => ... -- Let-bound skolem + +* LocalGivenEqs: definitely no Given equalities that would affect principal + types. But may have equalities that affect only skolems of this implication + (and hence do not affect princial types) + Examples: forall a. F a ~ Int => ... + forall a b. F a ~ G b => ... + +* MaybeGivenEqs: may have Given equalities that would affect principal + types + Examples: forall. (a ~ b) => ... + forall a. F a ~ b => ... + forall a. c a => ... -- The 'c' might be instantiated to (b ~) + forall a. C a b => .... + where class x~y => C a b + so there is an equality in the superclass of a Given + +The HasGivenEqs classifications affect two things: + +* Suppressing redundant givens during error reporting; see GHC.Tc.Errors + Note [Suppress redundant givens during error reporting] + +* Floating in approximateWC. + +Specifically, here's how it goes: + + Stops floating | Suppresses Givens in errors + in approximateWC | + ----------------------------------------------- + NoGivenEqs NO | YES + LocalGivenEqs NO | NO + MaybeGivenEqs YES | NO +-} + instance Outputable Implication where ppr (Implic { ic_tclvl = tclvl, ic_skols = skols , ic_given = given, ic_given_eqs = given_eqs ===================================== compiler/GHC/Tc/Utils/Monad.hs ===================================== @@ -1867,7 +1867,7 @@ It's distressingly delicate though: class constraints mentioned above. But we may /also/ end up taking constraints built at some inner level, and emitting them at some outer level, and then breaking the TcLevel invariants - See Note [TcLevel and untouchable type variables] in GHC.Tc.Utils.TcType + See Note [TcLevel invariants] in GHC.Tc.Utils.TcType So dropMisleading has a horridly ad-hoc structure. It keeps only /insoluble/ flat constraints (which are unlikely to very visibly trip ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -80,7 +80,7 @@ module GHC.Tc.Utils.TcMType ( --------------------------------- -- Promotion, defaulting, skolemisation - defaultTyVar, promoteTyVar, promoteTyVarSet, + defaultTyVar, promoteTyVarTo, promoteTyVarSet, quantifyTyVars, isQuantifiableTv, skolemiseUnboundMetaTyVar, zonkAndSkolemise, skolemiseQuantifiedTyVar, @@ -965,12 +965,18 @@ writeMetaTyVarRef tyvar ref ty ; writeTcRef ref (Indirect ty) } -- Everything from here on only happens if DEBUG is on + -- Need to zonk 'ty' because we may only recently have promoted + -- its free meta-tyvars (see Solver.Interact.tryToSolveByUnification) | otherwise = do { meta_details <- readMutVar ref; -- Zonk kinds to allow the error check to work ; zonked_tv_kind <- zonkTcType tv_kind - ; zonked_ty_kind <- zonkTcType ty_kind - ; let kind_check_ok = tcIsConstraintKind zonked_tv_kind + ; zonked_ty <- zonkTcType ty + ; let zonked_ty_kind = tcTypeKind zonked_ty + zonked_ty_lvl = tcTypeLevel zonked_ty + level_check_ok = not (zonked_ty_lvl `strictlyDeeperThan` tv_lvl) + level_check_msg = ppr zonked_ty_lvl $$ ppr tv_lvl $$ ppr tyvar $$ ppr ty + kind_check_ok = tcIsConstraintKind zonked_tv_kind || tcEqKind zonked_ty_kind zonked_tv_kind -- Hack alert! tcIsConstraintKind: see GHC.Tc.Gen.HsType -- Note [Extra-constraint holes in partial type signatures] @@ -995,13 +1001,9 @@ writeMetaTyVarRef tyvar ref ty ; writeMutVar ref (Indirect ty) } where tv_kind = tyVarKind tyvar - ty_kind = tcTypeKind ty tv_lvl = tcTyVarLevel tyvar - ty_lvl = tcTypeLevel ty - level_check_ok = not (ty_lvl `strictlyDeeperThan` tv_lvl) - level_check_msg = ppr ty_lvl $$ ppr tv_lvl $$ ppr tyvar $$ ppr ty double_upd_msg details = hang (text "Double update of meta tyvar") 2 (ppr tyvar $$ ppr details) @@ -1570,8 +1572,8 @@ than the ambient level (see Note [Use level numbers of quantification]). Note [Use level numbers for quantification] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The level numbers assigned to metavariables are very useful. Not only -do they track touchability (Note [TcLevel and untouchable type variables] -in GHC.Tc.Utils.TcType), but they also allow us to determine which variables to +do they track touchability (Note [TcLevel invariants] in GHC.Tc.Utils.TcType), +but they also allow us to determine which variables to generalise. The rule is this: When generalising, quantify only metavariables with a TcLevel greater @@ -2005,29 +2007,29 @@ a \/\a in the final result but all the occurrences of a will be zonked to () * * ********************************************************************* -} -promoteTyVar :: TcTyVar -> TcM Bool +promoteTyVarTo :: TcLevel -> TcTyVar -> TcM Bool -- When we float a constraint out of an implication we must restore --- invariant (WantedInv) in Note [TcLevel and untouchable type variables] in GHC.Tc.Utils.TcType +-- invariant (WantedInv) in Note [TcLevel invariants] in GHC.Tc.Utils.TcType -- Return True <=> we did some promotion -- Also returns either the original tyvar (no promotion) or the new one -- See Note [Promoting unification variables] -promoteTyVar tv - = do { tclvl <- getTcLevel - ; if (isFloatedTouchableMetaTyVar tclvl tv) - then do { cloned_tv <- cloneMetaTyVar tv - ; let rhs_tv = setMetaTyVarTcLevel cloned_tv tclvl - ; writeMetaTyVar tv (mkTyVarTy rhs_tv) - ; traceTc "promoteTyVar" (ppr tv <+> text "-->" <+> ppr rhs_tv) - ; return True } - else do { traceTc "promoteTyVar: no" (ppr tv) - ; return False } } +promoteTyVarTo tclvl tv + | isFloatedTouchableMetaTyVar tclvl tv + = do { cloned_tv <- cloneMetaTyVar tv + ; let rhs_tv = setMetaTyVarTcLevel cloned_tv tclvl + ; writeMetaTyVar tv (mkTyVarTy rhs_tv) + ; traceTc "promoteTyVar" (ppr tv <+> text "-->" <+> ppr rhs_tv) + ; return True } + | otherwise + = do { traceTc "promoteTyVar: no" (ppr tv) + ; return False } -- Returns whether or not *any* tyvar is defaulted promoteTyVarSet :: TcTyVarSet -> TcM Bool promoteTyVarSet tvs - = do { bools <- mapM promoteTyVar (nonDetEltsUniqSet tvs) + = do { tclvl <- getTcLevel + ; bools <- mapM (promoteTyVarTo tclvl) (nonDetEltsUniqSet tvs) -- Non-determinism is OK because order of promotion doesn't matter - ; return (or bools) } ===================================== compiler/GHC/Tc/Utils/TcType.hs ===================================== @@ -33,7 +33,7 @@ module GHC.Tc.Utils.TcType ( -- TcLevel TcLevel(..), topTcLevel, pushTcLevel, isTopTcLevel, - strictlyDeeperThan, sameDepthAs, + strictlyDeeperThan, deeperThanOrSame, sameDepthAs, tcTypeLevel, tcTyVarLevel, maxTcLevel, promoteSkolem, promoteSkolemX, promoteSkolemsX, -------------------------------- @@ -45,7 +45,7 @@ module GHC.Tc.Utils.TcType ( isAmbiguousTyVar, isCycleBreakerTyVar, metaTyVarRef, metaTyVarInfo, isFlexi, isIndirect, isRuntimeUnkSkol, metaTyVarTcLevel, setMetaTyVarTcLevel, metaTyVarTcLevel_maybe, - isTouchableMetaTyVar, + isTouchableMetaTyVar, isPromotableMetaTyVar, isFloatedTouchableMetaTyVar, findDupTyVarTvs, mkTyVarNamePairs, @@ -516,7 +516,7 @@ data TcTyVarDetails | MetaTv { mtv_info :: MetaInfo , mtv_ref :: IORef MetaDetails - , mtv_tclvl :: TcLevel } -- See Note [TcLevel and untouchable type variables] + , mtv_tclvl :: TcLevel } -- See Note [TcLevel invariants] vanillaSkolemTv, superSkolemTv :: TcTyVarDetails -- See Note [Binding when looking up instances] in GHC.Core.InstEnv @@ -574,13 +574,14 @@ instance Outputable MetaInfo where ********************************************************************* -} newtype TcLevel = TcLevel Int deriving( Eq, Ord ) - -- See Note [TcLevel and untouchable type variables] for what this Int is + -- See Note [TcLevel invariants] for what this Int is -- See also Note [TcLevel assignment] {- -Note [TcLevel and untouchable type variables] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [TcLevel invariants] +~~~~~~~~~~~~~~~~~~~~~~~~~ * Each unification variable (MetaTv) + and skolem (SkolemTv) and each Implication has a level number (of type TcLevel) @@ -602,9 +603,8 @@ Note [TcLevel and untouchable type variables] LESS THAN OR EQUAL TO the ic_tclvl of I See Note [WantedInv] -* A unification variable is *touchable* if its level number - is EQUAL TO that of its immediate parent implication, - and it is a TauTv or TyVarTv (but /not/ CycleBreakerTv) +The level of a MetaTyVar also governs its untouchability. See +Note [Unification preconditions] in GHC.Tc.Utils.Unify. Note [WantedInv] ~~~~~~~~~~~~~~~~ @@ -679,13 +679,17 @@ strictlyDeeperThan :: TcLevel -> TcLevel -> Bool strictlyDeeperThan (TcLevel tv_tclvl) (TcLevel ctxt_tclvl) = tv_tclvl > ctxt_tclvl +deeperThanOrSame :: TcLevel -> TcLevel -> Bool +deeperThanOrSame (TcLevel tv_tclvl) (TcLevel ctxt_tclvl) + = tv_tclvl >= ctxt_tclvl + sameDepthAs :: TcLevel -> TcLevel -> Bool sameDepthAs (TcLevel ctxt_tclvl) (TcLevel tv_tclvl) = ctxt_tclvl == tv_tclvl -- NB: invariant ctxt_tclvl >= tv_tclvl -- So <= would be equivalent checkTcLevelInvariant :: TcLevel -> TcLevel -> Bool --- Checks (WantedInv) from Note [TcLevel and untouchable type variables] +-- Checks (WantedInv) from Note [TcLevel invariants] checkTcLevelInvariant (TcLevel ctxt_tclvl) (TcLevel tv_tclvl) = ctxt_tclvl >= tv_tclvl @@ -998,6 +1002,15 @@ tcIsTcTyVar :: TcTyVar -> Bool -- See Note [TcTyVars and TyVars in the typechecker] tcIsTcTyVar tv = isTyVar tv +isPromotableMetaTyVar :: TcTyVar -> Bool +-- True is this is a meta-tyvar that can be +-- promoted to an outer level +isPromotableMetaTyVar tv + | MetaTv { mtv_info = info } <- tcTyVarDetails tv + = isTouchableInfo info -- Can't promote cycle breakers + | otherwise + = False + isTouchableMetaTyVar :: TcLevel -> TcTyVar -> Bool isTouchableMetaTyVar ctxt_tclvl tv | isTyVar tv -- See Note [Coercion variables in free variable lists] ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -37,7 +37,7 @@ module GHC.Tc.Utils.Unify ( matchExpectedFunKind, matchActualFunTySigma, matchActualFunTysRho, - metaTyVarUpdateOK, occCheckForErrors, MetaTyVarUpdateResult(..), + occCheckForErrors, CheckTyEqResult(..), checkTyVarEq, checkTyFamEq, checkTypeEq, AreTypeFamiliesOK(..) ) where @@ -78,6 +78,7 @@ import GHC.Utils.Panic import GHC.Exts ( inline ) import Control.Monad import Control.Arrow ( second ) +import qualified Data.Semigroup as S {- ********************************************************************* @@ -1169,17 +1170,17 @@ uType t_or_k origin orig_ty1 orig_ty2 -- so that type variables tend to get filled in with -- the most informative version of the type go (TyVarTy tv1) ty2 - = do { lookup_res <- lookupTcTyVar tv1 + = do { lookup_res <- isFilledMetaTyVar_maybe tv1 ; case lookup_res of - Filled ty1 -> do { traceTc "found filled tyvar" (ppr tv1 <+> text ":->" <+> ppr ty1) - ; go ty1 ty2 } - Unfilled _ -> uUnfilledVar origin t_or_k NotSwapped tv1 ty2 } + Just ty1 -> do { traceTc "found filled tyvar" (ppr tv1 <+> text ":->" <+> ppr ty1) + ; go ty1 ty2 } + Nothing -> uUnfilledVar origin t_or_k NotSwapped tv1 ty2 } go ty1 (TyVarTy tv2) - = do { lookup_res <- lookupTcTyVar tv2 + = do { lookup_res <- isFilledMetaTyVar_maybe tv2 ; case lookup_res of - Filled ty2 -> do { traceTc "found filled tyvar" (ppr tv2 <+> text ":->" <+> ppr ty2) - ; go ty1 ty2 } - Unfilled _ -> uUnfilledVar origin t_or_k IsSwapped tv2 ty1 } + Just ty2 -> do { traceTc "found filled tyvar" (ppr tv2 <+> text ":->" <+> ppr ty2) + ; go ty1 ty2 } + Nothing -> uUnfilledVar origin t_or_k IsSwapped tv2 ty1 } -- See Note [Expanding synonyms during unification] go ty1@(TyConApp tc1 []) (TyConApp tc2 []) @@ -1433,10 +1434,11 @@ uUnfilledVar2 origin t_or_k swapped tv1 ty2 ; go dflags cur_lvl } where go dflags cur_lvl - | canSolveByUnification cur_lvl tv1 ty2 + | isTouchableMetaTyVar cur_lvl tv1 + , canSolveByUnification (metaTyVarInfo tv1) ty2 + , CTE_OK <- checkTyVarEq dflags NoTypeFamilies tv1 ty2 -- See Note [Prevent unification with type families] about the NoTypeFamilies: - , MTVU_OK ty2' <- metaTyVarUpdateOK dflags NoTypeFamilies tv1 ty2 - = do { co_k <- uType KindLevel kind_origin (tcTypeKind ty2') (tyVarKind tv1) + = do { co_k <- uType KindLevel kind_origin (tcTypeKind ty2) (tyVarKind tv1) ; traceTc "uUnfilledVar2 ok" $ vcat [ ppr tv1 <+> dcolon <+> ppr (tyVarKind tv1) , ppr ty2 <+> dcolon <+> ppr (tcTypeKind ty2) @@ -1446,8 +1448,8 @@ uUnfilledVar2 origin t_or_k swapped tv1 ty2 -- Only proceed if the kinds match -- NB: tv1 should still be unfilled, despite the kind unification -- because tv1 is not free in ty2 (or, hence, in its kind) - then do { writeMetaTyVar tv1 ty2' - ; return (mkTcNomReflCo ty2') } + then do { writeMetaTyVar tv1 ty2 + ; return (mkTcNomReflCo ty2) } else defer } -- This cannot be solved now. See GHC.Tc.Solver.Canonical -- Note [Equalities with incompatible kinds] @@ -1464,6 +1466,22 @@ uUnfilledVar2 origin t_or_k swapped tv1 ty2 defer = unSwap swapped (uType_defer t_or_k origin) ty1 ty2 +canSolveByUnification :: MetaInfo -> TcType -> Bool +-- See Note [Unification preconditions, (TYVAR-TV)] +canSolveByUnification info xi + = case info of + CycleBreakerTv -> False + TyVarTv -> case tcGetTyVar_maybe xi of + Nothing -> False + Just tv -> case tcTyVarDetails tv of + MetaTv { mtv_info = info } + -> case info of + TyVarTv -> True + _ -> False + SkolemTv {} -> True + RuntimeUnk -> True + _ -> True + swapOverTyVars :: Bool -> TcTyVar -> TcTyVar -> Bool swapOverTyVars is_given tv1 tv2 -- See Note [Unification variables on the left] @@ -1507,8 +1525,94 @@ lhsPriority tv TauTv -> 2 RuntimeUnkTv -> 3 -{- Note [TyVar/TyVar orientation] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [Unification preconditions] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Question: given a homogeneous equality (alpha ~# ty), when is it OK to +unify alpha := ty? + +This note only applied to /homogeneous/ equalities, in which both +sides have the same kind. + +There are three reasons not to unify: + +1. (SKOL-ESC) Skolem-escape + Consider the constraint + forall[2] a[2]. alpha[1] ~ Maybe a[2] + If we unify alpha := Maybe a, the skolem 'a' may escape its scope. + The level alpha[1] says that alpha may be used outside this constraint, + where 'a' is not in scope at all. So we must not unify. + + Bottom line: when looking at a constraint alpha[n] := ty, do not unify + if any free variable of 'ty' has level deeper (greater) than n + +2. (UNTOUCHABLE) Untouchable unification variables + Consider the constraint + forall[2] a[2]. b[1] ~ Int => alpha[1] ~ Int + There is no (SKOL-ESC) problem with unifying alpha := Int, but it might + not be the principal solution. Perhaps the "right" solution is alpha := b. + We simply can't tell. See "OutsideIn(X): modular type inference with local + assumptions", section 2.2. We say that alpha[1] is "untouchable" inside + this implication. + + Bottom line: at amibient level 'l', when looking at a constraint + alpha[n] ~ ty, do not unify alpha := ty if there are any given equalities + between levels 'n' and 'l'. + + Exactly what is a "given equality" for the purpose of (UNTOUCHABLE)? + Answer: see Note [Tracking Given equalities] in GHC.Tc.Solver.Monad + +3. (TYVAR-TV) Unifying TyVarTvs and CycleBreakerTvs + This precondition looks at the MetaInfo of the unification variable: + + * TyVarTv: When considering alpha{tyv} ~ ty, if alpha{tyv} is a + TyVarTv it can only unify with a type variable, not with a + structured type. So if 'ty' is a structured type, such as (Maybe x), + don't unify. + + * CycleBreakerTv: never unified, except by restoreTyVarCycles. + + +Needless to say, all three have wrinkles: + +* (SKOL-ESC) Promotion. Given alpha[n] ~ ty, what if beta[k] is free + in 'ty', where beta is a unification variable, and k>n? 'beta' + stands for a monotype, and since it is part of a level-n type + (equal to alpha[n]), we must /promote/ beta to level n. Just make + up a fresh gamma[n], and unify beta[k] := gamma[n]. + +* (TYVAR-TV) Unification variables. Suppose alpha[tyv,n] is a level-n + TyVarTv (see Note [Signature skolems] in GHC.Tc.Types.TcType)? Now + consider alpha[tyv,n] ~ Bool. We don't want to unify because that + would break the TyVarTv invariant. + + What about alpha[tyv,n] ~ beta[tau,n], where beta is an ordinary + TauTv? Again, don't unify, because beta might later be unified + with, say Bool. (If levels permit, we reverse the orientation here; + see Note [TyVar/TyVar orientation].) + +* (UNTOUCHABLE) Untouchability. When considering (alpha[n] ~ ty), how + do we know whether there are any given equalities between level n + and the ambient level? We answer in two ways: + + * In the eager unifier, we only unify if l=n. If not, alpha may be + untouchable, and defer to the constraint solver. This check is + made in GHC.Tc.Utils.uUnifilledVar2, in the guard + isTouchableMetaTyVar. + + * In the constraint solver, we track where Given equalities occur + and use that to guard unification in GHC.Tc.Solver.Canonical.unifyTest + More details in Note [Tracking Given equalities] in GHC.Tc.Solver.Monad + + Historical note: in the olden days (pre 2021) the constraint solver + also used to unify only if l=n. Equalities were "floated" out of the + implication in a separate step, so that they would become touchable. + But the float/don't-float question turned out to be very delicate, + as you can see if you look at the long series of Notes associated with + GHC.Tc.Solver.floatEqualities, around Nov 2020. It's much easier + to unify in-place, with no floating. + +Note [TyVar/TyVar orientation] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Given (a ~ b), should we orient the CEqCan as (a~b) or (b~a)? This is a surprisingly tricky question! This is invariant (TyEq:TV). @@ -1616,8 +1720,8 @@ inert guy, so we get inert item: c ~ a And now the cycle just repeats -Note [Eliminate younger unification variables] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Historical Note [Eliminate younger unification variables] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Given a choice of unifying alpha := beta or beta := alpha we try, if possible, to eliminate the "younger" one, as determined @@ -1631,36 +1735,11 @@ This is a performance optimisation only. It turns out to fix It's simple to implement (see nicer_to_update_tv2 in swapOverTyVars). But, to my surprise, it didn't seem to make any significant difference to the compiler's performance, so I didn't take it any further. Still -it seemed to too nice to discard altogether, so I'm leaving these +it seemed too nice to discard altogether, so I'm leaving these notes. SLPJ Jan 18. --} --- @trySpontaneousSolve wi@ solves equalities where one side is a --- touchable unification variable. --- Returns True <=> spontaneous solve happened -canSolveByUnification :: TcLevel -> TcTyVar -> TcType -> Bool -canSolveByUnification tclvl tv xi - | isTouchableMetaTyVar tclvl tv - = case metaTyVarInfo tv of - TyVarTv -> is_tyvar xi - _ -> True - - | otherwise -- Untouchable - = False - where - is_tyvar xi - = case tcGetTyVar_maybe xi of - Nothing -> False - Just tv -> case tcTyVarDetails tv of - MetaTv { mtv_info = info } - -> case info of - TyVarTv -> True - _ -> False - SkolemTv {} -> True - RuntimeUnk -> True - -{- Note [Prevent unification with type families] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [Prevent unification with type families] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We prevent unification with type families because of an uneasy compromise. It's perfectly sound to unify with type families, and it even improves the error messages in the testsuite. It also modestly improves performance, at @@ -1764,35 +1843,6 @@ type-checking (with wrappers, etc.). Types get desugared very differently, causing this wibble in behavior seen here. -} -data LookupTyVarResult -- The result of a lookupTcTyVar call - = Unfilled TcTyVarDetails -- SkolemTv or virgin MetaTv - | Filled TcType - -lookupTcTyVar :: TcTyVar -> TcM LookupTyVarResult -lookupTcTyVar tyvar - | MetaTv { mtv_ref = ref } <- details - = do { meta_details <- readMutVar ref - ; case meta_details of - Indirect ty -> return (Filled ty) - Flexi -> do { is_touchable <- isTouchableTcM tyvar - -- Note [Unifying untouchables] - ; if is_touchable then - return (Unfilled details) - else - return (Unfilled vanillaSkolemTv) } } - | otherwise - = return (Unfilled details) - where - details = tcTyVarDetails tyvar - -{- -Note [Unifying untouchables] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We treat an untouchable type variable as if it was a skolem. That -ensures it won't unify with anything. It's a slight hack, because -we return a made-up TcTyVarDetails, but I think it works smoothly. --} - -- | Breaks apart a function kind into its pieces. matchExpectedFunKind :: Outputable fun @@ -1871,44 +1921,38 @@ with (forall k. k->*) -} -data MetaTyVarUpdateResult a - = MTVU_OK a - | MTVU_Bad -- Forall, predicate, or type family - | MTVU_HoleBlocker -- Blocking coercion hole +data CheckTyEqResult + = CTE_OK + | CTE_Bad -- Forall, predicate, or type family + | CTE_HoleBlocker -- Blocking coercion hole -- See Note [Equalities with incompatible kinds] in "GHC.Tc.Solver.Canonical" - | MTVU_Occurs - deriving (Functor) - -instance Applicative MetaTyVarUpdateResult where - pure = MTVU_OK - (<*>) = ap - -instance Monad MetaTyVarUpdateResult where - MTVU_OK x >>= k = k x - MTVU_Bad >>= _ = MTVU_Bad - MTVU_HoleBlocker >>= _ = MTVU_HoleBlocker - MTVU_Occurs >>= _ = MTVU_Occurs - -instance Outputable a => Outputable (MetaTyVarUpdateResult a) where - ppr (MTVU_OK a) = text "MTVU_OK" <+> ppr a - ppr MTVU_Bad = text "MTVU_Bad" - ppr MTVU_HoleBlocker = text "MTVU_HoleBlocker" - ppr MTVU_Occurs = text "MTVU_Occurs" - -occCheckForErrors :: DynFlags -> TcTyVar -> Type -> MetaTyVarUpdateResult () --- Just for error-message generation; so we return MetaTyVarUpdateResult + | CTE_Occurs + +instance S.Semigroup CheckTyEqResult where + CTE_OK <> x = x + x <> _ = x + +instance Monoid CheckTyEqResult where + mempty = CTE_OK + +instance Outputable CheckTyEqResult where + ppr CTE_OK = text "CTE_OK" + ppr CTE_Bad = text "CTE_Bad" + ppr CTE_HoleBlocker = text "CTE_HoleBlocker" + ppr CTE_Occurs = text "CTE_Occurs" + +occCheckForErrors :: DynFlags -> TcTyVar -> Type -> CheckTyEqResult +-- Just for error-message generation; so we return CheckTyEqResult -- so the caller can report the right kind of error -- Check whether -- a) the given variable occurs in the given type. -- b) there is a forall in the type (unless we have -XImpredicativeTypes) occCheckForErrors dflags tv ty = case checkTyVarEq dflags YesTypeFamilies tv ty of - MTVU_OK _ -> MTVU_OK () - MTVU_Bad -> MTVU_Bad - MTVU_HoleBlocker -> MTVU_HoleBlocker - MTVU_Occurs -> case occCheckExpand [tv] ty of - Nothing -> MTVU_Occurs - Just _ -> MTVU_OK () + CTE_Occurs -> case occCheckExpand [tv] ty of + Nothing -> CTE_Occurs + Just _ -> CTE_OK + other -> other ---------------- data AreTypeFamiliesOK = YesTypeFamilies @@ -1919,52 +1963,7 @@ instance Outputable AreTypeFamiliesOK where ppr YesTypeFamilies = text "YesTypeFamilies" ppr NoTypeFamilies = text "NoTypeFamilies" -metaTyVarUpdateOK :: DynFlags - -> AreTypeFamiliesOK -- allow type families in RHS? - -> TcTyVar -- tv :: k1 - -> TcType -- ty :: k2 - -> MetaTyVarUpdateResult TcType -- possibly-expanded ty --- (metaTyVarUpdateOK tv ty) --- Checks that the equality tv~ty is OK to be used to rewrite --- other equalities. Equivalently, checks the conditions for CEqCan --- (a) that tv doesn't occur in ty (occurs check) --- (b) that ty does not have any foralls or (perhaps) type functions --- (c) that ty does not have any blocking coercion holes --- See Note [Equalities with incompatible kinds] in "GHC.Tc.Solver.Canonical" --- --- Used in two places: --- - In the eager unifier: uUnfilledVar2 --- - In the canonicaliser: GHC.Tc.Solver.Canonical.canEqTyVar2 --- Note that in the latter case tv is not necessarily a meta-tyvar, --- despite the name of this function. - --- We have two possible outcomes: --- (1) Return the type to update the type variable with, --- [we know the update is ok] --- (2) Return Nothing, --- [the update might be dodgy] --- --- Note that "Nothing" does not mean "definite error". For example --- type family F a --- type instance F Int = Int --- consider --- a ~ F a --- This is perfectly reasonable, if we later get a ~ Int. For now, though, --- we return Nothing, leaving it to the later constraint simplifier to --- sort matters out. --- --- See Note [Refactoring hazard: metaTyVarUpdateOK] - -metaTyVarUpdateOK dflags ty_fam_ok tv ty - = case checkTyVarEq dflags ty_fam_ok tv ty of - MTVU_OK _ -> MTVU_OK ty - MTVU_Bad -> MTVU_Bad -- forall, predicate, type function - MTVU_HoleBlocker -> MTVU_HoleBlocker -- coercion hole - MTVU_Occurs -> case occCheckExpand [tv] ty of - Just expanded_ty -> MTVU_OK expanded_ty - Nothing -> MTVU_Occurs - -checkTyVarEq :: DynFlags -> AreTypeFamiliesOK -> TcTyVar -> TcType -> MetaTyVarUpdateResult () +checkTyVarEq :: DynFlags -> AreTypeFamiliesOK -> TcTyVar -> TcType -> CheckTyEqResult checkTyVarEq dflags ty_fam_ok tv ty = inline checkTypeEq dflags ty_fam_ok (TyVarLHS tv) ty -- inline checkTypeEq so that the `case`s over the CanEqLHS get blasted away @@ -1973,13 +1972,13 @@ checkTyFamEq :: DynFlags -> TyCon -- type function -> [TcType] -- args, exactly saturated -> TcType -- RHS - -> MetaTyVarUpdateResult () + -> CheckTyEqResult checkTyFamEq dflags fun_tc fun_args ty = inline checkTypeEq dflags YesTypeFamilies (TyFamLHS fun_tc fun_args) ty -- inline checkTypeEq so that the `case`s over the CanEqLHS get blasted away checkTypeEq :: DynFlags -> AreTypeFamiliesOK -> CanEqLHS -> TcType - -> MetaTyVarUpdateResult () + -> CheckTyEqResult -- Checks the invariants for CEqCan. In particular: -- (a) a forall type (forall a. blah) -- (b) a predicate type (c => ty) @@ -1987,6 +1986,14 @@ checkTypeEq :: DynFlags -> AreTypeFamiliesOK -> CanEqLHS -> TcType -- (d) a blocking coercion hole -- (e) an occurrence of the LHS (occurs check) -- +-- Note that an occurs-check does not mean "definite error". For example +-- type family F a +-- type instance F Int = Int +-- consider +-- b0 ~ F b0 +-- This is perfectly reasonable, if we later get b0 ~ Int. But we +-- certainly can't unify b0 := F b0 +-- -- For (a), (b), and (c) we check only the top level of the type, NOT -- inside the kinds of variables it mentions. For (d) we look deeply -- in coercions when the LHS is a tyvar (but skip coercions for type family @@ -1994,14 +2001,11 @@ checkTypeEq :: DynFlags -> AreTypeFamiliesOK -> CanEqLHS -> TcType -- -- checkTypeEq is called from -- * checkTyFamEq, checkTyVarEq (which inline it to specialise away the --- case-analysis on 'lhs' +-- case-analysis on 'lhs') -- * checkEqCanLHSFinish, which does not know the form of 'lhs' checkTypeEq dflags ty_fam_ok lhs ty = go ty where - ok :: MetaTyVarUpdateResult () - ok = MTVU_OK () - -- The GHCi runtime debugger does its type-matching with -- unification variables that can unify with a polytype -- or a TyCon that would usually be disallowed by bad_tc @@ -2014,71 +2018,70 @@ checkTypeEq dflags ty_fam_ok lhs ty | otherwise = False - go :: TcType -> MetaTyVarUpdateResult () + go :: TcType -> CheckTyEqResult go (TyVarTy tv') = go_tv tv' go (TyConApp tc tys) = go_tc tc tys - go (LitTy {}) = ok + go (LitTy {}) = CTE_OK go (FunTy{ft_af = af, ft_mult = w, ft_arg = a, ft_res = r}) | InvisArg <- af - , not ghci_tv = MTVU_Bad - | otherwise = go w >> go a >> go r - go (AppTy fun arg) = go fun >> go arg - go (CastTy ty co) = go ty >> go_co co + , not ghci_tv = CTE_Bad + | otherwise = go w S.<> go a S.<> go r + go (AppTy fun arg) = go fun S.<> go arg + go (CastTy ty co) = go ty S.<> go_co co go (CoercionTy co) = go_co co go (ForAllTy (Bndr tv' _) ty) - | not ghci_tv = MTVU_Bad + | not ghci_tv = CTE_Bad | otherwise = case lhs of - TyVarLHS tv | tv == tv' -> ok - | otherwise -> do { go_occ tv (tyVarKind tv') - ; go ty } + TyVarLHS tv | tv == tv' -> CTE_OK + | otherwise -> go_occ tv (tyVarKind tv') S.<> go ty _ -> go ty - go_tv :: TcTyVar -> MetaTyVarUpdateResult () + go_tv :: TcTyVar -> CheckTyEqResult -- this slightly peculiar way of defining this means -- we don't have to evaluate this `case` at every variable -- occurrence go_tv = case lhs of TyVarLHS tv -> \ tv' -> if tv == tv' - then MTVU_Occurs + then CTE_Occurs else go_occ tv (tyVarKind tv') - TyFamLHS {} -> \ _tv' -> ok + TyFamLHS {} -> \ _tv' -> CTE_OK -- See Note [Occurrence checking: look inside kinds] in GHC.Core.Type -- For kinds, we only do an occurs check; we do not worry -- about type families or foralls -- See Note [Checking for foralls] - go_occ tv k | tv `elemVarSet` tyCoVarsOfType k = MTVU_Occurs - | otherwise = ok + go_occ tv k | tv `elemVarSet` tyCoVarsOfType k = CTE_Occurs + | otherwise = CTE_OK - go_tc :: TyCon -> [TcType] -> MetaTyVarUpdateResult () + go_tc :: TyCon -> [TcType] -> CheckTyEqResult -- this slightly peculiar way of defining this means -- we don't have to evaluate this `case` at every tyconapp go_tc = case lhs of TyVarLHS {} -> \ tc tys -> - if | good_tc tc -> mapM go tys >> ok - | otherwise -> MTVU_Bad + if | good_tc tc -> mconcat (map go tys) + | otherwise -> CTE_Bad TyFamLHS fam_tc fam_args -> \ tc tys -> - if | tcEqTyConApps fam_tc fam_args tc tys -> MTVU_Occurs - | good_tc tc -> mapM go tys >> ok - | otherwise -> MTVU_Bad + if | tcEqTyConApps fam_tc fam_args tc tys -> CTE_Occurs + | good_tc tc -> mconcat (map go tys) + | otherwise -> CTE_Bad -- no bother about impredicativity in coercions, as they're -- inferred go_co co | not (gopt Opt_DeferTypeErrors dflags) , hasCoercionHoleCo co - = MTVU_HoleBlocker -- Wrinkle (2) in GHC.Tc.Solver.Canonical + = CTE_HoleBlocker -- Wrinkle (2) in GHC.Tc.Solver.Canonical -- See GHC.Tc.Solver.Canonical Note [Equalities with incompatible kinds] -- Wrinkle (2) about this case in general, Wrinkle (4b) about the check for -- deferred type errors. | TyVarLHS tv <- lhs , tv `elemVarSet` tyCoVarsOfCo co - = MTVU_Occurs + = CTE_Occurs -- Don't check coercions for type families; see commentary at top of function | otherwise - = ok + = CTE_OK good_tc :: TyCon -> Bool good_tc ===================================== testsuite/tests/ghci.debugger/scripts/break012.stdout ===================================== @@ -1,14 +1,14 @@ Stopped in Main.g, break012.hs:5:10-18 -_result :: (p, a1 -> a1, (), a -> a -> a) = _ -a :: p = _ -b :: a2 -> a2 = _ +_result :: (a1, a2 -> a2, (), a -> a -> a) = _ +a :: a1 = _ +b :: a3 -> a3 = _ c :: () = _ d :: a -> a -> a = _ -a :: p -b :: a2 -> a2 +a :: a1 +b :: a3 -> a3 c :: () d :: a -> a -> a -a = (_t1::p) -b = (_t2::a2 -> a2) +a = (_t1::a1) +b = (_t2::a3 -> a3) c = (_t3::()) d = (_t4::a -> a -> a) ===================================== testsuite/tests/partial-sigs/should_compile/T10403.stderr ===================================== @@ -14,35 +14,18 @@ T10403.hs:15:12: warning: [-Wpartial-type-signatures (in -Wdefault)] • In the type signature: h1 :: _ => _ T10403.hs:19:7: warning: [-Wpartial-type-signatures (in -Wdefault)] - • Found type wildcard ‘_’ standing for ‘(a -> a1) -> f0 a -> H f0’ - Where: ‘f0’ is an ambiguous type variable + • Found type wildcard ‘_’ + standing for ‘(a -> a1) -> B t0 a -> H (B t0)’ + Where: ‘t0’ is an ambiguous type variable ‘a1’, ‘a’ are rigid type variables bound by - the inferred type of h2 :: (a -> a1) -> f0 a -> H f0 + the inferred type of h2 :: (a -> a1) -> B t0 a -> H (B t0) at T10403.hs:22:1-41 • In the type signature: h2 :: _ -T10403.hs:22:15: warning: [-Wdeferred-type-errors (in -Wdefault)] - • Ambiguous type variable ‘f0’ arising from a use of ‘fmap’ - prevents the constraint ‘(Functor f0)’ from being solved. - Relevant bindings include - b :: f0 a (bound at T10403.hs:22:6) - h2 :: (a -> a1) -> f0 a -> H f0 (bound at T10403.hs:22:1) - Probable fix: use a type annotation to specify what ‘f0’ should be. - These potential instances exist: - instance Functor IO -- Defined in ‘GHC.Base’ - instance Functor (B t) -- Defined at T10403.hs:10:10 - instance Functor I -- Defined at T10403.hs:6:10 - ...plus five others - ...plus two instances involving out-of-scope types - (use -fprint-potential-instances to see them all) - • In the second argument of ‘(.)’, namely ‘fmap (const ())’ - In the expression: (H . fmap (const ())) (fmap f b) - In an equation for ‘h2’: h2 f b = (H . fmap (const ())) (fmap f b) - T10403.hs:28:8: warning: [-Wdeferred-type-errors (in -Wdefault)] - • Couldn't match type ‘f0’ with ‘B t’ + • Couldn't match type ‘t0’ with ‘t’ Expected: H (B t) - Actual: H f0 + Actual: H (B t0) because type variable ‘t’ would escape its scope This (rigid, skolem) type variable is bound by the type signature for: ===================================== testsuite/tests/partial-sigs/should_compile/T14715.stderr ===================================== @@ -1,12 +1,11 @@ T14715.hs:13:53: warning: [-Wpartial-type-signatures (in -Wdefault)] - • Found extra-constraints wildcard standing for - ‘Reduce (LiftOf zq) zq’ - Where: ‘zq’ is a rigid type variable bound by + • Found extra-constraints wildcard standing for ‘Reduce z zq’ + Where: ‘z’, ‘zq’ are rigid type variables bound by the inferred type of - bench_mulPublic :: (z ~ LiftOf zq, Reduce (LiftOf zq) zq) => + bench_mulPublic :: (z ~ LiftOf zq, Reduce z zq) => Cyc zp -> Cyc z -> IO (zp, zq) - at T14715.hs:13:32-33 + at T14715.hs:13:27-33 • In the type signature: - bench_mulPublic :: forall z zp zq. - (z ~ LiftOf zq, _) => Cyc zp -> Cyc z -> IO (zp, zq) + bench_mulPublic :: forall z zp zq. (z ~ LiftOf zq, _) => + Cyc zp -> Cyc z -> IO (zp, zq) ===================================== testsuite/tests/partial-sigs/should_fail/ScopedNamedWildcardsBad.stderr ===================================== @@ -1,6 +1,11 @@ -ScopedNamedWildcardsBad.hs:8:21: error: +ScopedNamedWildcardsBad.hs:11:15: error: • Couldn't match expected type ‘Bool’ with actual type ‘Char’ - • In the first argument of ‘not’, namely ‘x’ - In the expression: not x - In an equation for ‘v’: v = not x + • In the first argument of ‘g’, namely ‘'x'’ + In the expression: g 'x' + In the expression: + let + v = not x + g :: _a -> _a + g x = x + in (g 'x') ===================================== testsuite/tests/typecheck/should_fail/ExpandSynsFail2.stderr ===================================== @@ -1,6 +1,6 @@ ExpandSynsFail2.hs:19:37: error: - • Couldn't match type ‘Int’ with ‘Bool’ + • Couldn't match type ‘Bool’ with ‘Int’ Expected: ST s Foo Actual: MyBarST s Type synonyms expanded: ===================================== testsuite/tests/typecheck/should_fail/T7453.stderr ===================================== @@ -1,6 +1,8 @@ -T7453.hs:10:30: error: - • Couldn't match expected type ‘t’ with actual type ‘p’ +T7453.hs:9:15: error: + • Couldn't match type ‘t’ with ‘p’ + Expected: Id t + Actual: Id p ‘t’ is a rigid type variable bound by the type signature for: z :: forall t. Id t @@ -8,17 +10,29 @@ T7453.hs:10:30: error: ‘p’ is a rigid type variable bound by the inferred type of cast1 :: p -> a at T7453.hs:(7,1)-(10,30) - • In the first argument of ‘Id’, namely ‘v’ - In the expression: Id v - In an equation for ‘aux’: aux = Id v + • In the expression: aux + In an equation for ‘z’: + z = aux + where + aux = Id v + In an equation for ‘cast1’: + cast1 v + = runId z + where + z :: Id t + z = aux + where + aux = Id v • Relevant bindings include - aux :: Id t (bound at T7453.hs:10:21) + aux :: Id p (bound at T7453.hs:10:21) z :: Id t (bound at T7453.hs:9:11) v :: p (bound at T7453.hs:7:7) cast1 :: p -> a (bound at T7453.hs:7:1) -T7453.hs:16:33: error: - • Couldn't match expected type ‘t1’ with actual type ‘p’ +T7453.hs:15:15: error: + • Couldn't match type ‘t1’ with ‘p’ + Expected: () -> t1 + Actual: () -> p ‘t1’ is a rigid type variable bound by the type signature for: z :: forall t1. () -> t1 @@ -26,11 +40,21 @@ T7453.hs:16:33: error: ‘p’ is a rigid type variable bound by the inferred type of cast2 :: p -> t at T7453.hs:(13,1)-(16,33) - • In the first argument of ‘const’, namely ‘v’ - In the expression: const v - In an equation for ‘aux’: aux = const v + • In the expression: aux + In an equation for ‘z’: + z = aux + where + aux = const v + In an equation for ‘cast2’: + cast2 v + = z () + where + z :: () -> t + z = aux + where + aux = const v • Relevant bindings include - aux :: b -> t1 (bound at T7453.hs:16:21) + aux :: forall {b}. b -> p (bound at T7453.hs:16:21) z :: () -> t1 (bound at T7453.hs:15:11) v :: p (bound at T7453.hs:13:7) cast2 :: p -> t (bound at T7453.hs:13:1) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4273e231c5337889f556c00f081abafd9b49bd77 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4273e231c5337889f556c00f081abafd9b49bd77 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 16 12:51:21 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Wed, 16 Dec 2020 07:51:21 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/T18995 Message-ID: <5fda02c9e25e2_6b213272ce0181750@gitlab.mail> Simon Peyton Jones pushed new branch wip/T18995 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T18995 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 16 12:59:19 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Wed, 16 Dec 2020 07:59:19 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/T18730 Message-ID: <5fda04a7a45b8_6b213272ce01823862@gitlab.mail> Simon Peyton Jones pushed new branch wip/T18730 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T18730 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 16 13:26:09 2020 From: gitlab at gitlab.haskell.org (Danya Rogozin) Date: Wed, 16 Dec 2020 08:26:09 -0500 Subject: [Git][ghc/ghc][wip/ghc-11342-char-kind] 50 commits: gitlab-ci: Fix copy-paste error Message-ID: <5fda0af11142b_6b213272ce0183338@gitlab.mail> Danya Rogozin pushed to branch wip/ghc-11342-char-kind at Glasgow Haskell Compiler / GHC Commits: e0b08c5f by Ben Gamari at 2020-12-03T13:01:47-05:00 gitlab-ci: Fix copy-paste error Also be more consistent in quoting. - - - - - 33ec3a06 by Ben Gamari at 2020-12-03T23:11:31-05:00 gitlab-ci: Run linters through ci.sh Ensuring that the right toolchain is used. - - - - - 4a437bc1 by Shayne Fletcher at 2020-12-05T09:06:38-05:00 Fix bad span calculations of post qualified imports - - - - - 8fac4b93 by Ben Gamari at 2020-12-05T09:07:13-05:00 testsuite: Add a test for #18923 - - - - - 62ed6957 by Simon Peyton Jones at 2020-12-08T15:31:41-05:00 Fix kind inference for data types. Again. This patch fixes several aspects of kind inference for data type declarations, especially data /instance/ declarations Specifically 1. In kcConDecls/kcConDecl make it clear that the tc_res_kind argument is only used in the H98 case; and in that case there is no result kind signature; and hence no need for the disgusting splitPiTys in kcConDecls (now thankfully gone). The GADT case is a bit different to before, and much nicer. This is what fixes #18891. See Note [kcConDecls: kind-checking data type decls] 2. Do not look at the constructor decls of a data/newtype instance in tcDataFamInstanceHeader. See GHC.Tc.TyCl.Instance Note [Kind inference for data family instances]. This was a new realisation that arose when doing (1) This causes a few knock-on effects in the tests suite, because we require more information than before in the instance /header/. New user-manual material about this in "Kind inference in data type declarations" and "Kind inference for data/newtype instance declarations". 3. Minor improvement in kcTyClDecl, combining GADT and H98 cases 4. Fix #14111 and #8707 by allowing the header of a data instance to affect kind inferece for the the data constructor signatures; as described at length in Note [GADT return types] in GHC.Tc.TyCl This led to a modest refactoring of the arguments (and argument order) of tcConDecl/tcConDecls. 5. Fix #19000 by inverting the sense of the test in new_locs in GHC.Tc.Solver.Canonical.canDecomposableTyConAppOK. - - - - - 0abe3ddf by Adam Sandberg Ericsson at 2020-12-08T15:32:19-05:00 hadrian: build the _l and _thr_l rts flavours in the develN flavours The ghc binary requires the eventlog rts since fc644b1a643128041cfec25db84e417851e28bab - - - - - 51e3bb6d by Andreas Klebinger at 2020-12-08T22:43:21-05:00 CodeGen: Make folds User/DefinerOfRegs INLINEABLE. Reduces allocation for the test case I was looking at by about 1.2%. Mostly from avoiding allocation of some folding functions which turn into let-no-escape bindings which just reuse their environment instead. We also force inlining in a few key places in CmmSink which helps a bit more. - - - - - 69ae10c3 by Andreas Klebinger at 2020-12-08T22:43:21-05:00 CmmSink: Force inlining of foldRegsDefd Helps avoid allocating the folding function. Improves perf for T3294 by about 1%. - - - - - 6e3da800 by Andreas Klebinger at 2020-12-08T22:43:21-05:00 Cmm: Make a few types and utility function slightly stricter. About 0.6% reduction in allocations for the code I was looking at. Not a huge difference but no need to throw away performance. - - - - - aef44d7f by Andreas Klebinger at 2020-12-08T22:43:21-05:00 Cmm.Sink: Optimize retaining of assignments, live sets. Sinking requires us to track live local regs after each cmm statement. We used to do this via "Set LocalReg". However we can replace this with a solution based on IntSet which is overall more efficient without losing much. The thing we lose is width of the variables, which isn't used by the sinking pass anyway. I also reworked how we keep assignments to regs mentioned in skipped assignments. I put the details into Note [Keeping assignemnts mentioned in skipped RHSs]. The gist of it is instead of keeping track of it via the use count which is a `IntMap Int` we now use the live regs set (IntSet) which is quite a bit faster. I think it also matches the semantics a lot better. The skipped (not discarded) assignment does in fact keep the regs on it's rhs alive so keeping track of this in the live set seems like the clearer solution as well. Improves allocations for T3294 by yet another 1%. - - - - - 59f2249b by Andreas Klebinger at 2020-12-08T22:43:21-05:00 GHC.Cmm.Opt: Be stricter in results. Optimization either returns Nothing if nothing is to be done or `Just <cmmExpr>` otherwise. There is no point in being lazy in `cmmExpr`. We usually inspect this element so the thunk gets forced not long after. We might eliminate it as dead code once in a blue moon but that's not a case worth optimizing for. Overall the impact of this is rather low. As Cmm.Opt doesn't allocate much (compared to the rest of GHC) to begin with. - - - - - 54b88eac by Andreas Klebinger at 2020-12-08T22:43:57-05:00 Bump time submodule. This should fix #19002. - - - - - 35e7b0c6 by Kirill Elagin at 2020-12-10T01:45:54-05:00 doc: Clarify the default for -fomit-yields “Yield points enabled” is confusing (and probably wrong? I am not 100% sure what it means). Change it to a simple “on”. Undo this change from 2c23fff2e03e77187dc4d01f325f5f43a0e7cad2. - - - - - 3551c554 by Kirill Elagin at 2020-12-10T01:45:54-05:00 doc: Extra-clarify -fomit-yields Be more clear on what this optimisation being on by default means in terms of yields. - - - - - 6484f0d7 by Sergei Trofimovich at 2020-12-10T01:46:33-05:00 rts/linker/Elf.c: add missing <dlfcn.h> include (musl support) The change fixes build failure on musl: ``` rts/linker/Elf.c:2031:3: error: warning: implicit declaration of function 'dlclose'; did you mean 'close'? [-Wimplicit-function-declaration] 2031 | dlclose(nc->dlopen_handle); | ^~~~~~~ | close ``` Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - ab24ed9b by Ben Gamari at 2020-12-11T03:55:51-05:00 users guide: Fix syntax errors Fixes errors introduced by 3a55b3a2574f913d046f3a6f82db48d7f6df32e3. - - - - - d3a24d31 by Ben Gamari at 2020-12-11T03:55:51-05:00 users guide: Describe GC lifecycle events Every time I am asked about how to interpret these events I need to figure it out from scratch. It's well past time that the users guide properly documents these. - - - - - 741309b9 by Ben Gamari at 2020-12-11T03:56:27-05:00 gitlab-ci: Fix incorrect Docker image for nightly cross job Also refactor the job definition to eliminate the bug by construction. - - - - - 19703bc8 by Ben Gamari at 2020-12-11T03:56:27-05:00 gitlab-ci: Fix name of flavour in ThreadSanitizer job It looks like I neglected to update this after introduce flavour transformers. - - - - - 381eb660 by Sylvain Henry at 2020-12-11T12:57:35-05:00 Display FFI labels (fix #18539) - - - - - 4548d1f8 by Aaron Allen at 2020-12-11T12:58:14-05:00 Elide extraneous messages for :doc command (#15784) Do not print `<has no documentation>` alongside a valid doc. Additionally, if two matching symbols lack documentation then the message will only be printed once. Hence, `<has no documentation>` will be printed at most once and only if all matching symbols are lacking docs. - - - - - 5eba91b6 by Aaron Allen at 2020-12-11T12:58:14-05:00 Add :doc test case for duplicate record fields Tests that the output of the `:doc` command is correct for duplicate record fields defined using -XDuplicateRecordFields. - - - - - 5feb9b2d by Ryan Scott at 2020-12-11T22:39:29-05:00 Delete outdated Note [Kind-checking tyvar binders for associated types] This Note has severely bitrotted, as it has no references anywhere in the codebase, and none of the functions that it mentions exist anymore. Let's just delete this. While I was in town, I deleted some outdated comments from `checkFamPatBinders` of a similar caliber. Fixes #19008. [ci skip] - - - - - f9f9f030 by Sylvain Henry at 2020-12-11T22:40:08-05:00 Arrows: correctly query arrow methods (#17423) Consider the following code: proc (C x y) -> ... Before this patch, the evidence binding for the Arrow dictionary was attached to the C pattern: proc (C x y) { $dArrow = ... } -> ... But then when we desugar this, we use arrow operations ("arr", ">>>"...) specialised for this arrow: let arr_xy = arr $dArrow -- <-- Not in scope! ... in arr_xy (\(C x y) { $dArrow = ... } -> ...) This patch allows arrow operations to be type-checked before the proc itself, avoiding this issue. Fix #17423 - - - - - aaa8f00f by Sylvain Henry at 2020-12-11T22:40:48-05:00 Validate script: fix configure command when using stack - - - - - b4a929a1 by Sylvain Henry at 2020-12-11T22:41:30-05:00 Hadrian: fix libffi tarball parsing Fix parsing of "libffi-3.3.tar.gz". NB: switch to a newer libffi isn't done in this patch - - - - - 690c8946 by Sylvain Henry at 2020-12-11T22:42:09-05:00 Parser: move parser utils into their own module Move code unrelated to runtime evaluation out of GHC.Runtime.Eval - - - - - 76be0e32 by Sylvain Henry at 2020-12-11T22:42:48-05:00 Move SizedSeq into ghc-boot - - - - - 3a16d764 by Sylvain Henry at 2020-12-11T22:42:48-05:00 ghci: don't compile unneeded modules - - - - - 2895fa60 by Sylvain Henry at 2020-12-11T22:42:48-05:00 ghci: reuse Arch from ghc-boot - - - - - 480a38d4 by Sylvain Henry at 2020-12-11T22:43:30-05:00 rts: don't use siginterrupt (#19019) - - - - - 4af6126d by Sylvain Henry at 2020-12-11T22:44:11-05:00 Use static array in zeroCount - - - - - 5bd71bfd by Sebastian Graf at 2020-12-12T04:45:09-05:00 DmdAnal: Annotate top-level function bindings with demands (#18894) It's useful to annotate a non-exported top-level function like `g` in ```hs module Lib (h) where g :: Int -> Int -> (Int,Int) g m 1 = (m, 0) g m n = (2 * m, 2 `div` n) {-# NOINLINE g #-} h :: Int -> Int h 1 = 0 h m | odd m = snd (g m 2) | otherwise = uncurry (+) (g 2 m) ``` with its demand `UCU(CS(P(1P(U),SP(U))`, which tells us that whenever `g` was called, the second component of the returned pair was evaluated strictly. Since #18903 we do so for local functions, where we can see all calls. For top-level functions, we can assume that all *exported* functions are demanded according to `topDmd` and thus get sound demands for non-exported top-level functions. The demand on `g` is crucial information for Nested CPR, which may the go on and unbox `g` for the second pair component. That is true even if that pair component may diverge, as is the case for the call site `g 13 0`, which throws a div-by-zero exception. In `T18894b`, you can even see the new demand annotation enabling us to eta-expand a function that we wouldn't be able to eta-expand without Call Arity. We only track bindings of function type in order not to risk huge compile-time regressions, see `isInterestingTopLevelFn`. There was a CoreLint check that rejected strict demand annotations on recursive or top-level bindings, which seems completely unjustified. All the cases I investigated were fine, so I removed it. Fixes #18894. - - - - - 3aae036e by Sebastian Graf at 2020-12-12T04:45:09-05:00 Demand: Simplify `CU(U)` to `U` (#19005) Both sub-demands encode the same information. This is a trivial change and already affects a few regression tests (e.g. `T5075`), so no separate regression test is necessary. - - - - - c6477639 by Adam Sandberg Ericsson at 2020-12-12T04:45:48-05:00 hadrian: correctly copy the docs dir into the bindist #18669 - - - - - e033dd05 by Adam Sandberg Ericsson at 2020-12-12T10:52:19+00:00 mkDocs: support hadrian bindists #18973 - - - - - 78580ba3 by John Ericson at 2020-12-13T07:14:50-05:00 Remove old .travis.yml - - - - - c696bb2f by Cale Gibbard at 2020-12-14T13:37:09-05:00 Implement type applications in patterns The haddock submodule is also updated so that it understands the changes to patterns. - - - - - 7e9debd4 by Ben Gamari at 2020-12-14T13:37:09-05:00 Optimise nullary type constructor usage During the compilation of programs GHC very frequently deals with the `Type` type, which is a synonym of `TYPE 'LiftedRep`. This patch teaches GHC to avoid expanding the `Type` synonym (and other nullary type synonyms) during type comparisons, saving a good amount of work. This optimisation is described in `Note [Comparing nullary type synonyms]`. To maximize the impact of this optimisation, we introduce a few special-cases to reduce `TYPE 'LiftedRep` to `Type`. See `Note [Prefer Type over TYPE 'LiftedPtrRep]`. Closes #17958. Metric Decrease: T18698b T1969 T12227 T12545 T12707 T14683 T3064 T5631 T5642 T9020 T9630 T9872a T13035 haddock.Cabal haddock.base - - - - - 92377c27 by Ben Gamari at 2020-12-14T13:41:58-05:00 Revert "Optimise nullary type constructor usage" This was inadvertently merged. This reverts commit 7e9debd4ceb068effe8ac81892d2cabcb8f55850. - - - - - d0e8c10d by Sylvain Henry at 2020-12-14T19:45:13+01:00 Move Unit related fields from DynFlags to HscEnv The unit database cache, the home unit and the unit state were stored in DynFlags while they ought to be stored in the compiler session state (HscEnv). This patch fixes this. It introduces a new UnitEnv type that should be used in the future to handle separate unit environments (especially host vs target units). Related to #17957 Bump haddock submodule - - - - - af855ac1 by Andreas Klebinger at 2020-12-14T15:22:13-05:00 Optimize dumping of consecutive whitespace. The naive way of putting out n characters of indent would be something like `hPutStr hdl (replicate n ' ')`. However this is quite inefficient as we allocate an absurd number of strings consisting of simply spaces as we don't cache them. To improve on this we now track if we can simply write ascii spaces via hPutBuf instead. This is the case when running with -ddump-to-file where we force the encoding to be UTF8. This avoids both the cost of going through encoding as well as avoiding allocation churn from all the white space. Instead we simply use hPutBuf on a preallocated unlifted string. When dumping stg like this: > nofib/spectral/simple/Main.hs -fforce-recomp -ddump-stg-final -ddump-to-file -c +RTS -s Allocations went from 1,778 MB to 1,702MB. About a 4% reduction of allocation! I did not measure the difference in runtime but expect it to be similar. Bumps the haddock submodule since the interface of GHC's Pretty slightly changed. ------------------------- Metric Decrease: T12227 ------------------------- - - - - - dad87210 by Ben Gamari at 2020-12-14T15:22:29-05:00 Optimise nullary type constructor usage During the compilation of programs GHC very frequently deals with the `Type` type, which is a synonym of `TYPE 'LiftedRep`. This patch teaches GHC to avoid expanding the `Type` synonym (and other nullary type synonyms) during type comparisons, saving a good amount of work. This optimisation is described in `Note [Comparing nullary type synonyms]`. To maximize the impact of this optimisation, we introduce a few special-cases to reduce `TYPE 'LiftedRep` to `Type`. See `Note [Prefer Type over TYPE 'LiftedPtrRep]`. Closes #17958. Metric Decrease: T18698b T1969 T12227 T12545 T12707 T14683 T3064 T5631 T5642 T9020 T9630 T9872a T13035 haddock.Cabal haddock.base - - - - - 6c2eb223 by Andrew Martin at 2020-12-14T18:48:51-05:00 Implement BoxedRep proposal This implements the BoxedRep proposal, refacoring the `RuntimeRep` hierarchy from: ```haskell data RuntimeRep = LiftedPtrRep | UnliftedPtrRep | ... ``` to ```haskell data RuntimeRep = BoxedRep Levity | ... data Levity = Lifted | Unlifted ``` Closes #17526. - - - - - 3ee696cc by Sebastian Graf at 2020-12-15T10:53:31-05:00 Add regression test for #19053 - - - - - 535dae66 by Ben Gamari at 2020-12-15T10:53:58-05:00 testsuite: Mark divbyzero, derefnull as fragile Due to #18548. - - - - - 331f5568 by Ben Gamari at 2020-12-15T11:21:06-05:00 Revert "Implement BoxedRep proposal" This was inadvertently merged. This reverts commit 6c2eb2232b39ff4720fda0a4a009fb6afbc9dcea. - - - - - 50fae07d by Ben Gamari at 2020-12-15T15:15:16-05:00 Roll-back broken haddock commit Updates haddock submodule to revert a commit that does not build. - - - - - e9b18a75 by Ben Gamari at 2020-12-15T15:55:38-05:00 Revert haddock submodule yet again - - - - - e5ed968c by Daniel Rogozin at 2020-12-16T16:25:36+03:00 the char kind: type families, functionality, and submodule updates Co-authored-by: Rinat Stryungis <rinat.stryungis at serokell.io> Metric Decrease: T5205 Metric Increase: Naperian T13035 - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - − .travis.yml - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Types/Literals.hs - compiler/GHC/Builtin/Types/Prim.hs - + compiler/GHC/Builtin/Types/Prim.hs-boot - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/Expr.hs - + compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Liveness.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Parser/Monad.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Env.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/368d334fbdf1675dcbc77bf098e6628858778f4d...e5ed968cf1b5579caf3bf34f1edcd838567601e9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/368d334fbdf1675dcbc77bf098e6628858778f4d...e5ed968cf1b5579caf3bf34f1edcd838567601e9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 16 14:11:40 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 16 Dec 2020 09:11:40 -0500 Subject: [Git][ghc/ghc][master] Bump haddock submodule Message-ID: <5fda159c2004b_6b213272ce0184384@gitlab.mail> Ben Gamari pushed to branch master at Glasgow Haskell Compiler / GHC Commits: b58cb63a by GHC GitLab CI at 2020-12-16T03:46:31+00:00 Bump haddock submodule To adapt haddock for the nullary tyconapp optimisation patch. - - - - - 1 changed file: - utils/haddock Changes: ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit c577da9cf5c531a3e5678760823c61db8a3adeb6 +Subproject commit 059acb11d6134ee0d896bcf73c870958557a3909 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b58cb63afd3353beb3a6e11ba7fa557fdedb8941 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b58cb63afd3353beb3a6e11ba7fa557fdedb8941 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 16 14:19:25 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 16 Dec 2020 09:19:25 -0500 Subject: [Git][ghc/ghc][wip/boxed-rep] Implement BoxedRep proposal Message-ID: <5fda176deb07b_6b213272ce018459b@gitlab.mail> Ben Gamari pushed to branch wip/boxed-rep at Glasgow Haskell Compiler / GHC Commits: cafd4c7b by Andrew Martin at 2020-12-16T09:19:17-05:00 Implement BoxedRep proposal This implements the BoxedRep proposal, refacoring the `RuntimeRep` hierarchy from: ```haskell data RuntimeRep = LiftedPtrRep | UnliftedPtrRep | ... ``` to ```haskell data RuntimeRep = BoxedRep Levity | ... data Levity = Lifted | Unlifted ``` Updates binary, haddock submodules. Closes #17526. - - - - - 30 changed files: - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Instance/Typeable.hs - compiler/GHC/Types/RepType.hs - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/Binary/Typeable.hs - docs/users_guide/9.2.1-notes.rst - docs/users_guide/exts/levity_polymorphism.rst - docs/users_guide/exts/typed_holes.rst - libraries/base/Data/Typeable.hs - libraries/base/Data/Typeable/Internal.hs - libraries/base/GHC/Enum.hs - libraries/base/GHC/Exts.hs - libraries/base/GHC/Show.hs - libraries/base/Unsafe/Coerce.hs - libraries/base/tests/T11334a.hs - libraries/base/tests/T11334a.stdout - libraries/binary - libraries/ghc-heap/GHC/Exts/Heap.hs - libraries/ghc-heap/tests/ClosureSizeUtils.hs - libraries/ghc-prim/GHC/Types.hs - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - testsuite/tests/backpack/should_run/T13955.bkp The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cafd4c7b7a0a77de717942fdc38a491810b96455 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cafd4c7b7a0a77de717942fdc38a491810b96455 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 16 14:33:12 2020 From: gitlab at gitlab.haskell.org (Ryan Scott) Date: Wed, 16 Dec 2020 09:33:12 -0500 Subject: [Git][ghc/ghc][wip/T18914] 113 commits: rts: Post ticky entry counts to the eventlog Message-ID: <5fda1aa898ad4_6b2174471c184838@gitlab.mail> Ryan Scott pushed to branch wip/T18914 at Glasgow Haskell Compiler / GHC Commits: 7e93ae8b by Ben Gamari at 2020-11-21T13:13:29-05:00 rts: Post ticky entry counts to the eventlog We currently only post the entry counters, not the other global counters as in my experience the former are more useful. We use the heap profiler's census period to decide when to dump. Also spruces up the documentation surrounding ticky-ticky a bit. - - - - - bc9c3916 by Ben Gamari at 2020-11-22T06:28:10-05:00 Implement -ddump-c-backend argument To dump output of the C backend. - - - - - 901bc220 by Ben Gamari at 2020-11-22T12:39:02-05:00 Bump time submodule to 1.11.1 Also bumps directory, Cabal, hpc, time, and unix submodules. Closes #18847. - - - - - 92c0afbf by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Dump STG when ticky is enabled This changes the "ticky" modifier to enable dumping of final STG as this is generally needed to make sense of the ticky profiles. - - - - - d23fef68 by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Introduce notion of flavour transformers This extends Hadrian's notion of "flavour", as described in #18942. - - - - - 179d0bec by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Add a viaLlvmBackend modifier Note that this also slightly changes the semantics of these flavours as we only use LLVM for >= stage1 builds. - - - - - d4d95e51 by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Add profiled_ghc and no_dynamic_ghc modifiers - - - - - 6815603f by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Drop redundant flavour definitions Drop the profiled, LLVM, and ThreadSanitizer flavour definitions as these can now be realized with flavour transformers. - - - - - f88f4339 by Ben Gamari at 2020-11-24T02:43:20-05:00 rts: Flush eventlog buffers from flushEventLog As noted in #18043, flushTrace failed flush anything beyond the writer. This means that a significant amount of data sitting in capability-local event buffers may never get flushed, despite the users' pleads for us to flush. Fix this by making flushEventLog flush all of the event buffers before flushing the writer. Fixes #18043. - - - - - 7c03cc50 by Ben Gamari at 2020-11-24T02:43:55-05:00 gitlab-ci: Run LLVM job on appropriately-labelled MRs Namely, those marked with the ~"LLVM backend" label - - - - - 9b95d815 by Ben Gamari at 2020-11-24T02:43:55-05:00 gitlab-ci: Run LLVM builds on Debian 10 The current Debian 9 image doesn't provide LLVM 7. - - - - - 2ed3e6c0 by Ben Gamari at 2020-11-24T02:43:55-05:00 CmmToLlvm: Declare signature for memcmp Otherwise `opt` fails with: error: use of undefined value '@memcmp$def' - - - - - be5d74ca by Moritz Angermann at 2020-11-26T16:00:32-05:00 [Sized Cmm] properly retain sizes. This replaces all Word<N> = W<N># Word# and Int<N> = I<N># Int# with Word<N> = W<N># Word<N># and Int<N> = I<N># Int<N>#, thus providing us with properly sized primitives in the codegenerator instead of pretending they are all full machine words. This came up when implementing darwinpcs for arm64. The darwinpcs reqires us to pack function argugments in excess of registers on the stack. While most procedure call standards (pcs) assume arguments are just passed in 8 byte slots; and thus the caller does not know the exact signature to make the call, darwinpcs requires us to adhere to the prototype, and thus have the correct sizes. If we specify CInt in the FFI call, it should correspond to the C int, and not just be Word sized, when it's only half the size. This does change the expected output of T16402 but the new result is no less correct as it eliminates the narrowing (instead of the `and` as was previously done). Bumps the array, bytestring, text, and binary submodules. Co-Authored-By: Ben Gamari <ben at well-typed.com> Metric Increase: T13701 T14697 - - - - - a84e53f9 by Andreas Klebinger at 2020-11-26T16:00:32-05:00 RTS: Fix failed inlining of copy_tag. On windows using gcc-10 gcc failed to inline copy_tag into evacuate. To fix this we now set the always_inline attribute for the various copy* functions in Evac.c. The main motivation here is not the overhead of the function call, but rather that this allows the code to "specialize" for the size of the closure we copy which is often known at compile time. An earlier commit also tried to avoid evacuate_large inlining. But didn't quite succeed. So I also marked evacuate_large as noinline. Fixes #12416 - - - - - cdbd16f5 by Sylvain Henry at 2020-11-26T16:00:33-05:00 Fix toArgRep to support 64-bit reps on all systems [This is @Ericson2314 writing a commit message for @hsyl20's patch.] (Progress towards #11953, #17377, #17375) `Int64Rep` and `Word64Rep` are currently broken on 64-bit systems. This is because they should use "native arg rep" but instead use "large arg rep" as they do on 32-bit systems, which is either a non-concept or a 128-bit rep depending on one's vantage point. Now, these reps currently aren't used during 64-bit compilation, so the brokenness isn't observed, but I don't think that constitutes reasons not to fix it. Firstly, the linked issues there is a clearly expressed desire to use explicit-bitwidth constructs in more places. Secondly, per [1], there are other bugs that *do* manifest from not threading explicit-bitwidth information all the way through the compilation pipeline. One can therefore view this as one piece of the larger effort to do that, improve ergnomics, and squash remaining bugs. Also, this is needed for !3658. I could just merge this as part of that, but I'm keen on merging fixes "as they are ready" so the fixes that aren't ready are isolated and easier to debug. [1]: https://mail.haskell.org/pipermail/ghc-devs/2020-October/019332.html - - - - - a9378e69 by Tim Barnes at 2020-11-26T16:00:34-05:00 Set dynamic users-guide TOC spacing (fixes #18554) - - - - - 86a59d93 by Ben Gamari at 2020-11-26T16:00:34-05:00 rts: Use RTS_LIKELY in CHECK Most compilers probably already infer that `barf` diverges but it nevertheless doesn't hurt to be explicit. - - - - - 5757e82b by Matthew Pickering at 2020-11-26T16:00:35-05:00 Remove special case for GHC.ByteCode.Instr This was added in https://github.com/nomeata/ghc-heap-view/commit/34935206e51b9c86902481d84d2f368a6fd93423 GHC.ByteCode.Instr.BreakInfo no longer exists so the special case is dead code. Any check like this can be easily dealt with in client code. - - - - - d9c8b5b4 by Matthew Pickering at 2020-11-26T16:00:35-05:00 Split Up getClosureDataFromHeapRep Motivation 1. Don't enforce the repeated decoding of an info table, when the client can cache it (ghc-debug) 2. Allow the constructor information decoding to be overridden, this casues segfaults in ghc-debug - - - - - 3e3555cc by Andreas Klebinger at 2020-11-26T16:00:35-05:00 RegAlloc: Add missing raPlatformfield to RegAllocStatsSpill Fixes #18994 Co-Author: Benjamin Maurer <maurer.benjamin at gmail.com> - - - - - a1a75aa9 by Ben Gamari at 2020-11-27T06:20:41-05:00 rts: Allocate MBlocks with MAP_TOP_DOWN on Windows As noted in #18991, we would previously allocate heap in low memory. Due to this the linker, which typically *needs* low memory, would end up competing with the heap. In longer builds we end up running out of low memory entirely, leading to linking failures. - - - - - 75fc1ed5 by Sylvain Henry at 2020-11-28T15:40:23-05:00 Hadrian: fix detection of ghc-pkg for cross-compilers - - - - - 7cb5df96 by Sylvain Henry at 2020-11-28T15:40:23-05:00 hadrian: fix ghc-pkg uses (#17601) Make sure ghc-pkg doesn't read the compiler "settings" file by passing --no-user-package-db. - - - - - e3fd4226 by Ben Gamari at 2020-11-28T15:40:23-05:00 gitlab-ci: Introduce a nightly cross-compilation job This adds a job to test cross-compilation from x86-64 to AArch64 with Hadrian. Fixes #18234 - - - - - 698d3d96 by Ben Gamari at 2020-11-28T15:41:00-05:00 gitlab-ci: Only deploy GitLab Pages in ghc/ghc> The deployments are quite large and yet are currently only served for the ghc/ghc> project. - - - - - 625726f9 by David Eichmann at 2020-11-28T15:41:37-05:00 ghc-heap: partial TSO/STACK decoding Co-authored-by: Sven Tennie <sven.tennie at gmail.com> Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> Co-authored-by: Ben Gamari <bgamari.foss at gmail.com> - - - - - 22ea9c29 by Andreas Klebinger at 2020-11-28T15:42:13-05:00 Small optimization to CmmSink. Inside `regsUsedIn` we can avoid some thunks by specializing the recursion. In particular we avoid the thunk for `(f e z)` in the MachOp/Load branches, where we know this will evaluate to z. Reduces allocations for T3294 by ~1%. - - - - - bba42c62 by John Ericson at 2020-11-28T15:42:49-05:00 Make primop handler indentation more consistent - - - - - c82bc8e9 by John Ericson at 2020-11-28T15:42:49-05:00 Cleanup some primop constructor names Harmonize the internal (big sum type) names of the native vs fixed-sized number primops a bit. (Mainly by renaming the former.) No user-facing names are changed. - - - - - ae14f160 by Ben Gamari at 2020-11-28T15:43:25-05:00 testsuite: Mark T14702 as fragile on Windows Due to #18953. - - - - - 1bc104b0 by Ben Gamari at 2020-11-29T15:33:18-05:00 withTimings: Emit allocations counter This will allow us to back out the allocations per compiler pass from the eventlog. Note that we dump the allocation counter rather than the difference since this will allow us to determine how much work is done *between* `withTiming` blocks. - - - - - e992ea84 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 ThreadPaused: Don't zero slop until free vars are pushed When threadPaused blackholes a thunk it calls `OVERWRITING_CLOSURE` to zero the slop for the benefit of the sanity checker. Previously this was done *before* pushing the thunk's free variables to the update remembered set. Consequently we would pull zero'd pointers to the update remembered set. - - - - - e82cd140 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Fix regression from TSAN work The TSAN rework (specifically aad1f803) introduced a subtle regression in GC.c, swapping `g0` in place of `gen`. Whoops! Fixes #18997. - - - - - 35a5207e by GHC GitLab CI at 2020-11-29T15:33:54-05:00 rts/Messages: Add missing write barrier in THROWTO message update After a THROWTO message has been handle the message closure is overwritten by a NULL message. We must ensure that the original closure's pointers continue to be visible to the nonmoving GC. - - - - - 0120829f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Add missing write barrier in shrinkSmallByteArray - - - - - 8a4d8fb6 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 Updates: Don't zero slop until closure has been pushed Ensure that the the free variables have been pushed to the update remembered set before we zero the slop. - - - - - 2793cfdc by GHC GitLab CI at 2020-11-29T15:33:54-05:00 OSThreads: Fix error code checking pthread_join returns its error code and apparently doesn't set errno. - - - - - e391a16f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Don't join to mark_thread on shutdown The mark thread is not joinable as we detach from it on creation. - - - - - 60d088ab by Ben Gamari at 2020-11-29T15:33:54-05:00 nonmoving: Add reference to Ueno 2016 - - - - - 3aa60362 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Ensure that evacuated large objects are marked See Note [Non-moving GC: Marking evacuated objects]. - - - - - 8d304a99 by Ben Gamari at 2020-11-30T10:15:22-05:00 rts/m32: Refactor handling of allocator seeding Previously, in an attempt to reduce fragmentation, each new allocator would map a region of M32_MAX_PAGES fresh pages to seed itself. However, this ends up being extremely wasteful since it turns out that we often use fewer than this. Consequently, these pages end up getting freed which, ends up fragmenting our address space more than than we would have if we had naively allocated pages on-demand. Here we refactor m32 to avoid this waste while achieving the fragmentation mitigation previously desired. In particular, we move all page allocation into the global m32_alloc_page, which will pull a page from the free page pool. If the free page pool is empty we then refill it by allocating a region of M32_MAP_PAGES and adding them to the pool. Furthermore, we do away with the initial seeding entirely. That is, the allocator starts with no active pages: pages are rather allocated on an as-needed basis. On the whole this ends up being a pleasingly simple change, simultaneously making m32 more efficient, more robust, and simpler. Fixes #18980. - - - - - b6629289 by Ben Gamari at 2020-11-30T10:15:58-05:00 rts: Use CHECK instead of assert Use the GHC wrappers instead of <assert.h>. - - - - - 9f4efa6a by Ben Gamari at 2020-11-30T10:15:58-05:00 rts/linker: Replace some ASSERTs with CHECK In the past some people have confused ASSERT, which is for checking internal invariants, which CHECK, which should be used when checking things that might fail due to bad input (and therefore should be enabled even in the release compiler). Change some of these cases in the linker to use CHECK. - - - - - 0f8a4655 by Ryan Scott at 2020-11-30T10:16:34-05:00 Allow deploy:pages job to fail See #18973. - - - - - 49ebe369 by chessai at 2020-11-30T19:47:40-05:00 Optimisations in Data.Foldable (T17867) This PR concerns the following functions from `Data.Foldable`: * minimum * maximum * sum * product * minimumBy * maximumBy - Default implementations of these functions now use `foldl'` or `foldMap'`. - All have been marked with INLINEABLE to make room for further optimisations. - - - - - 4d79ef65 by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - 6af074ce by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - ab334262 by Viktor Dukhovni at 2020-11-30T19:48:17-05:00 dirty MVAR after mutating TSO queue head While the original head and tail of the TSO queue may be in the same generation as the MVAR, interior elements of the queue could be younger after a GC run and may then be exposed by putMVar operation that updates the queue head. Resolves #18919 - - - - - 5eb163f3 by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Don't allow shared libraries to be loaded multiple times - - - - - 490aa14d by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Initialise CCSs from native shared objects - - - - - 6ac3db5f by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Move shared library loading logic into Elf.c - - - - - b6698d73 by GHC GitLab CI at 2020-11-30T19:48:53-05:00 rts/linker: Don't declare dynamic objects with image_mapped This previously resulted in warnings due to spurious unmap failures. - - - - - b94a65af by jneira at 2020-11-30T19:49:31-05:00 Include tried paths in findToolDir error - - - - - 72a87fbc by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Move core flattening algorithm to Core.Unify This sets the stage for a later change, where this algorithm will be needed from GHC.Core.InstEnv. This commit also splits GHC.Core.Map into GHC.Core.Map.Type and GHC.Core.Map.Expr, in order to avoid module import cycles with GHC.Core. - - - - - 0dd45d0a by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Bump the # of commits searched for perf baseline The previous value of 75 meant that a feature branch with more than 75 commits would get spurious CI passes. This affects #18692, but does not fix that ticket, because if a baseline cannot be found, we should fail, not succeed. - - - - - 8bb52d91 by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Remove flattening variables This patch redesigns the flattener to simplify type family applications directly instead of using flattening meta-variables and skolems. The key new innovation is the CanEqLHS type and the new CEqCan constraint (Ct). A CanEqLHS is either a type variable or exactly-saturated type family application; either can now be rewritten using a CEqCan constraint in the inert set. Because the flattener no longer reduces all type family applications to variables, there was some performance degradation if a lengthy type family application is now flattened over and over (not making progress). To compensate, this patch contains some extra optimizations in the flattener, leading to a number of performance improvements. Close #18875. Close #18910. There are many extra parts of the compiler that had to be affected in writing this patch: * The family-application cache (formerly the flat-cache) sometimes stores coercions built from Given inerts. When these inerts get kicked out, we must kick out from the cache as well. (This was, I believe, true previously, but somehow never caused trouble.) Kicking out from the cache requires adding a filterTM function to TrieMap. * This patch obviates the need to distinguish "blocking" coercion holes from non-blocking ones (which, previously, arose from CFunEqCans). There is thus some simplification around coercion holes. * Extra commentary throughout parts of the code I read through, to preserve the knowledge I gained while working. * A change in the pure unifier around unifying skolems with other types. Unifying a skolem now leads to SurelyApart, not MaybeApart, as documented in Note [Binding when looking up instances] in GHC.Core.InstEnv. * Some more use of MCoercion where appropriate. * Previously, class-instance lookup automatically noticed that e.g. C Int was a "unifier" to a target [W] C (F Bool), because the F Bool was flattened to a variable. Now, a little more care must be taken around checking for unifying instances. * Previously, tcSplitTyConApp_maybe would split (Eq a => a). This is silly, because (=>) is not a tycon in Haskell. Fixed now, but there are some knock-on changes in e.g. TrieMap code and in the canonicaliser. * New function anyFreeVarsOf{Type,Co} to check whether a free variable satisfies a certain predicate. * Type synonyms now remember whether or not they are "forgetful"; a forgetful synonym drops at least one argument. This is useful when flattening; see flattenView. * The pattern-match completeness checker invokes the solver. This invocation might need to look through newtypes when checking representational equality. Thus, the desugarer needs to keep track of the in-scope variables to know what newtype constructors are in scope. I bet this bug was around before but never noticed. * Extra-constraints wildcards are no longer simplified before printing. See Note [Do not simplify ConstraintHoles] in GHC.Tc.Solver. * Whether or not there are Given equalities has become slightly subtler. See the new HasGivenEqs datatype. * Note [Type variable cycles in Givens] in GHC.Tc.Solver.Canonical explains a significant new wrinkle in the new approach. * See Note [What might match later?] in GHC.Tc.Solver.Interact, which explains the fix to #18910. * The inert_count field of InertCans wasn't actually used, so I removed it. Though I (Richard) did the implementation, Simon PJ was very involved in design and review. This updates the Haddock submodule to avoid #18932 by adding a type signature. ------------------------- Metric Decrease: T12227 T5030 T9872a T9872b T9872c Metric Increase: T9872d ------------------------- - - - - - d66660ba by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Rename the flattener to become the rewriter. Now that flattening doesn't produce flattening variables, it's not really flattening anything: it's rewriting. This change also means that the rewriter can no longer be confused the core flattener (in GHC.Core.Unify), which is sometimes used during type-checking. - - - - - add0aeae by Ben Gamari at 2020-12-01T19:58:17-05:00 rts: Introduce mmapAnonForLinker Previously most of the uses of mmapForLinker were mapping anonymous memory, resulting in a great deal of unnecessary repetition. Factor this out into a new helper. Also fixes a few places where error checking was missing or suboptimal. - - - - - 97d71646 by Ben Gamari at 2020-12-01T19:58:17-05:00 rts/linker: Introduce munmapForLinker Consolidates munmap calls to ensure consistent error handling. - - - - - d8872af0 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/Linker: Introduce Windows implementations for mmapForLinker, et al. - - - - - c35d0e03 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/m32: Introduce NEEDS_M32 macro Instead of relying on RTS_LINKER_USE_MMAP - - - - - 41c64eb5 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/linker: Use m32 to allocate symbol extras in PEi386 - - - - - e0b08c5f by Ben Gamari at 2020-12-03T13:01:47-05:00 gitlab-ci: Fix copy-paste error Also be more consistent in quoting. - - - - - 33ec3a06 by Ben Gamari at 2020-12-03T23:11:31-05:00 gitlab-ci: Run linters through ci.sh Ensuring that the right toolchain is used. - - - - - 4a437bc1 by Shayne Fletcher at 2020-12-05T09:06:38-05:00 Fix bad span calculations of post qualified imports - - - - - 8fac4b93 by Ben Gamari at 2020-12-05T09:07:13-05:00 testsuite: Add a test for #18923 - - - - - 62ed6957 by Simon Peyton Jones at 2020-12-08T15:31:41-05:00 Fix kind inference for data types. Again. This patch fixes several aspects of kind inference for data type declarations, especially data /instance/ declarations Specifically 1. In kcConDecls/kcConDecl make it clear that the tc_res_kind argument is only used in the H98 case; and in that case there is no result kind signature; and hence no need for the disgusting splitPiTys in kcConDecls (now thankfully gone). The GADT case is a bit different to before, and much nicer. This is what fixes #18891. See Note [kcConDecls: kind-checking data type decls] 2. Do not look at the constructor decls of a data/newtype instance in tcDataFamInstanceHeader. See GHC.Tc.TyCl.Instance Note [Kind inference for data family instances]. This was a new realisation that arose when doing (1) This causes a few knock-on effects in the tests suite, because we require more information than before in the instance /header/. New user-manual material about this in "Kind inference in data type declarations" and "Kind inference for data/newtype instance declarations". 3. Minor improvement in kcTyClDecl, combining GADT and H98 cases 4. Fix #14111 and #8707 by allowing the header of a data instance to affect kind inferece for the the data constructor signatures; as described at length in Note [GADT return types] in GHC.Tc.TyCl This led to a modest refactoring of the arguments (and argument order) of tcConDecl/tcConDecls. 5. Fix #19000 by inverting the sense of the test in new_locs in GHC.Tc.Solver.Canonical.canDecomposableTyConAppOK. - - - - - 0abe3ddf by Adam Sandberg Ericsson at 2020-12-08T15:32:19-05:00 hadrian: build the _l and _thr_l rts flavours in the develN flavours The ghc binary requires the eventlog rts since fc644b1a643128041cfec25db84e417851e28bab - - - - - 51e3bb6d by Andreas Klebinger at 2020-12-08T22:43:21-05:00 CodeGen: Make folds User/DefinerOfRegs INLINEABLE. Reduces allocation for the test case I was looking at by about 1.2%. Mostly from avoiding allocation of some folding functions which turn into let-no-escape bindings which just reuse their environment instead. We also force inlining in a few key places in CmmSink which helps a bit more. - - - - - 69ae10c3 by Andreas Klebinger at 2020-12-08T22:43:21-05:00 CmmSink: Force inlining of foldRegsDefd Helps avoid allocating the folding function. Improves perf for T3294 by about 1%. - - - - - 6e3da800 by Andreas Klebinger at 2020-12-08T22:43:21-05:00 Cmm: Make a few types and utility function slightly stricter. About 0.6% reduction in allocations for the code I was looking at. Not a huge difference but no need to throw away performance. - - - - - aef44d7f by Andreas Klebinger at 2020-12-08T22:43:21-05:00 Cmm.Sink: Optimize retaining of assignments, live sets. Sinking requires us to track live local regs after each cmm statement. We used to do this via "Set LocalReg". However we can replace this with a solution based on IntSet which is overall more efficient without losing much. The thing we lose is width of the variables, which isn't used by the sinking pass anyway. I also reworked how we keep assignments to regs mentioned in skipped assignments. I put the details into Note [Keeping assignemnts mentioned in skipped RHSs]. The gist of it is instead of keeping track of it via the use count which is a `IntMap Int` we now use the live regs set (IntSet) which is quite a bit faster. I think it also matches the semantics a lot better. The skipped (not discarded) assignment does in fact keep the regs on it's rhs alive so keeping track of this in the live set seems like the clearer solution as well. Improves allocations for T3294 by yet another 1%. - - - - - 59f2249b by Andreas Klebinger at 2020-12-08T22:43:21-05:00 GHC.Cmm.Opt: Be stricter in results. Optimization either returns Nothing if nothing is to be done or `Just <cmmExpr>` otherwise. There is no point in being lazy in `cmmExpr`. We usually inspect this element so the thunk gets forced not long after. We might eliminate it as dead code once in a blue moon but that's not a case worth optimizing for. Overall the impact of this is rather low. As Cmm.Opt doesn't allocate much (compared to the rest of GHC) to begin with. - - - - - 54b88eac by Andreas Klebinger at 2020-12-08T22:43:57-05:00 Bump time submodule. This should fix #19002. - - - - - 35e7b0c6 by Kirill Elagin at 2020-12-10T01:45:54-05:00 doc: Clarify the default for -fomit-yields “Yield points enabled” is confusing (and probably wrong? I am not 100% sure what it means). Change it to a simple “on”. Undo this change from 2c23fff2e03e77187dc4d01f325f5f43a0e7cad2. - - - - - 3551c554 by Kirill Elagin at 2020-12-10T01:45:54-05:00 doc: Extra-clarify -fomit-yields Be more clear on what this optimisation being on by default means in terms of yields. - - - - - 6484f0d7 by Sergei Trofimovich at 2020-12-10T01:46:33-05:00 rts/linker/Elf.c: add missing <dlfcn.h> include (musl support) The change fixes build failure on musl: ``` rts/linker/Elf.c:2031:3: error: warning: implicit declaration of function 'dlclose'; did you mean 'close'? [-Wimplicit-function-declaration] 2031 | dlclose(nc->dlopen_handle); | ^~~~~~~ | close ``` Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - ab24ed9b by Ben Gamari at 2020-12-11T03:55:51-05:00 users guide: Fix syntax errors Fixes errors introduced by 3a55b3a2574f913d046f3a6f82db48d7f6df32e3. - - - - - d3a24d31 by Ben Gamari at 2020-12-11T03:55:51-05:00 users guide: Describe GC lifecycle events Every time I am asked about how to interpret these events I need to figure it out from scratch. It's well past time that the users guide properly documents these. - - - - - 741309b9 by Ben Gamari at 2020-12-11T03:56:27-05:00 gitlab-ci: Fix incorrect Docker image for nightly cross job Also refactor the job definition to eliminate the bug by construction. - - - - - 19703bc8 by Ben Gamari at 2020-12-11T03:56:27-05:00 gitlab-ci: Fix name of flavour in ThreadSanitizer job It looks like I neglected to update this after introduce flavour transformers. - - - - - 381eb660 by Sylvain Henry at 2020-12-11T12:57:35-05:00 Display FFI labels (fix #18539) - - - - - 4548d1f8 by Aaron Allen at 2020-12-11T12:58:14-05:00 Elide extraneous messages for :doc command (#15784) Do not print `<has no documentation>` alongside a valid doc. Additionally, if two matching symbols lack documentation then the message will only be printed once. Hence, `<has no documentation>` will be printed at most once and only if all matching symbols are lacking docs. - - - - - 5eba91b6 by Aaron Allen at 2020-12-11T12:58:14-05:00 Add :doc test case for duplicate record fields Tests that the output of the `:doc` command is correct for duplicate record fields defined using -XDuplicateRecordFields. - - - - - 5feb9b2d by Ryan Scott at 2020-12-11T22:39:29-05:00 Delete outdated Note [Kind-checking tyvar binders for associated types] This Note has severely bitrotted, as it has no references anywhere in the codebase, and none of the functions that it mentions exist anymore. Let's just delete this. While I was in town, I deleted some outdated comments from `checkFamPatBinders` of a similar caliber. Fixes #19008. [ci skip] - - - - - f9f9f030 by Sylvain Henry at 2020-12-11T22:40:08-05:00 Arrows: correctly query arrow methods (#17423) Consider the following code: proc (C x y) -> ... Before this patch, the evidence binding for the Arrow dictionary was attached to the C pattern: proc (C x y) { $dArrow = ... } -> ... But then when we desugar this, we use arrow operations ("arr", ">>>"...) specialised for this arrow: let arr_xy = arr $dArrow -- <-- Not in scope! ... in arr_xy (\(C x y) { $dArrow = ... } -> ...) This patch allows arrow operations to be type-checked before the proc itself, avoiding this issue. Fix #17423 - - - - - aaa8f00f by Sylvain Henry at 2020-12-11T22:40:48-05:00 Validate script: fix configure command when using stack - - - - - b4a929a1 by Sylvain Henry at 2020-12-11T22:41:30-05:00 Hadrian: fix libffi tarball parsing Fix parsing of "libffi-3.3.tar.gz". NB: switch to a newer libffi isn't done in this patch - - - - - 690c8946 by Sylvain Henry at 2020-12-11T22:42:09-05:00 Parser: move parser utils into their own module Move code unrelated to runtime evaluation out of GHC.Runtime.Eval - - - - - 76be0e32 by Sylvain Henry at 2020-12-11T22:42:48-05:00 Move SizedSeq into ghc-boot - - - - - 3a16d764 by Sylvain Henry at 2020-12-11T22:42:48-05:00 ghci: don't compile unneeded modules - - - - - 2895fa60 by Sylvain Henry at 2020-12-11T22:42:48-05:00 ghci: reuse Arch from ghc-boot - - - - - 480a38d4 by Sylvain Henry at 2020-12-11T22:43:30-05:00 rts: don't use siginterrupt (#19019) - - - - - 4af6126d by Sylvain Henry at 2020-12-11T22:44:11-05:00 Use static array in zeroCount - - - - - 5bd71bfd by Sebastian Graf at 2020-12-12T04:45:09-05:00 DmdAnal: Annotate top-level function bindings with demands (#18894) It's useful to annotate a non-exported top-level function like `g` in ```hs module Lib (h) where g :: Int -> Int -> (Int,Int) g m 1 = (m, 0) g m n = (2 * m, 2 `div` n) {-# NOINLINE g #-} h :: Int -> Int h 1 = 0 h m | odd m = snd (g m 2) | otherwise = uncurry (+) (g 2 m) ``` with its demand `UCU(CS(P(1P(U),SP(U))`, which tells us that whenever `g` was called, the second component of the returned pair was evaluated strictly. Since #18903 we do so for local functions, where we can see all calls. For top-level functions, we can assume that all *exported* functions are demanded according to `topDmd` and thus get sound demands for non-exported top-level functions. The demand on `g` is crucial information for Nested CPR, which may the go on and unbox `g` for the second pair component. That is true even if that pair component may diverge, as is the case for the call site `g 13 0`, which throws a div-by-zero exception. In `T18894b`, you can even see the new demand annotation enabling us to eta-expand a function that we wouldn't be able to eta-expand without Call Arity. We only track bindings of function type in order not to risk huge compile-time regressions, see `isInterestingTopLevelFn`. There was a CoreLint check that rejected strict demand annotations on recursive or top-level bindings, which seems completely unjustified. All the cases I investigated were fine, so I removed it. Fixes #18894. - - - - - 3aae036e by Sebastian Graf at 2020-12-12T04:45:09-05:00 Demand: Simplify `CU(U)` to `U` (#19005) Both sub-demands encode the same information. This is a trivial change and already affects a few regression tests (e.g. `T5075`), so no separate regression test is necessary. - - - - - c6477639 by Adam Sandberg Ericsson at 2020-12-12T04:45:48-05:00 hadrian: correctly copy the docs dir into the bindist #18669 - - - - - e033dd05 by Adam Sandberg Ericsson at 2020-12-12T10:52:19+00:00 mkDocs: support hadrian bindists #18973 - - - - - 78580ba3 by John Ericson at 2020-12-13T07:14:50-05:00 Remove old .travis.yml - - - - - c696bb2f by Cale Gibbard at 2020-12-14T13:37:09-05:00 Implement type applications in patterns The haddock submodule is also updated so that it understands the changes to patterns. - - - - - 7e9debd4 by Ben Gamari at 2020-12-14T13:37:09-05:00 Optimise nullary type constructor usage During the compilation of programs GHC very frequently deals with the `Type` type, which is a synonym of `TYPE 'LiftedRep`. This patch teaches GHC to avoid expanding the `Type` synonym (and other nullary type synonyms) during type comparisons, saving a good amount of work. This optimisation is described in `Note [Comparing nullary type synonyms]`. To maximize the impact of this optimisation, we introduce a few special-cases to reduce `TYPE 'LiftedRep` to `Type`. See `Note [Prefer Type over TYPE 'LiftedPtrRep]`. Closes #17958. Metric Decrease: T18698b T1969 T12227 T12545 T12707 T14683 T3064 T5631 T5642 T9020 T9630 T9872a T13035 haddock.Cabal haddock.base - - - - - 92377c27 by Ben Gamari at 2020-12-14T13:41:58-05:00 Revert "Optimise nullary type constructor usage" This was inadvertently merged. This reverts commit 7e9debd4ceb068effe8ac81892d2cabcb8f55850. - - - - - d0e8c10d by Sylvain Henry at 2020-12-14T19:45:13+01:00 Move Unit related fields from DynFlags to HscEnv The unit database cache, the home unit and the unit state were stored in DynFlags while they ought to be stored in the compiler session state (HscEnv). This patch fixes this. It introduces a new UnitEnv type that should be used in the future to handle separate unit environments (especially host vs target units). Related to #17957 Bump haddock submodule - - - - - af855ac1 by Andreas Klebinger at 2020-12-14T15:22:13-05:00 Optimize dumping of consecutive whitespace. The naive way of putting out n characters of indent would be something like `hPutStr hdl (replicate n ' ')`. However this is quite inefficient as we allocate an absurd number of strings consisting of simply spaces as we don't cache them. To improve on this we now track if we can simply write ascii spaces via hPutBuf instead. This is the case when running with -ddump-to-file where we force the encoding to be UTF8. This avoids both the cost of going through encoding as well as avoiding allocation churn from all the white space. Instead we simply use hPutBuf on a preallocated unlifted string. When dumping stg like this: > nofib/spectral/simple/Main.hs -fforce-recomp -ddump-stg-final -ddump-to-file -c +RTS -s Allocations went from 1,778 MB to 1,702MB. About a 4% reduction of allocation! I did not measure the difference in runtime but expect it to be similar. Bumps the haddock submodule since the interface of GHC's Pretty slightly changed. ------------------------- Metric Decrease: T12227 ------------------------- - - - - - dad87210 by Ben Gamari at 2020-12-14T15:22:29-05:00 Optimise nullary type constructor usage During the compilation of programs GHC very frequently deals with the `Type` type, which is a synonym of `TYPE 'LiftedRep`. This patch teaches GHC to avoid expanding the `Type` synonym (and other nullary type synonyms) during type comparisons, saving a good amount of work. This optimisation is described in `Note [Comparing nullary type synonyms]`. To maximize the impact of this optimisation, we introduce a few special-cases to reduce `TYPE 'LiftedRep` to `Type`. See `Note [Prefer Type over TYPE 'LiftedPtrRep]`. Closes #17958. Metric Decrease: T18698b T1969 T12227 T12545 T12707 T14683 T3064 T5631 T5642 T9020 T9630 T9872a T13035 haddock.Cabal haddock.base - - - - - 6c2eb223 by Andrew Martin at 2020-12-14T18:48:51-05:00 Implement BoxedRep proposal This implements the BoxedRep proposal, refacoring the `RuntimeRep` hierarchy from: ```haskell data RuntimeRep = LiftedPtrRep | UnliftedPtrRep | ... ``` to ```haskell data RuntimeRep = BoxedRep Levity | ... data Levity = Lifted | Unlifted ``` Closes #17526. - - - - - 3ee696cc by Sebastian Graf at 2020-12-15T10:53:31-05:00 Add regression test for #19053 - - - - - 535dae66 by Ben Gamari at 2020-12-15T10:53:58-05:00 testsuite: Mark divbyzero, derefnull as fragile Due to #18548. - - - - - 331f5568 by Ben Gamari at 2020-12-15T11:21:06-05:00 Revert "Implement BoxedRep proposal" This was inadvertently merged. This reverts commit 6c2eb2232b39ff4720fda0a4a009fb6afbc9dcea. - - - - - 50fae07d by Ben Gamari at 2020-12-15T15:15:16-05:00 Roll-back broken haddock commit Updates haddock submodule to revert a commit that does not build. - - - - - e9b18a75 by Ben Gamari at 2020-12-15T15:55:38-05:00 Revert haddock submodule yet again - - - - - b58cb63a by GHC GitLab CI at 2020-12-16T03:46:31+00:00 Bump haddock submodule To adapt haddock for the nullary tyconapp optimisation patch. - - - - - a2d97616 by Ryan Scott at 2020-12-16T09:32:20-05:00 Use HsOuterExplicit in instance sigs in deriving-generated code Issue #18914 revealed that `GeneralizedNewtypeDeriving` would generate code that mentions unbound type variables, which is dangerously fragile. The problem (and fix) is described in the new `Wrinkle: Use HsOuterExplicit` in `Note [GND and QuantifiedConstraints]`. The gist of it: make sure to put the top-level `forall`s in `deriving`-generated instance signatures in an `HsOuterExplicit` to ensure that they scope over the bodies of methods correctly. A side effect of this process is that it will expand any type synonyms in the instance signature, which will surface any `forall`s that are hidden underneath type synonyms (such as in the test case for #18914). While I was in town, I also performed some maintenance on `NewHsTypeX`, which powers `GeneralizedNewtypeDeriving`: * I renamed `NewHsTypeX` to `HsCoreTy`, which more accurately describes its intended purpose (#15706). I also made `HsCoreTy` a type synonym instead of a newtype, as making it a distinct data type wasn't buying us much. * To make sure that mistakes similar to #18914 do not occur later, I added an additional validity check when renaming `HsCoreTy`s that complains if an `HsCoreTy`s contains an out-of-scope type variable. See the new `Note [Renaming HsCoreTys]` in `GHC.Rename.HsType` for the details. Fixes #15706. Fixes #18914. Bumps the `haddock` submodule. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - − .travis.yml - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - + compiler/GHC/Builtin/Types/Prim.hs-boot - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Expr.hs - + compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Liveness.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Parser/Monad.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/Reg/Graph.hs - compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/Base.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dd250208bc14be4919bd151b98d5ddc59f1fd070...a2d97616f256bd922a07c3e130459cd49f84e7de -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dd250208bc14be4919bd151b98d5ddc59f1fd070...a2d97616f256bd922a07c3e130459cd49f84e7de You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 16 14:34:49 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 16 Dec 2020 09:34:49 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/T19075 Message-ID: <5fda1b0941abf_6b21725c11c185059b@gitlab.mail> Ben Gamari pushed new branch wip/T19075 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T19075 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 16 14:35:09 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 16 Dec 2020 09:35:09 -0500 Subject: [Git][ghc/ghc][wip/T19075] rts/Messages: Relax locked-closure assertion Message-ID: <5fda1b1d5b6b0_6b2167418541850776@gitlab.mail> Ben Gamari pushed to branch wip/T19075 at Glasgow Haskell Compiler / GHC Commits: c7bfd425 by Ben Gamari at 2020-12-16T09:35:05-05:00 rts/Messages: Relax locked-closure assertion In general we are less careful about locking closures when running with only a single capability. Fixes #19075. - - - - - 1 changed file: - rts/Messages.h Changes: ===================================== rts/Messages.h ===================================== @@ -25,8 +25,9 @@ void sendMessage (Capability *from_cap, Capability *to_cap, Message *msg); INLINE_HEADER void doneWithMsgThrowTo (Capability *cap, MessageThrowTo *m) { - // The message better be locked - ASSERT(m->header.info == &stg_WHITEHOLE_info); + // The message better be locked (unless we are running single-threaded, + // where we are a bit more lenient (#19075). + ASSERT(n_capabilities == 1 || m->header.info == &stg_WHITEHOLE_info); IF_NONMOVING_WRITE_BARRIER_ENABLED { updateRemembSetPushClosure(cap, (StgClosure *) m->link); updateRemembSetPushClosure(cap, (StgClosure *) m->source); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c7bfd425000955b130f76011492340f0dbc9c565 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c7bfd425000955b130f76011492340f0dbc9c565 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 16 14:38:48 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Wed, 16 Dec 2020 09:38:48 -0500 Subject: [Git][ghc/ghc][wip/T17656] Kill floatEqualities completely Message-ID: <5fda1bf88f776_6b21866204418539b4@gitlab.mail> Simon Peyton Jones pushed to branch wip/T17656 at Glasgow Haskell Compiler / GHC Commits: 2aa777bf by Simon Peyton Jones at 2020-12-16T14:38:04+00:00 Kill floatEqualities completely This patch delivers on #17656, by entirel killing off the complex floatEqualities mechanism. Previously, floatEqualities would float an equality out of an implication, so that it could be solved at an outer level. But now we simply do unification in-place, without floating the constraint, relying on level numbers to determine untouchability. There are a number of important new Notes: * GHC.Tc.Utils.Unify Note [Unification preconditions] describes the preconditions for unification, including both skolem-escape and touchability. * GHC.Tc.Solver.Interact Note [Solve by unification] describes what we do when we do unify * GHC.Tc.Solver.Monad Note [The Unification Level Flag] describes how we control solver iteration under this new scheme * GHC.Tc.Solver.Monad Note [Tracking Given equalities] describes how we track when we have Given equalities * GHC.Tc.Types.Constraint Note [HasGivenEqs] is a new explanation of the ic_given_eqs field of an implication A big raft of subtle Notes in Solver, concerning floatEqualities, disappears. Main code changes: * GHC.Tc.Solver.floatEqualities disappears entirely * GHC.Tc.Solver.Monad: new fields in InertCans, inert_given_eq_lvl and inert_given_eq, updated by updateGivenEqs See Note [Tracking Given equalities]. * In exchange for updateGivenEqa, GHC.Tc.Solver.Monad.getHasGivenEqs is much simpler and more efficient * I found I could kill of metaTyVarUpdateOK entirely One test case T14683 showed a 4.5% decrease in compile-time allocation. Other changes were small Metric Decrease: T14683 - - - - - 19 changed files: - compiler/GHC/Runtime/Heap/Inspect.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Interact.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Utils/Unify.hs - testsuite/tests/ghci.debugger/scripts/break012.stdout - testsuite/tests/partial-sigs/should_compile/T10403.stderr - testsuite/tests/partial-sigs/should_compile/T14715.stderr - testsuite/tests/partial-sigs/should_fail/ScopedNamedWildcardsBad.stderr - testsuite/tests/typecheck/should_fail/ExpandSynsFail2.stderr - testsuite/tests/typecheck/should_fail/T7453.stderr Changes: ===================================== compiler/GHC/Runtime/Heap/Inspect.hs ===================================== @@ -577,7 +577,7 @@ newOpenVar = liftTcM (do { kind <- newOpenTypeKind ~~~~~~~~~~~~~~~~~~~~~~ In the GHCi debugger we use unification variables whose MetaInfo is RuntimeUnkTv. The special property of a RuntimeUnkTv is that it can -unify with a polytype (see GHC.Tc.Utils.Unify.metaTyVarUpdateOK). +unify with a polytype (see GHC.Tc.Utils.Unify.checkTypeEq). If we don't do this `:print ` will fail if the type of has nested `forall`s or `=>`s. ===================================== compiler/GHC/Tc/Errors.hs ===================================== @@ -21,7 +21,7 @@ import GHC.Tc.Utils.Monad import GHC.Tc.Types.Constraint import GHC.Core.Predicate import GHC.Tc.Utils.TcMType -import GHC.Tc.Utils.Unify( occCheckForErrors, MetaTyVarUpdateResult(..) ) +import GHC.Tc.Utils.Unify( occCheckForErrors, CheckTyEqResult(..) ) import GHC.Tc.Utils.Env( tcInitTidyEnv ) import GHC.Tc.Utils.TcType import GHC.Tc.Types.Origin @@ -1482,7 +1482,7 @@ mkTyVarEqErr' dflags ctxt report ct tv1 ty2 , report ] - | MTVU_Occurs <- occ_check_expand + | CTE_Occurs <- occ_check_expand -- We report an "occurs check" even for a ~ F t a, where F is a type -- function; it's not insoluble (because in principle F could reduce) -- but we have certainly been unable to solve it @@ -1503,7 +1503,7 @@ mkTyVarEqErr' dflags ctxt report ct tv1 ty2 ; mkErrorMsgFromCt ctxt ct $ mconcat [headline_msg, extra2, extra3, report] } - | MTVU_Bad <- occ_check_expand + | CTE_Bad <- occ_check_expand = do { let msg = vcat [ text "Cannot instantiate unification variable" <+> quotes (ppr tv1) , hang (text "with a" <+> what <+> text "involving polytypes:") 2 (ppr ty2) ] ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -907,7 +907,7 @@ That is the entire point of qlUnify! Wrinkles: * We must not make an occurs-check; we use occCheckExpand for that. -* metaTyVarUpdateOK also checks for various other things, including +* checkTypeEq also checks for various other things, including - foralls, and predicate types (which we want to allow here) - type families (relates to a very specific and exotic performance question, that is unlikely to bite here) ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -311,7 +311,7 @@ Note [Promotion in signatures] If an unsolved metavariable in a signature is not generalized (because we're not generalizing the construct -- e.g., pattern sig -- or because the metavars are constrained -- see kindGeneralizeSome) -we need to promote to maintain (WantedTvInv) of Note [TcLevel and untouchable type variables] +we need to promote to maintain (WantedTvInv) of Note [TcLevel invariants] in GHC.Tc.Utils.TcType. Note that promotion is identical in effect to generalizing and the reinstantiating with a fresh metavariable at the current level. So in some sense, we generalize *all* variables, but then re-instantiate @@ -329,7 +329,7 @@ the pattern signature (which is not kind-generalized). When we are checking the *body* of foo, though, we need to unify the type of x with the argument type of bar. At this point, the ambient TcLevel is 1, and spotting a matavariable with level 2 would violate the (WantedTvInv) invariant of -Note [TcLevel and untouchable type variables]. So, instead of kind-generalizing, +Note [TcLevel invariants]. So, instead of kind-generalizing, we promote the metavariable to level 1. This is all done in kindGeneralizeNone. -} ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -264,7 +264,7 @@ floatKindEqualities wc = float_wc emptyVarSet wc = Nothing -- A short cut /plus/ we must keep track of IC_BadTelescope | otherwise = do { (simples, holes) <- float_wc new_trapping_tvs wanted - ; when (not (isEmptyBag simples) && given_eqs /= NoGivenEqs) $ + ; when (not (isEmptyBag simples) && given_eqs == MaybeGivenEqs) $ Nothing -- If there are some constraints to float out, but we can't -- because we don't float out past local equalities @@ -1282,7 +1282,8 @@ decideMonoTyVars infer_mode name_taus psigs candidates mr_msg ; traceTc "decideMonoTyVars" $ vcat - [ text "mono_tvs0 =" <+> ppr mono_tvs0 + [ text "infer_mode =" <+> ppr infer_mode + , text "mono_tvs0 =" <+> ppr mono_tvs0 , text "no_quant =" <+> ppr no_quant , text "maybe_quant =" <+> ppr maybe_quant , text "eq_constraints =" <+> ppr eq_constraints @@ -1405,7 +1406,10 @@ decideQuantifiedTyVars name_taus psigs candidates dvs_plus = dv { dv_kvs = pick cand_kvs, dv_tvs = pick cand_tvs } ; traceTc "decideQuantifiedTyVars" (vcat - [ text "candidates =" <+> ppr candidates + [ text "tau_tys =" <+> ppr tau_tys + , text "candidates =" <+> ppr candidates + , text "cand_kvs =" <+> ppr cand_kvs + , text "cand_tvs =" <+> ppr cand_tvs , text "tau_tys =" <+> ppr tau_tys , text "seed_tys =" <+> ppr seed_tys , text "seed_tcvs =" <+> ppr (tyCoVarsOfTypes seed_tys) @@ -1660,22 +1664,14 @@ solveWantedsAndDrop wanted solveWanteds :: WantedConstraints -> TcS WantedConstraints -- so that the inert set doesn't mindlessly propagate. -- NB: wc_simples may be wanted /or/ derived now -solveWanteds wc@(WC { wc_simple = simples, wc_impl = implics, wc_holes = holes }) +solveWanteds wc@(WC { wc_holes = holes }) = do { cur_lvl <- TcS.getTcLevel ; traceTcS "solveWanteds {" $ vcat [ text "Level =" <+> ppr cur_lvl , ppr wc ] - ; wc1 <- solveSimpleWanteds simples - -- Any insoluble constraints are in 'simples' and so get rewritten - -- See Note [Rewrite insolubles] in GHC.Tc.Solver.Monad - - ; (floated_eqs, implics2) <- solveNestedImplications $ - implics `unionBags` wc_impl wc1 - - ; dflags <- getDynFlags - ; solved_wc <- simpl_loop 0 (solverIterations dflags) floated_eqs - (wc1 { wc_impl = implics2 }) + ; dflags <- getDynFlags + ; solved_wc <- simplify_loop 0 (solverIterations dflags) True wc ; holes' <- simplifyHoles holes ; let final_wc = solved_wc { wc_holes = holes' } @@ -1688,9 +1684,44 @@ solveWanteds wc@(WC { wc_simple = simples, wc_impl = implics, wc_holes = holes } ; return final_wc } -simpl_loop :: Int -> IntWithInf -> Cts - -> WantedConstraints -> TcS WantedConstraints -simpl_loop n limit floated_eqs wc@(WC { wc_simple = simples }) +simplify_loop :: Int -> IntWithInf -> Bool + -> WantedConstraints -> TcS WantedConstraints +-- Do a round of solving, and call maybe_simplify_again to iterate +-- The 'definitely_redo_implications' flags is False if the only reason we +-- are iterating is that we have added some new Derived superclasses (from Wanteds) +-- hoping for fundeps to help us; see Note [Superclass iteration] +-- +-- Does not affect wc_holes at all; reason: wc_holes never affects anything +-- else, so we do them once, at the end in solveWanteds +simplify_loop n limit definitely_redo_implications + wc@(WC { wc_simple = simples, wc_impl = implics }) + = do { csTraceTcS $ + text "simplify_loop iteration=" <> int n + <+> (parens $ hsep [ text "definitely_redo =" <+> ppr definitely_redo_implications <> comma + , int (lengthBag simples) <+> text "simples to solve" ]) + ; traceTcS "simplify_loop: wc =" (ppr wc) + + ; (unifs1, wc1) <- reportUnifications $ -- See Note [Superclass iteration] + solveSimpleWanteds simples + -- Any insoluble constraints are in 'simples' and so get rewritten + -- See Note [Rewrite insolubles] in GHC.Tc.Solver.Monad + + ; wc2 <- if not definitely_redo_implications -- See Note [Superclass iteration] + && unifs1 == 0 -- for this conditional + && isEmptyBag (wc_impl wc1) + then return (wc { wc_simple = wc_simple wc1 }) -- Short cut + else do { implics2 <- solveNestedImplications $ + implics `unionBags` (wc_impl wc1) + ; return (wc { wc_simple = wc_simple wc1 + , wc_impl = implics2 }) } + + ; unif_happened <- resetUnificationFlag + -- Note [The Unification Level Flag] in GHC.Tc.Solver.Monad + ; maybe_simplify_again (n+1) limit unif_happened wc2 } + +maybe_simplify_again :: Int -> IntWithInf -> Bool + -> WantedConstraints -> TcS WantedConstraints +maybe_simplify_again n limit unif_happened wc@(WC { wc_simple = simples }) | n `intGtLimit` limit = do { -- Add an error (not a warning) if we blow the limit, -- Typically if we blow the limit we are going to report some other error @@ -1699,17 +1730,12 @@ simpl_loop n limit floated_eqs wc@(WC { wc_simple = simples }) addErrTcS (hang (text "solveWanteds: too many iterations" <+> parens (text "limit =" <+> ppr limit)) 2 (vcat [ text "Unsolved:" <+> ppr wc - , ppUnless (isEmptyBag floated_eqs) $ - text "Floated equalities:" <+> ppr floated_eqs , text "Set limit with -fconstraint-solver-iterations=n; n=0 for no limit" ])) ; return wc } - | not (isEmptyBag floated_eqs) - = simplify_again n limit True (wc { wc_simple = floated_eqs `unionBags` simples }) - -- Put floated_eqs first so they get solved first - -- NB: the floated_eqs may include /derived/ equalities - -- arising from fundeps inside an implication + | unif_happened + = simplify_loop n limit True wc | superClassesMightHelp wc = -- We still have unsolved goals, and apparently no way to solve them, @@ -1722,82 +1748,65 @@ simpl_loop n limit floated_eqs wc@(WC { wc_simple = simples }) do { new_given <- makeSuperClasses pending_given ; new_wanted <- makeSuperClasses pending_wanted ; solveSimpleGivens new_given -- Add the new Givens to the inert set - ; simplify_again n limit (null pending_given) + ; simplify_loop n limit (not (null pending_given)) $ wc { wc_simple = simples1 `unionBags` listToBag new_wanted } } } + -- (not (null pending_given)): see Note [Superclass iteration] | otherwise = return wc -simplify_again :: Int -> IntWithInf -> Bool - -> WantedConstraints -> TcS WantedConstraints --- We have definitely decided to have another go at solving --- the wanted constraints (we have tried at least once already -simplify_again n limit no_new_given_scs - wc@(WC { wc_simple = simples, wc_impl = implics }) - = do { csTraceTcS $ - text "simpl_loop iteration=" <> int n - <+> (parens $ hsep [ text "no new given superclasses =" <+> ppr no_new_given_scs <> comma - , int (lengthBag simples) <+> text "simples to solve" ]) - ; traceTcS "simpl_loop: wc =" (ppr wc) - - ; (unifs1, wc1) <- reportUnifications $ - solveSimpleWanteds $ - simples - - -- See Note [Cutting off simpl_loop] - -- We have already tried to solve the nested implications once - -- Try again only if we have unified some meta-variables - -- (which is a bit like adding more givens), or we have some - -- new Given superclasses - ; let new_implics = wc_impl wc1 - ; if unifs1 == 0 && - no_new_given_scs && - isEmptyBag new_implics - - then -- Do not even try to solve the implications - simpl_loop (n+1) limit emptyBag (wc1 { wc_impl = implics }) - - else -- Try to solve the implications - do { (floated_eqs2, implics2) <- solveNestedImplications $ - implics `unionBags` new_implics - ; simpl_loop (n+1) limit floated_eqs2 (wc1 { wc_impl = implics2 }) - } } +{- Note [Superclass iteration] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider this implication constraint + forall a. + [W] d: C Int beta + forall b. blah +where + class D a b | a -> b + class D a b => C a b +We will expand d's superclasses, giving [D] D Int beta, in the hope of geting +fundeps to unify beta. Doing so is usually fruitless (no useful fundeps), +and if so it seems a pity to waste time iterating the implications (forall b. blah) +(If we add new Given superclasses it's a different matter: it's really worth looking +at the implications.) + +Hence the definitely_redo_implications flag to simplify_loop. It's usually +True, but False in the case where the only reason to iterate is new Derived +superclasses. In that case we check whether the new Deriveds actually led to +any new unifications, and iterate the implications only if so. +-} solveNestedImplications :: Bag Implication - -> TcS (Cts, Bag Implication) + -> TcS (Bag Implication) -- Precondition: the TcS inerts may contain unsolved simples which have -- to be converted to givens before we go inside a nested implication. solveNestedImplications implics | isEmptyBag implics - = return (emptyBag, emptyBag) + = return (emptyBag) | otherwise = do { traceTcS "solveNestedImplications starting {" empty - ; (floated_eqs_s, unsolved_implics) <- mapAndUnzipBagM solveImplication implics - ; let floated_eqs = concatBag floated_eqs_s + ; unsolved_implics <- mapBagM solveImplication implics -- ... and we are back in the original TcS inerts -- Notice that the original includes the _insoluble_simples so it was safe to ignore -- them in the beginning of this function. ; traceTcS "solveNestedImplications end }" $ - vcat [ text "all floated_eqs =" <+> ppr floated_eqs - , text "unsolved_implics =" <+> ppr unsolved_implics ] + vcat [ text "unsolved_implics =" <+> ppr unsolved_implics ] - ; return (floated_eqs, catBagMaybes unsolved_implics) } + ; return (catBagMaybes unsolved_implics) } solveImplication :: Implication -- Wanted - -> TcS (Cts, -- All wanted or derived floated equalities: var = type - Maybe Implication) -- Simplified implication (empty or singleton) + -> TcS (Maybe Implication) -- Simplified implication (empty or singleton) -- Precondition: The TcS monad contains an empty worklist and given-only inerts -- which after trying to solve this implication we must restore to their original value solveImplication imp@(Implic { ic_tclvl = tclvl , ic_binds = ev_binds_var - , ic_skols = skols , ic_given = given_ids , ic_wanted = wanteds , ic_info = info , ic_status = status }) | isSolvedStatus status - = return (emptyCts, Just imp) -- Do nothing + = return (Just imp) -- Do nothing | otherwise -- Even for IC_Insoluble it is worth doing more work -- The insoluble stuff might be in one sub-implication @@ -1819,7 +1828,7 @@ solveImplication imp@(Implic { ic_tclvl = tclvl ; residual_wanted <- solveWanteds wanteds -- solveWanteds, *not* solveWantedsAndDrop, because -- we want to retain derived equalities so we can float - -- them out in floatEqualities + -- them out in floatEqualities. ; (has_eqs, given_insols) <- getHasGivenEqs tclvl -- Call getHasGivenEqs /after/ solveWanteds, because @@ -1828,10 +1837,6 @@ solveImplication imp@(Implic { ic_tclvl = tclvl ; return (has_eqs, given_insols, residual_wanted) } - ; (floated_eqs, residual_wanted) - <- floatEqualities skols given_ids ev_binds_var - has_given_eqs residual_wanted - ; traceTcS "solveImplication 2" (ppr given_insols $$ ppr residual_wanted) ; let final_wanted = residual_wanted `addInsols` given_insols @@ -1845,15 +1850,14 @@ solveImplication imp@(Implic { ic_tclvl = tclvl ; tcvs <- TcS.getTcEvTyCoVars ev_binds_var ; traceTcS "solveImplication end }" $ vcat [ text "has_given_eqs =" <+> ppr has_given_eqs - , text "floated_eqs =" <+> ppr floated_eqs , text "res_implic =" <+> ppr res_implic , text "implication evbinds =" <+> ppr (evBindMapBinds evbinds) , text "implication tvcs =" <+> ppr tcvs ] - ; return (floated_eqs, res_implic) } + ; return res_implic } -- TcLevels must be strictly increasing (see (ImplicInv) in - -- Note [TcLevel and untouchable type variables] in GHC.Tc.Utils.TcType), + -- Note [TcLevel invariants] in GHC.Tc.Utils.TcType), -- and in fact I think they should always increase one level at a time. -- Though sensible, this check causes lots of testsuite failures. It is @@ -2237,49 +2241,8 @@ Consider (see #9939) We report (Eq a) as redundant, whereas actually (Ord a) is. But it's really not easy to detect that! - -Note [Cutting off simpl_loop] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -It is very important not to iterate in simpl_loop unless there is a chance -of progress. #8474 is a classic example: - - * There's a deeply-nested chain of implication constraints. - ?x:alpha => ?y1:beta1 => ... ?yn:betan => [W] ?x:Int - - * From the innermost one we get a [D] alpha ~ Int, - but alpha is untouchable until we get out to the outermost one - - * We float [D] alpha~Int out (it is in floated_eqs), but since alpha - is untouchable, the solveInteract in simpl_loop makes no progress - - * So there is no point in attempting to re-solve - ?yn:betan => [W] ?x:Int - via solveNestedImplications, because we'll just get the - same [D] again - - * If we *do* re-solve, we'll get an infinite loop. It is cut off by - the fixed bound of 10, but solving the next takes 10*10*...*10 (ie - exponentially many) iterations! - -Conclusion: we should call solveNestedImplications only if we did -some unification in solveSimpleWanteds; because that's the only way -we'll get more Givens (a unification is like adding a Given) to -allow the implication to make progress. -} -promoteTyVarTcS :: TcTyVar -> TcS () --- When we float a constraint out of an implication we must restore --- invariant (WantedInv) in Note [TcLevel and untouchable type variables] in GHC.Tc.Utils.TcType --- See Note [Promoting unification variables] --- We don't just call promoteTyVar because we want to use unifyTyVar, --- not writeMetaTyVar -promoteTyVarTcS tv - = do { tclvl <- TcS.getTcLevel - ; when (isFloatedTouchableMetaTyVar tclvl tv) $ - do { cloned_tv <- TcS.cloneMetaTyVar tv - ; let rhs_tv = setMetaTyVarTcLevel cloned_tv tclvl - ; unifyTyVar tv (mkTyVarTy rhs_tv) } } - -- | Like 'defaultTyVar', but in the TcS monad. defaultTyVarTcS :: TcTyVar -> TcS Bool defaultTyVarTcS the_tv @@ -2314,7 +2277,7 @@ approximateWC float_past_equalities wc concatMapBag (float_implic trapping_tvs) implics float_implic :: TcTyCoVarSet -> Implication -> Cts float_implic trapping_tvs imp - | float_past_equalities || ic_given_eqs imp == NoGivenEqs + | float_past_equalities || ic_given_eqs imp /= MaybeGivenEqs = float_wc new_trapping_tvs (ic_wanted imp) | otherwise -- Take care with equalities = emptyCts -- See (1) under Note [ApproximateWC] @@ -2414,7 +2377,7 @@ approximateWC to produce a list of candidate constraints. Then we MUST a) Promote any meta-tyvars that have been floated out by approximateWC, to restore invariant (WantedInv) described in - Note [TcLevel and untouchable type variables] in GHC.Tc.Utils.TcType. + Note [TcLevel invariants] in GHC.Tc.Utils.TcType. b) Default the kind of any meta-tyvars that are not mentioned in in the environment. @@ -2430,8 +2393,7 @@ Note [Promoting unification variables] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When we float an equality out of an implication we must "promote" free unification variables of the equality, in order to maintain Invariant -(WantedInv) from Note [TcLevel and untouchable type variables] in -TcType. for the leftover implication. +(WantedInv) from Note [TcLevel invariants] in GHC.Tc.Types.TcType. This is absolutely necessary. Consider the following example. We start with two implications and a class with a functional dependency. @@ -2468,276 +2430,6 @@ beta! Concrete example is in indexed_types/should_fail/ExtraTcsUntch.hs: in (g1 '3', g2 undefined) - -********************************************************************************* -* * -* Floating equalities * -* * -********************************************************************************* - -Note [Float Equalities out of Implications] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -For ordinary pattern matches (including existentials) we float -equalities out of implications, for instance: - data T where - MkT :: Eq a => a -> T - f x y = case x of MkT _ -> (y::Int) -We get the implication constraint (x::T) (y::alpha): - forall a. [untouchable=alpha] Eq a => alpha ~ Int -We want to float out the equality into a scope where alpha is no -longer untouchable, to solve the implication! - -But we cannot float equalities out of implications whose givens may -yield or contain equalities: - - data T a where - T1 :: T Int - T2 :: T Bool - T3 :: T a - - h :: T a -> a -> Int - - f x y = case x of - T1 -> y::Int - T2 -> y::Bool - T3 -> h x y - -We generate constraint, for (x::T alpha) and (y :: beta): - [untouchables = beta] (alpha ~ Int => beta ~ Int) -- From 1st branch - [untouchables = beta] (alpha ~ Bool => beta ~ Bool) -- From 2nd branch - (alpha ~ beta) -- From 3rd branch - -If we float the equality (beta ~ Int) outside of the first implication and -the equality (beta ~ Bool) out of the second we get an insoluble constraint. -But if we just leave them inside the implications, we unify alpha := beta and -solve everything. - -Principle: - We do not want to float equalities out which may - need the given *evidence* to become soluble. - -Consequence: classes with functional dependencies don't matter (since there is -no evidence for a fundep equality), but equality superclasses do matter (since -they carry evidence). --} - -floatEqualities :: [TcTyVar] -> [EvId] -> EvBindsVar -> HasGivenEqs - -> WantedConstraints - -> TcS (Cts, WantedConstraints) --- Main idea: see Note [Float Equalities out of Implications] --- --- Precondition: the wc_simple of the incoming WantedConstraints are --- fully zonked, so that we can see their free variables --- --- Postcondition: The returned floated constraints (Cts) are only --- Wanted or Derived --- --- Also performs some unifications (via promoteTyVar), adding to --- monadically-carried ty_binds. These will be used when processing --- floated_eqs later --- --- Subtleties: Note [Float equalities from under a skolem binding] --- Note [Skolem escape] --- Note [What prevents a constraint from floating] -floatEqualities skols given_ids ev_binds_var has_given_eqs - wanteds@(WC { wc_simple = simples }) - | MaybeGivenEqs <- has_given_eqs -- There are some given equalities, so don't float - = return (emptyBag, wanteds) -- Note [Float Equalities out of Implications] - - | otherwise - = do { -- First zonk: the inert set (from whence they came) is not - -- necessarily fully zonked; equalities are not kicked out - -- if a unification cannot make progress. See Note - -- [inert_eqs: the inert equalities] in GHC.Tc.Solver.Monad, which - -- describes how the inert set might not actually be inert. - simples <- TcS.zonkSimples simples - ; binds <- TcS.getTcEvBindsMap ev_binds_var - - -- Now we can pick the ones to float - -- The constraints are de-canonicalised - ; let (candidate_eqs, no_float_cts) = partitionBag is_float_eq_candidate simples - - seed_skols = mkVarSet skols `unionVarSet` - mkVarSet given_ids `unionVarSet` - foldr add_non_flt_ct emptyVarSet no_float_cts `unionVarSet` - evBindMapToVarSet binds - -- seed_skols: See Note [What prevents a constraint from floating] (1,2,3) - -- Include the EvIds of any non-floating constraints - - extended_skols = transCloVarSet (add_captured_ev_ids candidate_eqs) seed_skols - -- extended_skols contains the EvIds of all the trapped constraints - -- See Note [What prevents a constraint from floating] (3) - - (flt_eqs, no_flt_eqs) = partitionBag (is_floatable extended_skols) - candidate_eqs - - remaining_simples = no_float_cts `andCts` no_flt_eqs - - -- Promote any unification variables mentioned in the floated equalities - -- See Note [Promoting unification variables] - ; mapM_ promoteTyVarTcS (tyCoVarsOfCtsList flt_eqs) - - ; traceTcS "floatEqualities" (vcat [ text "Skols =" <+> ppr skols - , text "Extended skols =" <+> ppr extended_skols - , text "Simples =" <+> ppr simples - , text "Candidate eqs =" <+> ppr candidate_eqs - , text "Floated eqs =" <+> ppr flt_eqs]) - ; return ( flt_eqs, wanteds { wc_simple = remaining_simples } ) } - - where - add_non_flt_ct :: Ct -> VarSet -> VarSet - add_non_flt_ct ct acc | isDerivedCt ct = acc - | otherwise = extendVarSet acc (ctEvId ct) - - is_floatable :: VarSet -> Ct -> Bool - is_floatable skols ct - | isDerivedCt ct = tyCoVarsOfCt ct `disjointVarSet` skols - | otherwise = not (ctEvId ct `elemVarSet` skols) - - add_captured_ev_ids :: Cts -> VarSet -> VarSet - add_captured_ev_ids cts skols = foldr extra_skol emptyVarSet cts - where - extra_skol ct acc - | isDerivedCt ct = acc - | tyCoVarsOfCt ct `intersectsVarSet` skols = extendVarSet acc (ctEvId ct) - | otherwise = acc - - -- Identify which equalities are candidates for floating - -- Float out alpha ~ ty which might be unified outside - -- See Note [Which equalities to float] - is_float_eq_candidate ct - | pred <- ctPred ct - , EqPred NomEq ty1 ty2 <- classifyPredType pred - , case ct of - CIrredCan {} -> False -- See Note [Do not float blocked constraints] - _ -> True -- See #18855 - = float_eq ty1 ty2 || float_eq ty2 ty1 - | otherwise - = False - - float_eq ty1 ty2 - = case getTyVar_maybe ty1 of - Just tv1 -> isMetaTyVar tv1 - && (not (isTyVarTyVar tv1) || isTyVarTy ty2) - Nothing -> False - -{- Note [Do not float blocked constraints] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -As #18855 showed, we must not float an equality that is blocked. -Consider - forall a[4]. [W] co1: alpha[4] ~ Maybe (a[4] |> bco) - [W] co2: alpha[4] ~ Maybe (beta[4] |> bco]) - [W] bco: kappa[2] ~ Type - -Now co1, co2 are blocked by bco. We will eventually float out bco -and solve it at level 2. But the danger is that we will *also* -float out co2, and that is bad bad bad. Because we'll promote alpha -and beta to level 2, and then fail to unify the promoted beta -with the skolem a[4]. - -Solution: don't float out blocked equalities. Remember: we only want -to float out if we can solve; see Note [Which equalities to float]. - -(Future plan: kill floating altogether.) - -Note [Float equalities from under a skolem binding] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Which of the simple equalities can we float out? Obviously, only -ones that don't mention the skolem-bound variables. But that is -over-eager. Consider - [2] forall a. F a beta[1] ~ gamma[2], G beta[1] gamma[2] ~ Int -The second constraint doesn't mention 'a'. But if we float it, -we'll promote gamma[2] to gamma'[1]. Now suppose that we learn that -beta := Bool, and F a Bool = a, and G Bool _ = Int. Then we'll -we left with the constraint - [2] forall a. a ~ gamma'[1] -which is insoluble because gamma became untouchable. - -Solution: float only constraints that stand a jolly good chance of -being soluble simply by being floated, namely ones of form - a ~ ty -where 'a' is a currently-untouchable unification variable, but may -become touchable by being floated (perhaps by more than one level). - -We had a very complicated rule previously, but this is nice and -simple. (To see the notes, look at this Note in a version of -GHC.Tc.Solver prior to Oct 2014). - -Note [Which equalities to float] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Which equalities should we float? We want to float ones where there -is a decent chance that floating outwards will allow unification to -happen. In particular, float out equalities that are: - -* Of form (alpha ~# ty) or (ty ~# alpha), where - * alpha is a meta-tyvar. - * And 'alpha' is not a TyVarTv with 'ty' being a non-tyvar. In that - case, floating out won't help either, and it may affect grouping - of error messages. - - NB: generally we won't see (ty ~ alpha), with alpha on the right because - of Note [Unification variables on the left] in GHC.Tc.Utils.Unify, - but if we have (F tys ~ alpha) and alpha is untouchable, then it will - appear on the right. Example T4494. - -* Nominal. No point in floating (alpha ~R# ty), because we do not - unify representational equalities even if alpha is touchable. - See Note [Do not unify representational equalities] in GHC.Tc.Solver.Interact. - -Note [Skolem escape] -~~~~~~~~~~~~~~~~~~~~ -You might worry about skolem escape with all this floating. -For example, consider - [2] forall a. (a ~ F beta[2] delta, - Maybe beta[2] ~ gamma[1]) - -The (Maybe beta ~ gamma) doesn't mention 'a', so we float it, and -solve with gamma := beta. But what if later delta:=Int, and - F b Int = b. -Then we'd get a ~ beta[2], and solve to get beta:=a, and now the -skolem has escaped! - -But it's ok: when we float (Maybe beta[2] ~ gamma[1]), we promote beta[2] -to beta[1], and that means the (a ~ beta[1]) will be stuck, as it should be. - -Note [What prevents a constraint from floating] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -What /prevents/ a constraint from floating? If it mentions one of the -"bound variables of the implication". What are they? - -The "bound variables of the implication" are - - 1. The skolem type variables `ic_skols` - - 2. The "given" evidence variables `ic_given`. Example: - forall a. (co :: t1 ~# t2) => [W] co2 : (a ~# b |> co) - Here 'co' is bound - - 3. The binders of all evidence bindings in `ic_binds`. Example - forall a. (d :: t1 ~ t2) - EvBinds { (co :: t1 ~# t2) = superclass-sel d } - => [W] co2 : (a ~# b |> co) - Here `co` is gotten by superclass selection from `d`, and the - wanted constraint co2 must not float. - - 4. And the evidence variable of any equality constraint (incl - Wanted ones) whose type mentions a bound variable. Example: - forall k. [W] co1 :: t1 ~# t2 |> co2 - [W] co2 :: k ~# * - Here, since `k` is bound, so is `co2` and hence so is `co1`. - -Here (1,2,3) are handled by the "seed_skols" calculation, and -(4) is done by the transCloVarSet call. - -The possible dependence on givens, and evidence bindings, is more -subtle than we'd realised at first. See #14584. - -How can (4) arise? Suppose we have (k :: *), (a :: k), and ([G} k ~ *). -Then form an equality like (a ~ Int) we might end up with - [W] co1 :: k ~ * - [W] co2 :: (a |> co1) ~ Int - - ********************************************************************************* * * * Defaulting and disambiguation * ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -4,9 +4,9 @@ module GHC.Tc.Solver.Canonical( canonicalize, - unifyDerived, + unifyDerived, unifyTest, UnifyTestResult(..), makeSuperClasses, - StopOrContinue(..), stopWith, continueWith, + StopOrContinue(..), stopWith, continueWith, andWhenContinue, solveCallStack -- For GHC.Tc.Solver ) where @@ -51,7 +51,8 @@ import GHC.Data.Bag import GHC.Utils.Monad import Control.Monad import Data.Maybe ( isJust, isNothing ) -import Data.List ( zip4 ) +import Data.List ( zip4, partition ) +import GHC.Types.Unique.Set( nonDetEltsUniqSet ) import GHC.Types.Basic import Data.Bifunctor ( bimap ) @@ -2241,10 +2242,10 @@ canEqCanLHS2 ev eq_rel swapped lhs1 ps_xi1 lhs2 ps_xi2 mco -- If we have F a ~ F (F a), we want to swap. swap_for_occurs - | MTVU_OK () <- checkTyFamEq dflags fun_tc2 fun_args2 - (mkTyConApp fun_tc1 fun_args1) - , MTVU_Occurs <- checkTyFamEq dflags fun_tc1 fun_args1 - (mkTyConApp fun_tc2 fun_args2) + | CTE_OK <- checkTyFamEq dflags fun_tc2 fun_args2 + (mkTyConApp fun_tc1 fun_args1) + , CTE_Occurs <- checkTyFamEq dflags fun_tc1 fun_args1 + (mkTyConApp fun_tc2 fun_args2) = True | otherwise @@ -2269,8 +2270,8 @@ canEqCanLHS2 ev eq_rel swapped lhs1 ps_xi1 lhs2 ps_xi2 mco -- This function handles the case where one side is a tyvar and the other is -- a type family application. Which to put on the left? --- If we can unify the variable, put it on the left, as this may be our only --- shot to unify. +-- If the tyvar is a touchable meta-tyvar, put it on the left, as this may +-- be our only shot to unify. -- Otherwise, put the function on the left, because it's generally better to -- rewrite away function calls. This makes types smaller. And it seems necessary: -- [W] F alpha ~ alpha @@ -2278,22 +2279,20 @@ canEqCanLHS2 ev eq_rel swapped lhs1 ps_xi1 lhs2 ps_xi2 mco -- [W] G alpha beta ~ Int ( where we have type instance G a a = a ) -- If we end up with a stuck alpha ~ F alpha, we won't be able to solve this. -- Test case: indexed-types/should_compile/CEqCanOccursCheck --- It would probably work to always put the variable on the left, but we think --- it would be less efficient. canEqTyVarFunEq :: CtEvidence -- :: lhs ~ (rhs |> mco) -- or (rhs |> mco) ~ lhs if swapped -> EqRel -> SwapFlag - -> TyVar -> TcType -- lhs, pretty lhs - -> TyCon -> [Xi] -> TcType -- rhs fun, rhs args, pretty rhs + -> TyVar -> TcType -- lhs (or if swapped rhs), pretty lhs + -> TyCon -> [Xi] -> TcType -- rhs (or if swapped lhs) fun and args, pretty rhs -> MCoercion -- :: kind(rhs) ~N kind(lhs) -> TcS (StopOrContinue Ct) canEqTyVarFunEq ev eq_rel swapped tv1 ps_xi1 fun_tc2 fun_args2 ps_xi2 mco - = do { tclvl <- getTcLevel - ; dflags <- getDynFlags - ; if | isTouchableMetaTyVar tclvl tv1 - , MTVU_OK _ <- checkTyVarEq dflags YesTypeFamilies tv1 (ps_xi2 `mkCastTyMCo` mco) - -> canEqCanLHSFinish ev eq_rel swapped (TyVarLHS tv1) - (ps_xi2 `mkCastTyMCo` mco) + = do { can_unify <- unifyTest ev tv1 rhs + ; dflags <- getDynFlags + ; if | case can_unify of { NoUnify -> False; _ -> True } + , CTE_OK <- checkTyVarEq dflags YesTypeFamilies tv1 rhs + -> canEqCanLHSFinish ev eq_rel swapped (TyVarLHS tv1) rhs + | otherwise -> do { new_ev <- rewriteCastedEquality ev eq_rel swapped (mkTyVarTy tv1) (mkTyConApp fun_tc2 fun_args2) @@ -2303,6 +2302,78 @@ canEqTyVarFunEq ev eq_rel swapped tv1 ps_xi1 fun_tc2 fun_args2 ps_xi2 mco (ps_xi1 `mkCastTyMCo` sym_mco) } } where sym_mco = mkTcSymMCo mco + rhs = ps_xi2 `mkCastTyMCo` mco + +data UnifyTestResult + -- See Note [Solve by unification] in GHC.Tc.Solver.Interact + -- which points out that having UnifySameLevel is just an optimisation; + -- we could manage with UnifyOuterLevel alone (suitably renamed) + = UnifySameLevel + | UnifyOuterLevel [TcTyVar] -- Promote these + TcLevel -- ..to this level + | NoUnify + +instance Outputable UnifyTestResult where + ppr UnifySameLevel = text "UnifySameLevel" + ppr (UnifyOuterLevel tvs lvl) = text "UnifyOuterLevel" <> parens (ppr lvl <+> ppr tvs) + ppr NoUnify = text "NoUnify" + +unifyTest :: CtEvidence -> TcTyVar -> TcType -> TcS UnifyTestResult +-- This is the key test for untouchability: +-- See Note [Unification preconditions] in GHC.Tc.Utils.Unify +-- and Note [Solve by unification] in GHC.Tc.Solver.Interact +unifyTest ev tv1 rhs + | not (isGiven ev) -- See Note [Do not unify Givens] + , MetaTv { mtv_tclvl = tv_lvl, mtv_info = info } <- tcTyVarDetails tv1 + , canSolveByUnification info rhs + = do { ambient_lvl <- getTcLevel + ; given_eq_lvl <- getInnermostGivenEqLevel + + ; if | tv_lvl `sameDepthAs` ambient_lvl + -> return UnifySameLevel + + | tv_lvl `deeperThanOrSame` given_eq_lvl -- No intervening given equalities + , all (does_not_escape tv_lvl) free_skols -- No skolem escapes + -> return (UnifyOuterLevel free_metas tv_lvl) + + | otherwise + -> return NoUnify } + | otherwise + = return NoUnify + where + (free_metas, free_skols) = partition isPromotableMetaTyVar $ + filter isTyVar $ + nonDetEltsUniqSet $ + tyCoVarsOfType rhs + -- filter isTyVar: coercion variables are not an escape risk + -- If an implication binds a coercion variable, it'll have equalities, + -- so the "intervening given equalities" test above will catch it + -- Coercion holes get filled with coercions, so again no problem. + + does_not_escape tv_lvl fv = tv_lvl `deeperThanOrSame` tcTyVarLevel fv + +{- Note [Do not unify Givens] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider this GADT match + data T a where + T1 :: T Int + ... + + f x = case x of + T1 -> True + ... + +So we get f :: alpha[1] -> beta[1] + x :: alpha[1] +and from the T1 branch we get the implication + forall[2] (alpha[1] ~ Int) => beta[1] ~ Bool + +Now, clearly we don't want to unify alpha:=Int! Yet at the moment we +process [G] alpha[1] ~ Int, we don't have any given-equalities in the +inert set, and hence there are no given equalities to make alpha untouchable. + +Simple solution: never unify in Givens! +-} -- The RHS here is either not CanEqLHS, or it's one that we -- want to rewrite the LHS to (as per e.g. swapOverTyVars) @@ -2422,11 +2493,11 @@ canEqOK :: DynFlags -> EqRel -> CanEqLHS -> Xi -> CanEqOK canEqOK dflags eq_rel lhs rhs = ASSERT( good_rhs ) case checkTypeEq dflags YesTypeFamilies lhs rhs of - MTVU_OK () -> CanEqOK - MTVU_Bad -> CanEqNotOK OtherCIS + CTE_OK -> CanEqOK + CTE_Bad -> CanEqNotOK OtherCIS -- Violation of TyEq:F - MTVU_HoleBlocker -> CanEqNotOK (BlockedCIS holes) + CTE_HoleBlocker -> CanEqNotOK (BlockedCIS holes) where holes = coercionHolesOfType rhs -- This is the case detailed in -- Note [Equalities with incompatible kinds] @@ -2435,7 +2506,7 @@ canEqOK dflags eq_rel lhs rhs -- These are both a violation of TyEq:OC, but we -- want to differentiate for better production of -- error messages - MTVU_Occurs | TyVarLHS tv <- lhs + CTE_Occurs | TyVarLHS tv <- lhs , isInsolubleOccursCheck eq_rel tv rhs -> CanEqNotOK InsolubleCIS -- If we have a ~ [a], it is not canonical, and in particular -- we don't want to rewrite existing inerts with it, otherwise ===================================== compiler/GHC/Tc/Solver/Interact.hs ===================================== @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP, MultiWayIf #-} {-# OPTIONS_GHC -Wno-incomplete-record-updates #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} @@ -14,7 +14,6 @@ import GHC.Prelude import GHC.Types.Basic ( SwapFlag(..), infinity, IntWithInf, intGtLimit ) import GHC.Tc.Solver.Canonical -import GHC.Tc.Utils.Unify( canSolveByUnification ) import GHC.Types.Var.Set import GHC.Core.Type as Type import GHC.Core.InstEnv ( DFunInstType ) @@ -39,6 +38,7 @@ import GHC.Tc.Types import GHC.Tc.Types.Constraint import GHC.Core.Predicate import GHC.Tc.Types.Origin +import GHC.Tc.Utils.TcMType( promoteTyVarTo ) import GHC.Tc.Solver.Monad import GHC.Data.Bag import GHC.Utils.Monad ( concatMapM, foldlM ) @@ -430,12 +430,11 @@ interactWithInertsStage :: WorkItem -> TcS (StopOrContinue Ct) interactWithInertsStage wi = do { inerts <- getTcSInerts - ; lvl <- getTcLevel ; let ics = inert_cans inerts ; case wi of - CEqCan {} -> interactEq lvl ics wi - CIrredCan {} -> interactIrred ics wi - CDictCan {} -> interactDict ics wi + CEqCan {} -> interactEq ics wi + CIrredCan {} -> interactIrred ics wi + CDictCan {} -> interactDict ics wi _ -> pprPanic "interactWithInerts" (ppr wi) } -- CNonCanonical have been canonicalised @@ -1439,8 +1438,8 @@ inertsCanDischarge inerts lhs rhs fr | otherwise = False -- Work item is fully discharged -interactEq :: TcLevel -> InertCans -> Ct -> TcS (StopOrContinue Ct) -interactEq tclvl inerts workItem@(CEqCan { cc_lhs = lhs +interactEq :: InertCans -> Ct -> TcS (StopOrContinue Ct) +interactEq inerts workItem@(CEqCan { cc_lhs = lhs , cc_rhs = rhs , cc_ev = ev , cc_eq_rel = eq_rel }) @@ -1465,24 +1464,43 @@ interactEq tclvl inerts workItem@(CEqCan { cc_lhs = lhs = do { traceTcS "Not unifying representational equality" (ppr workItem) ; continueWith workItem } - -- try improvement, if possible - | TyFamLHS fam_tc fam_args <- lhs - , isImprovable ev - = do { improveLocalFunEqs ev inerts fam_tc fam_args rhs - ; continueWith workItem } - - | TyVarLHS tv <- lhs - , canSolveByUnification tclvl tv rhs - = do { solveByUnification ev tv rhs - ; n_kicked <- kickOutAfterUnification tv - ; return (Stop ev (text "Solved by unification" <+> pprKicked n_kicked)) } - | otherwise - = continueWith workItem - -interactEq _ _ wi = pprPanic "interactEq" (ppr wi) - -solveByUnification :: CtEvidence -> TcTyVar -> Xi -> TcS () + = case lhs of + TyVarLHS tv -> tryToSolveByUnification workItem ev tv rhs + + TyFamLHS tc args -> do { when (isImprovable ev) $ + -- Try improvement, if possible + improveLocalFunEqs ev inerts tc args rhs + ; continueWith workItem } + +interactEq _ wi = pprPanic "interactEq" (ppr wi) + +---------------------- +-- We have a meta-tyvar on the left, and metaTyVarUpateOK has said "yes" +-- So try to solve by unifying. +-- Three reasons why not: +-- Skolem escape +-- Given equalities (GADTs) +-- Unifying a TyVarTv with a non-tyvar type +tryToSolveByUnification :: Ct -> CtEvidence + -> TcTyVar -- LHS tyvar + -> TcType -- RHS + -> TcS (StopOrContinue Ct) +tryToSolveByUnification work_item ev tv rhs + = do { can_unify <- unifyTest ev tv rhs + ; traceTcS "tryToSolveByUnification" (vcat [ ppr tv <+> char '~' <+> ppr rhs + , ppr can_unify ]) + + ; case can_unify of + NoUnify -> continueWith work_item + -- For the latter two cases see Note [Solve by unification] + UnifySameLevel -> solveByUnification ev tv rhs + UnifyOuterLevel free_metas tv_lvl + -> do { wrapTcS $ mapM_ (promoteTyVarTo tv_lvl) free_metas + ; setUnificationFlag tv_lvl + ; solveByUnification ev tv rhs } } + +solveByUnification :: CtEvidence -> TcTyVar -> Xi -> TcS (StopOrContinue Ct) -- Solve with the identity coercion -- Precondition: kind(xi) equals kind(tv) -- Precondition: CtEvidence is Wanted or Derived @@ -1504,9 +1522,10 @@ solveByUnification wd tv xi text "Coercion:" <+> pprEq tv_ty xi, text "Left Kind is:" <+> ppr (tcTypeKind tv_ty), text "Right Kind is:" <+> ppr (tcTypeKind xi) ] - ; unifyTyVar tv xi - ; setEvBindIfWanted wd (evCoercion (mkTcNomReflCo xi)) } + ; setEvBindIfWanted wd (evCoercion (mkTcNomReflCo xi)) + ; n_kicked <- kickOutAfterUnification tv + ; return (Stop wd (text "Solved by unification" <+> pprKicked n_kicked)) } {- Note [Avoid double unifications] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1542,6 +1561,34 @@ and we want to get alpha := N b. See also #15144, which was caused by unifying a representational equality. +Note [Solve by unification] +~~~~~~~~~~~~~~~~~~~~~~~~~~~ +If we solve + alpha[n] ~ ty +by unification, there are two cases to consider + +* UnifySameLevel: if the ambient level is 'n', then + we can simply update alpha := ty, and do nothing else + +* UnifyOuterLevel free_metas n: if the ambient level is greater than + 'n' (the level of alpha), in addition to setting alpha := ty we must + do two other things: + + 1. Promote all the free meta-vars of 'ty' to level n. After all, + alpha[n] is at level n, and so if we set, say, + alpha[n] := Maybe beta[m], + we must ensure that when unifying beta we do skolem-escape checks + etc relevent to level n. Simple way to do that: promote beta to + level n. + + 2. Set the Unification Level Flag to record that a level-n unification has + taken place. See Note [The Unification Level Flag] in GHC.Tc.Solver.Monad + +NB: UnifySameLevel is just an optimisation for UnifyOuterLevel. Promotion +would be a no-op, and setting the unification flag unnecessarily would just +make the solver iterate more often. (We don't need to iterate when unifying +at the ambient level becuase of the kick-out mechanism.) + ************************************************************************ * * ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -17,7 +17,7 @@ module GHC.Tc.Solver.Monad ( -- The TcS monad TcS, runTcS, runTcSDeriveds, runTcSWithEvBinds, runTcSInerts, - failTcS, warnTcS, addErrTcS, + failTcS, warnTcS, addErrTcS, wrapTcS, runTcSEqualities, nestTcS, nestImplicTcS, setEvBindsTcS, emitImplicationTcS, emitTvImplicationTcS, @@ -31,6 +31,7 @@ module GHC.Tc.Solver.Monad ( panicTcS, traceTcS, traceFireTcS, bumpStepCountTcS, csTraceTcS, wrapErrTcS, wrapWarnTcS, + resetUnificationFlag, setUnificationFlag, -- Evidence creation and transformation MaybeNew(..), freshGoals, isFresh, getEvExpr, @@ -60,7 +61,7 @@ module GHC.Tc.Solver.Monad ( updInertTcS, updInertCans, updInertDicts, updInertIrreds, getHasGivenEqs, setInertCans, getInertEqs, getInertCans, getInertGivens, - getInertInsols, + getInertInsols, getInnermostGivenEqLevel, getTcSInerts, setTcSInerts, matchableGivens, prohibitedSuperClassSolve, mightMatchLater, getUnsolvedInerts, @@ -186,7 +187,6 @@ import Control.Monad import GHC.Utils.Monad import Data.IORef import Data.List ( partition, mapAccumL ) -import qualified Data.Semigroup as S import Data.List.NonEmpty ( NonEmpty(..), cons, toList, nonEmpty ) import qualified Data.List.NonEmpty as NE import Control.Arrow ( first ) @@ -418,12 +418,14 @@ instance Outputable InertSet where emptyInertCans :: InertCans emptyInertCans - = IC { inert_eqs = emptyDVarEnv - , inert_dicts = emptyDicts - , inert_safehask = emptyDicts - , inert_funeqs = emptyFunEqs - , inert_insts = [] - , inert_irreds = emptyCts } + = IC { inert_eqs = emptyDVarEnv + , inert_given_eq_lvl = topTcLevel + , inert_given_eqs = False + , inert_dicts = emptyDicts + , inert_safehask = emptyDicts + , inert_funeqs = emptyFunEqs + , inert_insts = [] + , inert_irreds = emptyCts } emptyInert :: InertSet emptyInert @@ -697,6 +699,19 @@ data InertCans -- See Note [Detailed InertCans Invariants] for more -- Irreducible predicates that cannot be made canonical, -- and which don't interact with others (e.g. (c a)) -- and insoluble predicates (e.g. Int ~ Bool, or a ~ [a]) + + , inert_given_eq_lvl :: TcLevel + -- The TcLevel of the innermost implication that has a Given + -- equality of the sort that make a unification variable untouchable + -- (see Note [Unification preconditions] in GHC.Tc.Utils.Unify). + -- See Note [Tracking Given equalities] below + + , inert_given_eqs :: Bool + -- True <=> The inert Givens *at this level* (tcl_tclvl) + -- could includes at least one equality /other than/ a + -- let-bound skolem equality. + -- Reason: report these givens when reporting a failed equality + -- See Note [Tracking Given equalities] } type InertEqs = DTyVarEnv EqualCtList @@ -730,7 +745,126 @@ listToEqualCtList :: [Ct] -> Maybe EqualCtList -- non-empty listToEqualCtList cts = EqualCtList <$> nonEmpty cts -{- Note [Detailed InertCans Invariants] +{- Note [Tracking Given equalities] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +For reasons described in (UNTOUCHABLE) in GHC.Tc.Utils.Unify +Note [Unification preconditions], we can't unify + alpha[2] ~ Int +under a level-4 implication if there are any Given equalities +bound by the implications at level 3 of 4. To that end, the +InertCans tracks + + inert_given_eq_lvl :: TcLevel + -- The TcLevel of the innermost implication that has a Given + -- equality of the sort that make a unification variable untouchable + -- (see Note [Unification preconditions] in GHC.Tc.Utils.Unify). + +We update inert_given_eq_lvl whenever we add a Given to the +inert set, in updateGivenEqs. + +Then a unification variable alpha[n] is untouchable iff + n < inert_given_eq_lvl +that is, if the unification variable was born outside an +enclosing Given equality. + +Exactly which constraints should trigger (UNTOUCHABLE), and hence +should update inert_given_eq_lvl? + +* We do /not/ need to worry about let-bound skolems, such ast + forall[2] a. a ~ [b] => blah + See Note [Let-bound skolems] + +* Consider an implication + forall[2]. beta[1] => alpha[1] ~ Int + where beta is a unification variable that has already been unified + to () in an outer scope. Then alpha[1] is perfectly touchable and + we can unify alpha := Int. So when deciding whether the givens contain + an equality, we should canonicalise first, rather than just looking at + the /original/ givens (#8644). + + * However, we must take account of *potential* equalities. Consider the + same example again, but this time we have /not/ yet unified beta: + forall[2] beta[1] => ...blah... + + Because beta might turn into an equality, updateGivenEqs conservatively + treats it as a potential equality, and updates inert_give_eq_lvl + + * What about something like forall[2] a b. a ~ F b => [W] alpha[1] ~ X y z? + + That Given cannot affect the Wanted, because the Given is entirely + *local*: it mentions only skolems bound in the very same + implication. Such equalities need not make alpha untouchable. (Test + case typecheck/should_compile/LocalGivenEqs has a real-life + motivating example, with some detailed commentary.) + Hence the 'mentionsOuterVar' test in updateGivenEqs. + + However, solely to support better error messages + (see Note [HasGivenEqs] in GHC.Tc.Types.Constraint) we also track + these "local" equalities in the boolean inert_given_eqs field. + This field is used only to set the ic_given_eqs field to LocalGivenEqs; + see the function getHasGivenEqs. + + Here is a simpler case that triggers this behaviour: + + data T where + MkT :: F a ~ G b => a -> b -> T + + f (MkT _ _) = True + + Because of this behaviour around local equality givens, we can infer the + type of f. This is typecheck/should_compile/LocalGivenEqs2. + + * We need not look at the equality relation involved (nominal vs + representational), because representational equalities can still + imply nominal ones. For example, if (G a ~R G b) and G's argument's + role is nominal, then we can deduce a ~N b. + +Note [Let-bound skolems] +~~~~~~~~~~~~~~~~~~~~~~~~ +If * the inert set contains a canonical Given CEqCan (a ~ ty) +and * 'a' is a skolem bound in this very implication, + +then: +a) The Given is pretty much a let-binding, like + f :: (a ~ b->c) => a -> a + Here the equality constraint is like saying + let a = b->c in ... + It is not adding any new, local equality information, + and hence can be ignored by has_given_eqs + +b) 'a' will have been completely substituted out in the inert set, + so we can safely discard it. + +For an example, see #9211. + +See also GHC.Tc.Utils.Unify Note [Deeper level on the left] for how we ensure +that the right variable is on the left of the equality when both are +tyvars. + +You might wonder whether the skolem really needs to be bound "in the +very same implication" as the equuality constraint. +Consider this (c.f. #15009): + + data S a where + MkS :: (a ~ Int) => S a + + g :: forall a. S a -> a -> blah + g x y = let h = \z. ( z :: Int + , case x of + MkS -> [y,z]) + in ... + +From the type signature for `g`, we get `y::a` . Then when we +encounter the `\z`, we'll assign `z :: alpha[1]`, say. Next, from the +body of the lambda we'll get + + [W] alpha[1] ~ Int -- From z::Int + [W] forall[2]. (a ~ Int) => [W] alpha[1] ~ a -- From [y,z] + +Now, unify alpha := a. Now we are stuck with an unsolved alpha~Int! +So we must treat alpha as untouchable under the forall[2] implication. + +Note [Detailed InertCans Invariants] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The InertCans represents a collection of constraints with the following properties: @@ -1027,6 +1161,8 @@ instance Outputable InertCans where ppr (IC { inert_eqs = eqs , inert_funeqs = funeqs, inert_dicts = dicts , inert_safehask = safehask, inert_irreds = irreds + , inert_given_eq_lvl = ge_lvl + , inert_given_eqs = given_eqs , inert_insts = insts }) = braces $ vcat @@ -1043,6 +1179,8 @@ instance Outputable InertCans where text "Irreds =" <+> pprCts irreds , ppUnless (null insts) $ text "Given instances =" <+> vcat (map ppr insts) + , text "Innermost given equalities =" <+> ppr ge_lvl + , text "Given eqs at this level =" <+> ppr given_eqs ] where folder (EqualCtList eqs) rest = nonEmptyToBag eqs `andCts` rest @@ -1456,20 +1594,32 @@ findEq icans (TyFamLHS fun_tc fun_args) addInertForAll :: QCInst -> TcS () -- Add a local Given instance, typically arising from a type signature addInertForAll new_qci - = do { ics <- getInertCans - ; insts' <- add_qci (inert_insts ics) - ; setInertCans (ics { inert_insts = insts' }) } + = do { ics <- getInertCans + ; ics1 <- add_qci ics + + -- Update given equalities. C.f updateGivenEqs + ; tclvl <- getTcLevel + ; let pred = qci_pred new_qci + not_equality = isClassPred pred && not (isEqPred pred) + -- True <=> definitely not an equality + -- A qci_pred like (f a) might be an equality + + ics2 | not_equality = ics1 + | otherwise = ics1 { inert_given_eq_lvl = tclvl + , inert_given_eqs = True } + + ; setInertCans ics2 } where - add_qci :: [QCInst] -> TcS [QCInst] + add_qci :: InertCans -> TcS InertCans -- See Note [Do not add duplicate quantified instances] - add_qci qcis + add_qci ics@(IC { inert_insts = qcis }) | any same_qci qcis = do { traceTcS "skipping duplicate quantified instance" (ppr new_qci) - ; return qcis } + ; return ics } | otherwise = do { traceTcS "adding new inert quantified instance" (ppr new_qci) - ; return (new_qci : qcis) } + ; return (ics { inert_insts = new_qci : qcis }) } same_qci old_qci = tcEqType (ctEvPred (qci_ev old_qci)) (ctEvPred (qci_ev new_qci)) @@ -1523,7 +1673,8 @@ addInertCan ct ; ics <- getInertCans ; ct <- maybeEmitShadow ics ct ; ics <- maybeKickOut ics ct - ; setInertCans (add_item ics ct) + ; tclvl <- getTcLevel + ; setInertCans (add_item tclvl ics ct) ; traceTcS "addInertCan }" $ empty } @@ -1536,23 +1687,54 @@ maybeKickOut ics ct | otherwise = return ics -add_item :: InertCans -> Ct -> InertCans -add_item ics item@(CEqCan { cc_lhs = TyFamLHS tc tys }) - = ics { inert_funeqs = addCanFunEq (inert_funeqs ics) tc tys item } - -add_item ics item@(CEqCan { cc_lhs = TyVarLHS tv }) - = ics { inert_eqs = addTyEq (inert_eqs ics) tv item } - -add_item ics@(IC { inert_irreds = irreds }) item@(CIrredCan {}) - = ics { inert_irreds = irreds `Bag.snocBag` item } - -add_item ics item@(CDictCan { cc_class = cls, cc_tyargs = tys }) +add_item :: TcLevel -> InertCans -> Ct -> InertCans +add_item tc_lvl + ics@(IC { inert_funeqs = funeqs, inert_eqs = eqs }) + item@(CEqCan { cc_lhs = lhs }) + = updateGivenEqs tc_lvl item $ + case lhs of + TyFamLHS tc tys -> ics { inert_funeqs = addCanFunEq funeqs tc tys item } + TyVarLHS tv -> ics { inert_eqs = addTyEq eqs tv item } + +add_item tc_lvl ics@(IC { inert_irreds = irreds }) item@(CIrredCan {}) + = updateGivenEqs tc_lvl item $ -- An Irred might turn out to be an + -- equality, so we play safe + ics { inert_irreds = irreds `Bag.snocBag` item } + +add_item _ ics item@(CDictCan { cc_class = cls, cc_tyargs = tys }) = ics { inert_dicts = addDict (inert_dicts ics) cls tys item } -add_item _ item +add_item _ _ item = pprPanic "upd_inert set: can't happen! Inserting " $ ppr item -- Can't be CNonCanonical because they only land in inert_irreds +updateGivenEqs :: TcLevel -> Ct -> InertCans -> InertCans +-- Set the inert_given_eq_level to the current level (tclvl) +-- if the constraint is a given equality that should prevent +-- filling in an outer unification variable. +-- See See Note [Tracking Given equalities] +updateGivenEqs tclvl ct inerts@(IC { inert_given_eq_lvl = ge_lvl }) + | not (isGivenCt ct) = inerts + | not_equality ct = inerts -- See Note [Let-bound skolems] + | otherwise = inerts { inert_given_eq_lvl = ge_lvl' + , inert_given_eqs = True } + where + ge_lvl' | mentionsOuterVar tclvl (ctEvidence ct) + -- Includes things like (c a), which *might* be an equality + = tclvl + | otherwise + = ge_lvl + + not_equality :: Ct -> Bool + -- True <=> definitely not an equality of any kind + -- except for a let-bound skolem, which doesn't count + -- See Note [Let-bound skolems] + -- NB: no need to spot the boxed CDictCan (a ~ b) because its + -- superclass (a ~# b) will be a CEqCan + not_equality (CEqCan { cc_lhs = TyVarLHS tv }) = not (isOuterTyVar tclvl tv) + not_equality (CDictCan {}) = True + not_equality _ = False + ----------------------------------------- kickOutRewritable :: CtFlavourRole -- Flavour/role of the equality that -- is being added to the inert set @@ -1596,7 +1778,6 @@ kick_out_rewritable :: CtFlavourRole -- Flavour/role of the equality that kick_out_rewritable new_fr new_lhs ics@(IC { inert_eqs = tv_eqs , inert_dicts = dictmap - , inert_safehask = safehask , inert_funeqs = funeqmap , inert_irreds = irreds , inert_insts = old_insts }) @@ -1610,12 +1791,12 @@ kick_out_rewritable new_fr new_lhs | otherwise = (kicked_out, inert_cans_in) where - inert_cans_in = IC { inert_eqs = tv_eqs_in - , inert_dicts = dicts_in - , inert_safehask = safehask -- ?? - , inert_funeqs = feqs_in - , inert_irreds = irs_in - , inert_insts = insts_in } + -- inert_safehask stays unchanged; is that right? + inert_cans_in = ics { inert_eqs = tv_eqs_in + , inert_dicts = dicts_in + , inert_funeqs = feqs_in + , inert_irreds = irs_in + , inert_insts = insts_in } kicked_out :: WorkList -- NB: use extendWorkList to ensure that kicked-out equalities get priority @@ -1968,6 +2149,10 @@ updInertIrreds upd_fn getInertEqs :: TcS (DTyVarEnv EqualCtList) getInertEqs = do { inert <- getInertCans; return (inert_eqs inert) } +getInnermostGivenEqLevel :: TcS TcLevel +getInnermostGivenEqLevel = do { inert <- getInertCans + ; return (inert_given_eq_lvl inert) } + getInertInsols :: TcS Cts -- Returns insoluble equality constraints -- specifically including Givens @@ -2077,63 +2262,46 @@ getUnsolvedInerts getHasGivenEqs :: TcLevel -- TcLevel of this implication -> TcS ( HasGivenEqs -- are there Given equalities? , Cts ) -- Insoluble equalities arising from givens --- See Note [When does an implication have given equalities?] +-- See Note [Tracking Given equalities] getHasGivenEqs tclvl - = do { inerts@(IC { inert_eqs = ieqs, inert_funeqs = funeqs, inert_irreds = irreds }) + = do { inerts@(IC { inert_irreds = irreds + , inert_given_eqs = given_eqs + , inert_given_eq_lvl = ge_lvl }) <- getInertCans - ; let has_given_eqs = foldMap check_local_given_ct irreds - S.<> foldMap (lift_equal_ct_list check_local_given_tv_eq) ieqs - S.<> foldMapFunEqs (lift_equal_ct_list check_local_given_ct) funeqs - insols = filterBag insolubleEqCt irreds + ; let insols = filterBag insolubleEqCt irreds -- Specifically includes ones that originated in some -- outer context but were refined to an insoluble by -- a local equality; so do /not/ add ct_given_here. + -- See Note [HasGivenEqs] in GHC.Tc.Types.Constraint, and + -- Note [Tracking Given equalities] in this module + has_ge | ge_lvl == tclvl = MaybeGivenEqs + | given_eqs = LocalGivenEqs + | otherwise = NoGivenEqs + ; traceTcS "getHasGivenEqs" $ - vcat [ text "has_given_eqs:" <+> ppr has_given_eqs + vcat [ text "given_eqs:" <+> ppr given_eqs + , text "ge_lvl:" <+> ppr ge_lvl + , text "ambient level:" <+> ppr tclvl , text "Inerts:" <+> ppr inerts , text "Insols:" <+> ppr insols] - ; return (has_given_eqs, insols) } - where - check_local_given_ct :: Ct -> HasGivenEqs - check_local_given_ct ct - | given_here ev = if mentions_outer_var ev then MaybeGivenEqs else LocalGivenEqs - | otherwise = NoGivenEqs - where - ev = ctEvidence ct - - lift_equal_ct_list :: (Ct -> HasGivenEqs) -> EqualCtList -> HasGivenEqs - -- returns NoGivenEqs for non-singleton lists, as Given lists are always - -- singletons - lift_equal_ct_list check (EqualCtList (ct :| [])) = check ct - lift_equal_ct_list _ _ = NoGivenEqs - - check_local_given_tv_eq :: Ct -> HasGivenEqs - check_local_given_tv_eq (CEqCan { cc_lhs = TyVarLHS tv, cc_ev = ev}) - | given_here ev - = if is_outer_var tv then MaybeGivenEqs else NoGivenEqs - -- See Note [Let-bound skolems] - | otherwise - = NoGivenEqs - check_local_given_tv_eq other_ct = check_local_given_ct other_ct - - given_here :: CtEvidence -> Bool - -- True for a Given bound by the current implication, - -- i.e. the current level - given_here ev = isGiven ev - && tclvl == ctLocLevel (ctEvLoc ev) - - mentions_outer_var :: CtEvidence -> Bool - mentions_outer_var = anyFreeVarsOfType is_outer_var . ctEvPred - - is_outer_var :: TyCoVar -> Bool - is_outer_var tv - -- NB: a meta-tv alpha[3] may end up unifying with skolem b[2], - -- so treat it as an "outer" var, even at level 3. - -- This will become redundant after fixing #18929. - | isTyVar tv = isTouchableMetaTyVar tclvl tv || - tclvl `strictlyDeeperThan` tcTyVarLevel tv - | otherwise = False + ; return (has_ge, insols) } + +mentionsOuterVar :: TcLevel -> CtEvidence -> Bool +mentionsOuterVar tclvl ev + = anyFreeVarsOfType (isOuterTyVar tclvl) $ + ctEvPred ev + +isOuterTyVar :: TcLevel -> TyCoVar -> Bool +-- True of a type variable that comes from a +-- shallower level than the ambient level (tclvl) +isOuterTyVar tclvl tv + | isTyVar tv = tclvl `strictlyDeeperThan` tcTyVarLevel tv + || isPromotableMetaTyVar tv + -- isPromotable: a meta-tv alpha[3] may end up unifying with skolem b[2], + -- so treat it as an "outer" var, even at level 3. + -- This will become redundant after fixing #18929. + | otherwise = False -- Coercion variables; doesn't much matter -- | Returns Given constraints that might, -- potentially, match the given pred. This is used when checking to see if a @@ -2267,112 +2435,6 @@ Examples: This treatment fixes #18910 and is tested in typecheck/should_compile/InstanceGivenOverlap{,2} -Note [When does an implication have given equalities?] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider an implication - beta => alpha ~ Int -where beta is a unification variable that has already been unified -to () in an outer scope. Then we can float the (alpha ~ Int) out -just fine. So when deciding whether the givens contain an equality, -we should canonicalise first, rather than just looking at the original -givens (#8644). - -So we simply look at the inert, canonical Givens and see if there are -any equalities among them, the calculation of has_given_eqs. There -are some wrinkles: - - * We must know which ones are bound in *this* implication and which - are bound further out. We can find that out from the TcLevel - of the Given, which is itself recorded in the tcl_tclvl field - of the TcLclEnv stored in the Given (ev_given_here). - - What about interactions between inner and outer givens? - - Outer given is rewritten by an inner given, then there must - have been an inner given equality, hence the “given-eq” flag - will be true anyway. - - - Inner given rewritten by outer, retains its level (ie. The inner one) - - * We must take account of *potential* equalities, like the one above: - beta => ...blah... - If we still don't know what beta is, we conservatively treat it as potentially - becoming an equality. Hence including 'irreds' in the calculation or has_given_eqs. - Note that we can't really know what's in an irred, so any irred is considered - a potential equality. - - * What about something like forall a b. a ~ F b => [W] c ~ X y z? That Given - cannot affect the Wanted, because the Given is entirely *local*: it mentions - only skolems bound in the very same implication. Such equalities need not - prevent floating. (Test case typecheck/should_compile/LocalGivenEqs has a - real-life motivating example, with some detailed commentary.) These - equalities are noted with LocalGivenEqs: they do not prevent floating, but - they also are allowed to show up in error messages. See - Note [Suppress redundant givens during error reporting] in GHC.Tc.Errors. - The difference between what stops floating and what is suppressed from - error messages is why we need three options for HasGivenEqs. - - There is also a simpler case that triggers this behaviour: - - data T where - MkT :: F a ~ G b => a -> b -> T - - f (MkT _ _) = True - - Because of this behaviour around local equality givens, we can infer the - type of f. This is typecheck/should_compile/LocalGivenEqs2. - - * See Note [Let-bound skolems] for another wrinkle - - * We need not look at the equality relation involved (nominal vs representational), - because representational equalities can still imply nominal ones. For example, - if (G a ~R G b) and G's argument's role is nominal, then we can deduce a ~N b. - -Note [Let-bound skolems] -~~~~~~~~~~~~~~~~~~~~~~~~ -If * the inert set contains a canonical Given CEqCan (a ~ ty) -and * 'a' is a skolem bound in this very implication, - -then: -a) The Given is pretty much a let-binding, like - f :: (a ~ b->c) => a -> a - Here the equality constraint is like saying - let a = b->c in ... - It is not adding any new, local equality information, - and hence can be ignored by has_given_eqs - -b) 'a' will have been completely substituted out in the inert set, - so we can safely discard it. - -For an example, see #9211. - -See also GHC.Tc.Utils.Unify Note [Deeper level on the left] for how we ensure -that the right variable is on the left of the equality when both are -tyvars. - -You might wonder whether the skokem really needs to be bound "in the -very same implication" as the equuality constraint. -(c.f. #15009) Consider this: - - data S a where - MkS :: (a ~ Int) => S a - - g :: forall a. S a -> a -> blah - g x y = let h = \z. ( z :: Int - , case x of - MkS -> [y,z]) - in ... - -From the type signature for `g`, we get `y::a` . Then when we -encounter the `\z`, we'll assign `z :: alpha[1]`, say. Next, from the -body of the lambda we'll get - - [W] alpha[1] ~ Int -- From z::Int - [W] forall[2]. (a ~ Int) => [W] alpha[1] ~ a -- From [y,z] - -Now, suppose we decide to float `alpha ~ a` out of the implication -and then unify `alpha := a`. Now we are stuck! But if treat -`alpha ~ Int` first, and unify `alpha := Int`, all is fine. -But we absolutely cannot float that equality or we will get stuck. -} removeInertCts :: [Ct] -> InertCans -> InertCans @@ -2552,9 +2614,6 @@ tcAppMapToBag m = foldTcAppMap consBag m emptyBag foldTcAppMap :: (a -> b -> b) -> TcAppMap a -> b -> b foldTcAppMap k m z = foldDTyConEnv (foldTM k) z m -foldMapTcAppMap :: Monoid m => (a -> m) -> TcAppMap a -> m -foldMapTcAppMap f = foldMap (foldMap f) - {- ********************************************************************* * * @@ -2688,9 +2747,6 @@ findFunEqsByTyCon m tc foldFunEqs :: (a -> b -> b) -> FunEqMap a -> b -> b foldFunEqs = foldTcAppMap -foldMapFunEqs :: Monoid m => (a -> m) -> FunEqMap a -> m -foldMapFunEqs = foldMapTcAppMap - insertFunEq :: FunEqMap a -> TyCon -> [Type] -> a -> FunEqMap a insertFunEq m tc tys val = insertTcApp m tc tys val @@ -2723,6 +2779,12 @@ data TcSEnv -- The number of unification variables we have filled -- The important thing is whether it is non-zero + tcs_unif_lvl :: IORef (Maybe TcLevel), + -- The Unification Level Flag + -- Outermost level at which we have unified a meta tyvar + -- Starts at Nothing, then (Just i), then (Just j) where j do { inerts <- TcM.readTcRef old_inert_var - ; let nest_inert = inerts { inert_cycle_breakers = [] } - -- all other InertSet fields are inherited + ; let nest_inert = inerts { inert_cycle_breakers = [] + , inert_cans = (inert_cans inerts) + { inert_given_eqs = False } } + -- All other InertSet fields are inherited ; new_inert_var <- TcM.newTcRef nest_inert ; new_wl_var <- TcM.newTcRef emptyWorkList - ; let nest_env = TcSEnv { tcs_ev_binds = ref + ; let nest_env = TcSEnv { tcs_count = count -- Inherited + , tcs_unif_lvl = unif_lvl -- Inherited + , tcs_ev_binds = ref , tcs_unified = unified_var - , tcs_count = count , tcs_inerts = new_inert_var , tcs_worklist = new_wl_var } ; res <- TcM.setTcLevel inner_tclvl $ @@ -3260,6 +3328,97 @@ pprKicked :: Int -> SDoc pprKicked 0 = empty pprKicked n = parens (int n <+> text "kicked out") +{- ********************************************************************* +* * +* The Unification Level Flag * +* * +********************************************************************* -} + +{- Note [The Unification Level Flag] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider a deep tree of implication constraints + forall[1] a. -- Outer-implic + C alpha[1] -- Simple + forall[2] c. ....(C alpha[1]).... -- Implic-1 + forall[2] b. ....(alpha[1] ~ Int).... -- Implic-2 + +The (C alpha) is insoluble until we know alpha. We solve alpha +by unifying alpha:=Int somewhere deep inside Implic-2. But then we +must try to solve the Outer-implic all over again. This time we can +solve (C alpha) both in Outer-implic, and nested inside Implic-1. + +When should we iterate solving a level-n implication? +Answer: if any unification of a tyvar at level n takes place + in the ic_implics of that implication. + +* What if a unification takes place at level n-1? Then don't iterate + level n, because we'll iterate level n-1, and that will in turn iterate + level n. + +* What if a unification takes place at level n, in the ic_simples of + level n? No need to track this, because the kick-out mechanism deals + with it. (We can't drop kick-out in favour of iteration, becuase kick-out + works for skolem-equalities, not just unifications.) + +So the monad-global Unification Level Flag, kept in tcs_unif_lvl keeps +track of + - Whether any unifications at all have taken place (Nothing => no unifications) + - If so, what is the outermost level that has seen a unification (Just lvl) + +The iteration done in the simplify_loop/maybe_simplify_again loop in GHC.Tc.Solver. + +It helpful not to iterate unless there is a chance of progress. #8474 is +an example: + + * There's a deeply-nested chain of implication constraints. + ?x:alpha => ?y1:beta1 => ... ?yn:betan => [W] ?x:Int + + * From the innermost one we get a [D] alpha[1] ~ Int, + so we can unify. + + * It's better not to iterate the inner implications, but go all the + way out to level 1 before iterating -- because iterating level 1 + will iterate the inner levels anyway. + +(In the olden days when we "floated" thse Derived constraints, this was +much, much more important -- we got exponential behaviour, as each iteration +produced the same Derived constraint.) +-} + + +resetUnificationFlag :: TcS Bool +-- We are at ambient level i +-- If the unification flag = Just i, reset it to Nothing and return True +-- Otherwise leave it unchanged and return False +resetUnificationFlag + = TcS $ \env -> + do { let ref = tcs_unif_lvl env + ; ambient_lvl <- TcM.getTcLevel + ; mb_lvl <- TcM.readTcRef ref + ; TcM.traceTc "resetUnificationFlag" $ + vcat [ text "ambient:" <+> ppr ambient_lvl + , text "unif_lvl:" <+> ppr mb_lvl ] + ; case mb_lvl of + Nothing -> return False + Just unif_lvl | ambient_lvl `strictlyDeeperThan` unif_lvl + -> return False + | otherwise + -> do { TcM.writeTcRef ref Nothing + ; return True } } + +setUnificationFlag :: TcLevel -> TcS () +-- (setUnificationFlag i) sets the unification level to (Just i) +-- unless it already is (Just j) where j <= i +setUnificationFlag lvl + = TcS $ \env -> + do { let ref = tcs_unif_lvl env + ; mb_lvl <- TcM.readTcRef ref + ; case mb_lvl of + Just unif_lvl | lvl `deeperThanOrSame` unif_lvl + -> return () + _ -> TcM.writeTcRef ref (Just lvl) } + + {- ********************************************************************* * * * Instantiation etc. ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -1095,7 +1095,7 @@ Yuk! data Implication = Implic { -- Invariants for a tree of implications: - -- see TcType Note [TcLevel and untouchable type variables] + -- see TcType Note [TcLevel invariants] ic_tclvl :: TcLevel, -- TcLevel of unification variables -- allocated /inside/ this implication @@ -1172,44 +1172,57 @@ data ImplicStatus | IC_Unsolved -- Neither of the above; might go either way --- | Does this implication have Given equalities? --- See Note [When does an implication have given equalities?] in GHC.Tc.Solver.Monad, --- which also explains why we need three options here. Also, see --- Note [Suppress redundant givens during error reporting] in GHC.Tc.Errors --- --- Stops floating | Suppresses Givens in errors --- ----------------------------------------------- --- NoGivenEqs NO | YES --- LocalGivenEqs NO | NO --- MaybeGivenEqs YES | NO --- --- Examples: --- --- NoGivenEqs: Eq a => ... --- (Show a, Num a) => ... --- forall a. a ~ Either Int Bool => ... --- See Note [Let-bound skolems] in GHC.Tc.Solver.Monad for --- that last one --- --- LocalGivenEqs: forall a b. F a ~ G b => ... --- forall a. F a ~ Int => ... --- --- MaybeGivenEqs: (a ~ b) => ... --- forall a. F a ~ b => ... --- --- The check is conservative. A MaybeGivenEqs might not have any equalities. --- A LocalGivenEqs might local equalities, but it definitely does not have non-local --- equalities. A NoGivenEqs definitely does not have equalities (except let-bound --- skolems). -data HasGivenEqs - = NoGivenEqs -- definitely no given equalities, - -- except by Note [Let-bound skolems] in GHC.Tc.Solver.Monad - | LocalGivenEqs -- might have Given equalities that affect only local skolems - -- e.g. forall a b. (a ~ F b) => ...; definitely no others - | MaybeGivenEqs -- might have any kind of Given equalities; no floating out - -- is possible. +data HasGivenEqs -- See Note [HasGivenEqs] + = NoGivenEqs -- Definitely no given equalities, + -- except by Note [Let-bound skolems] in GHC.Tc.Solver.Monad + | LocalGivenEqs -- Might have Given equalities, but only ones that affect only + -- local skolems e.g. forall a b. (a ~ F b) => ... + | MaybeGivenEqs -- Might have any kind of Given equalities; no floating out + -- is possible. deriving Eq +{- Note [HasGivenEqs] +~~~~~~~~~~~~~~~~~~~~~ +The GivenEqs data type describes the Given constraints of an implication constraint: + +* NoGivenEqs: definitely no Given equalities, except perhaps let-bound skolems + which don't count: see Note [Let-bound skolems] in GHC.Tc.Solver.Monad + Examples: forall a. Eq a => ... + forall a. (Show a, Num a) => ... + forall a. a ~ Either Int Bool => ... -- Let-bound skolem + +* LocalGivenEqs: definitely no Given equalities that would affect principal + types. But may have equalities that affect only skolems of this implication + (and hence do not affect princial types) + Examples: forall a. F a ~ Int => ... + forall a b. F a ~ G b => ... + +* MaybeGivenEqs: may have Given equalities that would affect principal + types + Examples: forall. (a ~ b) => ... + forall a. F a ~ b => ... + forall a. c a => ... -- The 'c' might be instantiated to (b ~) + forall a. C a b => .... + where class x~y => C a b + so there is an equality in the superclass of a Given + +The HasGivenEqs classifications affect two things: + +* Suppressing redundant givens during error reporting; see GHC.Tc.Errors + Note [Suppress redundant givens during error reporting] + +* Floating in approximateWC. + +Specifically, here's how it goes: + + Stops floating | Suppresses Givens in errors + in approximateWC | + ----------------------------------------------- + NoGivenEqs NO | YES + LocalGivenEqs NO | NO + MaybeGivenEqs YES | NO +-} + instance Outputable Implication where ppr (Implic { ic_tclvl = tclvl, ic_skols = skols , ic_given = given, ic_given_eqs = given_eqs ===================================== compiler/GHC/Tc/Utils/Monad.hs ===================================== @@ -1867,7 +1867,7 @@ It's distressingly delicate though: class constraints mentioned above. But we may /also/ end up taking constraints built at some inner level, and emitting them at some outer level, and then breaking the TcLevel invariants - See Note [TcLevel and untouchable type variables] in GHC.Tc.Utils.TcType + See Note [TcLevel invariants] in GHC.Tc.Utils.TcType So dropMisleading has a horridly ad-hoc structure. It keeps only /insoluble/ flat constraints (which are unlikely to very visibly trip ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -80,7 +80,7 @@ module GHC.Tc.Utils.TcMType ( --------------------------------- -- Promotion, defaulting, skolemisation - defaultTyVar, promoteTyVar, promoteTyVarSet, + defaultTyVar, promoteTyVarTo, promoteTyVarSet, quantifyTyVars, isQuantifiableTv, skolemiseUnboundMetaTyVar, zonkAndSkolemise, skolemiseQuantifiedTyVar, @@ -965,12 +965,18 @@ writeMetaTyVarRef tyvar ref ty ; writeTcRef ref (Indirect ty) } -- Everything from here on only happens if DEBUG is on + -- Need to zonk 'ty' because we may only recently have promoted + -- its free meta-tyvars (see Solver.Interact.tryToSolveByUnification) | otherwise = do { meta_details <- readMutVar ref; -- Zonk kinds to allow the error check to work ; zonked_tv_kind <- zonkTcType tv_kind - ; zonked_ty_kind <- zonkTcType ty_kind - ; let kind_check_ok = tcIsConstraintKind zonked_tv_kind + ; zonked_ty <- zonkTcType ty + ; let zonked_ty_kind = tcTypeKind zonked_ty + zonked_ty_lvl = tcTypeLevel zonked_ty + level_check_ok = not (zonked_ty_lvl `strictlyDeeperThan` tv_lvl) + level_check_msg = ppr zonked_ty_lvl $$ ppr tv_lvl $$ ppr tyvar $$ ppr ty + kind_check_ok = tcIsConstraintKind zonked_tv_kind || tcEqKind zonked_ty_kind zonked_tv_kind -- Hack alert! tcIsConstraintKind: see GHC.Tc.Gen.HsType -- Note [Extra-constraint holes in partial type signatures] @@ -995,13 +1001,9 @@ writeMetaTyVarRef tyvar ref ty ; writeMutVar ref (Indirect ty) } where tv_kind = tyVarKind tyvar - ty_kind = tcTypeKind ty tv_lvl = tcTyVarLevel tyvar - ty_lvl = tcTypeLevel ty - level_check_ok = not (ty_lvl `strictlyDeeperThan` tv_lvl) - level_check_msg = ppr ty_lvl $$ ppr tv_lvl $$ ppr tyvar $$ ppr ty double_upd_msg details = hang (text "Double update of meta tyvar") 2 (ppr tyvar $$ ppr details) @@ -1570,8 +1572,8 @@ than the ambient level (see Note [Use level numbers of quantification]). Note [Use level numbers for quantification] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The level numbers assigned to metavariables are very useful. Not only -do they track touchability (Note [TcLevel and untouchable type variables] -in GHC.Tc.Utils.TcType), but they also allow us to determine which variables to +do they track touchability (Note [TcLevel invariants] in GHC.Tc.Utils.TcType), +but they also allow us to determine which variables to generalise. The rule is this: When generalising, quantify only metavariables with a TcLevel greater @@ -2005,29 +2007,29 @@ a \/\a in the final result but all the occurrences of a will be zonked to () * * ********************************************************************* -} -promoteTyVar :: TcTyVar -> TcM Bool +promoteTyVarTo :: TcLevel -> TcTyVar -> TcM Bool -- When we float a constraint out of an implication we must restore --- invariant (WantedInv) in Note [TcLevel and untouchable type variables] in GHC.Tc.Utils.TcType +-- invariant (WantedInv) in Note [TcLevel invariants] in GHC.Tc.Utils.TcType -- Return True <=> we did some promotion -- Also returns either the original tyvar (no promotion) or the new one -- See Note [Promoting unification variables] -promoteTyVar tv - = do { tclvl <- getTcLevel - ; if (isFloatedTouchableMetaTyVar tclvl tv) - then do { cloned_tv <- cloneMetaTyVar tv - ; let rhs_tv = setMetaTyVarTcLevel cloned_tv tclvl - ; writeMetaTyVar tv (mkTyVarTy rhs_tv) - ; traceTc "promoteTyVar" (ppr tv <+> text "-->" <+> ppr rhs_tv) - ; return True } - else do { traceTc "promoteTyVar: no" (ppr tv) - ; return False } } +promoteTyVarTo tclvl tv + | isFloatedTouchableMetaTyVar tclvl tv + = do { cloned_tv <- cloneMetaTyVar tv + ; let rhs_tv = setMetaTyVarTcLevel cloned_tv tclvl + ; writeMetaTyVar tv (mkTyVarTy rhs_tv) + ; traceTc "promoteTyVar" (ppr tv <+> text "-->" <+> ppr rhs_tv) + ; return True } + | otherwise + = do { traceTc "promoteTyVar: no" (ppr tv) + ; return False } -- Returns whether or not *any* tyvar is defaulted promoteTyVarSet :: TcTyVarSet -> TcM Bool promoteTyVarSet tvs - = do { bools <- mapM promoteTyVar (nonDetEltsUniqSet tvs) + = do { tclvl <- getTcLevel + ; bools <- mapM (promoteTyVarTo tclvl) (nonDetEltsUniqSet tvs) -- Non-determinism is OK because order of promotion doesn't matter - ; return (or bools) } ===================================== compiler/GHC/Tc/Utils/TcType.hs ===================================== @@ -33,7 +33,7 @@ module GHC.Tc.Utils.TcType ( -- TcLevel TcLevel(..), topTcLevel, pushTcLevel, isTopTcLevel, - strictlyDeeperThan, sameDepthAs, + strictlyDeeperThan, deeperThanOrSame, sameDepthAs, tcTypeLevel, tcTyVarLevel, maxTcLevel, promoteSkolem, promoteSkolemX, promoteSkolemsX, -------------------------------- @@ -45,7 +45,7 @@ module GHC.Tc.Utils.TcType ( isAmbiguousTyVar, isCycleBreakerTyVar, metaTyVarRef, metaTyVarInfo, isFlexi, isIndirect, isRuntimeUnkSkol, metaTyVarTcLevel, setMetaTyVarTcLevel, metaTyVarTcLevel_maybe, - isTouchableMetaTyVar, + isTouchableMetaTyVar, isPromotableMetaTyVar, isFloatedTouchableMetaTyVar, findDupTyVarTvs, mkTyVarNamePairs, @@ -516,7 +516,7 @@ data TcTyVarDetails | MetaTv { mtv_info :: MetaInfo , mtv_ref :: IORef MetaDetails - , mtv_tclvl :: TcLevel } -- See Note [TcLevel and untouchable type variables] + , mtv_tclvl :: TcLevel } -- See Note [TcLevel invariants] vanillaSkolemTv, superSkolemTv :: TcTyVarDetails -- See Note [Binding when looking up instances] in GHC.Core.InstEnv @@ -574,13 +574,14 @@ instance Outputable MetaInfo where ********************************************************************* -} newtype TcLevel = TcLevel Int deriving( Eq, Ord ) - -- See Note [TcLevel and untouchable type variables] for what this Int is + -- See Note [TcLevel invariants] for what this Int is -- See also Note [TcLevel assignment] {- -Note [TcLevel and untouchable type variables] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [TcLevel invariants] +~~~~~~~~~~~~~~~~~~~~~~~~~ * Each unification variable (MetaTv) + and skolem (SkolemTv) and each Implication has a level number (of type TcLevel) @@ -602,9 +603,8 @@ Note [TcLevel and untouchable type variables] LESS THAN OR EQUAL TO the ic_tclvl of I See Note [WantedInv] -* A unification variable is *touchable* if its level number - is EQUAL TO that of its immediate parent implication, - and it is a TauTv or TyVarTv (but /not/ CycleBreakerTv) +The level of a MetaTyVar also governs its untouchability. See +Note [Unification preconditions] in GHC.Tc.Utils.Unify. Note [WantedInv] ~~~~~~~~~~~~~~~~ @@ -679,13 +679,17 @@ strictlyDeeperThan :: TcLevel -> TcLevel -> Bool strictlyDeeperThan (TcLevel tv_tclvl) (TcLevel ctxt_tclvl) = tv_tclvl > ctxt_tclvl +deeperThanOrSame :: TcLevel -> TcLevel -> Bool +deeperThanOrSame (TcLevel tv_tclvl) (TcLevel ctxt_tclvl) + = tv_tclvl >= ctxt_tclvl + sameDepthAs :: TcLevel -> TcLevel -> Bool sameDepthAs (TcLevel ctxt_tclvl) (TcLevel tv_tclvl) = ctxt_tclvl == tv_tclvl -- NB: invariant ctxt_tclvl >= tv_tclvl -- So <= would be equivalent checkTcLevelInvariant :: TcLevel -> TcLevel -> Bool --- Checks (WantedInv) from Note [TcLevel and untouchable type variables] +-- Checks (WantedInv) from Note [TcLevel invariants] checkTcLevelInvariant (TcLevel ctxt_tclvl) (TcLevel tv_tclvl) = ctxt_tclvl >= tv_tclvl @@ -998,6 +1002,15 @@ tcIsTcTyVar :: TcTyVar -> Bool -- See Note [TcTyVars and TyVars in the typechecker] tcIsTcTyVar tv = isTyVar tv +isPromotableMetaTyVar :: TcTyVar -> Bool +-- True is this is a meta-tyvar that can be +-- promoted to an outer level +isPromotableMetaTyVar tv + | MetaTv { mtv_info = info } <- tcTyVarDetails tv + = isTouchableInfo info -- Can't promote cycle breakers + | otherwise + = False + isTouchableMetaTyVar :: TcLevel -> TcTyVar -> Bool isTouchableMetaTyVar ctxt_tclvl tv | isTyVar tv -- See Note [Coercion variables in free variable lists] ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -37,7 +37,7 @@ module GHC.Tc.Utils.Unify ( matchExpectedFunKind, matchActualFunTySigma, matchActualFunTysRho, - metaTyVarUpdateOK, occCheckForErrors, MetaTyVarUpdateResult(..), + occCheckForErrors, CheckTyEqResult(..), checkTyVarEq, checkTyFamEq, checkTypeEq, AreTypeFamiliesOK(..) ) where @@ -78,6 +78,7 @@ import GHC.Utils.Panic import GHC.Exts ( inline ) import Control.Monad import Control.Arrow ( second ) +import qualified Data.Semigroup as S {- ********************************************************************* @@ -1169,17 +1170,17 @@ uType t_or_k origin orig_ty1 orig_ty2 -- so that type variables tend to get filled in with -- the most informative version of the type go (TyVarTy tv1) ty2 - = do { lookup_res <- lookupTcTyVar tv1 + = do { lookup_res <- isFilledMetaTyVar_maybe tv1 ; case lookup_res of - Filled ty1 -> do { traceTc "found filled tyvar" (ppr tv1 <+> text ":->" <+> ppr ty1) - ; go ty1 ty2 } - Unfilled _ -> uUnfilledVar origin t_or_k NotSwapped tv1 ty2 } + Just ty1 -> do { traceTc "found filled tyvar" (ppr tv1 <+> text ":->" <+> ppr ty1) + ; go ty1 ty2 } + Nothing -> uUnfilledVar origin t_or_k NotSwapped tv1 ty2 } go ty1 (TyVarTy tv2) - = do { lookup_res <- lookupTcTyVar tv2 + = do { lookup_res <- isFilledMetaTyVar_maybe tv2 ; case lookup_res of - Filled ty2 -> do { traceTc "found filled tyvar" (ppr tv2 <+> text ":->" <+> ppr ty2) - ; go ty1 ty2 } - Unfilled _ -> uUnfilledVar origin t_or_k IsSwapped tv2 ty1 } + Just ty2 -> do { traceTc "found filled tyvar" (ppr tv2 <+> text ":->" <+> ppr ty2) + ; go ty1 ty2 } + Nothing -> uUnfilledVar origin t_or_k IsSwapped tv2 ty1 } -- See Note [Expanding synonyms during unification] go ty1@(TyConApp tc1 []) (TyConApp tc2 []) @@ -1433,10 +1434,11 @@ uUnfilledVar2 origin t_or_k swapped tv1 ty2 ; go dflags cur_lvl } where go dflags cur_lvl - | canSolveByUnification cur_lvl tv1 ty2 + | isTouchableMetaTyVar cur_lvl tv1 + , canSolveByUnification (metaTyVarInfo tv1) ty2 + , CTE_OK <- checkTyVarEq dflags NoTypeFamilies tv1 ty2 -- See Note [Prevent unification with type families] about the NoTypeFamilies: - , MTVU_OK ty2' <- metaTyVarUpdateOK dflags NoTypeFamilies tv1 ty2 - = do { co_k <- uType KindLevel kind_origin (tcTypeKind ty2') (tyVarKind tv1) + = do { co_k <- uType KindLevel kind_origin (tcTypeKind ty2) (tyVarKind tv1) ; traceTc "uUnfilledVar2 ok" $ vcat [ ppr tv1 <+> dcolon <+> ppr (tyVarKind tv1) , ppr ty2 <+> dcolon <+> ppr (tcTypeKind ty2) @@ -1446,8 +1448,8 @@ uUnfilledVar2 origin t_or_k swapped tv1 ty2 -- Only proceed if the kinds match -- NB: tv1 should still be unfilled, despite the kind unification -- because tv1 is not free in ty2 (or, hence, in its kind) - then do { writeMetaTyVar tv1 ty2' - ; return (mkTcNomReflCo ty2') } + then do { writeMetaTyVar tv1 ty2 + ; return (mkTcNomReflCo ty2) } else defer } -- This cannot be solved now. See GHC.Tc.Solver.Canonical -- Note [Equalities with incompatible kinds] @@ -1464,6 +1466,22 @@ uUnfilledVar2 origin t_or_k swapped tv1 ty2 defer = unSwap swapped (uType_defer t_or_k origin) ty1 ty2 +canSolveByUnification :: MetaInfo -> TcType -> Bool +-- See Note [Unification preconditions, (TYVAR-TV)] +canSolveByUnification info xi + = case info of + CycleBreakerTv -> False + TyVarTv -> case tcGetTyVar_maybe xi of + Nothing -> False + Just tv -> case tcTyVarDetails tv of + MetaTv { mtv_info = info } + -> case info of + TyVarTv -> True + _ -> False + SkolemTv {} -> True + RuntimeUnk -> True + _ -> True + swapOverTyVars :: Bool -> TcTyVar -> TcTyVar -> Bool swapOverTyVars is_given tv1 tv2 -- See Note [Unification variables on the left] @@ -1507,8 +1525,94 @@ lhsPriority tv TauTv -> 2 RuntimeUnkTv -> 3 -{- Note [TyVar/TyVar orientation] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [Unification preconditions] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Question: given a homogeneous equality (alpha ~# ty), when is it OK to +unify alpha := ty? + +This note only applied to /homogeneous/ equalities, in which both +sides have the same kind. + +There are three reasons not to unify: + +1. (SKOL-ESC) Skolem-escape + Consider the constraint + forall[2] a[2]. alpha[1] ~ Maybe a[2] + If we unify alpha := Maybe a, the skolem 'a' may escape its scope. + The level alpha[1] says that alpha may be used outside this constraint, + where 'a' is not in scope at all. So we must not unify. + + Bottom line: when looking at a constraint alpha[n] := ty, do not unify + if any free variable of 'ty' has level deeper (greater) than n + +2. (UNTOUCHABLE) Untouchable unification variables + Consider the constraint + forall[2] a[2]. b[1] ~ Int => alpha[1] ~ Int + There is no (SKOL-ESC) problem with unifying alpha := Int, but it might + not be the principal solution. Perhaps the "right" solution is alpha := b. + We simply can't tell. See "OutsideIn(X): modular type inference with local + assumptions", section 2.2. We say that alpha[1] is "untouchable" inside + this implication. + + Bottom line: at amibient level 'l', when looking at a constraint + alpha[n] ~ ty, do not unify alpha := ty if there are any given equalities + between levels 'n' and 'l'. + + Exactly what is a "given equality" for the purpose of (UNTOUCHABLE)? + Answer: see Note [Tracking Given equalities] in GHC.Tc.Solver.Monad + +3. (TYVAR-TV) Unifying TyVarTvs and CycleBreakerTvs + This precondition looks at the MetaInfo of the unification variable: + + * TyVarTv: When considering alpha{tyv} ~ ty, if alpha{tyv} is a + TyVarTv it can only unify with a type variable, not with a + structured type. So if 'ty' is a structured type, such as (Maybe x), + don't unify. + + * CycleBreakerTv: never unified, except by restoreTyVarCycles. + + +Needless to say, all three have wrinkles: + +* (SKOL-ESC) Promotion. Given alpha[n] ~ ty, what if beta[k] is free + in 'ty', where beta is a unification variable, and k>n? 'beta' + stands for a monotype, and since it is part of a level-n type + (equal to alpha[n]), we must /promote/ beta to level n. Just make + up a fresh gamma[n], and unify beta[k] := gamma[n]. + +* (TYVAR-TV) Unification variables. Suppose alpha[tyv,n] is a level-n + TyVarTv (see Note [Signature skolems] in GHC.Tc.Types.TcType)? Now + consider alpha[tyv,n] ~ Bool. We don't want to unify because that + would break the TyVarTv invariant. + + What about alpha[tyv,n] ~ beta[tau,n], where beta is an ordinary + TauTv? Again, don't unify, because beta might later be unified + with, say Bool. (If levels permit, we reverse the orientation here; + see Note [TyVar/TyVar orientation].) + +* (UNTOUCHABLE) Untouchability. When considering (alpha[n] ~ ty), how + do we know whether there are any given equalities between level n + and the ambient level? We answer in two ways: + + * In the eager unifier, we only unify if l=n. If not, alpha may be + untouchable, and defer to the constraint solver. This check is + made in GHC.Tc.Utils.uUnifilledVar2, in the guard + isTouchableMetaTyVar. + + * In the constraint solver, we track where Given equalities occur + and use that to guard unification in GHC.Tc.Solver.Canonical.unifyTest + More details in Note [Tracking Given equalities] in GHC.Tc.Solver.Monad + + Historical note: in the olden days (pre 2021) the constraint solver + also used to unify only if l=n. Equalities were "floated" out of the + implication in a separate step, so that they would become touchable. + But the float/don't-float question turned out to be very delicate, + as you can see if you look at the long series of Notes associated with + GHC.Tc.Solver.floatEqualities, around Nov 2020. It's much easier + to unify in-place, with no floating. + +Note [TyVar/TyVar orientation] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Given (a ~ b), should we orient the CEqCan as (a~b) or (b~a)? This is a surprisingly tricky question! This is invariant (TyEq:TV). @@ -1616,8 +1720,8 @@ inert guy, so we get inert item: c ~ a And now the cycle just repeats -Note [Eliminate younger unification variables] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Historical Note [Eliminate younger unification variables] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Given a choice of unifying alpha := beta or beta := alpha we try, if possible, to eliminate the "younger" one, as determined @@ -1631,36 +1735,11 @@ This is a performance optimisation only. It turns out to fix It's simple to implement (see nicer_to_update_tv2 in swapOverTyVars). But, to my surprise, it didn't seem to make any significant difference to the compiler's performance, so I didn't take it any further. Still -it seemed to too nice to discard altogether, so I'm leaving these +it seemed too nice to discard altogether, so I'm leaving these notes. SLPJ Jan 18. --} --- @trySpontaneousSolve wi@ solves equalities where one side is a --- touchable unification variable. --- Returns True <=> spontaneous solve happened -canSolveByUnification :: TcLevel -> TcTyVar -> TcType -> Bool -canSolveByUnification tclvl tv xi - | isTouchableMetaTyVar tclvl tv - = case metaTyVarInfo tv of - TyVarTv -> is_tyvar xi - _ -> True - - | otherwise -- Untouchable - = False - where - is_tyvar xi - = case tcGetTyVar_maybe xi of - Nothing -> False - Just tv -> case tcTyVarDetails tv of - MetaTv { mtv_info = info } - -> case info of - TyVarTv -> True - _ -> False - SkolemTv {} -> True - RuntimeUnk -> True - -{- Note [Prevent unification with type families] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [Prevent unification with type families] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We prevent unification with type families because of an uneasy compromise. It's perfectly sound to unify with type families, and it even improves the error messages in the testsuite. It also modestly improves performance, at @@ -1764,35 +1843,6 @@ type-checking (with wrappers, etc.). Types get desugared very differently, causing this wibble in behavior seen here. -} -data LookupTyVarResult -- The result of a lookupTcTyVar call - = Unfilled TcTyVarDetails -- SkolemTv or virgin MetaTv - | Filled TcType - -lookupTcTyVar :: TcTyVar -> TcM LookupTyVarResult -lookupTcTyVar tyvar - | MetaTv { mtv_ref = ref } <- details - = do { meta_details <- readMutVar ref - ; case meta_details of - Indirect ty -> return (Filled ty) - Flexi -> do { is_touchable <- isTouchableTcM tyvar - -- Note [Unifying untouchables] - ; if is_touchable then - return (Unfilled details) - else - return (Unfilled vanillaSkolemTv) } } - | otherwise - = return (Unfilled details) - where - details = tcTyVarDetails tyvar - -{- -Note [Unifying untouchables] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We treat an untouchable type variable as if it was a skolem. That -ensures it won't unify with anything. It's a slight hack, because -we return a made-up TcTyVarDetails, but I think it works smoothly. --} - -- | Breaks apart a function kind into its pieces. matchExpectedFunKind :: Outputable fun @@ -1871,44 +1921,38 @@ with (forall k. k->*) -} -data MetaTyVarUpdateResult a - = MTVU_OK a - | MTVU_Bad -- Forall, predicate, or type family - | MTVU_HoleBlocker -- Blocking coercion hole +data CheckTyEqResult + = CTE_OK + | CTE_Bad -- Forall, predicate, or type family + | CTE_HoleBlocker -- Blocking coercion hole -- See Note [Equalities with incompatible kinds] in "GHC.Tc.Solver.Canonical" - | MTVU_Occurs - deriving (Functor) - -instance Applicative MetaTyVarUpdateResult where - pure = MTVU_OK - (<*>) = ap - -instance Monad MetaTyVarUpdateResult where - MTVU_OK x >>= k = k x - MTVU_Bad >>= _ = MTVU_Bad - MTVU_HoleBlocker >>= _ = MTVU_HoleBlocker - MTVU_Occurs >>= _ = MTVU_Occurs - -instance Outputable a => Outputable (MetaTyVarUpdateResult a) where - ppr (MTVU_OK a) = text "MTVU_OK" <+> ppr a - ppr MTVU_Bad = text "MTVU_Bad" - ppr MTVU_HoleBlocker = text "MTVU_HoleBlocker" - ppr MTVU_Occurs = text "MTVU_Occurs" - -occCheckForErrors :: DynFlags -> TcTyVar -> Type -> MetaTyVarUpdateResult () --- Just for error-message generation; so we return MetaTyVarUpdateResult + | CTE_Occurs + +instance S.Semigroup CheckTyEqResult where + CTE_OK <> x = x + x <> _ = x + +instance Monoid CheckTyEqResult where + mempty = CTE_OK + +instance Outputable CheckTyEqResult where + ppr CTE_OK = text "CTE_OK" + ppr CTE_Bad = text "CTE_Bad" + ppr CTE_HoleBlocker = text "CTE_HoleBlocker" + ppr CTE_Occurs = text "CTE_Occurs" + +occCheckForErrors :: DynFlags -> TcTyVar -> Type -> CheckTyEqResult +-- Just for error-message generation; so we return CheckTyEqResult -- so the caller can report the right kind of error -- Check whether -- a) the given variable occurs in the given type. -- b) there is a forall in the type (unless we have -XImpredicativeTypes) occCheckForErrors dflags tv ty = case checkTyVarEq dflags YesTypeFamilies tv ty of - MTVU_OK _ -> MTVU_OK () - MTVU_Bad -> MTVU_Bad - MTVU_HoleBlocker -> MTVU_HoleBlocker - MTVU_Occurs -> case occCheckExpand [tv] ty of - Nothing -> MTVU_Occurs - Just _ -> MTVU_OK () + CTE_Occurs -> case occCheckExpand [tv] ty of + Nothing -> CTE_Occurs + Just _ -> CTE_OK + other -> other ---------------- data AreTypeFamiliesOK = YesTypeFamilies @@ -1919,52 +1963,7 @@ instance Outputable AreTypeFamiliesOK where ppr YesTypeFamilies = text "YesTypeFamilies" ppr NoTypeFamilies = text "NoTypeFamilies" -metaTyVarUpdateOK :: DynFlags - -> AreTypeFamiliesOK -- allow type families in RHS? - -> TcTyVar -- tv :: k1 - -> TcType -- ty :: k2 - -> MetaTyVarUpdateResult TcType -- possibly-expanded ty --- (metaTyVarUpdateOK tv ty) --- Checks that the equality tv~ty is OK to be used to rewrite --- other equalities. Equivalently, checks the conditions for CEqCan --- (a) that tv doesn't occur in ty (occurs check) --- (b) that ty does not have any foralls or (perhaps) type functions --- (c) that ty does not have any blocking coercion holes --- See Note [Equalities with incompatible kinds] in "GHC.Tc.Solver.Canonical" --- --- Used in two places: --- - In the eager unifier: uUnfilledVar2 --- - In the canonicaliser: GHC.Tc.Solver.Canonical.canEqTyVar2 --- Note that in the latter case tv is not necessarily a meta-tyvar, --- despite the name of this function. - --- We have two possible outcomes: --- (1) Return the type to update the type variable with, --- [we know the update is ok] --- (2) Return Nothing, --- [the update might be dodgy] --- --- Note that "Nothing" does not mean "definite error". For example --- type family F a --- type instance F Int = Int --- consider --- a ~ F a --- This is perfectly reasonable, if we later get a ~ Int. For now, though, --- we return Nothing, leaving it to the later constraint simplifier to --- sort matters out. --- --- See Note [Refactoring hazard: metaTyVarUpdateOK] - -metaTyVarUpdateOK dflags ty_fam_ok tv ty - = case checkTyVarEq dflags ty_fam_ok tv ty of - MTVU_OK _ -> MTVU_OK ty - MTVU_Bad -> MTVU_Bad -- forall, predicate, type function - MTVU_HoleBlocker -> MTVU_HoleBlocker -- coercion hole - MTVU_Occurs -> case occCheckExpand [tv] ty of - Just expanded_ty -> MTVU_OK expanded_ty - Nothing -> MTVU_Occurs - -checkTyVarEq :: DynFlags -> AreTypeFamiliesOK -> TcTyVar -> TcType -> MetaTyVarUpdateResult () +checkTyVarEq :: DynFlags -> AreTypeFamiliesOK -> TcTyVar -> TcType -> CheckTyEqResult checkTyVarEq dflags ty_fam_ok tv ty = inline checkTypeEq dflags ty_fam_ok (TyVarLHS tv) ty -- inline checkTypeEq so that the `case`s over the CanEqLHS get blasted away @@ -1973,13 +1972,13 @@ checkTyFamEq :: DynFlags -> TyCon -- type function -> [TcType] -- args, exactly saturated -> TcType -- RHS - -> MetaTyVarUpdateResult () + -> CheckTyEqResult checkTyFamEq dflags fun_tc fun_args ty = inline checkTypeEq dflags YesTypeFamilies (TyFamLHS fun_tc fun_args) ty -- inline checkTypeEq so that the `case`s over the CanEqLHS get blasted away checkTypeEq :: DynFlags -> AreTypeFamiliesOK -> CanEqLHS -> TcType - -> MetaTyVarUpdateResult () + -> CheckTyEqResult -- Checks the invariants for CEqCan. In particular: -- (a) a forall type (forall a. blah) -- (b) a predicate type (c => ty) @@ -1987,6 +1986,14 @@ checkTypeEq :: DynFlags -> AreTypeFamiliesOK -> CanEqLHS -> TcType -- (d) a blocking coercion hole -- (e) an occurrence of the LHS (occurs check) -- +-- Note that an occurs-check does not mean "definite error". For example +-- type family F a +-- type instance F Int = Int +-- consider +-- b0 ~ F b0 +-- This is perfectly reasonable, if we later get b0 ~ Int. But we +-- certainly can't unify b0 := F b0 +-- -- For (a), (b), and (c) we check only the top level of the type, NOT -- inside the kinds of variables it mentions. For (d) we look deeply -- in coercions when the LHS is a tyvar (but skip coercions for type family @@ -1994,14 +2001,11 @@ checkTypeEq :: DynFlags -> AreTypeFamiliesOK -> CanEqLHS -> TcType -- -- checkTypeEq is called from -- * checkTyFamEq, checkTyVarEq (which inline it to specialise away the --- case-analysis on 'lhs' +-- case-analysis on 'lhs') -- * checkEqCanLHSFinish, which does not know the form of 'lhs' checkTypeEq dflags ty_fam_ok lhs ty = go ty where - ok :: MetaTyVarUpdateResult () - ok = MTVU_OK () - -- The GHCi runtime debugger does its type-matching with -- unification variables that can unify with a polytype -- or a TyCon that would usually be disallowed by bad_tc @@ -2014,71 +2018,70 @@ checkTypeEq dflags ty_fam_ok lhs ty | otherwise = False - go :: TcType -> MetaTyVarUpdateResult () + go :: TcType -> CheckTyEqResult go (TyVarTy tv') = go_tv tv' go (TyConApp tc tys) = go_tc tc tys - go (LitTy {}) = ok + go (LitTy {}) = CTE_OK go (FunTy{ft_af = af, ft_mult = w, ft_arg = a, ft_res = r}) | InvisArg <- af - , not ghci_tv = MTVU_Bad - | otherwise = go w >> go a >> go r - go (AppTy fun arg) = go fun >> go arg - go (CastTy ty co) = go ty >> go_co co + , not ghci_tv = CTE_Bad + | otherwise = go w S.<> go a S.<> go r + go (AppTy fun arg) = go fun S.<> go arg + go (CastTy ty co) = go ty S.<> go_co co go (CoercionTy co) = go_co co go (ForAllTy (Bndr tv' _) ty) - | not ghci_tv = MTVU_Bad + | not ghci_tv = CTE_Bad | otherwise = case lhs of - TyVarLHS tv | tv == tv' -> ok - | otherwise -> do { go_occ tv (tyVarKind tv') - ; go ty } + TyVarLHS tv | tv == tv' -> CTE_OK + | otherwise -> go_occ tv (tyVarKind tv') S.<> go ty _ -> go ty - go_tv :: TcTyVar -> MetaTyVarUpdateResult () + go_tv :: TcTyVar -> CheckTyEqResult -- this slightly peculiar way of defining this means -- we don't have to evaluate this `case` at every variable -- occurrence go_tv = case lhs of TyVarLHS tv -> \ tv' -> if tv == tv' - then MTVU_Occurs + then CTE_Occurs else go_occ tv (tyVarKind tv') - TyFamLHS {} -> \ _tv' -> ok + TyFamLHS {} -> \ _tv' -> CTE_OK -- See Note [Occurrence checking: look inside kinds] in GHC.Core.Type -- For kinds, we only do an occurs check; we do not worry -- about type families or foralls -- See Note [Checking for foralls] - go_occ tv k | tv `elemVarSet` tyCoVarsOfType k = MTVU_Occurs - | otherwise = ok + go_occ tv k | tv `elemVarSet` tyCoVarsOfType k = CTE_Occurs + | otherwise = CTE_OK - go_tc :: TyCon -> [TcType] -> MetaTyVarUpdateResult () + go_tc :: TyCon -> [TcType] -> CheckTyEqResult -- this slightly peculiar way of defining this means -- we don't have to evaluate this `case` at every tyconapp go_tc = case lhs of TyVarLHS {} -> \ tc tys -> - if | good_tc tc -> mapM go tys >> ok - | otherwise -> MTVU_Bad + if | good_tc tc -> mconcat (map go tys) + | otherwise -> CTE_Bad TyFamLHS fam_tc fam_args -> \ tc tys -> - if | tcEqTyConApps fam_tc fam_args tc tys -> MTVU_Occurs - | good_tc tc -> mapM go tys >> ok - | otherwise -> MTVU_Bad + if | tcEqTyConApps fam_tc fam_args tc tys -> CTE_Occurs + | good_tc tc -> mconcat (map go tys) + | otherwise -> CTE_Bad -- no bother about impredicativity in coercions, as they're -- inferred go_co co | not (gopt Opt_DeferTypeErrors dflags) , hasCoercionHoleCo co - = MTVU_HoleBlocker -- Wrinkle (2) in GHC.Tc.Solver.Canonical + = CTE_HoleBlocker -- Wrinkle (2) in GHC.Tc.Solver.Canonical -- See GHC.Tc.Solver.Canonical Note [Equalities with incompatible kinds] -- Wrinkle (2) about this case in general, Wrinkle (4b) about the check for -- deferred type errors. | TyVarLHS tv <- lhs , tv `elemVarSet` tyCoVarsOfCo co - = MTVU_Occurs + = CTE_Occurs -- Don't check coercions for type families; see commentary at top of function | otherwise - = ok + = CTE_OK good_tc :: TyCon -> Bool good_tc ===================================== testsuite/tests/ghci.debugger/scripts/break012.stdout ===================================== @@ -1,14 +1,14 @@ Stopped in Main.g, break012.hs:5:10-18 -_result :: (p, a1 -> a1, (), a -> a -> a) = _ -a :: p = _ -b :: a2 -> a2 = _ +_result :: (a1, a2 -> a2, (), a -> a -> a) = _ +a :: a1 = _ +b :: a3 -> a3 = _ c :: () = _ d :: a -> a -> a = _ -a :: p -b :: a2 -> a2 +a :: a1 +b :: a3 -> a3 c :: () d :: a -> a -> a -a = (_t1::p) -b = (_t2::a2 -> a2) +a = (_t1::a1) +b = (_t2::a3 -> a3) c = (_t3::()) d = (_t4::a -> a -> a) ===================================== testsuite/tests/partial-sigs/should_compile/T10403.stderr ===================================== @@ -14,35 +14,18 @@ T10403.hs:15:12: warning: [-Wpartial-type-signatures (in -Wdefault)] • In the type signature: h1 :: _ => _ T10403.hs:19:7: warning: [-Wpartial-type-signatures (in -Wdefault)] - • Found type wildcard ‘_’ standing for ‘(a -> a1) -> f0 a -> H f0’ - Where: ‘f0’ is an ambiguous type variable + • Found type wildcard ‘_’ + standing for ‘(a -> a1) -> B t0 a -> H (B t0)’ + Where: ‘t0’ is an ambiguous type variable ‘a1’, ‘a’ are rigid type variables bound by - the inferred type of h2 :: (a -> a1) -> f0 a -> H f0 + the inferred type of h2 :: (a -> a1) -> B t0 a -> H (B t0) at T10403.hs:22:1-41 • In the type signature: h2 :: _ -T10403.hs:22:15: warning: [-Wdeferred-type-errors (in -Wdefault)] - • Ambiguous type variable ‘f0’ arising from a use of ‘fmap’ - prevents the constraint ‘(Functor f0)’ from being solved. - Relevant bindings include - b :: f0 a (bound at T10403.hs:22:6) - h2 :: (a -> a1) -> f0 a -> H f0 (bound at T10403.hs:22:1) - Probable fix: use a type annotation to specify what ‘f0’ should be. - These potential instances exist: - instance Functor IO -- Defined in ‘GHC.Base’ - instance Functor (B t) -- Defined at T10403.hs:10:10 - instance Functor I -- Defined at T10403.hs:6:10 - ...plus five others - ...plus two instances involving out-of-scope types - (use -fprint-potential-instances to see them all) - • In the second argument of ‘(.)’, namely ‘fmap (const ())’ - In the expression: (H . fmap (const ())) (fmap f b) - In an equation for ‘h2’: h2 f b = (H . fmap (const ())) (fmap f b) - T10403.hs:28:8: warning: [-Wdeferred-type-errors (in -Wdefault)] - • Couldn't match type ‘f0’ with ‘B t’ + • Couldn't match type ‘t0’ with ‘t’ Expected: H (B t) - Actual: H f0 + Actual: H (B t0) because type variable ‘t’ would escape its scope This (rigid, skolem) type variable is bound by the type signature for: ===================================== testsuite/tests/partial-sigs/should_compile/T14715.stderr ===================================== @@ -1,12 +1,11 @@ T14715.hs:13:53: warning: [-Wpartial-type-signatures (in -Wdefault)] - • Found extra-constraints wildcard standing for - ‘Reduce (LiftOf zq) zq’ - Where: ‘zq’ is a rigid type variable bound by + • Found extra-constraints wildcard standing for ‘Reduce z zq’ + Where: ‘z’, ‘zq’ are rigid type variables bound by the inferred type of - bench_mulPublic :: (z ~ LiftOf zq, Reduce (LiftOf zq) zq) => + bench_mulPublic :: (z ~ LiftOf zq, Reduce z zq) => Cyc zp -> Cyc z -> IO (zp, zq) - at T14715.hs:13:32-33 + at T14715.hs:13:27-33 • In the type signature: - bench_mulPublic :: forall z zp zq. - (z ~ LiftOf zq, _) => Cyc zp -> Cyc z -> IO (zp, zq) + bench_mulPublic :: forall z zp zq. (z ~ LiftOf zq, _) => + Cyc zp -> Cyc z -> IO (zp, zq) ===================================== testsuite/tests/partial-sigs/should_fail/ScopedNamedWildcardsBad.stderr ===================================== @@ -1,6 +1,11 @@ -ScopedNamedWildcardsBad.hs:8:21: error: +ScopedNamedWildcardsBad.hs:11:15: error: • Couldn't match expected type ‘Bool’ with actual type ‘Char’ - • In the first argument of ‘not’, namely ‘x’ - In the expression: not x - In an equation for ‘v’: v = not x + • In the first argument of ‘g’, namely ‘'x'’ + In the expression: g 'x' + In the expression: + let + v = not x + g :: _a -> _a + g x = x + in (g 'x') ===================================== testsuite/tests/typecheck/should_fail/ExpandSynsFail2.stderr ===================================== @@ -1,6 +1,6 @@ ExpandSynsFail2.hs:19:37: error: - • Couldn't match type ‘Int’ with ‘Bool’ + • Couldn't match type ‘Bool’ with ‘Int’ Expected: ST s Foo Actual: MyBarST s Type synonyms expanded: ===================================== testsuite/tests/typecheck/should_fail/T7453.stderr ===================================== @@ -1,6 +1,8 @@ -T7453.hs:10:30: error: - • Couldn't match expected type ‘t’ with actual type ‘p’ +T7453.hs:9:15: error: + • Couldn't match type ‘t’ with ‘p’ + Expected: Id t + Actual: Id p ‘t’ is a rigid type variable bound by the type signature for: z :: forall t. Id t @@ -8,17 +10,29 @@ T7453.hs:10:30: error: ‘p’ is a rigid type variable bound by the inferred type of cast1 :: p -> a at T7453.hs:(7,1)-(10,30) - • In the first argument of ‘Id’, namely ‘v’ - In the expression: Id v - In an equation for ‘aux’: aux = Id v + • In the expression: aux + In an equation for ‘z’: + z = aux + where + aux = Id v + In an equation for ‘cast1’: + cast1 v + = runId z + where + z :: Id t + z = aux + where + aux = Id v • Relevant bindings include - aux :: Id t (bound at T7453.hs:10:21) + aux :: Id p (bound at T7453.hs:10:21) z :: Id t (bound at T7453.hs:9:11) v :: p (bound at T7453.hs:7:7) cast1 :: p -> a (bound at T7453.hs:7:1) -T7453.hs:16:33: error: - • Couldn't match expected type ‘t1’ with actual type ‘p’ +T7453.hs:15:15: error: + • Couldn't match type ‘t1’ with ‘p’ + Expected: () -> t1 + Actual: () -> p ‘t1’ is a rigid type variable bound by the type signature for: z :: forall t1. () -> t1 @@ -26,11 +40,21 @@ T7453.hs:16:33: error: ‘p’ is a rigid type variable bound by the inferred type of cast2 :: p -> t at T7453.hs:(13,1)-(16,33) - • In the first argument of ‘const’, namely ‘v’ - In the expression: const v - In an equation for ‘aux’: aux = const v + • In the expression: aux + In an equation for ‘z’: + z = aux + where + aux = const v + In an equation for ‘cast2’: + cast2 v + = z () + where + z :: () -> t + z = aux + where + aux = const v • Relevant bindings include - aux :: b -> t1 (bound at T7453.hs:16:21) + aux :: forall {b}. b -> p (bound at T7453.hs:16:21) z :: () -> t1 (bound at T7453.hs:15:11) v :: p (bound at T7453.hs:13:7) cast2 :: p -> t (bound at T7453.hs:13:1) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2aa777bf02e48255b7fc482b58505e60fbd843a6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2aa777bf02e48255b7fc482b58505e60fbd843a6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 16 15:42:26 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Wed, 16 Dec 2020 10:42:26 -0500 Subject: [Git][ghc/ghc][wip/nested-cpr-2019] 297 commits: Implement -Woperator-whitespace (#18834) Message-ID: <5fda2ae242a70_6b21725db8418726b3@gitlab.mail> Sebastian Graf pushed to branch wip/nested-cpr-2019 at Glasgow Haskell Compiler / GHC Commits: b5b3e34e by Vladislav Zavialov at 2020-10-19T18:16:20-04:00 Implement -Woperator-whitespace (#18834) This patch implements two related warnings: -Woperator-whitespace-ext-conflict warns on uses of infix operators that would be parsed differently were a particular GHC extension enabled -Woperator-whitespace warns on prefix, suffix, and tight infix uses of infix operators Updates submodules: haddock, containers. - - - - - 9648d680 by Sylvain Henry at 2020-10-19T18:16:58-04:00 Remove pdocPrec pdocPrec was only used in GHC.Cmm.DebugBlock.pprUnwindExpr, so remove it. OutputableP becomes a one-function class which might be better for performance. - - - - - ee5dcdf9 by Ben Gamari at 2020-10-20T00:47:54-04:00 testsuite: Add test for #18346 This was fixed by 4291bddaea3148908c55f235ee8978e1d9aa6f20. - - - - - 6c7a5c0c by Krzysztof Gogolewski at 2020-10-20T00:48:29-04:00 Minor comments, update linear types docs - Update comments: placeHolderTypeTc no longer exists "another level check problem" was a temporary comment from linear types - Use Mult type synonym (reported in #18676) - Mention multiplicity-polymorphic fields in linear types docs - - - - - 58a1ca38 by nineonine at 2020-10-20T00:49:07-04:00 Compile modules with `-fobject-code` enabled to byte-code when loaded with `*` prefix in ghci (#8042) The documentation states that when using :add and :load, the `*` prefix forces a module to be loaded as byte-code. However, this seems to be ignored when -fobject-code has been enabled. In that case, the compiled code is always used, regardless of whether the *-form is used. The idea is to consult the Targets in HscEnv and check the 'targetAllowObjCode' flag. If the flag for given module is set, then patch up DynFlags and select compilation backend accordingly. This would require a linear scan of course, but that shouldn't be too costly. - - - - - 59b08a5d by Ben Gamari at 2020-10-20T00:49:41-04:00 gitlab-ci: Rename FLAVOUR -> BUILD_FLAVOUR Previously the Hadrian jobs used the `FLAVOUR` environment variable to communicate which flavour `ci.sh` should build whereas `make` used `BUILD_FLAVOUR`. This caused unnecessary confusion. Consolidate these two. - - - - - ea736839 by Alan Zimmerman at 2020-10-20T08:35:34+01:00 API Annotations: Keep track of unicode for linear arrow notation The linear arrow can be parsed as `%1 ->` or a direct single token unicode equivalent. Make sure that this distinction is captured in the parsed AST by using IsUnicodeSyntax where it appears, and introduce a new API Annotation, AnnMult to represent its location when unicode is not used. Updated haddock submodule - - - - - cf3c3bcd by Ben Gamari at 2020-10-20T22:56:31-04:00 testsuite: Mark T12971 as fragile on Windows Due to #17945. - - - - - e2c4a947 by Vladislav Zavialov at 2020-10-21T16:00:30+03:00 Parser regression tests, close #12862 #12446 These issues were fixed by earlier parser changes, most likely related to whitespace-sensitive parsing. - - - - - 711929e6 by Simon Peyton Jones at 2020-10-23T02:42:59-04:00 Fix error message location in tcCheckPatSynDecl Ticket #18856 showed that we were failing to set the right location for an error message. Easy to fix, happily. Turns out that this also improves the error location in test T11010, which was bogus before but we had never noticed. - - - - - 730bb590 by Ben Gamari at 2020-10-23T02:43:33-04:00 cmm: Add Note reference to ForeignHint - - - - - b9d4dd9c by Ben Gamari at 2020-10-24T20:44:17-04:00 SMP.h: Add C11-style atomic operations - - - - - ccf2d4b0 by Ben Gamari at 2020-10-24T20:59:39-04:00 rts: Infrastructure for testing with ThreadSanitizer - - - - - a61f66d6 by Ben Gamari at 2020-10-24T20:59:39-04:00 rts/CNF: Initialize all bdescrs in group It seems wise and cheap to ensure that the whole bdescr of all blocks of a compact group is valid, even if most cases only look at the flags field. - - - - - 65136c13 by Ben Gamari at 2020-10-24T20:59:39-04:00 rts/Capability: Intialize interrupt field Previously this was left uninitialized. Also clarify some comments. - - - - - b3ce6aca by Ben Gamari at 2020-10-24T20:59:39-04:00 rts/Task: Make comments proper Notes - - - - - d3890ac7 by Ben Gamari at 2020-10-24T20:59:39-04:00 rts/SpinLock: Move to proper atomics This is fairly straightforward; we just needed to use relaxed operations for the PROF_SPIN counters and a release store instead of a write barrier. - - - - - ef88712f by Ben Gamari at 2020-10-24T20:59:39-04:00 rts/OSThreads: Fix data race Previously we would race on the cached processor count. Avoiding this is straightforward; just use relaxed operations. - - - - - 33a719c3 by Ben Gamari at 2020-10-24T20:59:39-04:00 rts/ClosureMaros: Use relaxed atomics - - - - - f08951fd by Ben Gamari at 2020-10-24T20:59:39-04:00 configure: Bump minimum-supported gcc version to 4.7 Since the __atomic_* builtins are not supported until gcc 4.7. Given that this version was released in 2012 I think this is acceptable. - - - - - d584923a by Ben Gamari at 2020-10-24T20:59:39-04:00 testsuite: Fix thread leak in hs_try_putmvar00[13] - - - - - bf1b0bc7 by Ben Gamari at 2020-10-24T20:59:39-04:00 rts: Introduce SET_HDR_RELEASE Also ensure that we also store the info table pointer last to ensure that the synchronization covers all stores. - - - - - 1a2e9f5e by Ben Gamari at 2020-10-24T21:00:19-04:00 gitlab-ci: Add nightly-x86_64-linux-deb9-tsan job - - - - - 58a5b0e5 by GHC GitLab CI at 2020-10-24T21:00:19-04:00 testsuite: Mark setnumcapabilities001 as broken with TSAN Due to #18808. - - - - - d9bc7dea by GHC GitLab CI at 2020-10-24T21:00:19-04:00 testsuite: Skip divbyzero and derefnull under TSAN ThreadSanitizer changes the output of these tests. - - - - - fcc42a10 by Ben Gamari at 2020-10-24T21:00:19-04:00 testsuite: Skip high memory usage tests with TSAN ThreadSanitizer significantly increases the memory footprint of tests, so much so that it can send machines into OOM. - - - - - cae4bb3e by Ben Gamari at 2020-10-24T21:00:19-04:00 testsuite: Mark hie002 as high_memory_usage This test has a peak residency of 1GByte; this is large enough to classify as "high" in my book. - - - - - dae1b86a by Ben Gamari at 2020-10-24T21:00:19-04:00 testsuite: Mark T9872[abc] as high_memory_usage These all have a maximum residency of over 2 GB. - - - - - c5a0bb22 by Ben Gamari at 2020-10-24T21:00:19-04:00 gitlab-ci: Disable documentation in TSAN build Haddock chews through enough memory to cause the CI builders to OOM and there's frankly no reason to build documentation in this job anyways. - - - - - 4cb1232e by Ben Gamari at 2020-10-24T21:00:19-04:00 TSANUtils: Ensure that C11 atomics are supported - - - - - 7ed15f7f by Ben Gamari at 2020-10-24T21:00:19-04:00 testsuite: Mark T3807 as broken with TSAN Due to #18883. - - - - - f7e6f012 by Ben Gamari at 2020-10-24T21:00:19-04:00 testsuite: Mark T13702 as broken with TSAN due to #18884 - - - - - 16b136b0 by Ben Gamari at 2020-10-24T21:00:36-04:00 rts: Factor out logic to identify a good capability for running a task Not only does this make the control flow a bit clearer but it also allows us to add a TSAN suppression on this logic, which requires (harmless) data races. - - - - - 2781d68c by Ben Gamari at 2020-10-24T21:00:36-04:00 rts: Annotate benign race in waitForCapability - - - - - f6b4b492 by Ben Gamari at 2020-10-24T21:00:36-04:00 rts: Clarify locking behavior of releaseCapability_ - - - - - 65219810 by Ben Gamari at 2020-10-24T21:00:36-04:00 rts: Add assertions for task ownership of capabilities - - - - - 31fa87ec by Ben Gamari at 2020-10-24T21:00:36-04:00 rts: Use relaxed atomics on n_returning_tasks This mitigates the warning of a benign race on n_returning_tasks in shouldYieldCapability. See #17261. - - - - - 6517a2ea by Ben Gamari at 2020-10-24T21:00:36-04:00 rts: Mitigate races in capability interruption logic - - - - - 2e9ba3f2 by Ben Gamari at 2020-10-24T21:00:36-04:00 rts/Capability: Use relaxed operations for last_free_capability - - - - - e10dde37 by Ben Gamari at 2020-10-24T21:00:37-04:00 rts: Use relaxed operations for cap->running_task (TODO) This shouldn't be necessary since only the owning thread of the capability should be touching this. - - - - - 855325cd by Ben Gamari at 2020-10-24T21:00:37-04:00 rts/Schedule: Use relaxed operations for sched_state - - - - - 811f915d by Ben Gamari at 2020-10-24T21:00:37-04:00 rts: Accept data race in work-stealing implementation This race is okay since the task is owned by the capability pushing it. By Note [Ownership of Task] this means that the capability is free to write to `task->cap` without taking `task->lock`. Fixes #17276. - - - - - 8d2b3c3d by Ben Gamari at 2020-10-24T21:00:37-04:00 rts: Eliminate data races on pending_sync - - - - - f8871018 by Ben Gamari at 2020-10-24T21:00:37-04:00 rts/Schedule: Eliminate data races on recent_activity We cannot safely use relaxed atomics here. - - - - - d079b943 by Ben Gamari at 2020-10-24T21:00:37-04:00 rts: Avoid data races in message handling - - - - - 06f80497 by Ben Gamari at 2020-10-24T21:00:37-04:00 rts/Messages: Drop incredibly fishy write barrier executeMessage previously had a write barrier at the beginning of its loop apparently in an attempt to synchronize with another thread's writes to the Message. I would guess that the author had intended to use a load barrier here given that there are no globally-visible writes done in executeMessage. I've removed the redundant barrier since the necessary load barrier is now provided by the ACQUIRE_LOAD. - - - - - d4a87779 by Ben Gamari at 2020-10-24T21:00:38-04:00 rts/ThreadPaused: Avoid data races - - - - - 56778ab3 by Ben Gamari at 2020-10-24T21:00:38-04:00 rts/Schedule: Eliminate data races in run queue management - - - - - 086521f7 by Ben Gamari at 2020-10-24T21:00:38-04:00 rts: Eliminate shutdown data race on task counters - - - - - abad9778 by Ben Gamari at 2020-10-24T21:00:38-04:00 rts/Threads: Avoid data races (TODO) Replace barriers with appropriate ordering. Drop redundant barrier in tryWakeupThread (the RELEASE barrier will be provided by sendMessage's mutex release). We use relaxed operations on why_blocked and the stack although it's not clear to me why this is necessary. - - - - - 2f56be8a by Ben Gamari at 2020-10-24T21:00:39-04:00 rts/Messages: Annotate benign race - - - - - 7c0cdab1 by Ben Gamari at 2020-10-24T21:00:39-04:00 rts/RaiseAsync: Synchronize what_next read - - - - - 6cc2a8a5 by Ben Gamari at 2020-10-24T21:00:39-04:00 rts/Task: Move debugTrace to avoid data race Specifically, we need to hold all_tasks_mutex to read taskCount. - - - - - bbaec97d by Ben Gamari at 2020-10-24T21:00:39-04:00 Disable flawed assertion - - - - - dd175a92 by Ben Gamari at 2020-10-24T21:00:39-04:00 Document schedulePushWork race - - - - - 3416244b by Ben Gamari at 2020-10-24T21:00:40-04:00 Capabiliity: Properly fix data race on n_returning_tasks There is a real data race but can be made safe by using proper atomic (but relaxed) accesses. - - - - - dffd9432 by Ben Gamari at 2020-10-24T21:00:40-04:00 rts: Make write of to_cap->inbox atomic This is necessary since emptyInbox may read from to_cap->inbox without taking cap->lock. - - - - - 1f4cbc29 by Ben Gamari at 2020-10-24T21:00:57-04:00 rts/BlockAlloc: Use relaxed operations - - - - - d0d07cff by Ben Gamari at 2020-10-24T21:00:57-04:00 rts: Rework handling of mutlist scavenging statistics - - - - - 9e5c7f6d by Ben Gamari at 2020-10-24T21:00:57-04:00 rts: Avoid data races in StablePtr implementation This fixes two potentially problematic data races in the StablePtr implementation: * We would fail to RELEASE the stable pointer table when enlarging it, causing other cores to potentially see uninitialized memory. * We would fail to ACQUIRE when dereferencing a stable pointer. - - - - - 316add67 by Ben Gamari at 2020-10-24T21:00:57-04:00 rts/Storage: Use atomics - - - - - 5c23bc4c by Ben Gamari at 2020-10-24T21:00:58-04:00 rts/Updates: Use proper atomic operations - - - - - 3d0f033c by Ben Gamari at 2020-10-24T21:00:58-04:00 rts/Weak: Eliminate data races By taking all_tasks_mutex in stat_exit. Also better-document the fact that the task statistics are protected by all_tasks_mutex. - - - - - edb4b92b by Ben Gamari at 2020-10-24T21:01:18-04:00 rts/WSDeque: Rewrite with proper atomics After a few attempts at shoring up the previous implementation, I ended up turning to the literature and now use the proven implementation, > N.M. Lê, A. Pop, A.Cohen, and F.Z. Nardelli. "Correct and Efficient > Work-Stealing for Weak Memory Models". PPoPP'13, February 2013, > ACM 978-1-4503-1922/13/02. Note only is this approach formally proven correct under C11 semantics but it is also proved to be a bit faster in practice. - - - - - d39bbd3d by Ben Gamari at 2020-10-24T21:01:33-04:00 rts: Use relaxed atomics for whitehole spin stats - - - - - 8f802f38 by Ben Gamari at 2020-10-24T21:01:33-04:00 rts: Avoid lock order inversion during fork Fixes #17275. - - - - - cef667b0 by GHC GitLab CI at 2020-10-24T21:01:34-04:00 rts: Use proper relaxe operations in getCurrentThreadCPUTime Here we are doing lazy initialization; it's okay if we do the check more than once, hence relaxed operation is fine. - - - - - 8cf50eb1 by Ben Gamari at 2020-10-24T21:01:54-04:00 rts/STM: Use atomics This fixes a potentially harmful race where we failed to synchronize before looking at a TVar's current_value. Also did a bit of refactoring to avoid abstract over management of max_commits. - - - - - 88a7ce38 by Ben Gamari at 2020-10-24T21:01:54-04:00 rts/stm: Strengthen orderings to SEQ_CST instead of volatile Previously the `current_value`, `first_watch_queue_entry`, and `num_updates` fields of `StgTVar` were marked as `volatile` in an attempt to provide strong ordering. Of course, this isn't sufficient. We now use proper atomic operations. In most of these cases I strengthen the ordering all the way to SEQ_CST although it's possible that some could be weakened with some thought. - - - - - f97c59ce by Ben Gamari at 2020-10-24T21:02:11-04:00 Mitigate data races in event manager startup/shutdown - - - - - c7c3f8aa by Ben Gamari at 2020-10-24T21:02:22-04:00 rts: Accept benign races in Proftimer - - - - - 5a98dfca by Ben Gamari at 2020-10-24T21:02:22-04:00 rts: Pause timer while changing capability count This avoids #17289. - - - - - 01d95525 by Ben Gamari at 2020-10-24T21:02:22-04:00 Fix #17289 - - - - - 9a528985 by Ben Gamari at 2020-10-24T21:02:23-04:00 suppress #17289 (ticker) race - - - - - 1726ec41 by Ben Gamari at 2020-10-24T21:02:23-04:00 rts: Fix timer initialization Previously `initScheduler` would attempt to pause the ticker and in so doing acquire the ticker mutex. However, initTicker, which is responsible for initializing said mutex, hadn't been called yet. - - - - - bfbe4366 by Ben Gamari at 2020-10-24T21:02:23-04:00 rts: Fix races in Pthread timer backend shudown We can generally be pretty relaxed in the barriers here since the timer thread is a loop. - - - - - 297acc71 by Ben Gamari at 2020-10-24T21:02:44-04:00 rts/Stats: Hide a few unused unnecessarily global functions - - - - - 9ad51bc9 by David Beacham at 2020-10-27T13:59:35-04:00 Fix `instance Bounded a => Bounded (Down a)` (#18716) * Flip `minBound` and `maxBound` to respect the change in ordering * Remove awkward `Enum` (and hence `Integral`) instances for `Data.Ord.Down` * Update changelog - - - - - eedec53d by Vladislav Zavialov at 2020-10-27T14:00:11-04:00 Version bump: base-4.16 (#18712) Also bumps upper bounds on base in boot libraries (incl. submodules). - - - - - 412018c1 by Tamar Christina at 2020-10-27T14:00:49-04:00 winio: simplify logic remove optimization step. - - - - - 4950dd07 by Ben Gamari at 2020-10-27T14:01:24-04:00 hadrian: Suppress xelatex output unless it fails As noted in #18835, xelatex produces an absurd amount of output, nearly all of which is meaningless. Silence this. Fixes #18835. - - - - - f3d8ab2e by Ben Gamari at 2020-10-27T14:02:00-04:00 build system: Clean mingw tarballs Tamar noticed in !4293 that the build systems fail to clean up the mingw tarballs directory (`ghc-tarballs`). Fix this in both the make build system and Hadrian. - - - - - 0b3d23af by Simon Peyton Jones at 2020-10-27T14:02:34-04:00 Fix two constraint solving problems This patch fixes two problems in the constraint solver. * An actual bug #18555: we were floating out a constraint to eagerly, and that was ultimately fatal. It's explained in Note [Do not float blocked constraints] in GHC.Core.Constraint. This is all very delicate, but it's all going to become irrelevant when we stop floating constraints (#17656). * A major performance infelicity in the flattener. When flattening (ty |> co) we *never* generated Refl, even when there was nothing at all to do. Result: we would gratuitously rewrite the constraint to exactly the same thing, wasting work. Described in #18413, and came up again in #18855. Solution: exploit the special case by calling the new function castCoercionKind1. See Note [castCoercionKind1] in GHC.Core.Coercion - - - - - f76c5a08 by Sergei Trofimovich at 2020-10-27T14:03:14-04:00 ghc.mk: amend 'make sdist' Noticed 'make sdist' failure seen as: ``` "rm" -rf sdistprep/ghc/ghc-9.1.0.20201020/hadrian/_build/ (SRC_DIST_GHC_DIR)/hadrian/dist-newstyle/ /bin/sh: -c: line 0: syntax error near unexpected token `(' ``` commit 9657f6f34 ("sdist: Include hadrian sources in source distribution") added a new cleanup path without a variable expantion. The change adds variable reference. While at it move directory cleanup to a separate statement. Amends #18794 Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - 78b52c88 by David Eichmann at 2020-10-27T14:03:51-04:00 Use config.run_ways for multi_compile_and_run tests - - - - - e3fdd419 by Alan Zimmerman at 2020-10-27T14:04:26-04:00 Api Annotations: Introduce AnnPercent for HsExplicitMult For the case foo :: a %p -> b The location of the '%' is captured, separate from the 'p' - - - - - d2a25f42 by Ben Gamari at 2020-10-27T14:05:02-04:00 gitlab-ci: Bump ci-images Bumps bootstrap compiler to 8.10.1. - - - - - 28f98b01 by Sebastian Graf at 2020-10-27T14:05:37-04:00 DmdAnal: Kill `is_thunk` case in `splitFV` The `splitFV` function implements the highly dubious hack described in `Note [Lazy und unleashable free variables]` in GHC.Core.Opt.DmdAnal. It arranges it so that demand signatures only carry strictness info on free variables. Usage info is released through other means, see the Note. It's purely for analysis performance reasons. It turns out that `splitFV` has a quite involved case for thunks that produces slightly different usage signatures and it's not clear why we need it: `splitFV` is only relevant in the LetDown case and the only time we call it on thunks is for top-level or local recursive thunks. Since usage signatures of top-level thunks can only reference other top-level bindings and we completely discard demand info we have on top-level things (see the lack of `setIdDemandInfo` in `dmdAnalTopBind`), the `is_thunk` case is completely irrelevant here. For local, recursive thunks, the added benefit of the `is_thunk` test is marginal: We get used-multiple-times in some cases where previously we had used-once if a recursive thunk has multiple call sites. It's very unlikely and not a case to optimise for. So we kill the `is_thunk` case and inline `splitFV` at its call site, exposing `isWeakDmd` from `GHC.Types.Demand` instead. The NoFib summary supports this decision: ``` Min 0.0% -0.0% Max 0.0% +0.0% Geometric Mean -0.0% -0.0% ``` - - - - - 60322f93 by Ben Gamari at 2020-10-28T21:11:39-04:00 hadrian: Don't quote metric baseline argument Previously this was quoted inappropriately. - - - - - c85eb372 by Alan Zimmerman at 2020-10-28T21:12:15-04:00 API Annotations: put constructors in alphabetical order - - - - - 795908dc by John Ericson at 2020-10-29T03:53:14-04:00 Widen acceptance threshold for T10421a Progress towards #18842. As @sgraf812 points out, widening the window is dangerous until the exponential described in #17658 is fixed. But this test has caused enough misery and is low stakes enough that we and @bgamari think it's worth it in this one case for the time being. - - - - - 0e9f6def by Sylvain Henry at 2020-10-29T03:53:52-04:00 Split GHC.Driver.Types I was working on making DynFlags stateless (#17957), especially by storing loaded plugins into HscEnv instead of DynFlags. It turned out to be complicated because HscEnv is in GHC.Driver.Types but LoadedPlugin isn't: it is in GHC.Driver.Plugins which depends on GHC.Driver.Types. I didn't feel like introducing yet another hs-boot file to break the loop. Additionally I remember that while we introduced the module hierarchy (#13009) we talked about splitting GHC.Driver.Types because it contained various unrelated types and functions, but we never executed. I didn't feel like making GHC.Driver.Types bigger with more unrelated Plugins related types, so finally I bit the bullet and split GHC.Driver.Types. As a consequence this patch moves a lot of things. I've tried to put them into appropriate modules but nothing is set in stone. Several other things moved to avoid loops. * Removed Binary instances from GHC.Utils.Binary for random compiler things * Moved Typeable Binary instances into GHC.Utils.Binary.Typeable: they import a lot of things that users of GHC.Utils.Binary don't want to depend on. * put everything related to Units/Modules under GHC.Unit: GHC.Unit.Finder, GHC.Unit.Module.{ModGuts,ModIface,Deps,etc.} * Created several modules under GHC.Types: GHC.Types.Fixity, SourceText, etc. * Split GHC.Utils.Error (into GHC.Types.Error) * Finally removed GHC.Driver.Types Note that this patch doesn't put loaded plugins into HscEnv. It's left for another patch. Bump haddock submodule - - - - - 22f5d9a9 by Sylvain Henry at 2020-10-29T03:53:52-04:00 GC: Avoid data race (#18717, #17964) - - - - - 2ef2fac4 by Ryan Scott at 2020-10-29T04:18:52-04:00 Check for large tuples more thoroughly This fixes #18723 by: * Moving the existing `GHC.Tc.Gen.HsType.bigConstraintTuple` validity check to `GHC.Rename.Utils.checkCTupSize` for consistency with `GHC.Rename.Utils.checkTupSize`, and * Using `check(C)TupSize` when checking tuple _types_, in addition to checking names, expressions, and patterns. Note that I put as many of these checks as possible in the typechecker so that GHC can properly distinguish between boxed and constraint tuples. The exception to this rule is checking names, which I perform in the renamer (in `GHC.Rename.Env`) so that we can rule out `(,, ... ,,)` and `''(,, ... ,,)` alike in one fell swoop. While I was in town, I also removed the `HsConstraintTuple` and `HsBoxedTuple` constructors of `HsTupleSort`, which are functionally unused. This requires a `haddock` submodule bump. - - - - - 7f8be3eb by Richard Eisenberg at 2020-10-29T22:08:13-04:00 Remove unnecessary gender from comments/docs While, say, alternating "he" and "she" in sequential writing may be nicer than always using "they", reading code/documentation is almost never sequential. If this small change makes individuals feel more welcome in GHC's codebase, that's a good thing. - - - - - aad1f803 by Ben Gamari at 2020-10-30T00:41:14-04:00 rts/GC: Use atomics - - - - - d0bc0517 by Ben Gamari at 2020-10-30T00:41:14-04:00 rts: Use RELEASE ordering in unlockClosure - - - - - d44f5232 by Ben Gamari at 2020-10-30T00:41:14-04:00 rts/Storage: Accept races on heap size counters - - - - - 4e4a7386 by Ben Gamari at 2020-10-30T00:41:14-04:00 rts: Join to concurrent mark thread during shutdown Previously we would take all capabilities but fail to join on the thread itself, potentially resulting in a leaked thread. - - - - - a80cc857 by GHC GitLab CI at 2020-10-30T00:41:14-04:00 rts: Fix race in GC CPU time accounting Ensure that the GC leader synchronizes with workers before calling stat_endGC. - - - - - 9902d9ec by Viktor Dukhovni at 2020-10-30T05:28:30-04:00 [skip ci] Fix typo in `callocBytes` haddock. - - - - - 105d43db by Ben Gamari at 2020-10-30T14:02:19-04:00 rts/SpinLock: Separate out slow path Not only is this in general a good idea, but it turns out that GCC unrolls the retry loop, resulting is massive code bloat in critical parts of the RTS (e.g. `evacuate`). - - - - - f7b45cde by Ben Gamari at 2020-10-30T14:02:19-04:00 rts: Use relaxed ordering on spinlock counters - - - - - 31fcb55f by Ryan Scott at 2020-10-30T18:52:50-04:00 Split HsConDecl{H98,GADT}Details Haskell98 and GADT constructors both use `HsConDeclDetails`, which includes `InfixCon`. But `InfixCon` is never used for GADT constructors, which results in an awkward unrepresentable state. This removes the unrepresentable state by: * Renaming the existing `HsConDeclDetails` synonym to `HsConDeclH98Details`, which emphasizes the fact that it is now only used for Haskell98-style data constructors, and * Creating a new `HsConDeclGADTDetails` data type with `PrefixConGADT` and `RecConGADT` constructors that closely resemble `PrefixCon` and `InfixCon` in `HsConDeclH98Details`. The key difference is that `HsConDeclGADTDetails` lacks any way to represent infix constructors. The rest of the patch is refactoring to accommodate the new structure of `HsConDecl{H98,GADT}Details`. Some highlights: * The `getConArgs` and `hsConDeclArgTys` functions have been removed, as there is no way to implement these functions uniformly for all `ConDecl`s. For the most part, their previous call sites now pattern match on the `ConDecl`s directly and do different things for `ConDeclH98`s and `ConDeclGADT`s. I did introduce one new function to make the transition easier: `getRecConArgs_maybe`, which extracts the arguments from a `RecCon(GADT)`. This is still possible since `RecCon(GADT)`s still use the same representation in both `HsConDeclH98Details` and `HsConDeclGADTDetails`, and since the pattern that `getRecConArgs_maybe` implements is used in several places, I thought it worthwhile to factor it out into its own function. * Previously, the `con_args` fields in `ConDeclH98` and `ConDeclGADT` were both of type `HsConDeclDetails`. Now, the former is of type `HsConDeclH98Details`, and the latter is of type `HsConDeclGADTDetails`, which are distinct types. As a result, I had to rename the `con_args` field in `ConDeclGADT` to `con_g_args` to make it typecheck. A consequence of all this is that the `con_args` field is now partial, so using `con_args` as a top-level field selector is dangerous. (Indeed, Haddock was using `con_args` at the top-level, which caused it to crash at runtime before I noticed what was wrong!) I decided to add a disclaimer in the 9.2.1 release notes to advertise this pitfall. Fixes #18844. Bumps the `haddock` submodule. - - - - - 57c3db96 by Ryan Scott at 2020-10-31T02:53:55-04:00 Make typechecker equality consider visibility in ForAllTys Previously, `can_eq_nc'` would equate `ForAllTy`s regardless of their `ArgFlag`, including `forall i -> i -> Type` and `forall i. i -> Type`! To fix this, `can_eq_nc'` now uses the `sameVis` function to first check if the `ArgFlag`s are equal modulo specificity. I have also updated `tcEqType`'s implementation to match this behavior. For more explanation on the "modulo specificity" part, see the new `Note [ForAllTy and typechecker equality]` in `GHC.Tc.Solver.Canonical`. While I was in town, I fixed some related documentation issues: * I added `Note [Typechecker equality]` to `GHC.Tc.Utils.TcType` to describe what exactly distinguishes `can_eq_nc'` and `tcEqType` (which implement typechecker equality) from `eqType` (which implements definitional equality, which does not care about the `ArgFlags` of `ForAllTy`s at all). * The User's Guide had some outdated prose on the specified/inferred distinction being different for types and kinds, a holdover from #15079. This is no longer the case on today's GHC, so I removed this prose, added some new prose to take its place, and added a regression test for the programs in #15079. * The User's Guide had some _more_ outdated prose on inferred type variables not being allowed in `default` type signatures for class methods, which is no longer true as of the resolution of #18432. * The related `Note [Deferred Unification]` was being referenced as `Note [Deferred unification]` elsewhere, which made it harder to `grep` for. I decided to change the name of the Note to `Deferred unification` for consistency with the capitalization style used for most other Notes. Fixes #18863. - - - - - a98593f0 by Sylvain Henry at 2020-10-31T02:54:34-04:00 Refactor numeric constant folding rules Avoid the use of global pattern synonyms. 1) I think it's going to be helpful to implement constant folding for other numeric types, especially Natural which doesn't have a wrapping behavior. We'll have to refactor these rules even more so we'd better make them less cryptic. 2) It should also be slightly faster because global pattern synonyms matched operations for every numeric types instead of the current one: e.g., ":**:" pattern was matching multiplication for both Int# and Word# types. As we will probably want to implement constant folding for other numeric types (Int8#, Int16#, etc.), it is more efficient to only match primops for a given type as we do now. - - - - - 730ef38f by Sylvain Henry at 2020-10-31T02:54:34-04:00 Simplify constant-folding (#18032) See #18032 for the details. * Use `Lit (LitNumber _ i)` instead of `isLitValue_maybe` which does more work but that is not needed for constant-folding * Don't export `GHC.Types.Literal.isLitValue_maybe` * Kill `GHC.Types.Literal.isLitValue` which isn't used - - - - - d5a53c1a by Ben Gamari at 2020-10-31T02:55:10-04:00 primops.txt.pp: Move ByteArray# primops to separate file This file will be generated. - - - - - b4278a41 by Ben Gamari at 2020-10-31T02:55:10-04:00 primops: Generate ByteArray# index/read/write primops Previously these were mostly undocumented and was ripe for potential inconsistencies. - - - - - 08e6993a by Sylvain Henry at 2020-10-31T02:55:50-04:00 Move loadDecl into IfaceToCore - - - - - cb1f755c by Tamar Christina at 2020-10-31T09:26:56-04:00 winio: Fix unused variables warnings - - - - - eb368078 by Andrzej Rybczak at 2020-10-31T09:27:34-04:00 Add testcase for #816 - - - - - bd4abdc9 by Ben Gamari at 2020-11-01T01:10:31-04:00 testsuite: Add performance test for #18698 - - - - - dfd27445 by Hécate at 2020-11-01T01:11:09-04:00 Add the proper HLint rules and remove redundant keywords from compiler - - - - - ce1bb995 by Hécate at 2020-11-01T08:52:08-05:00 Fix a leak in `transpose` This patch was authored by David Feuer <david.feuer at gmail.com> - - - - - e63db32c by Ben Gamari at 2020-11-01T08:52:44-05:00 Scav: Use bd->gen_no instead of bd->gen->no This potentially saves a cache miss per scavenge. - - - - - b1dda153 by Ben Gamari at 2020-11-01T12:58:36-05:00 rts/Stats: Protect with mutex While on face value this seems a bit heavy, I think it's far better than enforcing ordering on every access. - - - - - 5c2e6bce by Ben Gamari at 2020-11-01T12:58:36-05:00 rts: Tear down stats_mutex after exitHeapProfiling Since the latter wants to call getRTSStats. - - - - - ef25aaa1 by Ben Gamari at 2020-11-01T13:02:11-05:00 rts: Annotate hopefully "benign" races in freeGroup - - - - - 3a181553 by Ben Gamari at 2020-11-01T13:02:18-05:00 Strengthen ordering in releaseGCThreads - - - - - af474f62 by Ben Gamari at 2020-11-01T13:05:38-05:00 Suppress data race due to close This suppresses the other side of a race during shutdown. - - - - - b4686bff by Ben Gamari at 2020-11-01T13:09:59-05:00 Merge branch 'wip/tsan/ci' into wip/tsan/all - - - - - b8e66e0e by Ben Gamari at 2020-11-01T13:10:01-05:00 Merge branch 'wip/tsan/storage' into wip/tsan/all - - - - - 375512cf by Ben Gamari at 2020-11-01T13:10:02-05:00 Merge branch 'wip/tsan/wsdeque' into wip/tsan/all - - - - - 65ebf07e by Ben Gamari at 2020-11-01T13:10:03-05:00 Merge branch 'wip/tsan/misc' into wip/tsan/all - - - - - 55c375d0 by Ben Gamari at 2020-11-01T13:10:04-05:00 Merge branch 'wip/tsan/stm' into wip/tsan/all - - - - - a9f75fe2 by Ben Gamari at 2020-11-01T13:10:06-05:00 Merge branch 'wip/tsan/event-mgr' into wip/tsan/all - - - - - 8325d658 by Ben Gamari at 2020-11-01T13:10:24-05:00 Merge branch 'wip/tsan/timer' into wip/tsan/all - - - - - 07e82ba5 by Ben Gamari at 2020-11-01T13:10:35-05:00 Merge branch 'wip/tsan/stats' into wip/tsan/all - - - - - 4ce2f7d6 by GHC GitLab CI at 2020-11-02T23:45:06-05:00 testsuite: Add --top flag to driver This allows us to make `config.top` a proper Path. Previously it was a str, which caused the Ghostscript detection logic to break. - - - - - 0b772221 by Ben Gamari at 2020-11-02T23:45:42-05:00 Document that ccall convention doesn't support varargs We do not support foreign "C" imports of varargs functions. While this works on amd64, in general the platform's calling convention may need more type information that our Cmm representation can currently provide. For instance, this is the case with Darwin's AArch64 calling convention. Document this fact in the users guide and fix T5423 which makes use of a disallowed foreign import. Closes #18854. - - - - - 81006a06 by David Eichmann at 2020-11-02T23:46:19-05:00 RtsAPI: pause and resume the RTS The `rts_pause` and `rts_resume` functions have been added to `RtsAPI.h` and allow an external process to completely pause and resume the RTS. Co-authored-by: Sven Tennie <sven.tennie at gmail.com> Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> Co-authored-by: Ben Gamari <bgamari.foss at gmail.com> - - - - - bfb1e272 by Ryan Scott at 2020-11-02T23:46:55-05:00 Display results of GHC.Core.Lint.lint* functions consistently Previously, the functions in `GHC.Core.Lint` used a patchwork of different ways to display Core Lint errors: * `lintPassResult` (which is the source of most Core Lint errors) renders Core Lint errors with a distinctive banner (e.g., `*** Core Lint errors : in result of ... ***`) that sets them apart from ordinary GHC error messages. * `lintAxioms`, in contrast, uses a completely different code path that displays Core Lint errors in a rather confusing manner. For example, the program in #18770 would give these results: ``` Bug.hs:1:1: error: Bug.hs:12:1: warning: Non-*-like kind when *-like expected: RuntimeRep when checking the body of forall: 'TupleRep '[r] In the coercion axiom Bug.N:T :: []. Bug.T ~_R Any Substitution: [TCvSubst In scope: InScope {r} Type env: [axl :-> r] Co env: []] | 1 | {-# LANGUAGE DataKinds #-} | ^ ``` * Further digging reveals that `GHC.IfaceToCore` displays Core Lint errors for iface unfoldings as though they were a GHC panic. See, for example, this excerpt from #17723: ``` ghc: panic! (the 'impossible' happened) (GHC version 8.8.2 for x86_64-unknown-linux): Iface Lint failure In interface for Lib ... ``` This patch makes all of these code paths display Core Lint errors and warnings consistently. I decided to adopt the conventions that `lintPassResult` currently uses, as they appear to have been around the longest (and look the best, in my subjective opinion). We now use the `displayLintResult` function for all three scenarios mentioned above. For example, here is what the Core Lint error for the program in #18770 looks like after this patch: ``` [1 of 1] Compiling Bug ( Bug.hs, Bug.o ) *** Core Lint errors : in result of TcGblEnv axioms *** Bug.hs:12:1: warning: Non-*-like kind when *-like expected: RuntimeRep when checking the body of forall: 'TupleRep '[r_axn] In the coercion axiom N:T :: []. T ~_R Any Substitution: [TCvSubst In scope: InScope {r_axn} Type env: [axn :-> r_axn] Co env: []] *** Offending Program *** axiom N:T :: T = Any -- Defined at Bug.hs:12:1 *** End of Offense *** <no location info>: error: Compilation had errors ``` Fixes #18770. - - - - - a9e5f52c by Simon Peyton Jones at 2020-11-02T23:47:31-05:00 Expand type synonyms with :kind! The User's Guide claims that `:kind!` should expand type synonyms, but GHCi wasn't doing this in practice. Let's just update the implementation to match the specification in the User's Guide. Fixes #13795. Fixes #18828. Co-authored-by: Ryan Scott <ryan.gl.scott at gmail.com> - - - - - 1370eda7 by Ben Gamari at 2020-11-02T23:48:06-05:00 hadrian: Don't capture RunTest output There are a few reasons why capturing the output of the RunTest builder is undesirable: * there is a large amount of output which then gets unnecessarily duplicated by Hadrian if the builder fails * the output may contain codepoints which are unrepresentable in the current codepage on Windows, causing Hadrian to crash * capturing the output causes the testsuite driver to disable its colorisation logic, making the output less legible. - - - - - 78f2767d by Matthew Pickering at 2020-11-03T17:39:53-05:00 Update inlining flags documentation - - - - - 14ce454f by Sylvain Henry at 2020-11-03T17:40:34-05:00 Linker: reorganize linker related code Move linker related code into GHC.Linker. Previously it was scattered into GHC.Unit.State, GHC.Driver.Pipeline, GHC.Runtime.Linker, etc. Add documentation in GHC.Linker - - - - - 616bec0d by Alan Zimmerman at 2020-11-03T17:41:10-05:00 Restrict Linear arrow %1 to exactly literal 1 only This disallows `a %001 -> b`, and makes sure the type literal is printed from its SourceText so it is clear why. Closes #18888 - - - - - 3486ebe6 by Sylvain Henry at 2020-11-03T17:41:48-05:00 Hadrian: don't fail if ghc-tarballs dir doesn't exist - - - - - 37f0434d by Sylvain Henry at 2020-11-03T17:42:26-05:00 Constant-folding: don't pass through GHC's Int/Word (fix #11704) Constant-folding rules for integerToWord/integerToInt were performing the following coercions at compilation time: integerToWord: target's Integer -> ghc's Word -> target's Word integerToInt : target's Integer -> ghc's Int -> target's Int 1) It was wrong for cross-compilers when GHC's word size is smaller than the target one. This patch avoids passing through GHC's word-sized types: integerToWord: target's Integer -> ghc's Integer -> target's Word integerToInt : target's Integer -> ghc's Integer -> target's Int 2) Additionally we didn't wrap the target word/int literal to make it fit into the target's range! This broke the invariant of literals only containing values in range. The existing code is wrong only with a 64-bit cross-compiling GHC, targeting a 32-bit platform, and performing constant folding on a literal that doesn't fit in a 32-bit word. If GHC was built with DEBUG, the assertion in GHC.Types.Literal.mkLitWord would fail. Otherwise the bad transformation would go unnoticed. - - - - - bff74de7 by Sylvain Henry at 2020-11-03T17:43:03-05:00 Bignum: make GMP's bignat_add not recursive bignat_add was a loopbreaker with an INLINE pragma (spotted by @mpickering). This patch makes it non recursive to avoid the issue. - - - - - bb100805 by Andreas Klebinger at 2020-11-04T16:47:24-05:00 NCG: Fix 64bit int comparisons on 32bit x86 We no compare these by doing 64bit subtraction and checking the resulting flags. We used to do this differently but the old approach was broken when the high bits compared equal and the comparison was one of >= or <=. The new approach should be both correct and faster. - - - - - b790b7f9 by Andreas Klebinger at 2020-11-04T16:47:59-05:00 Testsuite: Support for user supplied package dbs We can now supply additional package dbs to the testsuite. For make the package db can be supplied by passing PACKAGE_DB=/path/to/db. In the testsuite driver it's passed via the --test-package-db argument. - - - - - 81560981 by Sylvain Henry at 2020-11-04T16:48:42-05:00 Don't use LEA with 8-bit registers (#18614) - - - - - 17d5c518 by Viktor Dukhovni at 2020-11-05T00:50:23-05:00 Naming, value types and tests for Addr# atomics The atomic Exchange and CAS operations on integral types are updated to take and return more natural `Word#` rather than `Int#` values. These are bit-block not arithmetic operations, and the sign bit plays no special role. Standardises the names to `atomic<OpType><ValType>Addr#`, where `OpType` is one of `Cas` or `Exchange` and `ValType` is presently either `Word` or `Addr`. Eventually, variants for `Word32` and `Word64` can and should be added, once #11953 and related issues (e.g. #13825) are resolved. Adds tests for `Addr#` CAS that mirror existing tests for `MutableByteArray#`. - - - - - 2125b1d6 by Ryan Scott at 2020-11-05T00:51:01-05:00 Add a regression test for #18920 Commit f594a68a5500696d94ae36425bbf4d4073aca3b2 (`Use level numbers for generalisation`) ended up fixing #18920. Let's add a regression test to ensure that it stays fixed. Fixes #18920. - - - - - e07e383a by Ryan Scott at 2020-11-06T03:45:28-05:00 Replace HsImplicitBndrs with HsOuterTyVarBndrs This refactors the GHC AST to remove `HsImplicitBndrs` and replace it with `HsOuterTyVarBndrs`, a type which records whether the outermost quantification in a type is explicit (i.e., with an outermost, invisible `forall`) or implicit. As a result of this refactoring, it is now evident in the AST where the `forall`-or-nothing rule applies: it's all the places that use `HsOuterTyVarBndrs`. See the revamped `Note [forall-or-nothing rule]` in `GHC.Hs.Type` (previously in `GHC.Rename.HsType`). Moreover, the places where `ScopedTypeVariables` brings lexically scoped type variables into scope are a subset of the places that adhere to the `forall`-or-nothing rule, so this also makes places that interact with `ScopedTypeVariables` easier to find. See the revamped `Note [Lexically scoped type variables]` in `GHC.Hs.Type` (previously in `GHC.Tc.Gen.Sig`). `HsOuterTyVarBndrs` are used in type signatures (see `HsOuterSigTyVarBndrs`) and type family equations (see `HsOuterFamEqnTyVarBndrs`). The main difference between the former and the latter is that the former cares about specificity but the latter does not. There are a number of knock-on consequences: * There is now a dedicated `HsSigType` type, which is the combination of `HsOuterSigTyVarBndrs` and `HsType`. `LHsSigType` is now an alias for an `XRec` of `HsSigType`. * Working out the details led us to a substantial refactoring of the handling of explicit (user-written) and implicit type-variable bindings in `GHC.Tc.Gen.HsType`. Instead of a confusing family of higher order functions, we now have a local data type, `SkolemInfo`, that controls how these binders are kind-checked. It remains very fiddly, not fully satisfying. But it's better than it was. Fixes #16762. Bumps the Haddock submodule. Co-authored-by: Simon Peyton Jones <simonpj at microsoft.com> Co-authored-by: Richard Eisenberg <rae at richarde.dev> Co-authored-by: Zubin Duggal <zubin at cmi.ac.in> - - - - - c85f4928 by Sylvain Henry at 2020-11-06T03:46:08-05:00 Refactor -dynamic-too handling 1) Don't modify DynFlags (too much) for -dynamic-too: now when we generate dynamic outputs for "-dynamic-too", we only set "dynamicNow" boolean field in DynFlags instead of modifying several other fields. These fields now have accessors that take dynamicNow into account. 2) Use DynamicTooState ADT to represent -dynamic-too state. It's much clearer than the undocumented "DynamicTooConditional" that was used before. As a result, we can finally remove the hscs_iface_dflags field in HscRecomp. There was a comment on this field saying: "FIXME (osa): I don't understand why this is necessary, but I spent almost two days trying to figure this out and I couldn't .. perhaps someone who understands this code better will remove this later." I don't fully understand the details, but it was needed because of the changes made to the DynFlags for -dynamic-too. There is still something very dubious in GHC.Iface.Recomp: we have to disable the "dynamicNow" flag at some point for some Backpack's "heinous hack" to continue to work. It may be because interfaces for indefinite units are always non-dynamic, or because we mix and match dynamic and non-dynamic interfaces (#9176), or something else, who knows? - - - - - 2cb87909 by Moritz Angermann at 2020-11-06T03:46:44-05:00 [AArch64] Aarch64 Always PIC - - - - - b1d2c1f3 by Ben Gamari at 2020-11-06T03:47:19-05:00 rts/Sanity: Avoid nasty race in weak pointer sanity-checking See Note [Racing weak pointer evacuation] for all of the gory details. - - - - - 638f38c5 by Ben Gamari at 2020-11-08T09:29:16-05:00 Merge remote-tracking branch 'origin/wip/tsan/all' - - - - - 22888798 by Ben Gamari at 2020-11-08T12:08:40-05:00 Fix haddock submodule The previous merge mistakenly reverted it. - - - - - d445cf05 by Ben Gamari at 2020-11-10T10:26:20-05:00 rts/linker: Fix relocation overflow in PE linker Previously the overflow check for the IMAGE_REL_AMD64_ADDR32NB relocation failed to account for the signed nature of the value. Specifically, the overflow check was: uint64_t v; v = S + A; if (v >> 32) { ... } However, `v` ultimately needs to fit into 32-bits as a signed value. Consequently, values `v > 2^31` in fact overflow yet this is not caught by the existing overflow check. Here we rewrite the overflow check to rather ensure that `INT32_MIN <= v <= INT32_MAX`. There is now quite a bit of repetition between the `IMAGE_REL_AMD64_REL32` and `IMAGE_REL_AMD64_ADDR32` cases but I am leaving fixing this for future work. This bug was first noticed by @awson. Fixes #15808. - - - - - 4c407f6e by Sylvain Henry at 2020-11-10T10:27:00-05:00 Export SPEC from GHC.Exts (#13681) - - - - - 7814cd5b by David Eichmann at 2020-11-10T10:27:35-05:00 ghc-heap: expose decoding from heap representation Co-authored-by: Sven Tennie <sven.tennie at gmail.com> Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> Co-authored-by: Ben Gamari <bgamari.foss at gmail.com> - - - - - fa344d33 by Richard Eisenberg at 2020-11-10T10:28:10-05:00 Add test case for #17186. This got fixed sometime recently; not worth it trying to figure out which commit. - - - - - 2e63a0fb by David Eichmann at 2020-11-10T10:28:46-05:00 Add code comments for StgInfoTable and StgStack structs - - - - - fcfda909 by Ben Gamari at 2020-11-11T03:19:59-05:00 nativeGen: Make makeImportsDoc take an NCGConfig rather than DynFlags It appears this was an oversight as there is no reason the full DynFlags is necessary. - - - - - 6e23695e by Ben Gamari at 2020-11-11T03:19:59-05:00 Move this_module into NCGConfig In various places in the NCG we need the Module currently being compiled. Let's move this into the environment instead of chewing threw another register. - - - - - c6264a2d by Ben Gamari at 2020-11-11T03:20:00-05:00 codeGen: Produce local symbols for module-internal functions It turns out that some important native debugging/profiling tools (e.g. perf) rely only on symbol tables for function name resolution (as opposed to using DWARF DIEs). However, previously GHC would emit temporary symbols (e.g. `.La42b`) to identify module-internal entities. Such symbols are dropped during linking and therefore not visible to runtime tools (in addition to having rather un-helpful unique names). For instance, `perf report` would often end up attributing all cost to the libc `frame_dummy` symbol since Haskell code was no covered by any proper symbol (see #17605). We now rather follow the model of C compilers and emit descriptively-named local symbols for module internal things. Since this will increase object file size this behavior can be disabled with the `-fno-expose-internal-symbols` flag. With this `perf record` can finally be used against Haskell executables. Even more, with `-g3` `perf annotate` provides inline source code. - - - - - 584058dd by Ben Gamari at 2020-11-11T03:20:00-05:00 Enable -fexpose-internal-symbols when debug level >=2 This seems like a reasonable default as the object file size increases by around 5%. - - - - - c34a4b98 by Ömer Sinan Ağacan at 2020-11-11T03:20:35-05:00 Fix and enable object unloading in GHCi Fixes #16525 by tracking dependencies between object file symbols and marking symbol liveness during garbage collection See Note [Object unloading] in CheckUnload.c for details. - - - - - 2782487f by Ray Shih at 2020-11-11T03:20:35-05:00 Add loadNativeObj and unloadNativeObj (This change is originally written by niteria) This adds two functions: * `loadNativeObj` * `unloadNativeObj` and implements them for Linux. They are useful if you want to load a shared object with Haskell code using the system linker and have GHC call dlclose() after the code is no longer referenced from the heap. Using the system linker allows you to load the shared object above outside the low-mem region. It also loads the DWARF sections in a way that `perf` understands. `dl_iterate_phdr` is what makes this implementation Linux specific. - - - - - 7a65f9e1 by GHC GitLab CI at 2020-11-11T03:20:35-05:00 rts: Introduce highMemDynamic - - - - - e9e1b2e7 by GHC GitLab CI at 2020-11-11T03:20:35-05:00 Introduce test for dynamic library unloading This uses the highMemDynamic flag introduced earlier to verify that dynamic objects are properly unloaded. - - - - - 5506f134 by Krzysztof Gogolewski at 2020-11-11T03:21:14-05:00 Force argument in setIdMult (#18925) - - - - - 787e93ae by Ben Gamari at 2020-11-11T23:14:11-05:00 testsuite: Add testcase for #18733 - - - - - 5353fd50 by Ben Gamari at 2020-11-12T10:05:30-05:00 compiler: Fix recompilation checking In ticket #18733 we noticed a rather serious deficiency in the current fingerprinting logic for recursive groups. I have described the old fingerprinting story and its problems in Note [Fingerprinting recursive groups] and have reworked the story accordingly to avoid these issues. Fixes #18733. - - - - - 63fa3997 by Sebastian Graf at 2020-11-13T14:29:39-05:00 Arity: Rework `ArityType` to fix monotonicity (#18870) As we found out in #18870, `andArityType` is not monotone, with potentially severe consequences for termination of fixed-point iteration. That showed in an abundance of "Exciting arity" DEBUG messages that are emitted whenever we do more than one step in fixed-point iteration. The solution necessitates also recording `OneShotInfo` info for `ABot` arity type. Thus we get the following definition for `ArityType`: ``` data ArityType = AT [OneShotInfo] Divergence ``` The majority of changes in this patch are the result of refactoring use sites of `ArityType` to match the new definition. The regression test `T18870` asserts that we indeed don't emit any DEBUG output anymore for a function where we previously would have. Similarly, there's a regression test `T18937` for #18937, which we expect to be broken for now. Fixes #18870. - - - - - 197d59fa by Sebastian Graf at 2020-11-13T14:29:39-05:00 Arity: Emit "Exciting arity" warning only after second iteration (#18937) See Note [Exciting arity] why we emit the warning at all and why we only do after the second iteration now. Fixes #18937. - - - - - de7ec9dd by David Eichmann at 2020-11-13T14:30:16-05:00 Add rts_listThreads and rts_listMiscRoots to RtsAPI.h These are used to find the current roots of the garbage collector. Co-authored-by: Sven Tennie's avatarSven Tennie <sven.tennie at gmail.com> Co-authored-by: Matthew Pickering's avatarMatthew Pickering <matthewtpickering at gmail.com> Co-authored-by: default avatarBen Gamari <bgamari.foss at gmail.com> - - - - - 24a86f09 by Ben Gamari at 2020-11-13T14:30:51-05:00 gitlab-ci: Cache cabal store in linting job - - - - - 0a7e592c by Ben Gamari at 2020-11-15T03:35:45-05:00 nativeGen/dwarf: Fix procedure end addresses Previously the `.debug_aranges` and `.debug_info` (DIE) DWARF information would claim that procedures (represented with a `DW_TAG_subprogram` DIE) would only span the range covered by their entry block. This omitted all of the continuation blocks (represented by `DW_TAG_lexical_block` DIEs), confusing `perf`. Fix this by introducing a end-of-procedure label and using this as the `DW_AT_high_pc` of procedure `DW_TAG_subprogram` DIEs Fixes #17605. - - - - - 1e19183d by Ben Gamari at 2020-11-15T03:35:45-05:00 nativeGen/dwarf: Only produce DW_AT_source_note DIEs in -g3 Standard debugging tools don't know how to understand these so let's not produce them unless asked. - - - - - ad73370f by Ben Gamari at 2020-11-15T03:35:45-05:00 nativeGen/dwarf: Use DW_AT_linkage instead of DW_AT_MIPS_linkage - - - - - a2539650 by Ben Gamari at 2020-11-15T03:35:45-05:00 gitlab-ci: Add DWARF release jobs for Debian 10, Fedora27 - - - - - d61adb3d by Ryan Scott at 2020-11-15T03:36:21-05:00 Name (tc)SplitForAll- functions more consistently There is a zoo of `splitForAll-` functions in `GHC.Core.Type` (as well as `tcSplitForAll-` functions in `GHC.Tc.Utils.TcType`) that all do very similar things, but vary in the particular form of type variable that they return. To make things worse, the names of these functions are often quite misleading. Some particularly egregious examples: * `splitForAllTys` returns `TyCoVar`s, but `splitSomeForAllTys` returns `VarBndr`s. * `splitSomeForAllTys` returns `VarBndr`s, but `tcSplitSomeForAllTys` returns `TyVar`s. * `splitForAllTys` returns `TyCoVar`s, but `splitForAllTysInvis` returns `InvisTVBinder`s. (This in particular arose in the context of #18939, and this finally motivated me to bite the bullet and improve the status quo vis-à-vis how we name these functions.) In an attempt to bring some sanity to how these functions are named, I have opted to rename most of these functions en masse to use consistent suffixes that describe the particular form of type variable that each function returns. In concrete terms, this amounts to: * Functions that return a `TyVar` now use the suffix `-TyVar`. This caused the following functions to be renamed: * `splitTyVarForAllTys` -> `splitForAllTyVars` * `splitForAllTy_ty_maybe` -> `splitForAllTyVar_maybe` * `tcSplitForAllTys` -> `tcSplitForAllTyVars` * `tcSplitSomeForAllTys` -> `tcSplitSomeForAllTyVars` * Functions that return a `CoVar` now use the suffix `-CoVar`. This caused the following functions to be renamed: * `splitForAllTy_co_maybe` -> `splitForAllCoVar_maybe` * Functions that return a `TyCoVar` now use the suffix `-TyCoVar`. This caused the following functions to be renamed: * `splitForAllTy` -> `splitForAllTyCoVar` * `splitForAllTys` -> `splitForAllTyCoVars` * `splitForAllTys'` -> `splitForAllTyCoVars'` * `splitForAllTy_maybe` -> `splitForAllTyCoVar_maybe` * Functions that return a `VarBndr` now use the suffix corresponding to the most relevant type synonym. This caused the following functions to be renamed: * `splitForAllVarBndrs` -> `splitForAllTyCoVarBinders` * `splitForAllTysInvis` -> `splitForAllInvisTVBinders` * `splitForAllTysReq` -> `splitForAllReqTVBinders` * `splitSomeForAllTys` -> `splitSomeForAllTyCoVarBndrs` * `tcSplitForAllVarBndrs` -> `tcSplitForAllTyVarBinders` * `tcSplitForAllTysInvis` -> `tcSplitForAllInvisTVBinders` * `tcSplitForAllTysReq` -> `tcSplitForAllReqTVBinders` * `tcSplitForAllTy_maybe` -> `tcSplitForAllTyVarBinder_maybe` Note that I left the following functions alone: * Functions that split apart things besides `ForAllTy`s, such as `splitFunTys` or `splitPiTys`. Thankfully, there are far fewer of these functions than there are functions that split apart `ForAllTy`s, so there isn't much of a pressing need to apply the new naming convention elsewhere. * Functions that split apart `ForAllCo`s in `Coercion`s, such as `GHC.Core.Coercion.splitForAllCo_maybe`. We could theoretically apply the new naming convention here, but then we'd have to figure out how to disambiguate `Type`-splitting functions from `Coercion`-splitting functions. Ultimately, the `Coercion`-splitting functions aren't used nearly as much as the `Type`-splitting functions, so I decided to leave the former alone. This is purely refactoring and should cause no change in behavior. - - - - - 645444af by Ryan Scott at 2020-11-15T03:36:21-05:00 Use tcSplitForAllInvisTyVars (not tcSplitForAllTyVars) in more places The use of `tcSplitForAllTyVars` in `tcDataFamInstHeader` was the immediate cause of #18939, and replacing it with a new `tcSplitForAllInvisTyVars` function (which behaves like `tcSplitForAllTyVars` but only splits invisible type variables) fixes the issue. However, this led me to realize that _most_ uses of `tcSplitForAllTyVars` in GHC really ought to be `tcSplitForAllInvisTyVars` instead. While I was in town, I opted to replace most uses of `tcSplitForAllTys` with `tcSplitForAllTysInvis` to reduce the likelihood of such bugs in the future. I say "most uses" above since there is one notable place where we _do_ want to use `tcSplitForAllTyVars`: in `GHC.Tc.Validity.forAllTyErr`, which produces the "`Illegal polymorphic type`" error message if you try to use a higher-rank `forall` without having `RankNTypes` enabled. Here, we really do want to split all `forall`s, not just invisible ones, or we run the risk of giving an inaccurate error message in the newly added `T18939_Fail` test case. I debated at some length whether I wanted to name the new function `tcSplitForAllInvisTyVars` or `tcSplitForAllTyVarsInvisible`, but in the end, I decided that I liked the former better. For consistency's sake, I opted to rename the existing `splitPiTysInvisible` and `splitPiTysInvisibleN` functions to `splitInvisPiTys` and `splitPiTysInvisN`, respectively, so that they use the same naming convention. As a consequence, this ended up requiring a `haddock` submodule bump. Fixes #18939. - - - - - 8887102f by Moritz Angermann at 2020-11-15T03:36:56-05:00 AArch64/arm64 adjustments This addes the necessary logic to support aarch64 on elf, as well as aarch64 on mach-o, which Apple calls arm64. We change architecture name to AArch64, which is the official arm naming scheme. - - - - - fc644b1a by Ben Gamari at 2020-11-15T03:37:31-05:00 ghc-bin: Build with eventlogging by default We now have all sorts of great facilities using the eventlog which were previously unavailable without building a custom GHC. Fix this by linking with `-eventlog` by default. - - - - - 52114fa0 by Sylvain Henry at 2020-11-16T11:48:47+01:00 Add Addr# atomic primops (#17751) This reuses the codegen used for ByteArray#'s atomic primops. - - - - - 8150f654 by Sebastian Graf at 2020-11-18T23:38:40-05:00 PmCheck: Print types of uncovered patterns (#18932) In order to avoid confusion as in #18932, we display the type of the match variables in the non-exhaustiveness warning, e.g. ``` T18932.hs:14:1: warning: [-Wincomplete-patterns] Pattern match(es) are non-exhaustive In an equation for ‘g’: Patterns of type ‘T a’, ‘T a’, ‘T a’ not matched: (MkT2 _) (MkT1 _) (MkT1 _) (MkT2 _) (MkT1 _) (MkT2 _) (MkT2 _) (MkT2 _) (MkT1 _) (MkT2 _) (MkT2 _) (MkT2 _) ... | 14 | g (MkT1 x) (MkT1 _) (MkT1 _) = x | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ``` It also allows us to omit the type signature on wildcard matches which we previously showed in only some situations, particularly `-XEmptyCase`. Fixes #18932. - - - - - 165352a2 by Krzysztof Gogolewski at 2020-11-20T02:08:36-05:00 Export indexError from GHC.Ix (#18579) - - - - - b57845c3 by Kamil Dworakowski at 2020-11-20T02:09:16-05:00 Clarify interruptible FFI wrt masking state - - - - - 321d1bd8 by Sebastian Graf at 2020-11-20T02:09:51-05:00 Fix strictness signatures of `prefetchValue*#` primops Their strictness signatures said the primops are strict in their first argument, which is wrong: Handing it a thunk will prefetch the pointer to the thunk, but not evaluate it. Hence not strict. The regression test `T8256` actually tests for laziness in the first argument, so GHC apparently never exploited the strictness signature. See also https://gitlab.haskell.org/ghc/ghc/-/issues/8256#note_310867, where this came up. - - - - - 0aec78b6 by Sebastian Graf at 2020-11-20T02:09:51-05:00 Demand: Interleave usage and strictness demands (#18903) As outlined in #18903, interleaving usage and strictness demands not only means a more compact demand representation, but also allows us to express demands that we weren't easily able to express before. Call demands are *relative* in the sense that a call demand `Cn(cd)` on `g` says "`g` is called `n` times. *Whenever `g` is called*, the result is used according to `cd`". Example from #18903: ```hs h :: Int -> Int h m = let g :: Int -> (Int,Int) g 1 = (m, 0) g n = (2 * n, 2 `div` n) {-# NOINLINE g #-} in case m of 1 -> 0 2 -> snd (g m) _ -> uncurry (+) (g m) ``` Without the interleaved representation, we would just get `L` for the strictness demand on `g`. Now we are able to express that whenever `g` is called, its second component is used strictly in denoting `g` by `1C1(P(1P(U),SP(U)))`. This would allow Nested CPR to unbox the division, for example. Fixes #18903. While fixing regressions, I also discovered and fixed #18957. Metric Decrease: T13253-spj - - - - - 3a55b3a2 by Sebastian Graf at 2020-11-20T02:09:51-05:00 Update user's guide entry on demand analysis and worker/wrapper The demand signature notation has been undocumented for a long time. The only source to understand it, apart from reading the `Outputable` instance, has been an outdated wiki page. Since the previous commits have reworked the demand lattice, I took it as an opportunity to also write some documentation about notation. - - - - - fc963932 by Greg Steuck at 2020-11-20T02:10:31-05:00 Find hadrian location more reliably in cabal-install output Fix #18944 - - - - - 9f40cf6c by Ben Gamari at 2020-11-20T02:11:07-05:00 rts/linker: Align bssSize to page size when mapping symbol extras We place symbol_extras right after bss. We also need to ensure that symbol_extras can be mprotect'd independently from the rest of the image. To ensure this we round up the size of bss to a page boundary, thus ensuring that symbol_extras is also page-aligned. - - - - - b739c319 by Ben Gamari at 2020-11-20T02:11:43-05:00 gitlab-ci: Add usage message to ci.sh - - - - - 802e9180 by Ben Gamari at 2020-11-20T02:11:43-05:00 gitlab-ci: Add VERBOSE environment variable And change the make build system's default behavior to V=0, greatly reducing build log sizes. - - - - - 2a8a979c by Ben Gamari at 2020-11-21T01:13:26-05:00 users-guide: A bit of clean-up in profiling flag documentation - - - - - 56804e33 by Ben Gamari at 2020-11-21T01:13:26-05:00 testsuite: Refactor CountParserDeps - - - - - 53ad67ea by Ben Gamari at 2020-11-21T01:13:26-05:00 Introduce -fprof-callers flag This introducing a new compiler flag to provide a convenient way to introduce profiler cost-centers on all occurrences of the named identifier. Closes #18566. - - - - - ecfd0278 by Sylvain Henry at 2020-11-21T01:14:09-05:00 Move Plugins into HscEnv (#17957) Loaded plugins have nothing to do in DynFlags so this patch moves them into HscEnv (session state). "DynFlags plugins" become "Driver plugins" to still be able to register static plugins. Bump haddock submodule - - - - - 72f2257c by Sylvain Henry at 2020-11-21T01:14:09-05:00 Don't initialize plugins in the Core2Core pipeline Some plugins can be added via TH (cf addCorePlugin). Initialize them in the driver instead of in the Core2Core pipeline. - - - - - ddbeeb3c by Ryan Scott at 2020-11-21T01:14:44-05:00 Add regression test for #10504 This issue was fixed at some point between GHC 8.0 and 8.2. Let's add a regression test to ensure that it stays fixed. Fixes #10504. - - - - - a4a6dc2a by Ben Gamari at 2020-11-21T01:15:21-05:00 dwarf: Apply info table offset consistently Previously we failed to apply the info table offset to the aranges and DIEs, meaning that we often failed to unwind in gdb. For some reason this only seemed to manifest in the RTS's Cmm closures. Nevertheless, now we can unwind completely up to `main` - - - - - 69bfbc21 by Ben Gamari at 2020-11-21T01:15:56-05:00 hadrian: Disable stripping when debug information is enabled - - - - - 7e93ae8b by Ben Gamari at 2020-11-21T13:13:29-05:00 rts: Post ticky entry counts to the eventlog We currently only post the entry counters, not the other global counters as in my experience the former are more useful. We use the heap profiler's census period to decide when to dump. Also spruces up the documentation surrounding ticky-ticky a bit. - - - - - bc9c3916 by Ben Gamari at 2020-11-22T06:28:10-05:00 Implement -ddump-c-backend argument To dump output of the C backend. - - - - - 901bc220 by Ben Gamari at 2020-11-22T12:39:02-05:00 Bump time submodule to 1.11.1 Also bumps directory, Cabal, hpc, time, and unix submodules. Closes #18847. - - - - - 92c0afbf by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Dump STG when ticky is enabled This changes the "ticky" modifier to enable dumping of final STG as this is generally needed to make sense of the ticky profiles. - - - - - d23fef68 by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Introduce notion of flavour transformers This extends Hadrian's notion of "flavour", as described in #18942. - - - - - 179d0bec by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Add a viaLlvmBackend modifier Note that this also slightly changes the semantics of these flavours as we only use LLVM for >= stage1 builds. - - - - - d4d95e51 by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Add profiled_ghc and no_dynamic_ghc modifiers - - - - - 6815603f by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Drop redundant flavour definitions Drop the profiled, LLVM, and ThreadSanitizer flavour definitions as these can now be realized with flavour transformers. - - - - - f88f4339 by Ben Gamari at 2020-11-24T02:43:20-05:00 rts: Flush eventlog buffers from flushEventLog As noted in #18043, flushTrace failed flush anything beyond the writer. This means that a significant amount of data sitting in capability-local event buffers may never get flushed, despite the users' pleads for us to flush. Fix this by making flushEventLog flush all of the event buffers before flushing the writer. Fixes #18043. - - - - - 7c03cc50 by Ben Gamari at 2020-11-24T02:43:55-05:00 gitlab-ci: Run LLVM job on appropriately-labelled MRs Namely, those marked with the ~"LLVM backend" label - - - - - 9b95d815 by Ben Gamari at 2020-11-24T02:43:55-05:00 gitlab-ci: Run LLVM builds on Debian 10 The current Debian 9 image doesn't provide LLVM 7. - - - - - 2ed3e6c0 by Ben Gamari at 2020-11-24T02:43:55-05:00 CmmToLlvm: Declare signature for memcmp Otherwise `opt` fails with: error: use of undefined value '@memcmp$def' - - - - - be5d74ca by Moritz Angermann at 2020-11-26T16:00:32-05:00 [Sized Cmm] properly retain sizes. This replaces all Word<N> = W<N># Word# and Int<N> = I<N># Int# with Word<N> = W<N># Word<N># and Int<N> = I<N># Int<N>#, thus providing us with properly sized primitives in the codegenerator instead of pretending they are all full machine words. This came up when implementing darwinpcs for arm64. The darwinpcs reqires us to pack function argugments in excess of registers on the stack. While most procedure call standards (pcs) assume arguments are just passed in 8 byte slots; and thus the caller does not know the exact signature to make the call, darwinpcs requires us to adhere to the prototype, and thus have the correct sizes. If we specify CInt in the FFI call, it should correspond to the C int, and not just be Word sized, when it's only half the size. This does change the expected output of T16402 but the new result is no less correct as it eliminates the narrowing (instead of the `and` as was previously done). Bumps the array, bytestring, text, and binary submodules. Co-Authored-By: Ben Gamari <ben at well-typed.com> Metric Increase: T13701 T14697 - - - - - a84e53f9 by Andreas Klebinger at 2020-11-26T16:00:32-05:00 RTS: Fix failed inlining of copy_tag. On windows using gcc-10 gcc failed to inline copy_tag into evacuate. To fix this we now set the always_inline attribute for the various copy* functions in Evac.c. The main motivation here is not the overhead of the function call, but rather that this allows the code to "specialize" for the size of the closure we copy which is often known at compile time. An earlier commit also tried to avoid evacuate_large inlining. But didn't quite succeed. So I also marked evacuate_large as noinline. Fixes #12416 - - - - - cdbd16f5 by Sylvain Henry at 2020-11-26T16:00:33-05:00 Fix toArgRep to support 64-bit reps on all systems [This is @Ericson2314 writing a commit message for @hsyl20's patch.] (Progress towards #11953, #17377, #17375) `Int64Rep` and `Word64Rep` are currently broken on 64-bit systems. This is because they should use "native arg rep" but instead use "large arg rep" as they do on 32-bit systems, which is either a non-concept or a 128-bit rep depending on one's vantage point. Now, these reps currently aren't used during 64-bit compilation, so the brokenness isn't observed, but I don't think that constitutes reasons not to fix it. Firstly, the linked issues there is a clearly expressed desire to use explicit-bitwidth constructs in more places. Secondly, per [1], there are other bugs that *do* manifest from not threading explicit-bitwidth information all the way through the compilation pipeline. One can therefore view this as one piece of the larger effort to do that, improve ergnomics, and squash remaining bugs. Also, this is needed for !3658. I could just merge this as part of that, but I'm keen on merging fixes "as they are ready" so the fixes that aren't ready are isolated and easier to debug. [1]: https://mail.haskell.org/pipermail/ghc-devs/2020-October/019332.html - - - - - a9378e69 by Tim Barnes at 2020-11-26T16:00:34-05:00 Set dynamic users-guide TOC spacing (fixes #18554) - - - - - 86a59d93 by Ben Gamari at 2020-11-26T16:00:34-05:00 rts: Use RTS_LIKELY in CHECK Most compilers probably already infer that `barf` diverges but it nevertheless doesn't hurt to be explicit. - - - - - 5757e82b by Matthew Pickering at 2020-11-26T16:00:35-05:00 Remove special case for GHC.ByteCode.Instr This was added in https://github.com/nomeata/ghc-heap-view/commit/34935206e51b9c86902481d84d2f368a6fd93423 GHC.ByteCode.Instr.BreakInfo no longer exists so the special case is dead code. Any check like this can be easily dealt with in client code. - - - - - d9c8b5b4 by Matthew Pickering at 2020-11-26T16:00:35-05:00 Split Up getClosureDataFromHeapRep Motivation 1. Don't enforce the repeated decoding of an info table, when the client can cache it (ghc-debug) 2. Allow the constructor information decoding to be overridden, this casues segfaults in ghc-debug - - - - - 3e3555cc by Andreas Klebinger at 2020-11-26T16:00:35-05:00 RegAlloc: Add missing raPlatformfield to RegAllocStatsSpill Fixes #18994 Co-Author: Benjamin Maurer <maurer.benjamin at gmail.com> - - - - - a1a75aa9 by Ben Gamari at 2020-11-27T06:20:41-05:00 rts: Allocate MBlocks with MAP_TOP_DOWN on Windows As noted in #18991, we would previously allocate heap in low memory. Due to this the linker, which typically *needs* low memory, would end up competing with the heap. In longer builds we end up running out of low memory entirely, leading to linking failures. - - - - - 75fc1ed5 by Sylvain Henry at 2020-11-28T15:40:23-05:00 Hadrian: fix detection of ghc-pkg for cross-compilers - - - - - 7cb5df96 by Sylvain Henry at 2020-11-28T15:40:23-05:00 hadrian: fix ghc-pkg uses (#17601) Make sure ghc-pkg doesn't read the compiler "settings" file by passing --no-user-package-db. - - - - - e3fd4226 by Ben Gamari at 2020-11-28T15:40:23-05:00 gitlab-ci: Introduce a nightly cross-compilation job This adds a job to test cross-compilation from x86-64 to AArch64 with Hadrian. Fixes #18234 - - - - - 698d3d96 by Ben Gamari at 2020-11-28T15:41:00-05:00 gitlab-ci: Only deploy GitLab Pages in ghc/ghc> The deployments are quite large and yet are currently only served for the ghc/ghc> project. - - - - - 625726f9 by David Eichmann at 2020-11-28T15:41:37-05:00 ghc-heap: partial TSO/STACK decoding Co-authored-by: Sven Tennie <sven.tennie at gmail.com> Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> Co-authored-by: Ben Gamari <bgamari.foss at gmail.com> - - - - - 22ea9c29 by Andreas Klebinger at 2020-11-28T15:42:13-05:00 Small optimization to CmmSink. Inside `regsUsedIn` we can avoid some thunks by specializing the recursion. In particular we avoid the thunk for `(f e z)` in the MachOp/Load branches, where we know this will evaluate to z. Reduces allocations for T3294 by ~1%. - - - - - bba42c62 by John Ericson at 2020-11-28T15:42:49-05:00 Make primop handler indentation more consistent - - - - - c82bc8e9 by John Ericson at 2020-11-28T15:42:49-05:00 Cleanup some primop constructor names Harmonize the internal (big sum type) names of the native vs fixed-sized number primops a bit. (Mainly by renaming the former.) No user-facing names are changed. - - - - - ae14f160 by Ben Gamari at 2020-11-28T15:43:25-05:00 testsuite: Mark T14702 as fragile on Windows Due to #18953. - - - - - 1bc104b0 by Ben Gamari at 2020-11-29T15:33:18-05:00 withTimings: Emit allocations counter This will allow us to back out the allocations per compiler pass from the eventlog. Note that we dump the allocation counter rather than the difference since this will allow us to determine how much work is done *between* `withTiming` blocks. - - - - - e992ea84 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 ThreadPaused: Don't zero slop until free vars are pushed When threadPaused blackholes a thunk it calls `OVERWRITING_CLOSURE` to zero the slop for the benefit of the sanity checker. Previously this was done *before* pushing the thunk's free variables to the update remembered set. Consequently we would pull zero'd pointers to the update remembered set. - - - - - e82cd140 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Fix regression from TSAN work The TSAN rework (specifically aad1f803) introduced a subtle regression in GC.c, swapping `g0` in place of `gen`. Whoops! Fixes #18997. - - - - - 35a5207e by GHC GitLab CI at 2020-11-29T15:33:54-05:00 rts/Messages: Add missing write barrier in THROWTO message update After a THROWTO message has been handle the message closure is overwritten by a NULL message. We must ensure that the original closure's pointers continue to be visible to the nonmoving GC. - - - - - 0120829f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Add missing write barrier in shrinkSmallByteArray - - - - - 8a4d8fb6 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 Updates: Don't zero slop until closure has been pushed Ensure that the the free variables have been pushed to the update remembered set before we zero the slop. - - - - - 2793cfdc by GHC GitLab CI at 2020-11-29T15:33:54-05:00 OSThreads: Fix error code checking pthread_join returns its error code and apparently doesn't set errno. - - - - - e391a16f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Don't join to mark_thread on shutdown The mark thread is not joinable as we detach from it on creation. - - - - - 60d088ab by Ben Gamari at 2020-11-29T15:33:54-05:00 nonmoving: Add reference to Ueno 2016 - - - - - 3aa60362 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Ensure that evacuated large objects are marked See Note [Non-moving GC: Marking evacuated objects]. - - - - - 8d304a99 by Ben Gamari at 2020-11-30T10:15:22-05:00 rts/m32: Refactor handling of allocator seeding Previously, in an attempt to reduce fragmentation, each new allocator would map a region of M32_MAX_PAGES fresh pages to seed itself. However, this ends up being extremely wasteful since it turns out that we often use fewer than this. Consequently, these pages end up getting freed which, ends up fragmenting our address space more than than we would have if we had naively allocated pages on-demand. Here we refactor m32 to avoid this waste while achieving the fragmentation mitigation previously desired. In particular, we move all page allocation into the global m32_alloc_page, which will pull a page from the free page pool. If the free page pool is empty we then refill it by allocating a region of M32_MAP_PAGES and adding them to the pool. Furthermore, we do away with the initial seeding entirely. That is, the allocator starts with no active pages: pages are rather allocated on an as-needed basis. On the whole this ends up being a pleasingly simple change, simultaneously making m32 more efficient, more robust, and simpler. Fixes #18980. - - - - - b6629289 by Ben Gamari at 2020-11-30T10:15:58-05:00 rts: Use CHECK instead of assert Use the GHC wrappers instead of <assert.h>. - - - - - 9f4efa6a by Ben Gamari at 2020-11-30T10:15:58-05:00 rts/linker: Replace some ASSERTs with CHECK In the past some people have confused ASSERT, which is for checking internal invariants, which CHECK, which should be used when checking things that might fail due to bad input (and therefore should be enabled even in the release compiler). Change some of these cases in the linker to use CHECK. - - - - - 0f8a4655 by Ryan Scott at 2020-11-30T10:16:34-05:00 Allow deploy:pages job to fail See #18973. - - - - - 49ebe369 by chessai at 2020-11-30T19:47:40-05:00 Optimisations in Data.Foldable (T17867) This PR concerns the following functions from `Data.Foldable`: * minimum * maximum * sum * product * minimumBy * maximumBy - Default implementations of these functions now use `foldl'` or `foldMap'`. - All have been marked with INLINEABLE to make room for further optimisations. - - - - - 4d79ef65 by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - 6af074ce by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - ab334262 by Viktor Dukhovni at 2020-11-30T19:48:17-05:00 dirty MVAR after mutating TSO queue head While the original head and tail of the TSO queue may be in the same generation as the MVAR, interior elements of the queue could be younger after a GC run and may then be exposed by putMVar operation that updates the queue head. Resolves #18919 - - - - - 5eb163f3 by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Don't allow shared libraries to be loaded multiple times - - - - - 490aa14d by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Initialise CCSs from native shared objects - - - - - 6ac3db5f by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Move shared library loading logic into Elf.c - - - - - b6698d73 by GHC GitLab CI at 2020-11-30T19:48:53-05:00 rts/linker: Don't declare dynamic objects with image_mapped This previously resulted in warnings due to spurious unmap failures. - - - - - b94a65af by jneira at 2020-11-30T19:49:31-05:00 Include tried paths in findToolDir error - - - - - 72a87fbc by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Move core flattening algorithm to Core.Unify This sets the stage for a later change, where this algorithm will be needed from GHC.Core.InstEnv. This commit also splits GHC.Core.Map into GHC.Core.Map.Type and GHC.Core.Map.Expr, in order to avoid module import cycles with GHC.Core. - - - - - 0dd45d0a by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Bump the # of commits searched for perf baseline The previous value of 75 meant that a feature branch with more than 75 commits would get spurious CI passes. This affects #18692, but does not fix that ticket, because if a baseline cannot be found, we should fail, not succeed. - - - - - 8bb52d91 by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Remove flattening variables This patch redesigns the flattener to simplify type family applications directly instead of using flattening meta-variables and skolems. The key new innovation is the CanEqLHS type and the new CEqCan constraint (Ct). A CanEqLHS is either a type variable or exactly-saturated type family application; either can now be rewritten using a CEqCan constraint in the inert set. Because the flattener no longer reduces all type family applications to variables, there was some performance degradation if a lengthy type family application is now flattened over and over (not making progress). To compensate, this patch contains some extra optimizations in the flattener, leading to a number of performance improvements. Close #18875. Close #18910. There are many extra parts of the compiler that had to be affected in writing this patch: * The family-application cache (formerly the flat-cache) sometimes stores coercions built from Given inerts. When these inerts get kicked out, we must kick out from the cache as well. (This was, I believe, true previously, but somehow never caused trouble.) Kicking out from the cache requires adding a filterTM function to TrieMap. * This patch obviates the need to distinguish "blocking" coercion holes from non-blocking ones (which, previously, arose from CFunEqCans). There is thus some simplification around coercion holes. * Extra commentary throughout parts of the code I read through, to preserve the knowledge I gained while working. * A change in the pure unifier around unifying skolems with other types. Unifying a skolem now leads to SurelyApart, not MaybeApart, as documented in Note [Binding when looking up instances] in GHC.Core.InstEnv. * Some more use of MCoercion where appropriate. * Previously, class-instance lookup automatically noticed that e.g. C Int was a "unifier" to a target [W] C (F Bool), because the F Bool was flattened to a variable. Now, a little more care must be taken around checking for unifying instances. * Previously, tcSplitTyConApp_maybe would split (Eq a => a). This is silly, because (=>) is not a tycon in Haskell. Fixed now, but there are some knock-on changes in e.g. TrieMap code and in the canonicaliser. * New function anyFreeVarsOf{Type,Co} to check whether a free variable satisfies a certain predicate. * Type synonyms now remember whether or not they are "forgetful"; a forgetful synonym drops at least one argument. This is useful when flattening; see flattenView. * The pattern-match completeness checker invokes the solver. This invocation might need to look through newtypes when checking representational equality. Thus, the desugarer needs to keep track of the in-scope variables to know what newtype constructors are in scope. I bet this bug was around before but never noticed. * Extra-constraints wildcards are no longer simplified before printing. See Note [Do not simplify ConstraintHoles] in GHC.Tc.Solver. * Whether or not there are Given equalities has become slightly subtler. See the new HasGivenEqs datatype. * Note [Type variable cycles in Givens] in GHC.Tc.Solver.Canonical explains a significant new wrinkle in the new approach. * See Note [What might match later?] in GHC.Tc.Solver.Interact, which explains the fix to #18910. * The inert_count field of InertCans wasn't actually used, so I removed it. Though I (Richard) did the implementation, Simon PJ was very involved in design and review. This updates the Haddock submodule to avoid #18932 by adding a type signature. ------------------------- Metric Decrease: T12227 T5030 T9872a T9872b T9872c Metric Increase: T9872d ------------------------- - - - - - d66660ba by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Rename the flattener to become the rewriter. Now that flattening doesn't produce flattening variables, it's not really flattening anything: it's rewriting. This change also means that the rewriter can no longer be confused the core flattener (in GHC.Core.Unify), which is sometimes used during type-checking. - - - - - add0aeae by Ben Gamari at 2020-12-01T19:58:17-05:00 rts: Introduce mmapAnonForLinker Previously most of the uses of mmapForLinker were mapping anonymous memory, resulting in a great deal of unnecessary repetition. Factor this out into a new helper. Also fixes a few places where error checking was missing or suboptimal. - - - - - 97d71646 by Ben Gamari at 2020-12-01T19:58:17-05:00 rts/linker: Introduce munmapForLinker Consolidates munmap calls to ensure consistent error handling. - - - - - d8872af0 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/Linker: Introduce Windows implementations for mmapForLinker, et al. - - - - - c35d0e03 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/m32: Introduce NEEDS_M32 macro Instead of relying on RTS_LINKER_USE_MMAP - - - - - 41c64eb5 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/linker: Use m32 to allocate symbol extras in PEi386 - - - - - e0b08c5f by Ben Gamari at 2020-12-03T13:01:47-05:00 gitlab-ci: Fix copy-paste error Also be more consistent in quoting. - - - - - 33ec3a06 by Ben Gamari at 2020-12-03T23:11:31-05:00 gitlab-ci: Run linters through ci.sh Ensuring that the right toolchain is used. - - - - - 4a437bc1 by Shayne Fletcher at 2020-12-05T09:06:38-05:00 Fix bad span calculations of post qualified imports - - - - - 8fac4b93 by Ben Gamari at 2020-12-05T09:07:13-05:00 testsuite: Add a test for #18923 - - - - - 62ed6957 by Simon Peyton Jones at 2020-12-08T15:31:41-05:00 Fix kind inference for data types. Again. This patch fixes several aspects of kind inference for data type declarations, especially data /instance/ declarations Specifically 1. In kcConDecls/kcConDecl make it clear that the tc_res_kind argument is only used in the H98 case; and in that case there is no result kind signature; and hence no need for the disgusting splitPiTys in kcConDecls (now thankfully gone). The GADT case is a bit different to before, and much nicer. This is what fixes #18891. See Note [kcConDecls: kind-checking data type decls] 2. Do not look at the constructor decls of a data/newtype instance in tcDataFamInstanceHeader. See GHC.Tc.TyCl.Instance Note [Kind inference for data family instances]. This was a new realisation that arose when doing (1) This causes a few knock-on effects in the tests suite, because we require more information than before in the instance /header/. New user-manual material about this in "Kind inference in data type declarations" and "Kind inference for data/newtype instance declarations". 3. Minor improvement in kcTyClDecl, combining GADT and H98 cases 4. Fix #14111 and #8707 by allowing the header of a data instance to affect kind inferece for the the data constructor signatures; as described at length in Note [GADT return types] in GHC.Tc.TyCl This led to a modest refactoring of the arguments (and argument order) of tcConDecl/tcConDecls. 5. Fix #19000 by inverting the sense of the test in new_locs in GHC.Tc.Solver.Canonical.canDecomposableTyConAppOK. - - - - - 0abe3ddf by Adam Sandberg Ericsson at 2020-12-08T15:32:19-05:00 hadrian: build the _l and _thr_l rts flavours in the develN flavours The ghc binary requires the eventlog rts since fc644b1a643128041cfec25db84e417851e28bab - - - - - 51e3bb6d by Andreas Klebinger at 2020-12-08T22:43:21-05:00 CodeGen: Make folds User/DefinerOfRegs INLINEABLE. Reduces allocation for the test case I was looking at by about 1.2%. Mostly from avoiding allocation of some folding functions which turn into let-no-escape bindings which just reuse their environment instead. We also force inlining in a few key places in CmmSink which helps a bit more. - - - - - 69ae10c3 by Andreas Klebinger at 2020-12-08T22:43:21-05:00 CmmSink: Force inlining of foldRegsDefd Helps avoid allocating the folding function. Improves perf for T3294 by about 1%. - - - - - 6e3da800 by Andreas Klebinger at 2020-12-08T22:43:21-05:00 Cmm: Make a few types and utility function slightly stricter. About 0.6% reduction in allocations for the code I was looking at. Not a huge difference but no need to throw away performance. - - - - - aef44d7f by Andreas Klebinger at 2020-12-08T22:43:21-05:00 Cmm.Sink: Optimize retaining of assignments, live sets. Sinking requires us to track live local regs after each cmm statement. We used to do this via "Set LocalReg". However we can replace this with a solution based on IntSet which is overall more efficient without losing much. The thing we lose is width of the variables, which isn't used by the sinking pass anyway. I also reworked how we keep assignments to regs mentioned in skipped assignments. I put the details into Note [Keeping assignemnts mentioned in skipped RHSs]. The gist of it is instead of keeping track of it via the use count which is a `IntMap Int` we now use the live regs set (IntSet) which is quite a bit faster. I think it also matches the semantics a lot better. The skipped (not discarded) assignment does in fact keep the regs on it's rhs alive so keeping track of this in the live set seems like the clearer solution as well. Improves allocations for T3294 by yet another 1%. - - - - - 59f2249b by Andreas Klebinger at 2020-12-08T22:43:21-05:00 GHC.Cmm.Opt: Be stricter in results. Optimization either returns Nothing if nothing is to be done or `Just <cmmExpr>` otherwise. There is no point in being lazy in `cmmExpr`. We usually inspect this element so the thunk gets forced not long after. We might eliminate it as dead code once in a blue moon but that's not a case worth optimizing for. Overall the impact of this is rather low. As Cmm.Opt doesn't allocate much (compared to the rest of GHC) to begin with. - - - - - 54b88eac by Andreas Klebinger at 2020-12-08T22:43:57-05:00 Bump time submodule. This should fix #19002. - - - - - 35e7b0c6 by Kirill Elagin at 2020-12-10T01:45:54-05:00 doc: Clarify the default for -fomit-yields “Yield points enabled” is confusing (and probably wrong? I am not 100% sure what it means). Change it to a simple “on”. Undo this change from 2c23fff2e03e77187dc4d01f325f5f43a0e7cad2. - - - - - 3551c554 by Kirill Elagin at 2020-12-10T01:45:54-05:00 doc: Extra-clarify -fomit-yields Be more clear on what this optimisation being on by default means in terms of yields. - - - - - 6484f0d7 by Sergei Trofimovich at 2020-12-10T01:46:33-05:00 rts/linker/Elf.c: add missing <dlfcn.h> include (musl support) The change fixes build failure on musl: ``` rts/linker/Elf.c:2031:3: error: warning: implicit declaration of function 'dlclose'; did you mean 'close'? [-Wimplicit-function-declaration] 2031 | dlclose(nc->dlopen_handle); | ^~~~~~~ | close ``` Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - ab24ed9b by Ben Gamari at 2020-12-11T03:55:51-05:00 users guide: Fix syntax errors Fixes errors introduced by 3a55b3a2574f913d046f3a6f82db48d7f6df32e3. - - - - - d3a24d31 by Ben Gamari at 2020-12-11T03:55:51-05:00 users guide: Describe GC lifecycle events Every time I am asked about how to interpret these events I need to figure it out from scratch. It's well past time that the users guide properly documents these. - - - - - 741309b9 by Ben Gamari at 2020-12-11T03:56:27-05:00 gitlab-ci: Fix incorrect Docker image for nightly cross job Also refactor the job definition to eliminate the bug by construction. - - - - - 19703bc8 by Ben Gamari at 2020-12-11T03:56:27-05:00 gitlab-ci: Fix name of flavour in ThreadSanitizer job It looks like I neglected to update this after introduce flavour transformers. - - - - - 381eb660 by Sylvain Henry at 2020-12-11T12:57:35-05:00 Display FFI labels (fix #18539) - - - - - 4548d1f8 by Aaron Allen at 2020-12-11T12:58:14-05:00 Elide extraneous messages for :doc command (#15784) Do not print `<has no documentation>` alongside a valid doc. Additionally, if two matching symbols lack documentation then the message will only be printed once. Hence, `<has no documentation>` will be printed at most once and only if all matching symbols are lacking docs. - - - - - 5eba91b6 by Aaron Allen at 2020-12-11T12:58:14-05:00 Add :doc test case for duplicate record fields Tests that the output of the `:doc` command is correct for duplicate record fields defined using -XDuplicateRecordFields. - - - - - 5feb9b2d by Ryan Scott at 2020-12-11T22:39:29-05:00 Delete outdated Note [Kind-checking tyvar binders for associated types] This Note has severely bitrotted, as it has no references anywhere in the codebase, and none of the functions that it mentions exist anymore. Let's just delete this. While I was in town, I deleted some outdated comments from `checkFamPatBinders` of a similar caliber. Fixes #19008. [ci skip] - - - - - f9f9f030 by Sylvain Henry at 2020-12-11T22:40:08-05:00 Arrows: correctly query arrow methods (#17423) Consider the following code: proc (C x y) -> ... Before this patch, the evidence binding for the Arrow dictionary was attached to the C pattern: proc (C x y) { $dArrow = ... } -> ... But then when we desugar this, we use arrow operations ("arr", ">>>"...) specialised for this arrow: let arr_xy = arr $dArrow -- <-- Not in scope! ... in arr_xy (\(C x y) { $dArrow = ... } -> ...) This patch allows arrow operations to be type-checked before the proc itself, avoiding this issue. Fix #17423 - - - - - aaa8f00f by Sylvain Henry at 2020-12-11T22:40:48-05:00 Validate script: fix configure command when using stack - - - - - b4a929a1 by Sylvain Henry at 2020-12-11T22:41:30-05:00 Hadrian: fix libffi tarball parsing Fix parsing of "libffi-3.3.tar.gz". NB: switch to a newer libffi isn't done in this patch - - - - - 690c8946 by Sylvain Henry at 2020-12-11T22:42:09-05:00 Parser: move parser utils into their own module Move code unrelated to runtime evaluation out of GHC.Runtime.Eval - - - - - 76be0e32 by Sylvain Henry at 2020-12-11T22:42:48-05:00 Move SizedSeq into ghc-boot - - - - - 3a16d764 by Sylvain Henry at 2020-12-11T22:42:48-05:00 ghci: don't compile unneeded modules - - - - - 2895fa60 by Sylvain Henry at 2020-12-11T22:42:48-05:00 ghci: reuse Arch from ghc-boot - - - - - 480a38d4 by Sylvain Henry at 2020-12-11T22:43:30-05:00 rts: don't use siginterrupt (#19019) - - - - - 4af6126d by Sylvain Henry at 2020-12-11T22:44:11-05:00 Use static array in zeroCount - - - - - 5bd71bfd by Sebastian Graf at 2020-12-12T04:45:09-05:00 DmdAnal: Annotate top-level function bindings with demands (#18894) It's useful to annotate a non-exported top-level function like `g` in ```hs module Lib (h) where g :: Int -> Int -> (Int,Int) g m 1 = (m, 0) g m n = (2 * m, 2 `div` n) {-# NOINLINE g #-} h :: Int -> Int h 1 = 0 h m | odd m = snd (g m 2) | otherwise = uncurry (+) (g 2 m) ``` with its demand `UCU(CS(P(1P(U),SP(U))`, which tells us that whenever `g` was called, the second component of the returned pair was evaluated strictly. Since #18903 we do so for local functions, where we can see all calls. For top-level functions, we can assume that all *exported* functions are demanded according to `topDmd` and thus get sound demands for non-exported top-level functions. The demand on `g` is crucial information for Nested CPR, which may the go on and unbox `g` for the second pair component. That is true even if that pair component may diverge, as is the case for the call site `g 13 0`, which throws a div-by-zero exception. In `T18894b`, you can even see the new demand annotation enabling us to eta-expand a function that we wouldn't be able to eta-expand without Call Arity. We only track bindings of function type in order not to risk huge compile-time regressions, see `isInterestingTopLevelFn`. There was a CoreLint check that rejected strict demand annotations on recursive or top-level bindings, which seems completely unjustified. All the cases I investigated were fine, so I removed it. Fixes #18894. - - - - - 3aae036e by Sebastian Graf at 2020-12-12T04:45:09-05:00 Demand: Simplify `CU(U)` to `U` (#19005) Both sub-demands encode the same information. This is a trivial change and already affects a few regression tests (e.g. `T5075`), so no separate regression test is necessary. - - - - - c6477639 by Adam Sandberg Ericsson at 2020-12-12T04:45:48-05:00 hadrian: correctly copy the docs dir into the bindist #18669 - - - - - 4d8a46f0 by Sebastian Graf at 2020-12-16T16:42:15+01:00 Nested CPR Move tests from stranal to cpranal Accept FacState Factor Cpr and Termination into a joint lattice As a result, we don't even have to export Termination from Cpr. Neat! Also I realised there is a simpler and more sound way to generate and unleash CPR signatures. Consider unboxing effects of WW better and get rid of hack stuff A slew of testsuite changes Fix T1600 Fix primop termination Test for DataCon wrapper CPR Fix CPR of bottoming functions/primops Fix DataConWrapperCpr and accept other test outputs Accept two more changed test outputs Update CaseBinderCPR with a new function Don't give the case binder the CPR property Prune CPR sigs to constant depth on all bindings Use variable length coding for ConTags Accept testuite output Don't attach CPR sigs to expandable bindings; transform their unfoldings instead Revert "Don't give the case binder the CPR property" This reverts commit 910edd76d5fe68b58c74f3805112f9faef4f2788. It seems we broke too much with this change. We lost our big win in `fish`. A more modular and configurable approach to optimistic case binder CPR Fix T9291 Document -fcase-binder-cpr-depth in the user's guide Testsuite changes Refactoring around cprAnalBind Fix case binder CPR by not looking into unfoldings of case binders Fix T16893 Accept new test output for T17673 Accepting metric changes to advance CI There are two ghc/alloc increases, which we might want to investigate later on. Metric Decrease: T1969 T9233 T9872a T9872b T9872c T9872d T12425 Metric Increase: T13253 T13701 T15164 Metric Increase ['max_bytes_used'] (test_env='x86_64-darwin'): T9675 Metric Increase ['max_bytes_used', 'peak_megabytes_allocated']: T10370 - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - aclocal.m4 - compiler/.hlint.yaml - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Builtin/Utils.hs - + compiler/GHC/Builtin/bytearray-ops.txt.pp - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/InfoTable.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/CallConv.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Graph.hs - compiler/GHC/Cmm/Info/Build.hs - + compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Liveness.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Opt.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9a0484ccd4c5afb63cc2200a15050f9289be1b2e...4d8a46f0ce883b2611ca8aeb6d4cf35a00c61294 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9a0484ccd4c5afb63cc2200a15050f9289be1b2e...4d8a46f0ce883b2611ca8aeb6d4cf35a00c61294 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 16 15:48:47 2020 From: gitlab at gitlab.haskell.org (Danya Rogozin) Date: Wed, 16 Dec 2020 10:48:47 -0500 Subject: [Git][ghc/ghc][wip/ghc-11342-char-kind] more tests Message-ID: <5fda2c5fdd01e_6b217be38c018764a6@gitlab.mail> Danya Rogozin pushed to branch wip/ghc-11342-char-kind at Glasgow Haskell Compiler / GHC Commits: 984027e7 by Daniel Rogozin at 2020-12-16T18:48:16+03:00 more tests - - - - - 3 changed files: - libraries/time - + testsuite/tests/typecheck/T11342c.hs - testsuite/tests/typecheck/all.T Changes: ===================================== libraries/time ===================================== @@ -1 +1 @@ -Subproject commit df292e1a74c6a87c2c1c889679074dd46ad39461 +Subproject commit c25d6a76702b454426e149fb590da5cb69f3bd0a ===================================== testsuite/tests/typecheck/T11342c.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE DataKinds #-} + +module T11342c where + +import Data.Typeable +import GHC.TypeLits + +x :: TypeRep +x = typeRep (Proxy :: Proxy 'x') ===================================== testsuite/tests/typecheck/all.T ===================================== @@ -1,3 +1,4 @@ test('T11342a', normal, compile, ['-v0']) +test('T11342c', normal, compile, ['-v0']) test('T11342d', normal, compile, ['-v0']) test('T11342e', normal, compile, ['-v0']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/984027e7ad7ba3fc164173bdd6f95021c79e1bf5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/984027e7ad7ba3fc164173bdd6f95021c79e1bf5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 16 15:53:35 2020 From: gitlab at gitlab.haskell.org (Danya Rogozin) Date: Wed, 16 Dec 2020 10:53:35 -0500 Subject: [Git][ghc/ghc][wip/ghc-11342-char-kind] the char kind: type families, functionality, and submodule updates Message-ID: <5fda2d7f852a_6b217be38c0188019f@gitlab.mail> Danya Rogozin pushed to branch wip/ghc-11342-char-kind at Glasgow Haskell Compiler / GHC Commits: cfe196a7 by Daniel Rogozin at 2020-12-16T18:53:14+03:00 the char kind: type families, functionality, and submodule updates Co-authored-by: Rinat Stryungis <rinat.stryungis at serokell.io> Metric Decrease: T5205 Metric Increase: Naperian T13035 - - - - - 30 changed files: - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Types/Literals.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/Type.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Data/FastString.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Parser.y - compiler/GHC/Rename/HsType.hs - compiler/GHC/StgToCmm/Closure.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Instance/Typeable.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/Binary/Typeable.hs - libraries/base/Data/Typeable/Internal.hs - libraries/base/GHC/TypeLits.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cfe196a7dd7b384af9e30f668ab69291c67c014b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cfe196a7dd7b384af9e30f668ab69291c67c014b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 16 17:22:40 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 16 Dec 2020 12:22:40 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/eventlog-flush-interval Message-ID: <5fda42602d53b_6b217be38c01902243@gitlab.mail> Ben Gamari pushed new branch wip/eventlog-flush-interval at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/eventlog-flush-interval You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 16 17:23:02 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 16 Dec 2020 12:23:02 -0500 Subject: [Git][ghc/ghc][wip/eventlog-flush-interval] rts: Introduce --eventlog-flush-interval flag Message-ID: <5fda4276b07bb_6b21674185419024eb@gitlab.mail> Ben Gamari pushed to branch wip/eventlog-flush-interval at Glasgow Haskell Compiler / GHC Commits: c5cd31ca by Ben Gamari at 2020-12-16T12:22:56-05:00 rts: Introduce --eventlog-flush-interval flag This introduces a flag, --eventlog-flush-interval, which can be used to set an upper bound on the amount of time for which an eventlog event will remain enqueued. This can be useful in real-time monitoring settings. - - - - - 4 changed files: - docs/users_guide/runtime_control.rst - includes/rts/Flags.h - rts/RtsFlags.c - rts/Timer.c Changes: ===================================== docs/users_guide/runtime_control.rst ===================================== @@ -1238,6 +1238,15 @@ When the program is linked with the :ghc-flag:`-eventlog` option Sets the destination for the eventlog produced with the :rts-flag:`-l ⟨flags⟩` flag. +.. rts-flag:: --eventlog-flush-interval=⟨seconds⟩ + + :default: disabled + :since: 9.2 + + When enabled, the eventlog will be flushed periodically every + ⟨seconds⟩. This can be useful in live-monitoring situations where the + eventlog is consumed in real-time by another process. + .. rts-flag:: -v [⟨flags⟩] Log events as text to standard output, instead of to the ===================================== includes/rts/Flags.h ===================================== @@ -178,6 +178,8 @@ typedef struct _TRACE_FLAGS { bool sparks_full; /* trace spark events 100% accurately */ bool ticky; /* trace ticky-ticky samples */ bool user; /* trace user events (emitted from Haskell code) */ + Time eventlogFlushTime; /* Time between force eventlog flushes (or 0 if disabled) */ + int eventlogFlushTicks; char *trace_output; /* output filename for eventlog */ } TRACE_FLAGS; ===================================== rts/RtsFlags.c ===================================== @@ -237,6 +237,7 @@ void initRtsFlagsDefaults(void) RtsFlags.TraceFlags.user = false; RtsFlags.TraceFlags.ticky = false; RtsFlags.TraceFlags.trace_output = NULL; + RtsFlags.TraceFlags.eventlogFlushTime = 0; #endif #if defined(PROFILING) @@ -977,6 +978,16 @@ error = true; printRtsInfo(rtsConfig); stg_exit(0); } + else if (strequal("eventlog-flush-interval=", + &rts_argv[arg][2])) { + OPTION_SAFE; + double intervalSeconds = parseDouble(rts_argv[arg]+26, &error); + if (error) { + errorBelch("bad value for --eventlog-flush-interval"); + } + RtsFlags.TraceFlags.eventlogFlushTime = + fsecondsToTime(intervalSeconds); + } else if (strequal("copying-gc", &rts_argv[arg][2])) { OPTION_SAFE; @@ -1799,6 +1810,14 @@ static void normaliseRtsOpts (void) RtsFlags.ProfFlags.heapProfileIntervalTicks = 0; } + if (RtsFlags.TraceFlags.eventlogFlushTime > 0) { + RtsFlags.TraceFlags.eventlogFlushTicks = + RtsFlags.TraceFlags.eventlogFlushTime / + RtsFlags.MiscFlags.tickInterval; + } else { + RtsFlags.TraceFlags.eventlogFlushTicks = 0; + } + if (RtsFlags.GcFlags.stkChunkBufferSize > RtsFlags.GcFlags.stkChunkSize / 2) { errorBelch("stack chunk buffer size (-kb) must be less than 50%%\n" ===================================== rts/Timer.c ===================================== @@ -111,6 +111,14 @@ handle_tick(int unused STG_UNUSED) } } + if (eventlog_enabled && RtsFlags.TraceFlags.eventlogFlushTicks > 0) { + ticks_to_eventlog_flush--; + if (ticks_to_eventlog_flush <= 0) { + ticks_to_eventlog_flush = RtsFlags.TraceFlags.eventlogFlushTicks; + flushEventLog(NULL); + } + } + /* * If we've been inactive for idleGCDelayTime (set by +RTS * -I), tell the scheduler to wake up and do a GC, to check View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c5cd31ca07db7b1a97423333cdec00dcb6a249d4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c5cd31ca07db7b1a97423333cdec00dcb6a249d4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 16 17:30:21 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 16 Dec 2020 12:30:21 -0500 Subject: [Git][ghc/ghc][wip/T19075] 3 commits: Revert haddock submodule yet again Message-ID: <5fda442d492ff_6b21725c11c190416b@gitlab.mail> Ben Gamari pushed to branch wip/T19075 at Glasgow Haskell Compiler / GHC Commits: e9b18a75 by Ben Gamari at 2020-12-15T15:55:38-05:00 Revert haddock submodule yet again - - - - - b58cb63a by GHC GitLab CI at 2020-12-16T03:46:31+00:00 Bump haddock submodule To adapt haddock for the nullary tyconapp optimisation patch. - - - - - e97d81c5 by Ben Gamari at 2020-12-16T12:30:20-05:00 rts/Messages: Relax locked-closure assertion In general we are less careful about locking closures when running with only a single capability. Fixes #19075. - - - - - 2 changed files: - rts/Messages.h - utils/haddock Changes: ===================================== rts/Messages.h ===================================== @@ -25,8 +25,9 @@ void sendMessage (Capability *from_cap, Capability *to_cap, Message *msg); INLINE_HEADER void doneWithMsgThrowTo (Capability *cap, MessageThrowTo *m) { - // The message better be locked - ASSERT(m->header.info == &stg_WHITEHOLE_info); + // The message better be locked (unless we are running single-threaded, + // where we are a bit more lenient (#19075). + ASSERT(n_capabilities == 1 || m->header.info == &stg_WHITEHOLE_info); IF_NONMOVING_WRITE_BARRIER_ENABLED { updateRemembSetPushClosure(cap, (StgClosure *) m->link); updateRemembSetPushClosure(cap, (StgClosure *) m->source); ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 46c3db2460cea396fae525f4b9d8f40c34c0680e +Subproject commit 059acb11d6134ee0d896bcf73c870958557a3909 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c7bfd425000955b130f76011492340f0dbc9c565...e97d81c5c3ce18c820fd2394650fdad625944d66 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c7bfd425000955b130f76011492340f0dbc9c565...e97d81c5c3ce18c820fd2394650fdad625944d66 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 16 17:36:58 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 16 Dec 2020 12:36:58 -0500 Subject: [Git][ghc/ghc][wip/eventlog-flush-interval] 3 commits: Revert haddock submodule yet again Message-ID: <5fda45ba680de_6b21725c11c19079d1@gitlab.mail> Ben Gamari pushed to branch wip/eventlog-flush-interval at Glasgow Haskell Compiler / GHC Commits: e9b18a75 by Ben Gamari at 2020-12-15T15:55:38-05:00 Revert haddock submodule yet again - - - - - b58cb63a by GHC GitLab CI at 2020-12-16T03:46:31+00:00 Bump haddock submodule To adapt haddock for the nullary tyconapp optimisation patch. - - - - - 70d6ea48 by Ben Gamari at 2020-12-16T12:36:51-05:00 rts: Introduce --eventlog-flush-interval flag This introduces a flag, --eventlog-flush-interval, which can be used to set an upper bound on the amount of time for which an eventlog event will remain enqueued. This can be useful in real-time monitoring settings. - - - - - 5 changed files: - docs/users_guide/runtime_control.rst - includes/rts/Flags.h - rts/RtsFlags.c - rts/Timer.c - utils/haddock Changes: ===================================== docs/users_guide/runtime_control.rst ===================================== @@ -1238,6 +1238,15 @@ When the program is linked with the :ghc-flag:`-eventlog` option Sets the destination for the eventlog produced with the :rts-flag:`-l ⟨flags⟩` flag. +.. rts-flag:: --eventlog-flush-interval=⟨seconds⟩ + + :default: disabled + :since: 9.2 + + When enabled, the eventlog will be flushed periodically every + ⟨seconds⟩. This can be useful in live-monitoring situations where the + eventlog is consumed in real-time by another process. + .. rts-flag:: -v [⟨flags⟩] Log events as text to standard output, instead of to the ===================================== includes/rts/Flags.h ===================================== @@ -178,6 +178,8 @@ typedef struct _TRACE_FLAGS { bool sparks_full; /* trace spark events 100% accurately */ bool ticky; /* trace ticky-ticky samples */ bool user; /* trace user events (emitted from Haskell code) */ + Time eventlogFlushTime; /* Time between force eventlog flushes (or 0 if disabled) */ + int eventlogFlushTicks; char *trace_output; /* output filename for eventlog */ } TRACE_FLAGS; ===================================== rts/RtsFlags.c ===================================== @@ -237,6 +237,7 @@ void initRtsFlagsDefaults(void) RtsFlags.TraceFlags.user = false; RtsFlags.TraceFlags.ticky = false; RtsFlags.TraceFlags.trace_output = NULL; + RtsFlags.TraceFlags.eventlogFlushTime = 0; #endif #if defined(PROFILING) @@ -977,6 +978,16 @@ error = true; printRtsInfo(rtsConfig); stg_exit(0); } + else if (strequal("eventlog-flush-interval=", + &rts_argv[arg][2])) { + OPTION_SAFE; + double intervalSeconds = parseDouble(rts_argv[arg]+26, &error); + if (error) { + errorBelch("bad value for --eventlog-flush-interval"); + } + RtsFlags.TraceFlags.eventlogFlushTime = + fsecondsToTime(intervalSeconds); + } else if (strequal("copying-gc", &rts_argv[arg][2])) { OPTION_SAFE; @@ -1799,6 +1810,14 @@ static void normaliseRtsOpts (void) RtsFlags.ProfFlags.heapProfileIntervalTicks = 0; } + if (RtsFlags.TraceFlags.eventlogFlushTime > 0) { + RtsFlags.TraceFlags.eventlogFlushTicks = + RtsFlags.TraceFlags.eventlogFlushTime / + RtsFlags.MiscFlags.tickInterval; + } else { + RtsFlags.TraceFlags.eventlogFlushTicks = 0; + } + if (RtsFlags.GcFlags.stkChunkBufferSize > RtsFlags.GcFlags.stkChunkSize / 2) { errorBelch("stack chunk buffer size (-kb) must be less than 50%%\n" ===================================== rts/Timer.c ===================================== @@ -111,6 +111,14 @@ handle_tick(int unused STG_UNUSED) } } + if (eventlog_enabled && RtsFlags.TraceFlags.eventlogFlushTicks > 0) { + ticks_to_eventlog_flush--; + if (ticks_to_eventlog_flush <= 0) { + ticks_to_eventlog_flush = RtsFlags.TraceFlags.eventlogFlushTicks; + flushEventLog(NULL); + } + } + /* * If we've been inactive for idleGCDelayTime (set by +RTS * -I), tell the scheduler to wake up and do a GC, to check ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 46c3db2460cea396fae525f4b9d8f40c34c0680e +Subproject commit 059acb11d6134ee0d896bcf73c870958557a3909 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c5cd31ca07db7b1a97423333cdec00dcb6a249d4...70d6ea4832b8bc132f83c4a55ad983fb03add153 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c5cd31ca07db7b1a97423333cdec00dcb6a249d4...70d6ea4832b8bc132f83c4a55ad983fb03add153 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 16 18:51:09 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 16 Dec 2020 13:51:09 -0500 Subject: [Git][ghc/ghc][wip/eventlog-flush-interval] rts: Introduce --eventlog-flush-interval flag Message-ID: <5fda571daf828_6b21725bd7019363ed@gitlab.mail> Ben Gamari pushed to branch wip/eventlog-flush-interval at Glasgow Haskell Compiler / GHC Commits: 02bc4b4f by Ben Gamari at 2020-12-16T13:51:01-05:00 rts: Introduce --eventlog-flush-interval flag This introduces a flag, --eventlog-flush-interval, which can be used to set an upper bound on the amount of time for which an eventlog event will remain enqueued. This can be useful in real-time monitoring settings. - - - - - 4 changed files: - docs/users_guide/runtime_control.rst - includes/rts/Flags.h - rts/RtsFlags.c - rts/Timer.c Changes: ===================================== docs/users_guide/runtime_control.rst ===================================== @@ -1238,6 +1238,15 @@ When the program is linked with the :ghc-flag:`-eventlog` option Sets the destination for the eventlog produced with the :rts-flag:`-l ⟨flags⟩` flag. +.. rts-flag:: --eventlog-flush-interval=⟨seconds⟩ + + :default: disabled + :since: 9.2 + + When enabled, the eventlog will be flushed periodically every + ⟨seconds⟩. This can be useful in live-monitoring situations where the + eventlog is consumed in real-time by another process. + .. rts-flag:: -v [⟨flags⟩] Log events as text to standard output, instead of to the ===================================== includes/rts/Flags.h ===================================== @@ -178,6 +178,8 @@ typedef struct _TRACE_FLAGS { bool sparks_full; /* trace spark events 100% accurately */ bool ticky; /* trace ticky-ticky samples */ bool user; /* trace user events (emitted from Haskell code) */ + Time eventlogFlushTime; /* Time between force eventlog flushes (or 0 if disabled) */ + int eventlogFlushTicks; char *trace_output; /* output filename for eventlog */ } TRACE_FLAGS; ===================================== rts/RtsFlags.c ===================================== @@ -237,6 +237,7 @@ void initRtsFlagsDefaults(void) RtsFlags.TraceFlags.user = false; RtsFlags.TraceFlags.ticky = false; RtsFlags.TraceFlags.trace_output = NULL; + RtsFlags.TraceFlags.eventlogFlushTime = 0; #endif #if defined(PROFILING) @@ -977,6 +978,16 @@ error = true; printRtsInfo(rtsConfig); stg_exit(0); } + else if (strequal("eventlog-flush-interval=", + &rts_argv[arg][2])) { + OPTION_SAFE; + double intervalSeconds = parseDouble(rts_argv[arg]+26, &error); + if (error) { + errorBelch("bad value for --eventlog-flush-interval"); + } + RtsFlags.TraceFlags.eventlogFlushTime = + fsecondsToTime(intervalSeconds); + } else if (strequal("copying-gc", &rts_argv[arg][2])) { OPTION_SAFE; @@ -1799,6 +1810,14 @@ static void normaliseRtsOpts (void) RtsFlags.ProfFlags.heapProfileIntervalTicks = 0; } + if (RtsFlags.TraceFlags.eventlogFlushTime > 0) { + RtsFlags.TraceFlags.eventlogFlushTicks = + RtsFlags.TraceFlags.eventlogFlushTime / + RtsFlags.MiscFlags.tickInterval; + } else { + RtsFlags.TraceFlags.eventlogFlushTicks = 0; + } + if (RtsFlags.GcFlags.stkChunkBufferSize > RtsFlags.GcFlags.stkChunkSize / 2) { errorBelch("stack chunk buffer size (-kb) must be less than 50%%\n" ===================================== rts/Timer.c ===================================== @@ -24,6 +24,7 @@ #include "Ticker.h" #include "Capability.h" #include "RtsSignals.h" +#include "rts/EventLogWriter.h" // This global counter is used to allow multiple threads to stop the // timer temporarily with a stopTimer()/startTimer() pair. If @@ -37,6 +38,9 @@ static StgWord timer_disabled; /* ticks left before next pre-emptive context switch */ static int ticks_to_ctxt_switch = 0; +/* ticks left before next next forced eventlog flush */ +static int ticks_to_eventlog_flush = 0; + /* Note [GC During Idle Time] @@ -111,6 +115,15 @@ handle_tick(int unused STG_UNUSED) } } + if (eventLogStatus() == EVENTLOG_RUNNING + && RtsFlags.TraceFlags.eventlogFlushTicks > 0) { + ticks_to_eventlog_flush--; + if (ticks_to_eventlog_flush <= 0) { + ticks_to_eventlog_flush = RtsFlags.TraceFlags.eventlogFlushTicks; + flushEventLog(NULL); + } + } + /* * If we've been inactive for idleGCDelayTime (set by +RTS * -I), tell the scheduler to wake up and do a GC, to check View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/02bc4b4f1a4fe07a46018738e7e12ec861aaf3df -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/02bc4b4f1a4fe07a46018738e7e12ec861aaf3df You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 16 19:13:30 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 16 Dec 2020 14:13:30 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/T19078 Message-ID: <5fda5c5a899ff_6b21725c11c19409bd@gitlab.mail> Ben Gamari pushed new branch wip/T19078 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T19078 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 16 19:46:20 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 16 Dec 2020 14:46:20 -0500 Subject: [Git][ghc/ghc][wip/T19078] Apply 1 suggestion(s) to 1 file(s) Message-ID: <5fda640cc5eda_6b217c5d454195831d@gitlab.mail> Ben Gamari pushed to branch wip/T19078 at Glasgow Haskell Compiler / GHC Commits: d2dfb7b9 by Ben Gamari at 2020-12-16T14:46:18-05:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 1 changed file: - rts/eventlog/EventLog.c Changes: ===================================== rts/eventlog/EventLog.c ===================================== @@ -591,7 +591,7 @@ static bool startEventLogging_(void) { initEventLogWriter(); - +ASSERT(eventBuf.begin == eventBuf.pos); postHeaderEvents(); // Flush capEventBuf with header. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d2dfb7b918cc49df021c56fffce79c372045b862 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d2dfb7b918cc49df021c56fffce79c372045b862 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 16 19:48:17 2020 From: gitlab at gitlab.haskell.org (Richard Eisenberg) Date: Wed, 16 Dec 2020 14:48:17 -0500 Subject: [Git][ghc/ghc][wip/T19044] Fix #19044 by tweaking unification in inst lookup Message-ID: <5fda6481c5b9e_6b21725bd7019637e6@gitlab.mail> Richard Eisenberg pushed to branch wip/T19044 at Glasgow Haskell Compiler / GHC Commits: a65abc31 by Richard Eisenberg at 2020-12-16T14:47:39-05:00 Fix #19044 by tweaking unification in inst lookup See Note [Infinitary substitution in lookup] in GHC.Core.InstEnv and Note [Unification result] in GHC.Core.Unify. Test case: typecheck/should_compile/T190{44,52} Close #19044 Close #19052 - - - - - 5 changed files: - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/Unify.hs - + testsuite/tests/typecheck/should_compile/T19044.hs - + testsuite/tests/typecheck/should_compile/T19052.hs - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== compiler/GHC/Core/InstEnv.hs ===================================== @@ -760,6 +760,49 @@ When we match this against D [ty], we return the instantiating types where the 'Nothing' indicates that 'b' can be freely instantiated. (The caller instantiates it to a flexi type variable, which will presumably later become fixed via functional dependencies.) + +Note [Infinitary substitution in lookup] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + + class C a b + instance C c c + instance C d (Maybe d) + [W] C e (Maybe e) + +You would think we could just use the second instance, because the first doesn't +unify. But that's just ever so slightly wrong. The reason we check for unifiers +along with matchers is that we don't want the possibility that a type variable +instantiation could cause an instance choice to change. Yet if we have + type family M = Maybe M +and choose (e |-> M), then both instances match. This is absurd, but we cannot +rule it out. Yet, worrying about this case is awfully inconvenient to users, +and so we pretend the problem doesn't exist, by considering a lookup that runs into +this occurs-check issue to indicate that an instance surely does not apply (i.e. +is like the SurelyApart case). In the brief time that we didn't treat infinitary +substitutions specially, two tickets were filed: #19044 and #19052, both trying +to do Real Work. + +Why don't we just exclude any instances that are MaybeApart? Because we might +have a [W] C e (F e), where F is a type family. The second instance above does +not match, but it should be included as a future possibility. Unification will +return MaybeApart MARTypeFamily in this case. + +What can go wrong with this design choice? We might get incoherence -- but not +loss of type safety. In particular, if we have [W] C M M (for the M type family +above), then GHC might arbitrarily choose either instance, depending on how +M reduces (or doesn't). + +For type families, we can't just ignore the problem (as we essentially do here), +because doing so would give us a hole in the type safety proof (as explored in +Section 6 of "Closed Type Families with Overlapping Equations", POPL'14). This +possibility of an infinitary substitution manifests as closed type families that +look like they should reduce, but don't. Users complain: #9082 and #17311. For +open type families, we actually can have unsoundness if we don't take infinitary +substitutions into account: #8162. But, luckily, for class instances, we just +risk coherence -- not great, but it seems better to give users what they likely +want. (Also, note that this problem existed for the entire decade of 201x without +anyone noticing, so it's manifestly not ruining anyone's day.) -} -- |Look up an instance in the given instance environment. The given class application must match exactly @@ -839,8 +882,10 @@ lookupInstEnv' ie vis_mods cls tys -- We consider MaybeApart to be a case where the instance might -- apply in the future. This covers an instance like C Int and -- a target like [W] C (F a), where F is a type family. - SurelyApart -> find ms us rest - _ -> find ms (item:us) rest + SurelyApart -> find ms us rest + -- Note [Infinitary substitution in lookup] + MaybeApart MARInfinite _ -> find ms us rest + _ -> find ms (item:us) rest where tpl_tv_set = mkVarSet tpl_tvs tys_tv_set = tyCoVarsOfTypes tys ===================================== compiler/GHC/Core/Unify.hs ===================================== @@ -18,7 +18,7 @@ module GHC.Core.Unify ( tcUnifyTy, tcUnifyTyKi, tcUnifyTys, tcUnifyTyKis, tcUnifyTysFG, tcUnifyTyWithTFs, BindFlag(..), - UnifyResult, UnifyResultM(..), + UnifyResult, UnifyResultM(..), MaybeApartReason(..), -- Matching a type against a lifted type (coercion) liftCoMatch, @@ -55,8 +55,7 @@ import GHC.Data.FastString import Data.List ( mapAccumL ) import Control.Monad -import Control.Applicative hiding ( empty ) -import qualified Control.Applicative +import qualified Data.Semigroup as S {- @@ -347,6 +346,46 @@ complete. This means that, sometimes, a closed type family does not reduce when it should. See test case indexed-types/should_fail/Overlap15 for an example. +Note [Unificiation result] +~~~~~~~~~~~~~~~~~~~~~~~~~~ +When unifying t1 ~ t2, we return +* Unifiable s, if s is a substitution such that s(t1) is syntactically the + same as s(t2), modulo type-synonym expansion. +* SurelyApart, if there is no substitution s such that s(t1) = s(t2), + where "=" includes type-family reductions. +* MaybeApart mar s, when we aren't sure. `mar` is a MaybeApartReason. + +Examples +* [a] ~ Maybe b: SurelyApart, because [] and Maybe can't unify +* [(a,Int)] ~ [(Bool,b)]: Unifiable +* [F Int] ~ [Bool]: MaybeApart MARTypeFamily, because F Int might reduce to Bool (the unifier + does not try this) +* a ~ Maybe a: MaybeApart MARInfinite. Not Unifiable clearly, but not SurelyApart either; consider + a := Loop + where type family Loop where Loop = Maybe Loop + +There is the possibility that two types are MaybeApart for *both* reasons: + +* (a, F Int) ~ (Maybe a, Bool) + +What reason should we use? The *only* consumer of the reason is described +in Note [Infinitary substitution in lookup] in GHC.Core.InstEnv. The goal +there is identify which instances might match a target later (but don't +match now) -- except that we want to ignore the possibility of infinitary +substitutions. So let's examine a concrete scenario: + + class C a b c + instance C a (Maybe a) Bool + -- other instances, including one that will actually match + [W] C b b (F Int) + +Do we want the instance as a future possibility? No. The only way that +instance can match is in the presence of an infinite type (infinitely +nested Maybes). We thus say that MARInfinite takes precedence, so that +InstEnv treats this case as an infinitary substitution case; the fact +that a type family is involved is only incidental. We thus define +the Semigroup instance for MaybeApartReason to prefer MARInfinite. + Note [The substitution in MaybeApart] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The constructor MaybeApart carries data with it, typically a TvSubstEnv. Why? @@ -391,8 +430,8 @@ tcUnifyTyWithTFs twoWay t1 t2 = case tc_unify_tys (const BindMe) twoWay True False rn_env emptyTvSubstEnv emptyCvSubstEnv [t1] [t2] of - Unifiable (subst, _) -> Just $ maybe_fix subst - MaybeApart (subst, _) -> Just $ maybe_fix subst + Unifiable (subst, _) -> Just $ maybe_fix subst + MaybeApart _reason (subst, _) -> Just $ maybe_fix subst -- we want to *succeed* in questionable cases. This is a -- pre-unification algorithm. SurelyApart -> Nothing @@ -431,36 +470,42 @@ tcUnifyTyKis bind_fn tys1 tys2 -- This type does double-duty. It is used in the UM (unifier monad) and to -- return the final result. See Note [Fine-grained unification] type UnifyResult = UnifyResultM TCvSubst + +-- | See Note [Unificiation result] data UnifyResultM a = Unifiable a -- the subst that unifies the types - | MaybeApart a -- the subst has as much as we know + | MaybeApart MaybeApartReason + a -- the subst has as much as we know -- it must be part of a most general unifier -- See Note [The substitution in MaybeApart] | SurelyApart deriving Functor +-- | Why are two types 'MaybeApart'? 'MARTypeFamily' takes precedence: +-- This is used (only) in Note [Infinitary substitution in lookup] in GHC.Core.InstEnv +data MaybeApartReason = MARTypeFamily -- ^ matching e.g. F Int ~? Bool + | MARInfinite -- ^ matching e.g. a ~? Maybe a + +instance Outputable MaybeApartReason where + ppr MARTypeFamily = text "MARTypeFamily" + ppr MARInfinite = text "MARInfinite" + +instance Semigroup MaybeApartReason where + -- see end of Note [Unification result] for why + MARTypeFamily <> r = r + MARInfinite <> _ = MARInfinite + instance Applicative UnifyResultM where pure = Unifiable (<*>) = ap instance Monad UnifyResultM where - SurelyApart >>= _ = SurelyApart - MaybeApart x >>= f = case f x of - Unifiable y -> MaybeApart y - other -> other + MaybeApart r1 x >>= f = case f x of + Unifiable y -> MaybeApart r1 y + MaybeApart r2 y -> MaybeApart (r1 S.<> r2) y + SurelyApart -> SurelyApart Unifiable x >>= f = f x -instance Alternative UnifyResultM where - empty = SurelyApart - - a@(Unifiable {}) <|> _ = a - _ <|> b@(Unifiable {}) = b - a@(MaybeApart {}) <|> _ = a - _ <|> b@(MaybeApart {}) = b - SurelyApart <|> SurelyApart = SurelyApart - -instance MonadPlus UnifyResultM - -- | @tcUnifyTysFG bind_tv tys1 tys2@ attepts to find a substitution @s@ (whose -- domain elements all respond 'BindMe' to @bind_tv@) such that -- @s(tys1)@ and that of @s(tys2)@ are equal, as witnessed by the returned @@ -530,9 +575,9 @@ tc_unify_tys bind_fn unif inj_check match_kis rn_env tv_env cv_env tys1 tys2 kis2 = map typeKind tys2 instance Outputable a => Outputable (UnifyResultM a) where - ppr SurelyApart = text "SurelyApart" - ppr (Unifiable x) = text "Unifiable" <+> ppr x - ppr (MaybeApart x) = text "MaybeApart" <+> ppr x + ppr SurelyApart = text "SurelyApart" + ppr (Unifiable x) = text "Unifiable" <+> ppr x + ppr (MaybeApart r x) = text "MaybeApart" <+> ppr r <+> ppr x {- ************************************************************************ @@ -773,7 +818,7 @@ this, but we mustn't map a to anything else!) We thus must parameterize the algorithm over whether it's being used for an injectivity check (refrain from looking at non-injective arguments to type families) or not (do indeed look at those arguments). This is -implemented by the uf_inj_tf field of UmEnv. +implemented by the um_inj_tf field of UMEnv. (It's all a question of whether or not to include equation (7) from Fig. 2 of [ITF].) @@ -994,7 +1039,7 @@ unify_ty env ty1 ty2 _kco ; unify_tys env inj_tys1 inj_tys2 ; unless (um_inj_tf env) $ -- See (end of) Note [Specification of unification] - don'tBeSoSure $ unify_tys env noninj_tys1 noninj_tys2 } + don'tBeSoSure MARTypeFamily $ unify_tys env noninj_tys1 noninj_tys2 } | Just (tc1, _) <- mb_tc_app1 , not (isGenerativeTyCon tc1 Nominal) @@ -1002,7 +1047,7 @@ unify_ty env ty1 ty2 _kco -- because the (F ty1) behaves like a variable -- NB: if unifying, we have already dealt -- with the 'ty2 = variable' case - = maybeApart + = maybeApart MARTypeFamily | Just (tc2, _) <- mb_tc_app2 , not (isGenerativeTyCon tc2 Nominal) @@ -1010,7 +1055,7 @@ unify_ty env ty1 ty2 _kco -- E.g. unify_ty [a] (F ty2) = MaybeApart, when unifying (only) -- because the (F ty2) behaves like a variable -- NB: we have already dealt with the 'ty1 = variable' case - = maybeApart + = maybeApart MARTypeFamily where mb_tc_app1 = tcSplitTyConApp_maybe ty1 @@ -1120,7 +1165,8 @@ uVar env tv1 ty kco -- this is because the range of the subst is the target -- type, not the template type. So, just check for -- normal type equality. - guard ((ty' `mkCastTy` kco) `eqType` ty) + unless ((ty' `mkCastTy` kco) `eqType` ty) $ + surelyApart Nothing -> uUnrefined env tv1' ty ty kco } -- No, continue uUnrefined :: UMEnv @@ -1190,7 +1236,7 @@ bindTv env tv1 ty2 -- Make sure you include 'kco' (which ty2 does) #14846 ; occurs <- occursCheck env tv1 free_tvs2 - ; if occurs then maybeApart + ; if occurs then maybeApart MARInfinite else extendTvEnv tv1 ty2 } occursCheck :: UMEnv -> TyVar -> VarSet -> UM Bool @@ -1274,15 +1320,6 @@ instance Monad UM where do { (state', v) <- unUM m state ; unUM (k v) state' }) --- need this instance because of a use of 'guard' above -instance Alternative UM where - empty = UM (\_ -> Control.Applicative.empty) - m1 <|> m2 = UM (\state -> - unUM m1 state <|> - unUM m2 state) - -instance MonadPlus UM - instance MonadFail UM where fail _ = UM (\_ -> SurelyApart) -- failed pattern match @@ -1291,9 +1328,9 @@ initUM :: TvSubstEnv -- subst to extend -> UM a -> UnifyResultM a initUM subst_env cv_subst_env um = case unUM um state of - Unifiable (_, subst) -> Unifiable subst - MaybeApart (_, subst) -> MaybeApart subst - SurelyApart -> SurelyApart + Unifiable (_, subst) -> Unifiable subst + MaybeApart r (_, subst) -> MaybeApart r subst + SurelyApart -> SurelyApart where state = UMState { um_tv_env = subst_env , um_cv_env = cv_subst_env } @@ -1333,9 +1370,7 @@ checkRnEnv :: UMEnv -> VarSet -> UM () checkRnEnv env varset | isEmptyVarSet skol_vars = return () | varset `disjointVarSet` skol_vars = return () - | otherwise = maybeApart - -- ToDo: why MaybeApart? - -- I think SurelyApart would be right + | otherwise = surelyApart where skol_vars = um_skols env -- NB: That isEmptyVarSet guard is a critical optimization; @@ -1343,10 +1378,10 @@ checkRnEnv env varset -- the type, often saving quite a bit of allocation. -- | Converts any SurelyApart to a MaybeApart -don'tBeSoSure :: UM () -> UM () -don'tBeSoSure um = UM $ \ state -> +don'tBeSoSure :: MaybeApartReason -> UM () -> UM () +don'tBeSoSure r um = UM $ \ state -> case unUM um state of - SurelyApart -> MaybeApart (state, ()) + SurelyApart -> MaybeApart r (state, ()) other -> other umRnOccL :: UMEnv -> TyVar -> TyVar @@ -1358,8 +1393,8 @@ umRnOccR env v = rnOccR (um_rn_env env) v umSwapRn :: UMEnv -> UMEnv umSwapRn env = env { um_rn_env = rnSwap (um_rn_env env) } -maybeApart :: UM () -maybeApart = UM (\state -> MaybeApart (state, ())) +maybeApart :: MaybeApartReason -> UM () +maybeApart r = UM (\state -> MaybeApart r (state, ())) surelyApart :: UM a surelyApart = UM (\_ -> SurelyApart) ===================================== testsuite/tests/typecheck/should_compile/T19044.hs ===================================== @@ -0,0 +1,20 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +module T19044 where + +class C a b where + m :: a -> b + +instance C a a where + m = id + +instance C a (Maybe a) where + m _ = Nothing + +f :: a -> Maybe a +f = g + where + g x = h (m x) x + +h :: Maybe a -> a -> Maybe a +h = const ===================================== testsuite/tests/typecheck/should_compile/T19052.hs ===================================== @@ -0,0 +1,14 @@ +{-# LANGUAGE AllowAmbiguousTypes, DataKinds, FlexibleInstances, KindSignatures, MultiParamTypeClasses, ScopedTypeVariables, TypeApplications, TypeFamilies, TypeOperators, UndecidableInstances #-} +module Overlap where + +import Data.Kind (Type) + +class Sub (xs :: [Type]) (ys :: [Type]) where + subIndex :: Int +instance {-# OVERLAPPING #-} Sub xs xs where + subIndex = 0 +instance (ys ~ (y ': ys'), Sub xs ys') => Sub xs ys where + subIndex = subIndex @xs @ys' + 1 + +subIndex1 :: forall (x :: Type) (xs :: [Type]). Int +subIndex1 = subIndex @xs @(x ': xs) ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -734,6 +734,8 @@ test('T17186', normal, compile, ['']) test('CbvOverlap', normal, compile, ['']) test('InstanceGivenOverlap', normal, compile, ['']) test('InstanceGivenOverlap2', normal, compile, ['']) +test('T19044', normal, compile, ['']) +test('T19052', normal, compile, ['']) test('LocalGivenEqs', normal, compile, ['']) test('LocalGivenEqs2', normal, compile, ['']) test('T18891', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a65abc31007f57cff07a942eead7684c9eb6b857 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a65abc31007f57cff07a942eead7684c9eb6b857 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 16 19:59:40 2020 From: gitlab at gitlab.haskell.org (Richard Eisenberg) Date: Wed, 16 Dec 2020 14:59:40 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/T19064 Message-ID: <5fda672cf6c1_6b213272ce019719bd@gitlab.mail> Richard Eisenberg pushed new branch wip/T19064 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T19064 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 16 20:00:33 2020 From: gitlab at gitlab.haskell.org (Richard Eisenberg) Date: Wed, 16 Dec 2020 15:00:33 -0500 Subject: [Git][ghc/ghc][wip/T19064] Correct documentation around -XTypeOperators Message-ID: <5fda67619776_6b217be38c0197216d@gitlab.mail> Richard Eisenberg pushed to branch wip/T19064 at Glasgow Haskell Compiler / GHC Commits: ae4f003b by Richard Eisenberg at 2020-12-16T15:00:20-05:00 Correct documentation around -XTypeOperators Close #19064 - - - - - 1 changed file: - docs/users_guide/exts/type_operators.rst Changes: ===================================== docs/users_guide/exts/type_operators.rst ===================================== @@ -12,24 +12,11 @@ Type operators Allow the use and definition of types with operator names. -In types, an operator symbol like ``(+)`` is normally treated as a type -*variable*, just like ``a``. Thus in Haskell 98 you can say +The language :extension:`TypeOperators` allows you to use infix operators +in types. -:: - - type T (+) = ((+), (+)) - -- Just like: type T a = (a,a) - - f :: T Int -> Int - f (x,y)= x - -As you can see, using operators in this way is not very useful, and -Haskell 98 does not even allow you to write them infix. - -The language :extension:`TypeOperators` changes this behaviour: - -- Operator symbols become type *constructors* rather than type - *variables*. +- Operator symbols are *constructors* rather than type + *variables* (as they are in terms). - Operator symbols in types can be written infix, both in definitions and uses. For example: :: @@ -37,6 +24,12 @@ The language :extension:`TypeOperators` changes this behaviour: data a + b = Plus a b type Foo = Int + Bool +- Alphanumeric type constructors can now be written infix, using backquote + syntax:: + + x :: Int `Either` Bool + x = Left 5 + - There is now some potential ambiguity in import and export lists; for example if you write ``import M( (+) )`` do you mean the *function* ``(+)`` or the *type constructor* ``(+)``? The default is the former, @@ -52,4 +45,18 @@ The language :extension:`TypeOperators` changes this behaviour: declarations but, as in :ref:`infix-tycons`, the function and type constructor share a single fixity. - +- There is now potential ambiguity in the traditional syntax for + data constructor declarations. For example:: + + type a :+: b = Either a b + data X = Int :+: Bool :+: Char + + This code wants to declare both a type-level ``:+:`` and a term-level + ``:+:`` (which is, generally, allowed). But we cannot tell how to + parenthesize the data constructor declaration in ``X``: either way + makes sense. We might + imagine that a fixity declaration could help us, but it is awkward + to apply the fixity declaration to the very definition of a new + data constructor. Instead of declaring delicate rules around this + issue, GHC simply rejects if the top level of a traditional-syntax + data constructor declaration uses two operators without parenthesizing. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ae4f003bf1971be216b87dbfebde29ac531217c2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ae4f003bf1971be216b87dbfebde29ac531217c2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 16 20:02:42 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 16 Dec 2020 15:02:42 -0500 Subject: [Git][ghc/ghc][wip/testsuite-fixes] 1199 commits: GHC.Core.Unfold: Refactor traceInline Message-ID: <5fda67e27dbcb_6b216741854197650@gitlab.mail> Ben Gamari pushed to branch wip/testsuite-fixes at Glasgow Haskell Compiler / GHC Commits: 28deee28 by Ben Gamari at 2020-05-28T16:23:21-04:00 GHC.Core.Unfold: Refactor traceInline This reduces duplication as well as fixes a bug wherein -dinlining-check would override -ddump-inlinings. Moreover, the new variant - - - - - 1f393e1e by Ben Gamari at 2020-05-28T16:23:21-04:00 Avoid unnecessary allocations due to tracing utilities While ticky-profiling the typechecker I noticed that hundreds of millions of SDocs are being allocated just in case -ddump-*-trace is enabled. This is awful. We avoid this by ensuring that the dump flag check is inlined into the call site, ensuring that the tracing document needn't be allocated unless it's actually needed. See Note [INLINE conditional tracing utilities] for details. Fixes #18168. Metric Decrease: T9961 haddock.Cabal haddock.base haddock.compiler - - - - - 5f621a78 by Vladislav Zavialov at 2020-05-28T16:23:58-04:00 Add Semigroup/Monoid for Q (#18123) - - - - - dc5f004c by Xavier Denis at 2020-05-28T16:24:37-04:00 Fix #18071 Run the core linter on candidate instances to ensure they are well-kinded. Better handle quantified constraints by using a CtWanted to avoid having unsolved constraints thrown away at the end by the solver. - - - - - 10e6982c by Sebastian Graf at 2020-05-28T16:25:14-04:00 FloatOut: Only eta-expand dead-end RHS if arity will increase (#18231) Otherwise we risk turning trivial RHS into non-trivial RHS, introducing unnecessary bindings in the next Simplifier run, resulting in more churn. Fixes #18231. - - - - - 08dab5f7 by Sebastian Graf at 2020-05-28T16:25:14-04:00 DmdAnal: Recognise precise exceptions from case alternatives (#18086) Consider ```hs m :: IO () m = do putStrLn "foo" error "bar" ``` `m` (from #18086) always throws a (precise or imprecise) exception or diverges. Yet demand analysis infers `<L,A>` as demand signature instead of `<L,A>x` for it. That's because the demand analyser sees `putStrLn` occuring in a case scrutinee and decides that it has to `deferAfterPreciseException`, because `putStrLn` throws a precise exception on some control flow paths. This will mask the `botDiv` `Divergence`of the single case alt containing `error` to `topDiv`. Since `putStrLn` has `topDiv` itself, the final `Divergence` is `topDiv`. This is easily fixed: `deferAfterPreciseException` works by `lub`ing with the demand type of a virtual case branch denoting the precise exceptional control flow. We used `nopDmdType` before, but we can be more precise and use `exnDmdType`, which is `nopDmdType` with `exnDiv`. Now the `Divergence` from the case alt will degrade `botDiv` to `exnDiv` instead of `topDiv`, which combines with the result from the scrutinee to `exnDiv`, and all is well. Fixes #18086. - - - - - aef95f11 by Ben Gamari at 2020-05-28T16:25:53-04:00 Ticky-ticky: Record DataCon name in ticker name This makes it significantly easier to spot the nature of allocations regressions and comes at a reasonably low cost. - - - - - 8f021b8c by Ben Gamari at 2020-05-28T16:26:34-04:00 hadrian: Don't track GHC's verbosity argument Teach hadrian to ignore GHC's -v argument in its recompilation check, thus fixing #18131. - - - - - 13d9380b by Ben Gamari at 2020-05-28T16:27:20-04:00 Rip out CmmStackInfo(updfr_space) As noted in #18232, this field is currently completely unused and moreover doesn't have a clear meaning. - - - - - f10d11fa by Andreas Klebinger at 2020-05-29T01:38:42-04:00 Fix "build/elem" RULE. An redundant constraint prevented the rule from matching. Fixing this allows a call to elem on a known list to be translated into a series of equality checks, and eventually a simple case expression. Surprisingly this seems to regress elem for strings. To avoid this we now also allow foldrCString to inline and add an UTF8 variant. This results in elem being compiled to a tight non-allocating loop over the primitive string literal which performs a linear search. In the process this commit adds UTF8 variants for some of the functions in GHC.CString. This is required to make this work for both ASCII and UTF8 strings. There are also small tweaks to the CString related rules. We now allow ourselfes the luxury to compare the folding function via eqExpr, which helps to ensure the rule fires before we inline foldrCString*. Together with a few changes to allow matching on both the UTF8 and ASCII variants of the CString functions. - - - - - bbeb2389 by Ben Gamari at 2020-05-29T01:39:19-04:00 CoreToStg: Add Outputable ArgInfo instance - - - - - 0e3361ca by Simon Peyton Jones at 2020-05-29T01:39:19-04:00 Make Lint check return type of a join point Consider join x = rhs in body It's important that the type of 'rhs' is the same as the type of 'body', but Lint wasn't checking that invariant. Now it does! This was exposed by investigation into !3113. - - - - - c49f7df0 by Simon Peyton Jones at 2020-05-29T01:39:19-04:00 Do not float join points in exprIsConApp_maybe We hvae been making exprIsConApp_maybe cleverer in recent times: commit b78cc64e923716ac0512c299f42d4d0012306c05 Date: Thu Nov 15 17:14:31 2018 +0100 Make constructor wrappers inline only during the final phase commit 7833cf407d1f608bebb1d38bb99d3035d8d735e6 Date: Thu Jan 24 17:58:50 2019 +0100 Look through newtype wrappers (Trac #16254) commit c25b135ff5b9c69a90df0ccf51b04952c2dc6ee1 Date: Thu Feb 21 12:03:22 2019 +0000 Fix exprIsConApp_maybe But alas there was still a bug, now immortalised in Note [Don't float join points] in SimpleOpt. It's quite hard to trigger because it requires a dead join point, but it came up when compiling Cabal Cabal.Distribution.Fields.Lexer.hs, when working on !3113. Happily, the fix is extremly easy. Finding the bug was not so easy. - - - - - 46720997 by Ben Gamari at 2020-05-29T01:39:19-04:00 Allow simplification through runRW# Because runRW# inlines so late, we were previously able to do very little simplification across it. For instance, given even a simple program like case runRW# (\s -> let n = I# 42# in n) of I# n# -> f n# we previously had no way to avoid the allocation of the I#. This patch allows the simplifier to push strict contexts into the continuation of a runRW# application, as explained in in Note [Simplification of runRW#] in GHC.CoreToStg.Prep. Fixes #15127. Metric Increase: T9961 Metric Decrease: ManyConstructors Co-Authored-By: Simon Peyton-Jone <simonpj at microsoft.com> - - - - - 277c2f26 by Ben Gamari at 2020-05-29T01:39:55-04:00 Eta expand un-saturated primops Now since we no longer try to predict CAFfyness we have no need for the solution to #16846. Eta expanding unsaturated primop applications is conceptually simpler, especially in the presence of levity polymorphism. This essentially reverts cac8dc9f51e31e4c0a6cd9bc302f7e1bc7c03beb, as suggested in #18079. Closes #18079. - - - - - f44d7ae0 by Simon Jakobi at 2020-05-29T01:40:34-04:00 base: Scrap deprecation plan for Data.Monoid.{First,Last} See the discussion on the libraries mailing list for context: https://mail.haskell.org/pipermail/libraries/2020-April/030357.html - - - - - 8b494895 by Jeremy Schlatter at 2020-05-29T01:41:12-04:00 Fix typo in documentation - - - - - 998450f4 by Gleb Popov at 2020-05-29T01:41:53-04:00 Always define USE_PTHREAD_FOR_ITIMER for FreeBSD. - - - - - f9a513e0 by Alp Mestanogullari at 2020-05-29T01:42:36-04:00 hadrian: introduce 'install' target Its logic is very simple. It `need`s the `binary-dist-dir` target and runs suitable `configure` and `make install` commands for the user. A new `--prefix` command line argument is introduced to specify where GHC should be installed. - - - - - 67738db1 by Travis Whitaker at 2020-05-29T13:34:48-04:00 Build a threaded stage 1 if the bootstrapping GHC supports it. - - - - - aac19e6c by Peter Trommler at 2020-05-29T13:35:24-04:00 PPC NCG: No per-symbol .section ".toc" directives All position independent symbols are collected during code generation and emitted in one go. Prepending each symbol with a .section ".toc" directive is redundant. This patch drops the per-symbol directives leading to smaller assembler files. Fixes #18250 - - - - - 4413828b by Ben Gamari at 2020-05-30T06:07:31-04:00 rts: Teach getNumProcessors to return available processors Previously we would report the number of physical processors, which can be quite wrong in a containerized setting. Now we rather return how many processors are in our affinity mask when possible. I also refactored the code to prefer platform-specific since this will report logical CPUs instead of physical (using `machdep.cpu.thread_count` on Darwin and `cpuset_getaffinity` on FreeBSD). Fixes #14781. - - - - - 1449435c by Ben Gamari at 2020-05-30T06:07:31-04:00 users-guide: Note change in getNumProcessors in users guide - - - - - 3d960169 by Ben Gamari at 2020-05-30T06:07:31-04:00 rts: Drop compatibility shims for Windows Vista We can now assume that the thread and processor group interfaces are available. - - - - - 7f8f948c by Peter Trommler at 2020-05-30T06:08:07-04:00 PPC NCG: Fix .size directive on powerpc64 ELF v1 Thanks to Sergei Trofimovich for pointing out the issue. Fixes #18237 - - - - - 7c555b05 by Andreas Klebinger at 2020-05-30T06:08:43-04:00 Optimize GHC.Utils.Monad. Many functions in this module are recursive and as such are marked loop breakers. Which means they are unlikely to get an unfolding. This is *bad*. We always want to specialize them to specific Monads. Which requires a visible unfolding at the use site. I rewrote the recursive ones from: foo f x = ... foo x' ... to foo f x = go x where go x = ... As well as giving some pragmas to make all of them available for specialization. The end result is a reduction of allocations of about -1.4% for nofib/spectral/simple/Main.hs when compiled with `-O`. ------------------------- Metric Decrease: T12425 T14683 T5631 T9233 T9675 T9961 WWRec ------------------------- - - - - - 8b1cb5df by Ben Gamari at 2020-05-30T06:09:20-04:00 Windows: Bump Windows toolchain to 0.2 - - - - - 6947231a by Zubin Duggal at 2020-05-30T06:10:02-04:00 Simplify contexts in GHC.Iface.Ext.Ast - - - - - 2ee4f36c by Daniel Gröber at 2020-06-01T06:32:56-04:00 Cleanup OVERWRITING_CLOSURE logic The code is just more confusing than it needs to be. We don't need to mix the threaded check with the ldv profiling check since ldv's init already checks for this. Hence they can be two separate checks. Taking the sanity checking into account is also cleaner via DebugFlags.sanity. No need for checking the DEBUG define. The ZERO_SLOP_FOR_LDV_PROF and ZERO_SLOP_FOR_SANITY_CHECK definitions the old code had also make things a lot more opaque IMO so I removed those. - - - - - 6159559b by Daniel Gröber at 2020-06-01T06:32:56-04:00 Fix OVERWRITING_CLOSURE assuming closures are not inherently used The new ASSERT in LDV_recordDead() was being tripped up by MVars when removeFromMVarBlockedQueue() calls OVERWRITING_CLOSURE() via OVERWRITE_INFO(). - - - - - 38992085 by Daniel Gröber at 2020-06-01T06:32:56-04:00 Always zero shrunk mutable array slop when profiling When shrinking arrays in the profiling way we currently don't always zero the leftover slop. This means we can't traverse such closures in the heap profiler. The old Note [zeroing slop] and #8402 have some rationale for why this is so but I belive the reasoning doesn't apply to mutable closures. There users already have to ensure multiple threads don't step on each other's toes so zeroing should be safe. - - - - - b0c1f2a6 by Ben Gamari at 2020-06-01T06:33:37-04:00 testsuite: Add test for #18151 - - - - - 9a99a178 by Ben Gamari at 2020-06-01T06:33:37-04:00 testsuite: Add test for desugaring of PostfixOperators - - - - - 2b89ca5b by Ben Gamari at 2020-06-01T06:33:37-04:00 HsToCore: Eta expand left sections Strangely, the comment next to this code already alluded to the fact that even simply eta-expanding will sacrifice laziness. It's quite unclear how we regressed so far. See #18151. - - - - - d412d7a3 by Kirill Elagin at 2020-06-01T06:34:21-04:00 Winferred-safe-imports: Do not exit with error Currently, when -Winferred-safe-imports is enabled, even when it is not turned into an error, the compiler will still exit with exit code 1 if this warning was emitted. Make sure it is really treated as a warning. - - - - - f945eea5 by Ben Gamari at 2020-06-01T06:34:58-04:00 nonmoving: Optimise log2_ceil - - - - - aab606e4 by Bodigrim at 2020-06-01T06:35:36-04:00 Clarify description of fromListN - - - - - 7e5220e2 by Bodigrim at 2020-06-01T06:35:36-04:00 Apply suggestion to libraries/base/GHC/Exts.hs - - - - - f3fb1ce9 by fendor at 2020-06-01T06:36:18-04:00 Add `isInScope` check to `lintCoercion` Mirrors the behaviour of `lintType`. - - - - - 5ac4d946 by fendor at 2020-06-01T06:36:18-04:00 Lint rhs of IfaceRule - - - - - 1cef6126 by Jeremy Schlatter at 2020-06-01T06:37:00-04:00 Fix wording in documentation The duplicate "orphan instance" phrase here doesn't make sense, and was probably an accident. - - - - - 5aaf08f2 by Takenobu Tani at 2020-06-01T06:37:43-04:00 configure: Modify aclocal.m4 according to new module hierarchy This patch updates file paths according to new module hierarchy [1]: * Rename: * compiler/GHC/Parser.hs <= compiler/parser/Parser.hs * compiler/GHC/Parser/Lexer.hs <= compiler/Parser/Lexer.hs * Add: * compiler/GHC/Cmm/Lexer.hs [1]: https://gitlab.haskell.org/ghc/ghc/-/wikis/Make-GHC-codebase-more-modular - - - - - 15857ad8 by Ben Gamari at 2020-06-01T06:38:26-04:00 testsuite: Don't fail if we can't unlink __symlink_test Afterall, it's possible we were unable to create it due to lack of symlink permission. - - - - - 4a7229ef by Ben Gamari at 2020-06-01T06:38:26-04:00 testsuite: Refactor ghostscript detection Tamar reported that he saw crashes due to unhandled exceptions. - - - - - 2ab37eaf by Ben Gamari at 2020-06-01T06:38:26-04:00 testsuite/perf_notes: Fix ill-typed assignments - - - - - e45d5b66 by Ben Gamari at 2020-06-01T06:38:26-04:00 testsuite/testutil: Fix bytes/str mismatch - - - - - 7002d0cb by Ben Gamari at 2020-06-01T06:38:26-04:00 testsuite: Work around spurious mypy failure - - - - - 11390e3a by Takenobu Tani at 2020-06-01T06:39:05-04:00 Clean up file paths for new module hierarchy This updates comments only. This patch replaces file references according to new module hierarchy. See also: * https://gitlab.haskell.org/ghc/ghc/-/wikis/Make-GHC-codebase-more-modular * https://gitlab.haskell.org/ghc/ghc/issues/13009 - - - - - 8f2e5732 by Takenobu Tani at 2020-06-01T06:39:05-04:00 Modify file paths to module paths for new module hierarchy This updates comments only. This patch replaces module references according to new module hierarchy [1][2]. For files under the `compiler/` directory, I replace them as module paths instead of file paths. For instance, `GHC.Unit.State` instead of `compiler/GHC/Unit/State.hs` [3]. For current and future haddock's markup, this patch encloses the module name with "" [4]. [1]: https://gitlab.haskell.org/ghc/ghc/-/wikis/Make-GHC-codebase-more-modular [2]: https://gitlab.haskell.org/ghc/ghc/issues/13009 [3]: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3375#note_276613 [4]: https://haskell-haddock.readthedocs.io/en/latest/markup.html#linking-to-modules - - - - - 68b71c4a by Tom Ellis at 2020-06-01T06:39:55-04:00 Rename the singleton tuple GHC.Tuple.Unit to GHC.Tuple.Solo - - - - - 95da76c2 by Sylvain Henry at 2020-06-01T06:40:41-04:00 Hadrian: fix binary-dist target for cross-compilation - - - - - 730fcd54 by Vladislav Zavialov at 2020-06-01T06:41:18-04:00 Improve parser error messages for the @-operator Since GHC diverges from the Haskell Report by allowing the user to define (@) as an infix operator, we better give a good error message when the user does so unintentionally. In general, this is rather hard to do, as some failures will be discovered only in the renamer or the type checker: x :: (Integer, Integer) x @ (a, b) = (1, 2) This patch does *not* address this general case. However, it gives much better error messages when the binding is not syntactically valid: pairs xs @ (_:xs') = zip xs xs' Before this patch, the error message was rather puzzling: <interactive>:1:1: error: Parse error in pattern: pairs After this patch, the error message includes a hint: <interactive>:1:1: error: Parse error in pattern: pairs In a function binding for the ‘@’ operator. Perhaps you meant an as-pattern, which must not be surrounded by whitespace - - - - - 0fde5377 by Vladislav Zavialov at 2020-06-01T06:41:18-04:00 Improve parser error messages for TypeApplications With this patch, we always parse f @t as a type application, thereby producing better error messages. This steals two syntactic forms: * Prefix form of the @-operator in expressions. Since the @-operator is a divergence from the Haskell Report anyway, this is not a major loss. * Prefix form of @-patterns. Since we are stealing loose infix form anyway, might as well sacrifice the prefix form for the sake of much better error messages. - - - - - c68e7e1e by Vladislav Zavialov at 2020-06-01T06:41:18-04:00 Improve parser error messages for TemplateHaskellQuotes While [e| |], [t| |], [d| |], and so on, steal syntax from list comprehensions, [| |] and [|| ||] do not steal any syntax. Thus we can improve error messages by always accepting them in the lexer. Turns out the renamer already performs necessary validation. - - - - - 120aedbd by Ben Gamari at 2020-06-01T16:07:02-04:00 gitlab-ci: Disable use of ld.lld on ARMv7 It turns out that lld non-deterministically fails on ARMv7. I suspect this may be due to the a kernel regression as this only started happening when we upgraded to 5.4. Nevertheless, easily avoided by simply sticking with gold. Works around #18280. - - - - - d6279ff0 by Ben Gamari at 2020-06-02T13:03:30-04:00 gitlab-ci: Ensure that workaround for #18280 applies to bindisttest We need to ensure that the `configure` flags working around #18280 are propagated to the bindisttest `configure` as well. - - - - - cb5c31b5 by Ben Gamari at 2020-06-03T17:55:04-04:00 gitlab-ci: Allow ARMv7 job to fail Due to #18298. - - - - - 32a4ae90 by John Ericson at 2020-06-04T04:34:42-04:00 Clean up boot vs non-boot disambiguating types We often have (ModuleName, Bool) or (Module, Bool) pairs for "extended" module names (without or with a unit id) disambiguating boot and normal modules. We think this is important enough across the compiler that it deserves a new nominal product type. We do this with synnoyms and a functor named with a `Gen` prefix, matching other newly created definitions. It was also requested that we keep custom `IsBoot` / `NotBoot` sum type. So we have it too. This means changing many the many bools to use that instead. Updates `haddock` submodule. - - - - - c05756cd by Niklas Hambüchen at 2020-06-04T04:35:24-04:00 docs: Add more details on InterruptibleFFI. Details from https://gitlab.haskell.org/ghc/ghc/issues/8684 and https://github.com/takano-akio/filelock/pull/7#discussion_r280332430 - - - - - 1b975aed by Andrew Martin at 2020-06-04T04:36:03-04:00 Allow finalizeForeignPtr to be called on FinalPtr/PlainPtr. MR 2165 (commit 49301ad6226d9a83d110bee8c419615dd94f5ded) regressed finalizeForeignPtr by throwing exceptions when PlainPtr was encounterd. This regression did not make it into a release of GHC. Here, the original behavior is restored, and FinalPtr is given the same treatment as PlainPtr. - - - - - 2bd3929a by Luke Lau at 2020-06-04T04:36:41-04:00 Fix documentation on type families not being extracted It looks like the location of the Names used for CoAxioms on type families are now located at their type constructors. Previously, Docs.hs thought the Names were located in the RHS, so the RealSrcSpan in the instanceMap and getInstLoc didn't match up. Fixes #18241 - - - - - 6735b9d9 by Ben Gamari at 2020-06-04T04:37:21-04:00 GHC.Hs.Instances: Compile with -O0 This module contains exclusively Data instances, which are going to be slow no matter what we do. Furthermore, they are incredibly slow to compile with optimisation (see #9557). Consequently we compile this with -O0. See #18254. - - - - - c330331a by nineonine at 2020-06-04T04:37:59-04:00 Add test for #17669 - - - - - cab684f0 by Ben Gamari at 2020-06-04T04:38:36-04:00 rts: Add Windows-specific implementation of rtsSleep Previously we would use the POSIX path, which uses `nanosleep`. However, it turns out that `nanosleep` is provided by `libpthread` on Windows. In general we don't want to incur such a dependency. Avoid this by simply using `Sleep` on Windows. Fixes #18272. - - - - - ad44b504 by Ben Gamari at 2020-06-04T04:38:36-04:00 compiler: Disable use of process jobs with process < 1.6.9 Due to #17926. - - - - - 6a4098a4 by Moritz Angermann at 2020-06-04T04:55:51-04:00 [linker] Adds void printLoadedObjects(void); This allows us to dump in-memory object code locations for debugging. Fixup printLoadedObjects prototype - - - - - af5e3a88 by Artem Pelenitsyn at 2020-06-05T03:18:49-04:00 base: fix sign confusion in log1mexp implementation (fix #17125) author: claude (https://gitlab.haskell.org/trac-claude) The correct threshold for log1mexp is -(log 2) with the current specification of log1mexp. This change improves accuracy for large negative inputs. To avoid code duplication, a small helper function is added; it isn't the default implementation in Floating because it needs Ord. This patch does nothing to address that the Haskell specification is different from that in common use in other languages. - - - - - 2b792fac by Simon Peyton Jones at 2020-06-05T09:27:50-04:00 Simple subsumption This patch simplifies GHC to use simple subsumption. Ticket #17775 Implements GHC proposal #287 https://github.com/ghc-proposals/ghc-proposals/blob/master/ proposals/0287-simplify-subsumption.rst All the motivation is described there; I will not repeat it here. The implementation payload: * tcSubType and friends become noticably simpler, because it no longer uses eta-expansion when checking subsumption. * No deeplyInstantiate or deeplySkolemise That in turn means that some tests fail, by design; they can all be fixed by eta expansion. There is a list of such changes below. Implementing the patch led me into a variety of sticky corners, so the patch includes several othe changes, some quite significant: * I made String wired-in, so that "foo" :: String rather than "foo" :: [Char] This improves error messages, and fixes #15679 * The pattern match checker relies on knowing about in-scope equality constraints, andd adds them to the desugarer's environment using addTyCsDs. But the co_fn in a FunBind was missed, and for some reason simple-subsumption ends up with dictionaries there. So I added a call to addTyCsDs. This is really part of #18049. * I moved the ic_telescope field out of Implication and into ForAllSkol instead. This is a nice win; just expresses the code much better. * There was a bug in GHC.Tc.TyCl.Instance.tcDataFamInstHeader. We called checkDataKindSig inside tc_kind_sig, /before/ solveEqualities and zonking. Obviously wrong, easily fixed. * solveLocalEqualitiesX: there was a whole mess in here, around failing fast enough. I discovered a bad latent bug where we could successfully kind-check a type signature, and use it, but have unsolved constraints that could fill in coercion holes in that signature -- aargh. It's all explained in Note [Failure in local type signatures] in GHC.Tc.Solver. Much better now. * I fixed a serious bug in anonymous type holes. IN f :: Int -> (forall a. a -> _) -> Int that "_" should be a unification variable at the /outer/ level; it cannot be instantiated to 'a'. This was plain wrong. New fields mode_lvl and mode_holes in TcTyMode, and auxiliary data type GHC.Tc.Gen.HsType.HoleMode. This fixes #16292, but makes no progress towards the more ambitious #16082 * I got sucked into an enormous refactoring of the reporting of equality errors in GHC.Tc.Errors, especially in mkEqErr1 mkTyVarEqErr misMatchMsg misMatchMsgOrCND In particular, the very tricky mkExpectedActualMsg function is gone. It took me a full day. But the result is far easier to understand. (Still not easy!) This led to various minor improvements in error output, and an enormous number of test-case error wibbles. One particular point: for occurs-check errors I now just say Can't match 'a' against '[a]' rather than using the intimidating language of "occurs check". * Pretty-printing AbsBinds Tests review * Eta expansions T11305: one eta expansion T12082: one eta expansion (undefined) T13585a: one eta expansion T3102: one eta expansion T3692: two eta expansions (tricky) T2239: two eta expansions T16473: one eta determ004: two eta expansions (undefined) annfail06: two eta (undefined) T17923: four eta expansions (a strange program indeed!) tcrun035: one eta expansion * Ambiguity check at higher rank. Now that we have simple subsumption, a type like f :: (forall a. Eq a => Int) -> Int is no longer ambiguous, because we could write g :: (forall a. Eq a => Int) -> Int g = f and it'd typecheck just fine. But f's type is a bit suspicious, and we might want to consider making the ambiguity check do a check on each sub-term. Meanwhile, these tests are accepted, whereas they were previously rejected as ambiguous: T7220a T15438 T10503 T9222 * Some more interesting error message wibbles T13381: Fine: one error (Int ~ Exp Int) rather than two (Int ~ Exp Int, Exp Int ~ Int) T9834: Small change in error (improvement) T10619: Improved T2414: Small change, due to order of unification, fine T2534: A very simple case in which a change of unification order means we get tow unsolved constraints instead of one tc211: bizarre impredicative tests; just accept this for now Updates Cabal and haddock submodules. Metric Increase: T12150 T12234 T5837 haddock.base Metric Decrease: haddock.compiler haddock.Cabal haddock.base Merge note: This appears to break the `UnliftedNewtypesDifficultUnification` test. It has been marked as broken in the interest of merging. (cherry picked from commit 66b7b195cb3dce93ed5078b80bf568efae904cc5) - - - - - 2dff8141 by Ryan Scott at 2020-06-05T14:21:24-04:00 Simplify bindLHsTyVarBndrs and bindHsQTyVars Both `bindLHsTyVarBndrs` and `bindHsQTyVars` take two separate `Maybe` arguments, which I find terribly confusing. Thankfully, it's possible to remove one `Maybe` argument from each of these functions, which this patch accomplishes: * `bindHsQTyVars` takes a `Maybe SDoc` argument, which is `Just` if GHC should warn about any of the quantified type variables going unused. However, every call site uses `Nothing` in practice. This makes sense, since it doesn't really make sense to warn about unused type variables bound by an `LHsQTyVars`. For instance, you wouldn't warn about the `a` in `data Proxy a = Proxy` going unused. As a result, I simply remove this `Maybe SDoc` argument altogether. * `bindLHsTyVarBndrs` also takes a `Maybe SDoc` argument for the same reasons that `bindHsQTyVars` took one. To make things more confusing, however, `bindLHsTyVarBndrs` also takes a separate `HsDocContext` argument, which is pretty-printed (to an `SDoc`) in warnings and error messages. In practice, the `Maybe SDoc` and the `HsDocContext` often contain the same text. See the call sites for `bindLHsTyVarBndrs` in `rnFamInstEqn` and `rnConDecl`, for instance. There are only a handful of call sites where the text differs between the `Maybe SDoc` and `HsDocContext` arguments: * In `rnHsRuleDecl`, where the `Maybe SDoc` says "`In the rule`" and the `HsDocContext` says "`In the transformation rule`". * In `rnHsTyKi`/`rn_ty`, where the `Maybe SDoc` says "`In the type`" but the `HsDocContext` is inhereted from the surrounding context (e.g., if `rnHsTyKi` were called on a top-level type signature, the `HsDocContext` would be "`In the type signature`" instead) In both cases, warnings/error messages arguably _improve_ by unifying making the `Maybe SDoc`'s text match that of the `HsDocContext`. As a result, I decided to remove the `Maybe SDoc` argument to `bindLHsTyVarBndrs` entirely and simply reuse the text from the `HsDocContext`. (I decided to change the phrase "transformation rule" to "rewrite rule" while I was in the area.) The `Maybe SDoc` argument has one other purpose: signaling when to emit "`Unused quantified type variable`" warnings. To recover this functionality, I replaced the `Maybe SDoc` argument with a boolean-like `WarnUnusedForalls` argument. The only `bindLHsTyVarBndrs` call site that chooses _not_ to emit these warnings in `bindHsQTyVars`. - - - - - e372331b by Ben Gamari at 2020-06-07T08:46:41-04:00 hadrian: Add missing deriveConstants dependency on ghcplatform.h deriveConstants wants to compile C sources which #include PosixSource.h, which itself #includes ghcplatform.h. Make sure that Hadrian knows about this dependency. Fixes #18290. - - - - - b022051a by Moritz Angermann at 2020-06-07T08:46:42-04:00 ghc-prim needs to depend on libc and libm libm is just an empty shell on musl, and all the math functions are contained in libc. - - - - - 6dae6548 by Moritz Angermann at 2020-06-07T08:46:42-04:00 Disable DLL loading if without system linker Some platforms (musl, aarch64) do not have a working dynamic linker implemented in the libc, even though we might see dlopen. It will ultimately just return that this is not supported. Hence we'll add a flag to the compiler to flat our disable loading dlls. This is needed as we will otherwise try to load the shared library even if this will subsequently fail. At that point we have given up looking for static options though. - - - - - 4a158ffc by Moritz Angermann at 2020-06-07T08:46:43-04:00 Range is actually +/-2^32, not +/-2^31 See also: https://static.docs.arm.com/ihi0056/g/aaelf64.pdf - - - - - f1bfb806 by Ben Gamari at 2020-06-07T10:49:30-04:00 OccurAnal: Avoid exponential behavior due to where clauses Previously the `Var` case of `occAnalApp` could in some cases (namely in the case of `runRW#` applications) call `occAnalRhs` two. In the case of nested `runRW#`s this results in exponential complexity. In some cases the compilation time that resulted would be very long indeed (see #18296). Fixes #18296. Metric Decrease: T9961 T12150 T12234 - - - - - 9b607671 by Takenobu Tani at 2020-06-09T08:05:46-04:00 Add link to GHC's wiki in the GHC API header This adds a URL to point to GHC's wiki in the GHC API header. Newcomers could easily find more information from the GHC API's web like [1]. [1]: Current version, https://ghc.gitlab.haskell.org/ghc/doc/libraries/ghc-8.11.0.20200604/index.html [skip ci] - - - - - 72c7fe9a by Ryan Scott at 2020-06-09T08:06:24-04:00 Make GADT constructors adhere to the forall-or-nothing rule properly Issue #18191 revealed that the types of GADT constructors don't quite adhere to the `forall`-or-nothing rule. This patch serves to clean up this sad state of affairs somewhat. The main change is not in the code itself, but in the documentation, as this patch introduces two sections to the GHC User's Guide: * A "Formal syntax for GADTs" section that presents a BNF-style grammar for what is and isn't allowed in GADT constructor types. This mostly exists to codify GHC's existing behavior, but it also imposes a new restriction that addresses #18191: the outermost `forall` and/or context in a GADT constructor is not allowed to be surrounded by parentheses. Doing so would make these `forall`s/contexts nested, and GADTs do not support nested `forall`s/contexts at present. * A "`forall`-or-nothing rule" section that describes exactly what the `forall`-or-nothing rule is all about. Surprisingly, there was no mention of this anywhere in the User's Guide up until now! To adhere the new specification in the "Formal syntax for GADTs" section of the User's Guide, the following code changes were made: * A new function, `GHC.Hs.Type.splitLHsGADTPrefixTy`, was introduced. This is very much like `splitLHsSigmaTy`, except that it avoids splitting apart any parentheses, which can be syntactically significant for GADT types. See `Note [No nested foralls or contexts in GADT constructors]` in `GHC.Hs.Type`. * `ConDeclGADTPrefixPs`, an extension constructor for `XConDecl`, was introduced so that `GHC.Parser.PostProcess.mkGadtDecl` can return it when given a prefix GADT constructor. Unlike `ConDeclGADT`, `ConDeclGADTPrefixPs` does not split the GADT type into its argument and result types, as this cannot be done until after the type is renamed (see `Note [GADT abstract syntax]` in `GHC.Hs.Decls` for why this is the case). * `GHC.Renamer.Module.rnConDecl` now has an additional case for `ConDeclGADTPrefixPs` that (1) splits apart the full `LHsType` into its `forall`s, context, argument types, and result type, and (2) checks for nested `forall`s/contexts. Step (2) used to be performed the typechecker (in `GHC.Tc.TyCl.badDataConTyCon`) rather than the renamer, but now the relevant code from the typechecker can simply be deleted. One nice side effect of this change is that we are able to give a more accurate error message for GADT constructors that use visible dependent quantification (e.g., `MkFoo :: forall a -> a -> Foo a`), which improves the stderr in the `T16326_Fail6` test case. Fixes #18191. Bumps the Haddock submodule. - - - - - a47e6442 by Ryan Scott at 2020-06-10T03:39:12-04:00 Always use rnImplicitBndrs to bring implicit tyvars into scope This implements a first step towards #16762 by changing the renamer to always use `rnImplicitBndrs` to bring implicitly bound type variables into scope. The main change is in `rnFamInstEqn` and `bindHsQTyVars`, which previously used _ad hoc_ methods of binding their implicit tyvars. There are a number of knock-on consequences: * One of the reasons that `rnFamInstEqn` used an _ad hoc_ binding mechanism was to give more precise source locations in `-Wunused-type-patterns` warnings. (See https://gitlab.haskell.org/ghc/ghc/issues/16762#note_273343 for an example of this.) However, these warnings are actually a little _too_ precise, since implicitly bound type variables don't have exact binding sites like explicitly bound type variables do. A similar problem existed for "`Different names for the same type variable`" errors involving implicit tyvars bound by `bindHsQTyVars`. Therefore, we simply accept the less precise (but more accurate) source locations from `rnImplicitBndrs` in `rnFamInstEqn` and `bindHsQTyVars`. See `Note [Source locations for implicitly bound type variables]` in `GHC.Rename.HsType` for the full story. * In order for `rnImplicitBndrs` to work in `rnFamInstEqn`, it needs to be able to look up names from the parent class (in the event that we are renaming an associated type family instance). As a result, `rnImplicitBndrs` now takes an argument of type `Maybe assoc`, which is `Just` in the event that a type family instance is associated with a class. * Previously, GHC kept track of three type synonyms for free type variables in the renamer: `FreeKiTyVars`, `FreeKiTyVarsDups` (which are allowed to contain duplicates), and `FreeKiTyVarsNoDups` (which contain no duplicates). However, making is a distinction between `-Dups` and `-NoDups` is now pointless, as all code that returns `FreeKiTyVars{,Dups,NoDups}` will eventually end up being passed to `rnImplicitBndrs`, which removes duplicates. As a result, I decided to just get rid of `FreeKiTyVarsDups` and `FreeKiTyVarsNoDups`, leaving only `FreeKiTyVars`. * The `bindLRdrNames` and `deleteBys` functions are now dead code, so I took the liberty of removing them. - - - - - 24879129 by Takenobu Tani at 2020-06-10T03:39:59-04:00 Clarify leaf module names for new module hierarchy This updates comments only. This patch replaces leaf module names according to new module hierarchy [1][2] as followings: * Expand leaf names to easily find the module path: for instance, `Id.hs` to `GHC.Types.Id`. * Modify leaf names according to new module hierarchy: for instance, `Convert.hs` to `GHC.ThToHs`. * Fix typo: for instance, `GHC.Core.TyCo.Rep.hs` to `GHC.Core.TyCo.Rep` See also !3375 [1]: https://gitlab.haskell.org/ghc/ghc/-/wikis/Make-GHC-codebase-more-modular [2]: https://gitlab.haskell.org/ghc/ghc/issues/13009 - - - - - 92de9e25 by Ömer Sinan Ağacan at 2020-06-10T03:41:07-04:00 rts: Remove unused GET_ENTRY closure macro This macro is not used and got broken in the meantime, as ENTRY_CODE was deleted. - - - - - 87102928 by Ömer Sinan Ağacan at 2020-06-10T03:41:50-04:00 Fix -fkeep-cafs flag name in users guide - - - - - ccd6843d by Shayne Fletcher at 2020-06-10T04:14:57-04:00 Expose impliedGFlags, impledOffGFlags, impliedXFlags - - - - - 7a737e89 by Ömer Sinan Ağacan at 2020-06-10T04:14:58-04:00 Cross-module LambdaFormInfo passing - Store LambdaFormInfos of exported Ids in interface files - Use them in importing modules This is for optimization purposes: if we know LambdaFormInfo of imported Ids we can generate more efficient calling code, see `getCallMethod`. Exporting (putting them in interface files or in ModDetails) and importing (reading them from interface files) are both optional. We don't assume known LambdaFormInfos anywhere and do not change how we call Ids with unknown LambdaFormInfos. Runtime, allocation, and residency numbers when building Cabal-the-library (commit 0d4ee7ba3): (Log and .hp files are in the MR: !2842) | | GHC HEAD | This patch | Diff | |-----|----------|------------|----------------| | -O0 | 0:35.89 | 0:34.10 | -1.78s, -4.98% | | -O1 | 2:24.01 | 2:23.62 | -0.39s, -0.27% | | -O2 | 2:52.23 | 2:51.35 | -0.88s, -0.51% | | | GHC HEAD | This patch | Diff | |-----|-----------------|-----------------|----------------------------| | -O0 | 54,843,608,416 | 54,878,769,544 | +35,161,128 bytes, +0.06% | | -O1 | 227,136,076,400 | 227,569,045,168 | +432,968,768 bytes, +0.19% | | -O2 | 266,147,063,296 | 266,749,643,440 | +602,580,144 bytes, +0.22% | NOTE: Residency is measured with extra runtime args: `-i0 -h` which effectively turn all GCs into major GCs, and do GC more often. | | GHC HEAD | This patch | Diff | |-----|----------------------------|------------------------------|----------------------------| | -O0 | 410,284,000 (910 samples) | 411,745,008 (906 samples) | +1,461,008 bytes, +0.35% | | -O1 | 928,580,856 (2109 samples) | 943,506,552 (2103 samples) | +14,925,696 bytes, +1.60% | | -O2 | 993,951,352 (2549 samples) | 1,010,156,328 (2545 samples) | +16,204,9760 bytes, +1.63% | NoFib results: -------------------------------------------------------------------------------- Program Size Allocs Instrs Reads Writes -------------------------------------------------------------------------------- CS 0.0% 0.0% +0.0% +0.0% +0.0% CSD 0.0% 0.0% 0.0% +0.0% +0.0% FS 0.0% 0.0% +0.0% +0.0% +0.0% S 0.0% 0.0% +0.0% +0.0% +0.0% VS 0.0% 0.0% +0.0% +0.0% +0.0% VSD 0.0% 0.0% +0.0% +0.0% +0.1% VSM 0.0% 0.0% +0.0% +0.0% +0.0% anna 0.0% 0.0% -0.3% -0.8% -0.0% ansi 0.0% 0.0% -0.0% -0.0% 0.0% atom 0.0% 0.0% -0.0% -0.0% 0.0% awards 0.0% 0.0% -0.1% -0.3% 0.0% banner 0.0% 0.0% -0.0% -0.0% -0.0% bernouilli 0.0% 0.0% -0.0% -0.0% -0.0% binary-trees 0.0% 0.0% -0.0% -0.0% +0.0% boyer 0.0% 0.0% -0.0% -0.0% 0.0% boyer2 0.0% 0.0% -0.0% -0.0% 0.0% bspt 0.0% 0.0% -0.0% -0.2% 0.0% cacheprof 0.0% 0.0% -0.1% -0.4% +0.0% calendar 0.0% 0.0% -0.0% -0.0% 0.0% cichelli 0.0% 0.0% -0.9% -2.4% 0.0% circsim 0.0% 0.0% -0.0% -0.0% 0.0% clausify 0.0% 0.0% -0.1% -0.3% 0.0% comp_lab_zift 0.0% 0.0% -0.0% -0.0% +0.0% compress 0.0% 0.0% -0.0% -0.0% -0.0% compress2 0.0% 0.0% -0.0% -0.0% 0.0% constraints 0.0% 0.0% -0.1% -0.2% -0.0% cryptarithm1 0.0% 0.0% -0.0% -0.0% 0.0% cryptarithm2 0.0% 0.0% -1.4% -4.1% -0.0% cse 0.0% 0.0% -0.0% -0.0% -0.0% digits-of-e1 0.0% 0.0% -0.0% -0.0% -0.0% digits-of-e2 0.0% 0.0% -0.0% -0.0% -0.0% dom-lt 0.0% 0.0% -0.1% -0.2% 0.0% eliza 0.0% 0.0% -0.5% -1.5% 0.0% event 0.0% 0.0% -0.0% -0.0% -0.0% exact-reals 0.0% 0.0% -0.1% -0.3% +0.0% exp3_8 0.0% 0.0% -0.0% -0.0% -0.0% expert 0.0% 0.0% -0.3% -1.0% -0.0% fannkuch-redux 0.0% 0.0% +0.0% +0.0% +0.0% fasta 0.0% 0.0% -0.0% -0.0% +0.0% fem 0.0% 0.0% -0.0% -0.0% 0.0% fft 0.0% 0.0% -0.0% -0.0% 0.0% fft2 0.0% 0.0% -0.0% -0.0% 0.0% fibheaps 0.0% 0.0% -0.0% -0.0% +0.0% fish 0.0% 0.0% 0.0% -0.0% +0.0% fluid 0.0% 0.0% -0.4% -1.2% +0.0% fulsom 0.0% 0.0% -0.0% -0.0% 0.0% gamteb 0.0% 0.0% -0.1% -0.3% 0.0% gcd 0.0% 0.0% -0.0% -0.0% 0.0% gen_regexps 0.0% 0.0% -0.0% -0.0% -0.0% genfft 0.0% 0.0% -0.0% -0.0% 0.0% gg 0.0% 0.0% -0.0% -0.0% +0.0% grep 0.0% 0.0% -0.0% -0.0% -0.0% hidden 0.0% 0.0% -0.1% -0.4% -0.0% hpg 0.0% 0.0% -0.2% -0.5% +0.0% ida 0.0% 0.0% -0.0% -0.0% +0.0% infer 0.0% 0.0% -0.3% -0.8% -0.0% integer 0.0% 0.0% -0.0% -0.0% +0.0% integrate 0.0% 0.0% -0.0% -0.0% 0.0% k-nucleotide 0.0% 0.0% -0.0% -0.0% +0.0% kahan 0.0% 0.0% -0.0% -0.0% +0.0% knights 0.0% 0.0% -2.2% -5.4% 0.0% lambda 0.0% 0.0% -0.6% -1.8% 0.0% last-piece 0.0% 0.0% -0.0% -0.0% 0.0% lcss 0.0% 0.0% -0.0% -0.1% 0.0% life 0.0% 0.0% -0.0% -0.1% 0.0% lift 0.0% 0.0% -0.2% -0.6% +0.0% linear 0.0% 0.0% -0.0% -0.0% -0.0% listcompr 0.0% 0.0% -0.0% -0.0% 0.0% listcopy 0.0% 0.0% -0.0% -0.0% 0.0% maillist 0.0% 0.0% -0.1% -0.3% +0.0% mandel 0.0% 0.0% -0.0% -0.0% 0.0% mandel2 0.0% 0.0% -0.0% -0.0% -0.0% mate +0.0% 0.0% -0.0% -0.0% -0.0% minimax 0.0% 0.0% -0.2% -1.0% 0.0% mkhprog 0.0% 0.0% -0.1% -0.2% -0.0% multiplier 0.0% 0.0% -0.0% -0.0% -0.0% n-body 0.0% 0.0% -0.0% -0.0% +0.0% nucleic2 0.0% 0.0% -0.1% -0.2% 0.0% para 0.0% 0.0% -0.0% -0.0% -0.0% paraffins 0.0% 0.0% -0.0% -0.0% 0.0% parser 0.0% 0.0% -0.2% -0.7% 0.0% parstof 0.0% 0.0% -0.0% -0.0% +0.0% pic 0.0% 0.0% -0.0% -0.0% 0.0% pidigits 0.0% 0.0% +0.0% +0.0% +0.0% power 0.0% 0.0% -0.2% -0.6% +0.0% pretty 0.0% 0.0% -0.0% -0.0% -0.0% primes 0.0% 0.0% -0.0% -0.0% 0.0% primetest 0.0% 0.0% -0.0% -0.0% -0.0% prolog 0.0% 0.0% -0.3% -1.1% 0.0% puzzle 0.0% 0.0% -0.0% -0.0% 0.0% queens 0.0% 0.0% -0.0% -0.0% +0.0% reptile 0.0% 0.0% -0.0% -0.0% 0.0% reverse-complem 0.0% 0.0% -0.0% -0.0% +0.0% rewrite 0.0% 0.0% -0.7% -2.5% -0.0% rfib 0.0% 0.0% -0.0% -0.0% 0.0% rsa 0.0% 0.0% -0.0% -0.0% 0.0% scc 0.0% 0.0% -0.1% -0.2% -0.0% sched 0.0% 0.0% -0.0% -0.0% -0.0% scs 0.0% 0.0% -1.0% -2.6% +0.0% simple 0.0% 0.0% +0.0% -0.0% +0.0% solid 0.0% 0.0% -0.0% -0.0% 0.0% sorting 0.0% 0.0% -0.6% -1.6% 0.0% spectral-norm 0.0% 0.0% +0.0% 0.0% +0.0% sphere 0.0% 0.0% -0.0% -0.0% -0.0% symalg 0.0% 0.0% -0.0% -0.0% +0.0% tak 0.0% 0.0% -0.0% -0.0% 0.0% transform 0.0% 0.0% -0.0% -0.0% 0.0% treejoin 0.0% 0.0% -0.0% -0.0% 0.0% typecheck 0.0% 0.0% -0.0% -0.0% +0.0% veritas +0.0% 0.0% -0.2% -0.4% +0.0% wang 0.0% 0.0% -0.0% -0.0% 0.0% wave4main 0.0% 0.0% -0.0% -0.0% -0.0% wheel-sieve1 0.0% 0.0% -0.0% -0.0% -0.0% wheel-sieve2 0.0% 0.0% -0.0% -0.0% +0.0% x2n1 0.0% 0.0% -0.0% -0.0% -0.0% -------------------------------------------------------------------------------- Min 0.0% 0.0% -2.2% -5.4% -0.0% Max +0.0% 0.0% +0.0% +0.0% +0.1% Geometric Mean -0.0% -0.0% -0.1% -0.3% +0.0% Metric increases micro benchmarks tracked in #17686: Metric Increase: T12150 T12234 T12425 T13035 T5837 T6048 T9233 Co-authored-by: Andreas Klebinger <klebinger.andreas at gmx.at> - - - - - 3b22b14a by Shayne Fletcher at 2020-06-10T04:15:01-04:00 Give Language a Bounded instance - - - - - 9454511b by Simon Peyton Jones at 2020-06-10T04:17:06-04:00 Optimisation in Unique.Supply This patch switches on -fno-state-hack in GHC.Types.Unique.Supply. It turned out that my fixes for #18078 (coercion floating) changed the optimisation pathway for mkSplitUniqSupply in such a way that we had an extra allocation inside the inner loop. Adding -fno-state-hack fixed that -- and indeed the loop in mkSplitUniqSupply is a classic example of the way in which -fno-state-hack can be bad; see #18238. Moreover, the new code is better than the old. They allocate the same, but the old code ends up with a partial application. The net effect is that the test perf/should_run/UniqLoop runs 20% faster! From 2.5s down to 2.0s. The allocation numbers are the same -- but elapsed time falls. Good! The bad thing about this is that it's terribly delicate. But at least it's a good example of such delicacy in action. There is a long Note [Optimising the unique supply] which now explains all this. - - - - - 6d49d5be by Simon Peyton Jones at 2020-06-10T04:17:06-04:00 Implement cast worker/wrapper properly The cast worker/wrapper transformation transforms x = e |> co into y = e x = y |> co This is done by the simplifier, but we were being careless about transferring IdInfo from x to y, and about what to do if x is a NOINLNE function. This resulted in a series of bugs: #17673, #18093, #18078. This patch fixes all that: * Main change is in GHC.Core.Opt.Simplify, and the new prepareBinding function, which does this cast worker/wrapper transform. See Note [Cast worker/wrappers]. * There is quite a bit of refactoring around prepareRhs, makeTrivial etc. It's nicer now. * Some wrappers from strictness and cast w/w, notably those for a function with a NOINLINE, should inline very late. There wasn't really a mechanism for that, which was an existing bug really; so I invented a new finalPhase = Phase (-1). It's used for all simplifier runs after the user-visible phase 2,1,0 have run. (No new runs of the simplifier are introduced thereby.) See new Note [Compiler phases] in GHC.Types.Basic; the main changes are in GHC.Core.Opt.Driver * Doing this made me trip over two places where the AnonArgFlag on a FunTy was being lost so we could end up with (Num a -> ty) rather than (Num a => ty) - In coercionLKind/coercionRKind - In contHoleType in the Simplifier I fixed the former by defining mkFunctionType and using it in coercionLKind/RKind. I could have done the same for the latter, but the information is almost to hand. So I fixed the latter by - adding sc_hole_ty to ApplyToVal (like ApplyToTy), - adding as_hole_ty to ValArg (like TyArg) - adding sc_fun_ty to StrictArg Turned out I could then remove ai_type from ArgInfo. This is just moving the deck chairs around, but it worked out nicely. See the new Note [AnonArgFlag] in GHC.Types.Var * When looking at the 'arity decrease' thing (#18093) I discovered that stable unfoldings had a much lower arity than the actual optimised function. That's what led to the arity-decrease message. Simple solution: eta-expand. It's described in Note [Eta-expand stable unfoldings] in GHC.Core.Opt.Simplify * I also discovered that unsafeCoerce wasn't being inlined if the context was boring. So (\x. f (unsafeCoerce x)) would create a thunk -- yikes! I fixed that by making inlineBoringOK a bit cleverer: see Note [Inline unsafeCoerce] in GHC.Core.Unfold. I also found that unsafeCoerceName was unused, so I removed it. I made a test case for #18078, and a very similar one for #17673. The net effect of all this on nofib is very modest, but positive: -------------------------------------------------------------------------------- Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- anna -0.4% -0.1% -3.1% -3.1% 0.0% fannkuch-redux -0.4% -0.3% -0.1% -0.1% 0.0% maillist -0.4% -0.1% -7.8% -1.0% -14.3% primetest -0.4% -15.6% -7.1% -6.6% 0.0% -------------------------------------------------------------------------------- Min -0.9% -15.6% -13.3% -14.2% -14.3% Max -0.3% 0.0% +12.1% +12.4% 0.0% Geometric Mean -0.4% -0.2% -2.3% -2.2% -0.1% All following metric decreases are compile-time allocation decreases between -1% and -3%: Metric Decrease: T5631 T13701 T14697 T15164 - - - - - 32fd37f5 by Luke Lau at 2020-06-10T04:17:22-04:00 Fix lookupGlobalOccRn_maybe sometimes reporting an error In some cases it was possible for lookupGlobalOccRn_maybe to return an error, when it should be returning a Nothing. If it called lookupExactOcc_either when there were no matching GlobalRdrElts in the otherwise case, it would return an error message. This could be caused when lookupThName_maybe in Template Haskell was looking in different namespaces (thRdrNameGuesses), guessing different namespaces that the name wasn't guaranteed to be found in. However, by addressing this some more accurate errors were being lost in the conversion to Maybes. So some of the lookup* functions have been shuffled about so that errors should always be ignored in lookup*_maybes, and propagated otherwise. This fixes #18263 - - - - - 9b283e1b by Roland Senn at 2020-06-10T04:17:34-04:00 Initialize the allocation counter in GHCi to 0 (Fixes #16012) According to the documentation for the function `getAllocationCounter` in [System.Mem](http://hackage.haskell.org/package/base-4.14.0.0/docs/System-Mem.html) initialize the allocationCounter also in GHCi to 0. - - - - - 8d07c48c by Sylvain Henry at 2020-06-10T04:17:36-04:00 test: fix conc038 We had spurious failures of conc038 test on CI with stdout: ``` newThread started -mainThread -Haskell: 2 newThread back again +mainThread 1 sec later shutting down +Haskell: 2 ``` - - - - - 4c7e9689 by Sebastian Graf at 2020-06-11T10:37:38+02:00 Release Notes: Add news from the pattern-match checker [skip ci] - - - - - 3445b965 by Sylvain Henry at 2020-06-13T02:13:01-04:00 Only test T16190 with the NCG T16190 is meant to test a NCG feature. It has already caused spurious failures in other MRs (e.g. !2165) when LLVM is used. - - - - - 2517a51c by Sylvain Henry at 2020-06-13T02:13:01-04:00 DynFlags refactoring VIII (#17957) * Remove several uses of `sdocWithDynFlags`, especially in GHC.Llvm.* * Add LlvmOpts datatype to store Llvm backend options * Remove Outputable instances (for LlvmVar, LlvmLit, LlvmStatic and Llvm.MetaExpr) which require LlvmOpts. * Rename ppMetaExpr into ppMetaAnnotExpr (pprMetaExpr is now used in place of `ppr :: MetaExpr -> SDoc`) - - - - - 7a02599a by Sylvain Henry at 2020-06-13T02:13:02-04:00 Remove unused code - - - - - 72d08610 by Sylvain Henry at 2020-06-13T02:13:02-04:00 Refactor homeUnit * rename thisPackage into homeUnit * document and refactor several Backpack things - - - - - 8dc71f55 by Sylvain Henry at 2020-06-13T02:13:02-04:00 Rename unsafeGetUnitInfo into unsafeLookupUnit - - - - - f6be6e43 by Sylvain Henry at 2020-06-13T02:13:02-04:00 Add allowVirtualUnits field in PackageState Instead of always querying DynFlags to know whether we are allowed to use virtual units (i.e. instantiated on-the-fly, cf Note [About units] in GHC.Unit), we store it once for all in `PackageState.allowVirtualUnits`. This avoids using DynFlags too much (cf #17957) and is preliminary work for #14335. - - - - - e7272d53 by Sylvain Henry at 2020-06-13T02:13:02-04:00 Enhance UnitId use * use UnitId instead of String to identify wired-in units * use UnitId instead of Unit in the backend (Unit are only use by Backpack to produce type-checked interfaces, not real code) * rename lookup functions for consistency * documentation - - - - - 9c5572cd by Sylvain Henry at 2020-06-13T02:13:02-04:00 Remove LinkerUnitId type alias - - - - - d345edfe by Sylvain Henry at 2020-06-13T02:13:02-04:00 Refactor WiredMap * Remove WiredInUnitId and WiredUnitId type aliases - - - - - 3d171cd6 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Document and refactor `mkUnit` and `mkUnitInfoMap` - - - - - d2109b4f by Sylvain Henry at 2020-06-13T02:13:03-04:00 Remove PreloadUnitId type alias - - - - - f50c19b8 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Rename listUnitInfoMap into listUnitInfo There is no Map involved - - - - - ed533ec2 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Rename Package into Unit The terminology changed over time and now package databases contain "units" (there can be several units compiled from a single Cabal package: one per-component, one for each option set, one per instantiation, etc.). We should try to be consistent internally and use "units": that's what this renaming does. Maybe one day we'll fix the UI too (e.g. replace -package-id with -unit-id, we already have -this-unit-id and ghc-pkg has -unit-id...) but it's not done in this patch. * rename getPkgFrameworkOpts into getUnitFrameworkOpts * rename UnitInfoMap into ClosureUnitInfoMap * rename InstalledPackageIndex into UnitInfoMap * rename UnusablePackages into UnusableUnits * rename PackagePrecedenceIndex into UnitPrecedenceMap * rename PackageDatabase into UnitDatabase * rename pkgDatabase into unitDatabases * rename pkgState into unitState * rename initPackages into initUnits * rename renamePackage into renameUnitInfo * rename UnusablePackageReason into UnusableUnitReason * rename getPackage* into getUnit* * etc. - - - - - 202728e5 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Make ClosureUnitInfoMap uses UnitInfoMap - - - - - 55b4263e by Sylvain Henry at 2020-06-13T02:13:03-04:00 Remove ClosureUnitInfoMap - - - - - 653d17bd by Sylvain Henry at 2020-06-13T02:13:03-04:00 Rename Package into Unit (2) * rename PackageState into UnitState * rename findWiredInPackages into findWiredInUnits * rename lookupModuleInAll[Packages,Units] * etc. - - - - - ae900605 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Move dump_mod_map into initUnits - - - - - 598cc1dd by Sylvain Henry at 2020-06-13T02:13:03-04:00 Move wiring of homeUnitInstantiations outside of mkUnitState - - - - - 437265eb by Sylvain Henry at 2020-06-13T02:13:03-04:00 Avoid timing module map dump in initUnits - - - - - 9400aa93 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Remove preload parameter of mkUnitState * Remove preload parameter (unused) * Don't explicitly return preloaded units: redundant because already returned as "preloadUnits" field of UnitState - - - - - 266bc3d9 by Sylvain Henry at 2020-06-13T02:13:03-04:00 DynFlags: refactor unwireUnit - - - - - 9e715c1b by Sylvain Henry at 2020-06-13T02:13:03-04:00 Document getPreloadUnitsAnd - - - - - bd5810dc by Sylvain Henry at 2020-06-13T02:13:03-04:00 DynFlags: remove useless add_package parameter - - - - - 36e1daf0 by Sylvain Henry at 2020-06-13T02:13:03-04:00 DynFlags: make listVisibleModuleNames take a UnitState - - - - - 5226da37 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Refactor and document add_package - - - - - 4b53aac1 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Refactor and document closeUnitDeps - - - - - 42c054f6 by Sylvain Henry at 2020-06-13T02:13:03-04:00 DynFlags: findWiredInUnits - - - - - a444d01b by Sylvain Henry at 2020-06-13T02:13:03-04:00 DynFlags: reportCycles, reportUnusable - - - - - 8408d521 by Sylvain Henry at 2020-06-13T02:13:03-04:00 DynFlags: merge_databases - - - - - fca2d25f by Sylvain Henry at 2020-06-13T02:13:03-04:00 DynFlags: add UnitConfig datatype Avoid directly querying flags from DynFlags to build the UnitState. Instead go via UnitConfig so that we could reuse this to make another UnitState for plugins. - - - - - 4274688a by Sylvain Henry at 2020-06-13T02:13:03-04:00 Move distrustAll into mkUnitState - - - - - 28d804e1 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Create helper upd_wired_in_home_instantiations - - - - - ac964c83 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Put database cache in UnitConfig - - - - - bfd0a78c by Sylvain Henry at 2020-06-13T02:13:03-04:00 Don't return preload units when we set DyNFlags Preload units can be retrieved in UnitState when needed (i.e. in GHCi) - - - - - 1fbb4bf5 by Sylvain Henry at 2020-06-13T02:13:03-04:00 NCGConfig: remove useless ncgUnitId field - - - - - c10ff7e7 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Doc: fix some comments - - - - - 456e17f0 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Bump haddock submodule and allow metric decrease Metric Decrease: T12150 T12234 T5837 Metric Increase: T16190 - - - - - 42953902 by Simon Peyton Jones at 2020-06-13T02:13:03-04:00 Trim the demand for recursive product types Ticket #18304 showed that we need to be very careful when exploring the demand (esp usage demand) on recursive product types. This patch solves the problem by trimming the demand on such types -- in effect, a form of "widening". See the Note [Trimming a demand to a type] in DmdAnal, which explains how I did this by piggy-backing on an existing mechansim for trimming demands becuase of GADTs. The significant payload of this patch is very small indeed: * Make GHC.Core.Opt.WorkWrap.Utils.typeShape use RecTcChecker to avoid looking through recursive types. But on the way * I found that ae_rec_tc was entirely inoperative and did nothing. So I removed it altogether from DmdAnal. * I moved some code around in DmdAnal and Demand. (There are no actual changes in dmdFix.) * I changed the API of DmsAnal.dmdAnalRhsLetDown to return a StrictSig rather than a decorated Id * I removed the dead function peelTsFuns from Demand Performance effects: Nofib: 0.0% changes. Not surprising, because they don't use recursive products Perf tests T12227: 1% increase in compiler allocation, becuase $cto gets w/w'd. It did not w/w before because it takes a deeply nested argument, so the worker gets too many args, so we abandon w/w altogether (see GHC.Core.Opt.WorkWrap.Utils.isWorkerSmallEnough) With this patch we trim the demands. That is not strictly necessary (since these Generic type constructors are like tuples -- they can't cause a loop) but the net result is that we now w/w $cto which is fine. UniqLoop: 16% decrease in /runtime/ allocation. The UniqSupply is a recursive product, so currently we abandon all strictness on 'churn'. With this patch 'churn' gets useful strictness, and we w/w it. Hooray Metric Decrease: UniqLoop Metric Increase: T12227 - - - - - 87d504f4 by Viktor Dukhovni at 2020-06-13T02:13:05-04:00 Add introductory prose for Data.Traversable - - - - - 9f09b608 by Oleg Grenrus at 2020-06-13T02:13:07-04:00 Fix #12073: Add MonadFix Q instance - - - - - 220c2d34 by Ben Gamari at 2020-06-13T02:13:07-04:00 testsuite: Increase size of T12150 As noted in #18319, this test was previously very fragile. Increase its size to make it more likely that its fails with its newly-increased acceptance threshold. Metric Increase: T12150 - - - - - 8bba1c26 by Ben Gamari at 2020-06-13T04:59:06-04:00 gitlab-ci: Always push perf notes Previously we ci.sh would run with `set -e` implying that we wouldn't push perf notes if the testsuite were to fail, even if it *only* failed due to perf notes. This rendered the whole performance testing story quite fragile as a single regressing commit would cause every successive commit to fail since a new baseline would not be uploaded. Fix this by ensuring that we always push performance notes. - - - - - 7a773f16 by Ben Gamari at 2020-06-13T15:10:55-04:00 gitlab-ci: Eliminate redundant push of CI metrics - - - - - a31218f7 by Ryan Scott at 2020-06-13T15:58:37-04:00 Use HsForAllTelescope to avoid inferred, visible foralls Currently, `HsForAllTy` permits the combination of `ForallVis` and `Inferred`, but you can't actually typecheck code that uses it (e.g., `forall {a} ->`). This patch refactors `HsForAllTy` to use a new `HsForAllTelescope` data type that makes a type-level distinction between visible and invisible `forall`s such that visible `forall`s do not track `Specificity`. That part of the patch is actually quite small; the rest is simply changing consumers of `HsType` to accommodate this new type. Fixes #18235. Bumps the `haddock` submodule. - - - - - c0e6dee9 by Tamar Christina at 2020-06-14T09:07:44-04:00 winio: Add Atomic Exchange PrimOp and implement Atomic Ptr exchanges. The initial version was rewritten by Tamar Christina. It was rewritten in large parts by Andreas Klebinger. Co-authored-by: Andreas Klebinger <klebinger.andreas at gmx.at> - - - - - 9a7462fb by Ben Gamari at 2020-06-14T15:35:23-04:00 codeGen: Don't discard live case binders in unsafeEqualityProof logic Previously CoreToStg would unconditionally discard cases of the form: case unsafeEqualityProof of wild { _ -> rhs } and rather replace the whole thing with `rhs`. However, in some cases (see #18227) the case binder is still live, resulting in unbound occurrences in `rhs`. Fix this by only discarding the case if the case binder is dead. Fixes #18227. - - - - - e4137c48 by Ben Gamari at 2020-06-14T15:35:23-04:00 testsuite: Add tests for #18227 T18227A is the original issue which gave rise to the ticket and depends upon bytestring. T18227B is a minimized reproducer. - - - - - 8bab9ff1 by Ben Gamari at 2020-06-14T15:35:59-04:00 hadrian: Fix rts include and library paths Fixes two bugs: * (?) and (<>) associated in a surprising way * We neglected to include libdw paths in the rts configure flags - - - - - bd761185 by Ben Gamari at 2020-06-14T15:35:59-04:00 hadrian: Drop redundant GHC arguments Cabal should already be passing this arguments to GHC. - - - - - 01f7052c by Peter Trommler at 2020-06-14T15:36:38-04:00 FFI: Fix pass small ints in foreign call wrappers The Haskell calling convention requires integer parameters smaller than wordsize to be promoted to wordsize (where the upper bits are don't care). To access such small integer parameter read a word from the parameter array and then cast that word to the small integer target type. Fixes #15933 - - - - - 502647f7 by Krzysztof Gogolewski at 2020-06-14T15:37:14-04:00 Fix "ndecreasingIndentation" in manual (#18116) - - - - - 9a9cc089 by Simon Jakobi at 2020-06-15T13:10:00-04:00 Use foldl' in unionManyUniqDSets - - - - - 761dcb84 by Moritz Angermann at 2020-06-15T13:10:36-04:00 Load .lo as well. Some archives contain so called linker objects, with the affectionate .lo suffic. For example the musl libc.a will come in that form. We still want to load those objects, hence we should not discard them and look for .lo as well. Ultimately we might want to fix this proerly by looking at the file magic. - - - - - cf01477f by Vladislav Zavialov at 2020-06-15T13:11:20-04:00 User's Guide: KnownNat evidence is Natural This bit of documentation got outdated after commit 1fcede43d2b30f33b7505e25eb6b1f321be0407f - - - - - d0dcbfe6 by Jan Hrček at 2020-06-16T20:36:38+02:00 Fix typos and formatting in user guide - - - - - 56a9e95f by Jan Hrček at 2020-06-16T20:36:38+02:00 Resolve TODO - - - - - 3e884d14 by Jan Hrček at 2020-06-16T20:36:38+02:00 Rename TcHoleErrors to GHC.Tc.Errors.Hole - - - - - d23fc678 by Stefan Schulze Frielinghaus at 2020-06-17T15:31:09-04:00 hadrian: Build with threaded runtime if available See #16873. - - - - - 0639dc10 by Sylvain Henry at 2020-06-17T15:31:53-04:00 T16190: only measure bytes_allocated Just adding `{-# LANGUAGE BangPatterns #-}` makes the two other metrics fluctuate by 13%. - - - - - 4cab6897 by Adam Sandberg Ericsson at 2020-06-17T15:32:44-04:00 docs: fix formatting in users guide - - - - - eb8115a8 by Sylvain Henry at 2020-06-17T15:33:23-04:00 Move CLabel assertions into smart constructors (#17957) It avoids using DynFlags in the Outputable instance of Clabel to check assertions at pretty-printing time. - - - - - 7faa4509 by Ben Gamari at 2020-06-17T15:43:31-04:00 base: Bump to 4.15.0.0 - - - - - 20616959 by Ben Gamari at 2020-06-17T15:43:31-04:00 configure: Use grep -q instead of --quiet The latter is apparently not supported by busybox. - - - - - 40fa237e by Krzysztof Gogolewski at 2020-06-17T16:21:58-04:00 Linear types (#15981) This is the first step towards implementation of the linear types proposal (https://github.com/ghc-proposals/ghc-proposals/pull/111). It features * A language extension -XLinearTypes * Syntax for linear functions in the surface language * Linearity checking in Core Lint, enabled with -dlinear-core-lint * Core-to-core passes are mostly compatible with linearity * Fields in a data type can be linear or unrestricted; linear fields have multiplicity-polymorphic constructors. If -XLinearTypes is disabled, the GADT syntax defaults to linear fields The following items are not yet supported: * a # m -> b syntax (only prefix FUN is supported for now) * Full multiplicity inference (multiplicities are really only checked) * Decent linearity error messages * Linear let, where, and case expressions in the surface language (each of these currently introduce the unrestricted variant) * Multiplicity-parametric fields * Syntax for annotating lambda-bound or let-bound with a multiplicity * Syntax for non-linear/multiple-field-multiplicity records * Linear projections for records with a single linear field * Linear pattern synonyms * Multiplicity coercions (test LinearPolyType) A high-level description can be found at https://ghc.haskell.org/trac/ghc/wiki/LinearTypes/Implementation Following the link above you will find a description of the changes made to Core. This commit has been authored by * Richard Eisenberg * Krzysztof Gogolewski * Matthew Pickering * Arnaud Spiwack With contributions from: * Mark Barbone * Alexander Vershilov Updates haddock submodule. - - - - - 6cb84c46 by Krzysztof Gogolewski at 2020-06-17T16:22:03-04:00 Various performance improvements This implements several general performance improvements to GHC, to offset the effect of the linear types change. General optimisations: - Add a `coreFullView` function which iterates `coreView` on the head. This avoids making function recursive solely because the iterate `coreView` themselves. As a consequence, this functions can be inlined, and trigger case-of-known constructor (_e.g._ `kindRep_maybe`, `isLiftedRuntimeRep`, `isMultiplicityTy`, `getTyVar_maybe`, `splitAppTy_maybe`, `splitFunType_maybe`, `tyConAppTyCon_maybe`). The common pattern about all these functions is that they are almost always used as views, and immediately consumed by a case expression. This commit also mark them asx `INLINE`. - In `subst_ty` add a special case for nullary `TyConApp`, which avoid allocations altogether. - Use `mkTyConApp` in `subst_ty` for the general `TyConApp`. This required quite a bit of module shuffling. case. `myTyConApp` enforces crucial sharing, which was lost during substitution. See also !2952 . - Make `subst_ty` stricter. - In `eqType` (specifically, in `nonDetCmpType`), add a special case, tested first, for the very common case of nullary `TyConApp`. `nonDetCmpType` has been made `INLINE` otherwise it is actually a regression. This is similar to the optimisations in !2952. Linear-type specific optimisations: - Use `tyConAppTyCon_maybe` instead of the more complex `eqType` in the definition of the pattern synonyms `One` and `Many`. - Break the `hs-boot` cycles between `Multiplicity.hs` and `Type.hs`: `Multiplicity` now import `Type` normally, rather than from the `hs-boot`. This way `tyConAppTyCon_maybe` can inline properly in the `One` and `Many` pattern synonyms. - Make `updateIdTypeAndMult` strict in its type and multiplicity - The `scaleIdBy` gets a specialised definition rather than being an alias to `scaleVarBy` - `splitFunTy_maybe` is given the type `Type -> Maybe (Mult, Type, Type)` instead of `Type -> Maybe (Scaled Type, Type)` - Remove the `MultMul` pattern synonym in favour of a view `isMultMul` because pattern synonyms appear not to inline well. - in `eqType`, in a `FunTy`, compare multiplicities last: they are almost always both `Many`, so it helps failing faster. - Cache `manyDataConTy` in `mkTyConApp`, to make sure that all the instances of `TyConApp ManyDataConTy []` are physically the same. This commit has been authored by * Richard Eisenberg * Krzysztof Gogolewski * Arnaud Spiwack Metric Decrease: haddock.base T12227 T12545 T12990 T1969 T3064 T5030 T9872b Metric Increase: haddock.base haddock.Cabal haddock.compiler T12150 T12234 T12425 T12707 T13035 T13056 T15164 T16190 T18304 T1969 T3064 T3294 T5631 T5642 T5837 T6048 T9020 T9233 T9675 T9872a T9961 WWRec - - - - - 57db91d8 by Sylvain Henry at 2020-06-17T16:22:03-04:00 Remove integer-simple integer-simple uses lists of words (`[Word]`) to represent big numbers instead of ByteArray#: * it is less efficient than the newer ghc-bignum native backend * it isn't compatible with the big number representation that is now shared by all the ghc-bignum backends (based on the one that was used only in integer-gmp before). As a consequence, we simply drop integer-simple - - - - - 9f96bc12 by Sylvain Henry at 2020-06-17T16:22:03-04:00 ghc-bignum library ghc-bignum is a newer package that aims to replace the legacy integer-simple and integer-gmp packages. * it supports several backends. In particular GMP is still supported and most of the code from integer-gmp has been merged in the "gmp" backend. * the pure Haskell "native" backend is new and is much faster than the previous pure Haskell implementation provided by integer-simple * new backends are easier to write because they only have to provide a few well defined functions. All the other code is common to all backends. In particular they all share the efficient small/big number distinction previously used only in integer-gmp. * backends can all be tested against the "native" backend with a simple Cabal flag. Backends are only allowed to differ in performance, their results should be the same. * Add `integer-gmp` compat package: provide some pattern synonyms and function aliases for those in `ghc-bignum`. It is intended to avoid breaking packages that depend on `integer-gmp` internals. Update submodules: text, bytestring Metric Decrease: Conversions ManyAlternatives ManyConstructors Naperian T10359 T10547 T10678 T12150 T12227 T12234 T12425 T13035 T13719 T14936 T1969 T4801 T4830 T5237 T5549 T5837 T8766 T9020 parsing001 space_leak_001 T16190 haddock.base On ARM and i386, T17499 regresses (+6% > 5%). On x86_64 unregistered, T13701 sometimes regresses (+2.2% > 2%). Metric Increase: T17499 T13701 - - - - - 96aa5787 by Sylvain Henry at 2020-06-17T16:22:03-04:00 Update compiler Thanks to ghc-bignum, the compiler can be simplified: * Types and constructors of Integer and Natural can be wired-in. It means that we don't have to query them from interfaces. It also means that numeric literals don't have to carry their type with them. * The same code is used whatever ghc-bignum backend is enabled. In particular, conversion of bignum literals into final Core expressions is now much more straightforward. Bignum closure inspection too. * GHC itself doesn't depend on any integer-* package anymore * The `integerLibrary` setting is gone. - - - - - 0f67e344 by Sylvain Henry at 2020-06-17T16:22:03-04:00 Update `base` package * GHC.Natural isn't implemented in `base` anymore. It is provided by ghc-bignum in GHC.Num.Natural. It means that we can safely use Natural primitives in `base` without fearing issues with built-in rewrite rules (cf #15286) * `base` doesn't conditionally depend on an integer-* package anymore, it depends on ghc-bignum * Some duplicated code in integer-* can now be factored in GHC.Float * ghc-bignum tries to use a uniform naming convention so most of the other changes are renaming - - - - - aa9e7b71 by Sylvain Henry at 2020-06-17T16:22:03-04:00 Update `make` based build system * replace integer-* package selection with ghc-bignum backend selection - - - - - f817d816 by Sylvain Henry at 2020-06-17T16:22:04-04:00 Update testsuite * support detection of slow ghc-bignum backend (to replace the detection of integer-simple use). There are still some test cases that the native backend doesn't handle efficiently enough. * remove tests for GMP only functions that have been removed from ghc-bignum * fix test results showing dependent packages (e.g. integer-gmp) or showing suggested instances * fix test using Integer/Natural API or showing internal names - - - - - dceecb09 by Sylvain Henry at 2020-06-17T16:22:04-04:00 Update Hadrian * support ghc-bignum backend selection in flavours and command-line * support ghc-bignum "--check" flag (compare results of selected backend against results of the native one) in flavours and command-line (e.g. pass --bignum=check-gmp" to check the "gmp" backend) * remove the hack to workaround #15286 * build GMP only when the gmp backend is used * remove hacks to workaround `text` package flags about integer-*. We fix `text` to use ghc-bignum unconditionally in another patch - - - - - fa4281d6 by Sylvain Henry at 2020-06-17T16:22:04-04:00 Bump bytestring and text submodules - - - - - 1a3f6f34 by Adam Sandberg Ericsson at 2020-06-18T23:03:36-04:00 docs: mention -hiedir in docs for -outputdir [skip ci] - - - - - 729bcb02 by Sylvain Henry at 2020-06-18T23:04:17-04:00 Hadrian: fix build on Mac OS Catalina (#17798) - - - - - 95e18292 by Andreas Klebinger at 2020-06-18T23:04:58-04:00 Relax allocation threshold for T12150. This test performs little work, so the most minor allocation changes often cause the test to fail. Increasing the threshold to 2% should help with this. - - - - - 8ce6c393 by Sebastian Graf at 2020-06-18T23:05:36-04:00 hadrian: Bump pinned cabal.project to an existent index-state - - - - - 08c1cb0f by Ömer Sinan Ağacan at 2020-06-18T23:06:21-04:00 Fix uninitialized field read in Linker.c Valgrind report of the bug when running the test `linker_unload`: ==29666== Conditional jump or move depends on uninitialised value(s) ==29666== at 0x369C5B4: setOcInitialStatus (Linker.c:1305) ==29666== by 0x369C6C5: mkOc (Linker.c:1347) ==29666== by 0x36C027A: loadArchive_ (LoadArchive.c:522) ==29666== by 0x36C0600: loadArchive (LoadArchive.c:626) ==29666== by 0x2C144CD: ??? (in /home/omer/haskell/ghc_2/testsuite/tests/rts/linker/linker_unload.run/linker_unload) ==29666== ==29666== Conditional jump or move depends on uninitialised value(s) ==29666== at 0x369C5B4: setOcInitialStatus (Linker.c:1305) ==29666== by 0x369C6C5: mkOc (Linker.c:1347) ==29666== by 0x369C9F6: preloadObjectFile (Linker.c:1507) ==29666== by 0x369CA8D: loadObj_ (Linker.c:1536) ==29666== by 0x369CB17: loadObj (Linker.c:1557) ==29666== by 0x3866BC: main (linker_unload.c:33) The problem is `mkOc` allocates a new `ObjectCode` and calls `setOcInitialStatus` without initializing the `status` field. `setOcInitialStatus` reads the field as first thing: static void setOcInitialStatus(ObjectCode* oc) { if (oc->status == OBJECT_DONT_RESOLVE) return; if (oc->archiveMemberName == NULL) { oc->status = OBJECT_NEEDED; } else { oc->status = OBJECT_LOADED; } } `setOcInitialStatus` is unsed in two places for two different purposes: in `mkOc` where we don't have the `status` field initialized yet (`mkOc` is supposed to initialize it), and `loadOc` where we do have `status` field initialized and we want to update it. Instead of splitting the function into two functions which are both called just once I inline the functions in the use sites and remove it. Fixes #18342 - - - - - da18ff99 by Tamar Christina at 2020-06-18T23:07:03-04:00 fix windows bootstrap due to linker changes - - - - - 2af0ec90 by Sylvain Henry at 2020-06-18T23:07:47-04:00 DynFlags: store default depth in SDocContext (#17957) It avoids having to use DynFlags to reach for pprUserLength. - - - - - d4a0be75 by Sylvain Henry at 2020-06-18T23:08:35-04:00 Move tablesNextToCode field into Platform tablesNextToCode is a platform setting and doesn't belong into DynFlags (#17957). Doing this is also a prerequisite to fix #14335 where we deal with two platforms (target and host) that may have different platform settings. - - - - - 809caedf by John Ericson at 2020-06-23T22:47:37-04:00 Switch from HscSource to IsBootInterface for module lookup in GhcMake We look up modules by their name, and not their contents. There is no way to separately reference a signature vs regular module; you get what you get. Only boot files can be referenced indepenently with `import {-# SOURCE #-}`. - - - - - 7750bd45 by Sylvain Henry at 2020-06-23T22:48:18-04:00 Cmm: introduce SAVE_REGS/RESTORE_REGS We don't want to save both Fn and Dn register sets on x86-64 as they are aliased to the same arch register (XMMn). Moreover, when SAVE_STGREGS was used in conjunction with `jump foo [*]` which makes a set of Cmm registers alive so that they cover all arch registers used to pass parameter, we could have Fn, Dn and XMMn alive at the same time. It made the LLVM code generator choke (see #17920). Now `SAVE_REGS/RESTORE_REGS` and `jump foo [*]` use the same set of registers. - - - - - 2636794d by Sylvain Henry at 2020-06-23T22:48:18-04:00 CmmToC: don't add extern decl to parsed Cmm data Previously, if a .cmm file *not in the RTS* contained something like: ```cmm section "rodata" { msg : bits8[] "Test\n"; } ``` It would get compiled by CmmToC into: ```c ERW_(msg); const char msg[] = "Test\012"; ``` and fail with: ``` /tmp/ghc32129_0/ghc_4.hc:5:12: error: error: conflicting types for \u2018msg\u2019 const char msg[] = "Test\012"; ^~~ In file included from /tmp/ghc32129_0/ghc_4.hc:3:0: error: /tmp/ghc32129_0/ghc_4.hc:4:6: error: note: previous declaration of \u2018msg\u2019 was here ERW_(msg); ^ /builds/hsyl20/ghc/_build/install/lib/ghc-8.11.0.20200605/lib/../lib/x86_64-linux-ghc-8.11.0.20200605/rts-1.0/include/Stg.h:253:46: error: note: in definition of macro \u2018ERW_\u2019 #define ERW_(X) extern StgWordArray (X) ^ ``` See the rationale for this on https://gitlab.haskell.org/ghc/ghc/-/wikis/commentary/compiler/backends/ppr-c#prototypes Now we don't generate these extern declarations (ERW_, etc.) for top-level data. It shouldn't change anything for the RTS (the only place we use .cmm files) as it is already special cased in `GHC.Cmm.CLabel.needsCDecl`. And hand-written Cmm can use explicit extern declarations when needed. Note that it allows `cgrun069` test to pass with CmmToC (cf #15467). - - - - - 5f6a0665 by Sylvain Henry at 2020-06-23T22:48:18-04:00 LLVM: refactor and comment register padding code (#17920) - - - - - cad62ef1 by Sylvain Henry at 2020-06-23T22:48:18-04:00 Add tests for #17920 Metric Decrease: T12150 T12234 - - - - - a2a9006b by Xavier Denis at 2020-06-23T22:48:56-04:00 Fix issue #18262 by zonking constraints after solving Zonk residual constraints in checkForExistence to reveal user type errors. Previously when `:instances` was used with instances that have TypeError constraints the result would look something like: instance [safe] s0 => Err 'A -- Defined at ../Bug2.hs:8:10 whereas after zonking, `:instances` now sees the `TypeError` and properly eliminates the constraint from the results. - - - - - 181516bc by Simon Peyton Jones at 2020-06-23T22:49:33-04:00 Fix a buglet in Simplify.simplCast This bug, revealed by #18347, is just a missing update to sc_hole_ty in simplCast. I'd missed a code path when I made the recentchanges in commit 6d49d5be904c0c01788fa7aae1b112d5b4dfaf1c Author: Simon Peyton Jones <simonpj at microsoft.com> Date: Thu May 21 12:53:35 2020 +0100 Implement cast worker/wrapper properly The fix is very easy. Two other minor changes * Tidy up in SimpleOpt.simple_opt_expr. In fact I think this is an outright bug, introduced in the fix to #18112: we were simplifying the same coercion twice *with the same substitution*, which is just wrong. It'd be a hard bug to trigger, so I just fixed it; less code too. * Better debug printing of ApplyToVal - - - - - 625a7f54 by Simon Peyton Jones at 2020-06-23T22:50:11-04:00 Two small tweaks to Coercion.simplifyArgsWorker These tweaks affect the inner loop of simplifyArgsWorker, which in turn is called from the flattener in Flatten.hs. This is a key perf bottleneck to T9872{a,b,c,d}. These two small changes have a modest but useful benefit. No change in functionality whatsoever. Relates to #18354 - - - - - b5768cce by Sylvain Henry at 2020-06-23T22:50:49-04:00 Don't use timesInt2# with GHC < 8.11 (fix #18358) - - - - - 7ad4085c by Sylvain Henry at 2020-06-23T22:51:27-04:00 Fix invalid printf format - - - - - a1f34d37 by Krzysztof Gogolewski at 2020-06-23T22:52:09-04:00 Add missing entry to freeNamesItem (#18369) - - - - - 03a708ba by Andreas Klebinger at 2020-06-25T03:54:37-04:00 Enable large address space optimization on windows. Starting with Win 8.1/Server 2012 windows no longer preallocates page tables for reserverd memory eagerly, which prevented us from using this approach in the past. We also try to allocate the heap high in the memory space. Hopefully this makes it easier to allocate things in the low 4GB of memory that need to be there. Like jump islands for the linker. - - - - - 7e6d3d09 by Roland Senn at 2020-06-25T03:54:38-04:00 In `:break ident` allow out of scope and nested identifiers (Fix #3000) This patch fixes the bug and implements the feature request of #3000. 1. If `Module` is a real module name and `identifier` a name of a top-level function in `Module` then `:break Module.identifer` works also for an `identifier` that is out of scope. 2. Extend the syntax for `:break identifier` to: :break [ModQual.]topLevelIdent[.nestedIdent]...[.nestedIdent] `ModQual` is optional and is either the effective name of a module or the local alias of a qualified import statement. `topLevelIdent` is the name of a top level function in the module referenced by `ModQual`. `nestedIdent` is optional and the name of a function nested in a let or where clause inside the previously mentioned function `nestedIdent` or `topLevelIdent`. If `ModQual` is a module name, then `topLevelIdent` can be any top level identifier in this module. If `ModQual` is missing or a local alias of a qualified import, then `topLevelIdent` must be in scope. Breakpoints can be set on arbitrarily deeply nested functions, but the whole chain of nested function names must be specified. 3. To support the new functionality rewrite the code to tab complete `:break`. - - - - - 30e42652 by Ben Gamari at 2020-06-25T03:54:39-04:00 make: Respect XELATEX variable Previously we simply ignored the XELATEX variable when building PDF documentation. - - - - - 4acc2934 by Ben Gamari at 2020-06-25T03:54:39-04:00 hadrian/make: Detect makeindex Previously we would simply assume that makeindex was available. Now we correctly detect it in `configure` and respect this conclusion in hadrian and make. - - - - - 0d61f866 by Simon Peyton Jones at 2020-06-25T03:54:40-04:00 Expunge GhcTcId GHC.Hs.Extension had type GhcPs = GhcPass 'Parsed type GhcRn = GhcPass 'Renamed type GhcTc = GhcPass 'Typechecked type GhcTcId = GhcTc The last of these, GhcTcId, is a vestige of the past. This patch expunges it from GHC. - - - - - 8ddbed4a by Adam Wespiser at 2020-06-25T03:54:40-04:00 add examples to Data.Traversable - - - - - 284001d0 by Oleg Grenrus at 2020-06-25T03:54:42-04:00 Export readBinIface_ - - - - - 90f43872 by Zubin Duggal at 2020-06-25T03:54:43-04:00 Export everything from HsToCore. This lets us reuse these functions in haddock, avoiding synchronization bugs. Also fixed some divergences with haddock in that file Updates haddock submodule - - - - - c7dd6da7 by Takenobu Tani at 2020-06-25T03:54:44-04:00 Clean up haddock hyperlinks of GHC.* (part1) This updates haddock comments only. This patch focuses to update for hyperlinks in GHC API's haddock comments, because broken links especially discourage newcomers. This includes the following hierarchies: - GHC.Hs.* - GHC.Core.* - GHC.Stg.* - GHC.Cmm.* - GHC.Types.* - GHC.Data.* - GHC.Builtin.* - GHC.Parser.* - GHC.Driver.* - GHC top - - - - - 1eb997a8 by Takenobu Tani at 2020-06-25T03:54:44-04:00 Clean up haddock hyperlinks of GHC.* (part2) This updates haddock comments only. This patch focuses to update for hyperlinks in GHC API's haddock comments, because broken links especially discourage newcomers. This includes the following hierarchies: - GHC.Iface.* - GHC.Llvm.* - GHC.Rename.* - GHC.Tc.* - GHC.HsToCore.* - GHC.StgToCmm.* - GHC.CmmToAsm.* - GHC.Runtime.* - GHC.Unit.* - GHC.Utils.* - GHC.SysTools.* - - - - - 67a86b4d by Oleg Grenrus at 2020-06-25T03:54:46-04:00 Add MonadZip and MonadFix instances for Complex These instances are taken from https://hackage.haskell.org/package/linear-1.21/docs/Linear-Instances.html They are the unique possible, so let they be in `base`. - - - - - c50ef26e by Artem Pelenitsyn at 2020-06-25T03:54:47-04:00 test suite: add reproducer for #17516 - - - - - fe281b27 by Roland Senn at 2020-06-25T03:54:48-04:00 Enable maxBound checks for OverloadedLists (Fixes #18172) Consider the Literal `[256] :: [Data.Word.Word8]` When the `OverloadedLists` extension is not active, then the `ol_ext` field in the `OverLitTc` record that is passed to the function `getIntegralLit` contains the type `Word8`. This is a simple type, and we can use its type constructor immediately for the `warnAboutOverflowedLiterals` function. When the `OverloadedLists` extension is active, then the `ol_ext` field contains the type family `Item [Word8]`. The function `nomaliseType` is used to convert it to the needed type `Word8`. - - - - - a788d4d1 by Ben Gamari at 2020-06-25T03:54:52-04:00 rts/Hash: Simplify freeing of HashListChunks While looking at #18348 I noticed that the treatment of HashLists are a bit more complex than necessary (which lead to some initial confusion on my part). Specifically, we allocate HashLists in chunks. Each chunk allocation makes two allocations: one for the chunk itself and one for a HashListChunk to link together the chunks for the purposes of freeing. Simplify this (and hopefully make the relationship between these clearer) but allocating the HashLists and HashListChunk in a single malloc. This will both make the implementation easier to follow and reduce C heap fragmentation. Note that even after this patch we fail to bound the size of the free HashList pool. However, this is a separate bug. - - - - - d3c2d59b by Sylvain Henry at 2020-06-25T03:54:55-04:00 RTS: avoid overflow on 32-bit arch (#18375) We're now correctly computing allocated bytes on 32-bit arch, so we get huge increases. Metric Increase: haddock.Cabal haddock.base haddock.compiler space_leak_001 - - - - - a3d69dc6 by Sebastian Graf at 2020-06-25T23:06:18-04:00 GHC.Core.Unify: Make UM actions one-shot by default This MR makes the UM monad in GHC.Core.Unify into a one-shot monad. See the long Note [The one-shot state monad trick]. See also #18202 and !3309, which applies this to all Reader/State-like monads in GHC for compile-time perf improvements. The pattern used here enables something similar to the state-hack, but is applicable to user-defined monads, not just `IO`. Metric Decrease 'runtime/bytes allocated' (test_env='i386-linux-deb9'): haddock.Cabal - - - - - 9ee58f8d by Matthias Pall Gissurarson at 2020-06-26T17:12:45+00:00 Implement the proposed -XQualifiedDo extension Co-authored-by: Facundo Domínguez <facundo.dominguez at tweag.io> QualifiedDo is implemented using the same placeholders for operation names in the AST that were devised for RebindableSyntax. Whenever the renamer checks which names to use for do syntax, it first checks if the do block is qualified (e.g. M.do { stmts }), in which case it searches for qualified names in the module M. This allows users to write {-# LANGUAGE QualifiedDo #-} import qualified SomeModule as M f x = M.do -- desugars to: y <- M.return x -- M.return x M.>>= \y -> M.return y -- M.return y M.>> M.return y -- M.return y See Note [QualifiedDo] and the users' guide for more details. Issue #18214 Proposal: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0216-qualified-do.rst Since we change the constructors `ITdo` and `ITmdo` to carry the new module name, we need to bump the haddock submodule to account or the new shape of these constructors. - - - - - ce987865 by Ryan Scott at 2020-06-27T11:55:21-04:00 Revamp the treatment of auxiliary bindings for derived instances This started as a simple fix for #18321 that organically grew into a much more sweeping refactor of how auxiliary bindings for derived instances are handled. I have rewritten `Note [Auxiliary binders]` in `GHC.Tc.Deriv.Generate` to explain all of the moving parts, but the highlights are: * Previously, the OccName of each auxiliary binding would be given a suffix containing a hash of its package name, module name, and parent data type to avoid name clashes. This was needlessly complicated, so we take the more direct approach of generating `Exact` `RdrName`s for each auxiliary binding with the same `OccName`, but using an underlying `System` `Name` with a fresh `Unique` for each binding. Unlike hashes, allocating new `Unique`s does not require any cleverness and avoid name clashes all the same... * ...speaking of which, in order to convince the renamer that multiple auxiliary bindings with the same `OccName` (but different `Unique`s) are kosher, we now use `rnLocalValBindsLHS` instead of `rnTopBindsLHS` to rename auxiliary bindings. Again, see `Note [Auxiliary binders]` for the full story. * I have removed the `DerivHsBind` constructor for `DerivStuff`—which was only used for `Data.Data`-related auxiliary bindings—and refactored `gen_Data_binds` to use `DerivAuxBind` instead. This brings the treatment of `Data.Data`-related auxiliary bindings in line with every other form of auxiliary binding. Fixes #18321. - - - - - a403eb91 by Sylvain Henry at 2020-06-27T11:55:59-04:00 ghc-bignum: fix division by zero (#18359) - - - - - 1b3d13b6 by Sylvain Henry at 2020-06-27T11:55:59-04:00 Fix ghc-bignum exceptions We must ensure that exceptions are not simplified. Previously we used: case raiseDivZero of _ -> 0## -- dummyValue But it was wrong because the evaluation of `raiseDivZero` was removed and the dummy value was directly returned. See new Note [ghc-bignum exceptions]. I've also removed the exception triggering primops which were fragile. We don't need them to be primops, we can have them exported by ghc-prim. I've also added a test for #18359 which triggered this patch. - - - - - a74ec37c by Simon Peyton Jones at 2020-06-27T11:56:34-04:00 Better loop detection in findTypeShape Andreas pointed out, in !3466, that my fix for #18304 was not quite right. This patch fixes it properly, by having just one RecTcChecker rather than (implicitly) two nested ones, in findTypeShape. - - - - - a04020b8 by Sylvain Henry at 2020-06-27T11:57:11-04:00 DynFlags: don't store buildTag `DynFlags.buildTag` was a field created from the set of Ways in `DynFlags.ways`. It had to be kept in sync with `DynFlags.ways` which was fragile. We want to avoid global state like this (#17957). Moreover in #14335 we also want to support loading units with different ways: target units would still use `DynFlags.ways` but plugins would use `GHC.Driver.Ways.hostFullWays`. To avoid having to deal both with build tag and with ways, we recompute the buildTag on-the-fly (should be pretty cheap) and we remove `DynFlags.buildTag` field. - - - - - 0e83efa2 by Krzysztof Gogolewski at 2020-06-27T11:57:49-04:00 Don't generalize when typechecking a tuple section The code is simpler and cleaner. - - - - - d8ba9e6f by Peter Trommler at 2020-06-28T09:19:11-04:00 RTS: Refactor Haskell-C glue for PPC 64-bit Make sure the stack is 16 byte aligned even when reserved stack bytes are not a multiple of 16 bytes. Avoid saving r2 (TOC). On ELF v1 the function descriptor of StgReturn has the same TOC as StgRun, on ELF v2 the TOC is recomputed in the function prologue. Use the ABI provided functions to save clobbered GPRs and FPRs. Improve comments. Describe what the stack looks like and how it relates to the respective ABIs. - - - - - 42f797b0 by Ryan Scott at 2020-06-28T09:19:46-04:00 Use NHsCoreTy to embed types into GND-generated code `GeneralizedNewtypeDeriving` is in the unique situation where it must produce an `LHsType GhcPs` from a Core `Type`. Historically, this was done with the `typeToLHsType` function, which walked over the entire `Type` and attempted to construct an `LHsType` with the same overall structure. `typeToLHsType` is quite complicated, however, and has been the subject of numerous bugs over the years (e.g., #14579). Luckily, there is an easier way to accomplish the same thing: the `XHsType` constructor of `HsType`. `XHsType` bundles an `NHsCoreTy`, which allows embedding a Core `Type` directly into an `HsType`, avoiding the need to laboriously convert from one to another (as `typeToLHsType` did). Moreover, renaming and typechecking an `XHsType` is simple, since one doesn't need to do anything to a Core `Type`... ...well, almost. For the reasons described in `Note [Typechecking NHsCoreTys]` in `GHC.Tc.Gen.HsType`, we must apply a substitution that we build from the local `tcl_env` type environment. But that's a relatively modest price to pay. Now that `GeneralizedNewtypeDeriving` uses `NHsCoreTy`, the `typeToLHsType` function no longer has any uses in GHC, so this patch rips it out. Some additional tweaks to `hsTypeNeedsParens` were necessary to make the new `-ddump-deriv` output correctly parenthesized, but other than that, this patch is quite straightforward. This is a mostly internal refactoring, although it is likely that `GeneralizedNewtypeDeriving`-generated code will now need fewer language extensions in certain situations than it did before. - - - - - 68530b1c by Jan Hrček at 2020-06-28T09:20:22-04:00 Fix duplicated words and typos in comments and user guide - - - - - 15b79bef by Ryan Scott at 2020-06-28T09:20:57-04:00 Add integer-gmp's ghc.mk and GNUmakefile to .gitignore - - - - - bfa5698b by Simon Peyton Jones at 2020-06-28T09:21:32-04:00 Fix a typo in Lint This simple error in GHC.Core.Litn.lintJoinLams meant that Lint reported bogus errors. Fixes #18399 - - - - - 71006532 by Ryan Scott at 2020-06-30T07:10:42-04:00 Reject nested foralls/contexts in instance types more consistently GHC is very wishy-washy about rejecting instance declarations with nested `forall`s or contexts that are surrounded by outermost parentheses. This can even lead to some strange interactions with `ScopedTypeVariables`, as demonstrated in #18240. This patch makes GHC more consistently reject instance types with nested `forall`s/contexts so as to prevent these strange interactions. On the implementation side, this patch tweaks `splitLHsInstDeclTy` and `getLHsInstDeclHead` to not look through parentheses, which can be semantically significant. I've added a `Note [No nested foralls or contexts in instance types]` in `GHC.Hs.Type` to explain why. This also introduces a `no_nested_foralls_contexts_err` function in `GHC.Rename.HsType` to catch nested `forall`s/contexts in instance types. This function is now used in `rnClsInstDecl` (for ordinary instance declarations) and `rnSrcDerivDecl` (for standalone `deriving` declarations), the latter of which fixes #18271. On the documentation side, this adds a new "Formal syntax for instance declaration types" section to the GHC User's Guide that presents a BNF-style grammar for what is and isn't allowed in instance types. Fixes #18240. Fixes #18271. - - - - - bccf3351 by Sylvain Henry at 2020-06-30T07:10:46-04:00 Add ghc-bignum to 8.12 release notes - - - - - 81704a6f by David Eichmann at 2020-06-30T07:10:48-04:00 Update ssh keys in CI performance metrics upload script - - - - - 85310fb8 by Joshua Price at 2020-06-30T07:10:49-04:00 Add missing Ix instances for tuples of size 6 through 15 (#16643) - - - - - cbb6b62f by Vladislav Zavialov at 2020-07-01T15:41:38-04:00 Implement -XLexicalNegation (GHC Proposal #229) This patch introduces a new extension, -XLexicalNegation, which detects whether the minus sign stands for negation or subtraction using the whitespace-based rules described in GHC Proposal #229. Updates haddock submodule. - - - - - fb5a0d01 by Martin Handley at 2020-07-01T15:42:14-04:00 #17169: Clarify Fixed's Enum instance. - - - - - b316804d by Simon Peyton Jones at 2020-07-01T15:42:49-04:00 Improve debug tracing for substitution This patch improves debug tracing a bit (#18395) * Remove the ancient SDoc argument to substitution, replacing it with a HasDebugCallStack constraint. The latter does the same job (indicate the call site) but much better. * Add HasDebugCallStack to simpleOptExpr, exprIsConApp_maybe I needed this to help nail the lookupIdSubst panic in #18326, #17784 - - - - - 5c9fabb8 by Hécate at 2020-07-01T15:43:25-04:00 Add most common return values for `os` and `arch` - - - - - 76d8cc74 by Ryan Scott at 2020-07-01T15:44:01-04:00 Desugar quoted uses of DerivingVia and expression type signatures properly The way that `GHC.HsToCore.Quote` desugared quoted `via` types (e.g., `deriving via forall a. [a] instance Eq a => Eq (List a)`) and explicit type annotations in signatures (e.g., `f = id @a :: forall a. a -> a`) was completely wrong, as it did not implement the scoping guidelines laid out in `Note [Scoped type variables in bindings]`. This is easily fixed. While I was in town, I did some minor cleanup of related Notes: * `Note [Scoped type variables in bindings]` and `Note [Scoped type variables in class and instance declarations]` say very nearly the same thing. I decided to just consolidate the two Notes into `Note [Scoped type variables in quotes]`. * `Note [Don't quantify implicit type variables in quotes]` is somewhat outdated, as it predates GHC 8.10, where the `forall`-or-nothing rule requires kind variables to be explicitly quantified in the presence of an explicit `forall`. As a result, the running example in that Note doesn't even compile. I have changed the example to something simpler that illustrates the same point that the original Note was making. Fixes #18388. - - - - - 44d6a335 by Andreas Klebinger at 2020-07-02T02:54:54-04:00 T16012: Be verbose on failure. - - - - - f9853330 by Ryan Scott at 2020-07-02T02:55:29-04:00 Bump ghc-prim version to 0.7.0 Fixes #18279. Bumps the `text` submodule. - - - - - 23e4e047 by Sylvain Henry at 2020-07-02T10:46:31-04:00 Hadrian: fix PowerPC64le support (#17601) [ci skip] - - - - - 3cdd8d69 by Sylvain Henry at 2020-07-02T10:47:08-04:00 NCG: correctly handle addresses with huge offsets (#15570) Before this patch we could generate addresses of this form: movzbl cP0_str+-9223372036854775808,%eax The linker can't handle them because the offset is too large: ld.lld: error: Main.o:(.text+0xB3): relocation R_X86_64_32S out of range: -9223372036852653050 is not in [-2147483648, 2147483647] With this patch we detect those cases and generate: movq $-9223372036854775808,%rax addq $cP0_str,%rax movzbl (%rax),%eax I've also refactored `getAmode` a little bit to make it easier to understand and to trace. - - - - - 4d90b3ff by Gabor Greif at 2020-07-02T20:07:59-04:00 No need for CURSES_INCLUDE_DIRS This is a leftover from ef63ff27251a20ff11e58c9303677fa31e609a88 - - - - - f08d6316 by Sylvain Henry at 2020-07-02T20:08:36-04:00 Replace Opt_SccProfilingOn flag with sccProfilingEnabled helper function SCC profiling was enabled in a convoluted way: if WayProf was enabled, Opt_SccProfilingOn general flag was set (in `GHC.Driver.Ways.wayGeneralFlags`), and then this flag was queried in various places. There is no need to go via general flags, so this patch defines a `sccProfilingEnabled :: DynFlags -> Bool` helper function that just checks whether WayProf is enabled. - - - - - 8cc7274b by Ben Gamari at 2020-07-03T02:49:27-04:00 rts/ProfHeap: Only allocate the Censuses that we need When not LDV profiling there is no reason to allocate 32 Censuses; one will do. This is a very small memory footprint optimisation, but it comes for free. - - - - - b835112c by Ben Gamari at 2020-07-03T02:49:27-04:00 rts/ProfHeap: Free old allocations when reinitialising Censuses Previously when not LDV profiling we would repeatedly reinitialise `censuses[0]` with `initEra`. This failed to free the `Arena` and `HashTable` from the old census, resulting in a memory leak. Fixes #18348. - - - - - 34be6523 by Valery Tolstov at 2020-07-03T02:50:03-04:00 Mention flags that are not enabled by -Wall (#18372) * Mention missing flags that are not actually enabled by -Wall (docs/users_guide/using-warnings.rst) * Additionally remove -Wmissing-monadfail-instances from the list of flags enabled by -Wcompat, as it is not the case since 8.8 - - - - - edc8d22b by Sylvain Henry at 2020-07-03T02:50:40-04:00 LLVM: support R9 and R10 registers d535ef006d85dbdb7cda2b09c5bc35cb80108909 allowed the use of up to 10 vanilla registers but didn't update LLVM backend to support them. This patch fixes it. - - - - - 4bf18646 by Simon Peyton Jones at 2020-07-03T08:37:42+01:00 Improve handling of data type return kinds Following a long conversation with Richard, this patch tidies up the handling of return kinds for data/newtype declarations (vanilla, family, and instance). I have substantially edited the Notes in TyCl, so they would bear careful reading. Fixes #18300, #18357 In GHC.Tc.Instance.Family.newFamInst we were checking some Lint-like properties with ASSSERT. Instead Richard and I have added a proper linter for axioms, and called it from lintGblEnv, which in turn is called in tcRnModuleTcRnM New tests (T18300, T18357) cause an ASSERT failure in HEAD. - - - - - 41d26492 by Sylvain Henry at 2020-07-03T17:33:59-04:00 DynFlags: avoid the use of sdocWithDynFlags in GHC.Core.Rules (#17957) - - - - - 7aa6ef11 by Hécate at 2020-07-03T17:34:36-04:00 Add the __GHC_FULL_VERSION__ CPP macro to expose the full GHC version - - - - - e61d5395 by Chaitanya Koparkar at 2020-07-07T13:55:59-04:00 ghc-prim: Turn some comments into haddocks [ci skip] - - - - - 37743f91 by John Ericson at 2020-07-07T13:56:00-04:00 Support `timesInt2#` in LLVM backend - - - - - 46397e53 by John Ericson at 2020-07-07T13:56:00-04:00 `genericIntMul2Op`: Call `genericWordMul2Op` directly This unblocks a refactor, and removes partiality. It might be a PowerPC regression but that should be fixable. - - - - - 8a1c0584 by John Ericson at 2020-07-07T13:56:00-04:00 Simplify `PrimopCmmEmit` Follow @simonpj's suggestion of pushing the "into regs" logic into `emitPrimOp`. With the previous commit getting rid of the recursion in `genericIntMul2Op`, this is now an easy refactor. - - - - - 6607f203 by John Ericson at 2020-07-07T13:56:00-04:00 `opAllDone` -> `opIntoRegs` The old name was and terrible and became worse after the previous commit's refactor moved non-trivial funcationlity into its body. - - - - - fdcc53ba by Sylvain Henry at 2020-07-07T13:56:00-04:00 Optimise genericIntMul2Op We shouldn't directly call 'genericWordMul2Op' in genericIntMul2Op because a target may provide a faster primop for 'WordMul2Op': we'd better use it! - - - - - 686e7225 by Moritz Angermann at 2020-07-07T13:56:01-04:00 [linker/rtsSymbols] More linker symbols Mostly symbols needed for aarch64/armv7l and in combination with musl, where we have to rely on loading *all* objects/archives - __stack_chk_* only when not DYNAMIC - - - - - 3f60b94d by Moritz Angermann at 2020-07-07T13:56:01-04:00 better if guards. - - - - - 7abffced by Moritz Angermann at 2020-07-07T13:56:01-04:00 Fix (1) - - - - - cdfeb3f2 by Moritz Angermann at 2020-07-07T13:56:01-04:00 AArch32 symbols only on aarch32. - - - - - f496c955 by Adam Sandberg Ericsson at 2020-07-07T13:56:02-04:00 add -flink-rts flag to link the rts when linking a shared or static library #18072 By default we don't link the RTS when linking shared libraries because in the most usual mode a shared library is an intermediary product, for example a Haskell library, that will be linked into some executable in the end. So we wish to defer the RTS flavour to link to the final link. However sometimes the final product is the shared library, for example when writing a plugin for some other system, so we do wish the shared library to link the RTS. For consistency we also make -staticlib honor this flag and its inversion. -staticlib currently implies -flink-shared. - - - - - c59faf67 by Stefan Schulze Frielinghaus at 2020-07-07T13:56:04-04:00 hadrian: link check-ppr against debugging RTS if ghcDebugged - - - - - 0effc57d by Adam Sandberg Ericsson at 2020-07-07T13:56:05-04:00 rts linker: teach the linker about GLIBC's special handling of *stat, mknod and atexit functions #7072 - - - - - 96153433 by Adam Sandberg Ericsson at 2020-07-07T13:56:06-04:00 hadrian: make hadrian/ghci use the bootstrap compiler from configure #18190 - - - - - 4d24f886 by Adam Sandberg Ericsson at 2020-07-07T13:56:07-04:00 hadrian: ignore cabal configure verbosity related flags #18131 - - - - - 7332bbff by Ben Gamari at 2020-07-07T13:56:08-04:00 testsuite: Widen T12234 acceptance window to 2% Previously it wasn't uncommon to see +/-1% fluctuations in compiler allocations on this test. - - - - - 180b6313 by Gabor Greif at 2020-07-07T13:56:08-04:00 When running libtool, report it as such - - - - - d3bd6897 by Sylvain Henry at 2020-07-07T13:56:11-04:00 BigNum: rename BigNat types Before this patch BigNat names were confusing because we had: * GHC.Num.BigNat.BigNat: unlifted type used everywhere else * GHC.Num.BigNat.BigNatW: lifted type only used to share static constants * GHC.Natural.BigNat: lifted type only used for backward compatibility After this patch we have: * GHC.Num.BigNat.BigNat#: unlifted type * GHC.Num.BigNat.BigNat: lifted type (reexported from GHC.Natural) Thanks to @RyanGlScott for spotting this. - - - - - 929d26db by Sylvain Henry at 2020-07-07T13:56:12-04:00 Bignum: don't build ghc-bignum with stage0 Noticed by @Ericson2314 - - - - - d25b6851 by Sylvain Henry at 2020-07-07T13:56:12-04:00 Hadrian: ghc-gmp.h shouldn't be a compiler dependency - - - - - 0ddae2ba by Sylvain Henry at 2020-07-07T13:56:14-04:00 DynFlags: factor out pprUnitId from "Outputable UnitId" instance - - - - - 204f3f5d by Krzysztof Gogolewski at 2020-07-07T13:56:18-04:00 Remove unused function pprHsForAllExtra (#18423) The function `pprHsForAllExtra` was called only on `Nothing` since 2015 (1e041b7382b6aa). - - - - - 3033e0e4 by Adam Sandberg Ericsson at 2020-07-08T20:36:49-04:00 hadrian: add flag to skip rebuilding dependency information #17636 - - - - - b7de4b96 by Stefan Schulze Frielinghaus at 2020-07-09T09:49:22-04:00 Fix GHCi :print on big-endian platforms On big-endian platforms executing import GHC.Exts data Foo = Foo Float# deriving Show foo = Foo 42.0# foo :print foo results in an arithmetic overflow exception which is caused by function index where moveBytes equals word_size - (r + item_size_b) * 8 Here we have a mixture of units. Both, word_size and item_size_b have unit bytes whereas r has unit bits. On 64-bit platforms moveBytes equals then 8 - (0 + 4) * 8 which results in a negative and therefore invalid second parameter for a shiftL operation. In order to make things more clear the expression (word .&. (mask `shiftL` moveBytes)) `shiftR` moveBytes is equivalent to (word `shiftR` moveBytes) .&. mask On big-endian platforms the shift must be a left shift instead of a right shift. For symmetry reasons not a mask is used but two shifts in order to zero out bits. Thus the fixed version equals case endian of BigEndian -> (word `shiftL` moveBits) `shiftR` zeroOutBits `shiftL` zeroOutBits LittleEndian -> (word `shiftR` moveBits) `shiftL` zeroOutBits `shiftR` zeroOutBits Fixes #16548 and #14455 - - - - - 3656dff8 by Sylvain Henry at 2020-07-09T09:50:01-04:00 LLVM: fix MO_S_Mul2 support (#18434) The value indicating if the carry is useful wasn't taken into account. - - - - - d9f09506 by Simon Peyton Jones at 2020-07-10T10:33:44-04:00 Define multiShotIO and use it in mkSplitUniqueSupply This patch is part of the ongoing eta-expansion saga; see #18238. It implements a neat trick (suggested by Sebastian Graf) that allows the programmer to disable the default one-shot behaviour of IO (the "state hack"). The trick is to use a new multiShotIO function; see Note [multiShotIO]. For now, multiShotIO is defined here in Unique.Supply; but it should ultimately be moved to the IO library. The change is necessary to get good code for GHC's unique supply; see Note [Optimising the unique supply]. However it makes no difference to GHC as-is. Rather, it makes a difference when a subsequent commit Improve eta-expansion using ArityType lands. - - - - - bce695cc by Simon Peyton Jones at 2020-07-10T10:33:44-04:00 Make arityType deal with join points As Note [Eta-expansion and join points] describes, this patch makes arityType deal correctly with join points. What was there before was not wrong, but yielded lower arities than it could. Fixes #18328 In base GHC this makes no difference to nofib. Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- n-body -0.1% -0.1% -1.2% -1.1% 0.0% -------------------------------------------------------------------------------- Min -0.1% -0.1% -55.0% -56.5% 0.0% Max -0.0% 0.0% +16.1% +13.4% 0.0% Geometric Mean -0.0% -0.0% -30.1% -31.0% -0.0% But it starts to make real difference when we land the change to the way mkDupableAlts handles StrictArg, in fixing #13253 and friends. I think this is because we then get more non-inlined join points. - - - - - 2b7c71cb by Simon Peyton Jones at 2020-07-11T12:17:02-04:00 Improve eta-expansion using ArityType As #18355 shows, we were failing to preserve one-shot info when eta-expanding. It's rather easy to fix, by using ArityType more, rather than just Arity. This patch is important to suport the one-shot monad trick; see #18202. But the extra tracking of one-shot-ness requires the patch Define multiShotIO and use it in mkSplitUniqueSupply If that patch is missing, ths patch makes things worse in GHC.Types.Uniq.Supply. With it, however, we see these improvements T3064 compiler bytes allocated -2.2% T3294 compiler bytes allocated -1.3% T12707 compiler bytes allocated -1.3% T13056 compiler bytes allocated -2.2% Metric Decrease: T3064 T3294 T12707 T13056 - - - - - de139cc4 by Artem Pelenitsyn at 2020-07-12T02:53:20-04:00 add reproducer for #15630 - - - - - c4de6a7a by Andreas Klebinger at 2020-07-12T02:53:55-04:00 Give Uniq[D]FM a phantom type for its key. This fixes #17667 and should help to avoid such issues going forward. The changes are mostly mechanical in nature. With two notable exceptions. * The register allocator. The register allocator references registers by distinct uniques. However they come from the types of VirtualReg, Reg or Unique in various places. As a result we sometimes cast the key type of the map and use functions which operate on the now typed map but take a raw Unique as actual key. The logic itself has not changed it just becomes obvious where we do so now. * <Type>Env Modules. As an example a ClassEnv is currently queried using the types `Class`, `Name`, and `TyCon`. This is safe since for a distinct class value all these expressions give the same unique. getUnique cls getUnique (classTyCon cls) getUnique (className cls) getUnique (tcName $ classTyCon cls) This is for the most part contained within the modules defining the interface. However it requires us to play dirty when we are given a `Name` to lookup in a `UniqFM Class a` map. But again the logic did not change and it's for the most part hidden behind the Env Module. Some of these cases could be avoided by refactoring but this is left for future work. We also bump the haddock submodule as it uses UniqFM. - - - - - c2cfdfde by Aaron Allen at 2020-07-13T09:00:33-04:00 Warn about empty Char enumerations (#18402) Currently the "Enumeration is empty" warning (-Wempty-enumerations) only fires for numeric literals. This patch adds support for `Char` literals so that enumerating an empty list of `Char`s will also trigger the warning. - - - - - c3ac87ec by Stefan Schulze Frielinghaus at 2020-07-13T09:01:10-04:00 hadrian: build check-ppr dynamic if GHC is build dynamic Fixes #18361 - - - - - 9ad072b4 by Simon Peyton Jones at 2020-07-13T14:52:49-04:00 Use dumpStyle when printing inlinings This just makes debug-printing consistent, and more informative. - - - - - e78c4efb by Simon Peyton Jones at 2020-07-13T14:52:49-04:00 Comments only - - - - - 7ccb760b by Simon Peyton Jones at 2020-07-13T14:52:49-04:00 Reduce result discount in conSize Ticket #18282 showed that the result discount given by conSize was massively too large. This patch reduces that discount to a constant 10, which just balances the cost of the constructor application itself. Note [Constructor size and result discount] elaborates, as does the ticket #18282. Reducing result discount reduces inlining, which affects perf. I found that I could increase the unfoldingUseThrehold from 80 to 90 in compensation; in combination with the result discount change I get these overall nofib numbers: Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- boyer -0.2% +5.4% -3.2% -3.4% 0.0% cichelli -0.1% +5.9% -11.2% -11.7% 0.0% compress2 -0.2% +9.6% -6.0% -6.8% 0.0% cryptarithm2 -0.1% -3.9% -6.0% -5.7% 0.0% gamteb -0.2% +2.6% -13.8% -14.4% 0.0% genfft -0.1% -1.6% -29.5% -29.9% 0.0% gg -0.0% -2.2% -17.2% -17.8% -20.0% life -0.1% -2.2% -62.3% -63.4% 0.0% mate +0.0% +1.4% -5.1% -5.1% -14.3% parser -0.2% -2.1% +7.4% +6.7% 0.0% primetest -0.2% -12.8% -14.3% -14.2% 0.0% puzzle -0.2% +2.1% -10.0% -10.4% 0.0% rsa -0.2% -11.7% -3.7% -3.8% 0.0% simple -0.2% +2.8% -36.7% -38.3% -2.2% wheel-sieve2 -0.1% -19.2% -48.8% -49.2% -42.9% -------------------------------------------------------------------------------- Min -0.4% -19.2% -62.3% -63.4% -42.9% Max +0.3% +9.6% +7.4% +11.0% +16.7% Geometric Mean -0.1% -0.3% -17.6% -18.0% -0.7% I'm ok with these numbers, remembering that this change removes an *exponential* increase in code size in some in-the-wild cases. I investigated compress2. The difference is entirely caused by this function no longer inlining WriteRoutines.$woutputCodes = \ (w :: [CodeEvent]) -> let result_s1Sr = case WriteRoutines.outputCodes_$s$woutput w 0# 0# 8# 9# of (# ww1, ww2 #) -> (ww1, ww2) in (# case result_s1Sr of (x, _) -> map @Int @Char WriteRoutines.outputCodes1 x , case result_s1Sr of { (_, y) -> y } #) It was right on the cusp before, driven by the excessive result discount. Too bad! Happily, the compiler/perf tests show a number of improvements: T12227 compiler bytes-alloc -6.6% T12545 compiler bytes-alloc -4.7% T13056 compiler bytes-alloc -3.3% T15263 runtime bytes-alloc -13.1% T17499 runtime bytes-alloc -14.3% T3294 compiler bytes-alloc -1.1% T5030 compiler bytes-alloc -11.7% T9872a compiler bytes-alloc -2.0% T9872b compiler bytes-alloc -1.2% T9872c compiler bytes-alloc -1.5% Metric Decrease: T12227 T12545 T13056 T15263 T17499 T3294 T5030 T9872a T9872b T9872c - - - - - 7f0b671e by Ben Gamari at 2020-07-13T14:52:49-04:00 testsuite: Widen acceptance threshold on T5837 This test is positively tiny and consequently the bytes allocated measurement will be relatively noisy. Consequently I have seen this fail spuriously quite often. - - - - - 118e1c3d by Alp Mestanogullari at 2020-07-14T21:30:52-04:00 compiler: re-engineer the treatment of rebindable if Executing on the plan described in #17582, this patch changes the way if expressions are handled in the compiler in the presence of rebindable syntax. We get rid of the SyntaxExpr field of HsIf and instead, when rebindable syntax is on, we rewrite the HsIf node to the appropriate sequence of applications of the local `ifThenElse` function. In order to be able to report good error messages, with expressions as they were written by the user (and not as desugared by the renamer), we make use of TTG extensions to extend GhcRn expression ASTs with an `HsExpansion` construct, which keeps track of a source (GhcPs) expression and the desugared (GhcRn) expression that it gives rise to. This way, we can typecheck the latter while reporting the former in error messages. In order to discard the error context lines that arise from typechecking the desugared expressions (because they talk about expressions that the user has not written), we carefully give a special treatment to the nodes fabricated by this new renaming-time transformation when typechecking them. See Note [Rebindable syntax and HsExpansion] for more details. The note also includes a recipe to apply the same treatment to other rebindable constructs. Tests 'rebindable11' and 'rebindable12' have been added to make sure we report identical error messages as before this patch under various circumstances. We also now disable rebindable syntax when processing untyped TH quotes, as per the discussion in #18102 and document the interaction of rebindable syntax and Template Haskell, both in Note [Template Haskell quotes and Rebindable Syntax] and in the user guide, adding a test to make sure that we do not regress in that regard. - - - - - 64c774b0 by Andreas Klebinger at 2020-07-14T21:31:27-04:00 Explain why keeping DynFlags in AnalEnv saves allocation. - - - - - 254245d0 by Ben Gamari at 2020-07-14T21:32:03-04:00 docs/users-guide: Update default -funfolding-use-threshold value This was changed in 3d2991f8 but I neglected to update the documentation. Fixes #18419. - - - - - 4c259f86 by Andreas Klebinger at 2020-07-14T21:32:41-04:00 Escape backslashes in json profiling reports properly. I also took the liberty to do away the fixed buffer size for escaping. Using a fixed size here can only lead to issues down the line. Fixes #18438. - - - - - 23797224 by Sergei Trofimovich at 2020-07-14T21:33:19-04:00 .gitlab: re-enable integer-simple substitute (BIGNUM_BACKEND) Recently build system migrated from INTEGER_LIBRARY to BIGNUM_BACKEND. But gitlab CI was never updated. Let's enable BIGNUM_BACKEND=native. Bug: https://gitlab.haskell.org/ghc/ghc/-/issues/18437 Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - e0db878a by Sergei Trofimovich at 2020-07-14T21:33:19-04:00 ghc-bignum: bring in sync .hs-boot files with module declarations Before this change `BIGNUM_BACKEND=native` build was failing as: ``` libraries/ghc-bignum/src/GHC/Num/BigNat/Native.hs:708:16: error: * Variable not in scope: naturalFromBigNat# :: WordArray# -> t * Perhaps you meant one of these: `naturalFromBigNat' (imported from GHC.Num.Natural), `naturalToBigNat' (imported from GHC.Num.Natural) | 708 | m' = naturalFromBigNat# m | ``` This happens because `.hs-boot` files are slightly out of date. This change brings in data and function types in sync. Bug: https://gitlab.haskell.org/ghc/ghc/-/issues/18437 Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - c9f65c36 by Stefan Schulze Frielinghaus at 2020-07-14T21:33:57-04:00 rts/Disassembler.c: Use FMT_HexWord for printing values in hex format - - - - - 58ae62eb by Matthias Andreas Benkard at 2020-07-14T21:34:35-04:00 macOS: Load frameworks without stating them first. macOS Big Sur makes the following change to how frameworks are shipped with the OS: > New in macOS Big Sur 11 beta, the system ships with a built-in > dynamic linker cache of all system-provided libraries. As part of > this change, copies of dynamic libraries are no longer present on > the filesystem. Code that attempts to check for dynamic library > presence by looking for a file at a path or enumerating a directory > will fail. Instead, check for library presence by attempting to > dlopen() the path, which will correctly check for the library in the > cache. (62986286) https://developer.apple.com/documentation/macos-release-notes/macos-big-sur-11-beta-release-notes/ Therefore, the previous method of checking whether a library exists before attempting to load it makes GHC.Runtime.Linker.loadFramework fail to find frameworks installed at /System/Library/Frameworks. GHC.Runtime.Linker.loadFramework now opportunistically loads the framework libraries without checking for their existence first, failing only if all attempts to load a given framework from any of the various possible locations fail. - - - - - cdc4a6b0 by Matthias Andreas Benkard at 2020-07-14T21:34:35-04:00 loadFramework: Output the errors collected in all loading attempts. With the recent change away from first finding and then loading a framework, loadFramework had no way of communicating the real reason why loadDLL failed if it was any reason other than the framework missing from the file system. It now collects all loading attempt errors into a list and concatenates them into a string to return to the caller. - - - - - 51dbfa52 by Ben Gamari at 2020-07-15T04:05:34-04:00 StgToCmm: Use CmmRegOff smart constructor Previously we would generate expressions of the form `CmmRegOff BaseReg 0`. This should do no harm (and really should be handled by the NCG anyways) but it's better to just generate a plain `CmmReg`. - - - - - ae11bdfd by Ben Gamari at 2020-07-15T04:06:08-04:00 testsuite: Add regression test for #17744 Test due to @monoidal. - - - - - 0e3c277a by Ben Gamari at 2020-07-15T16:41:01-04:00 Bump Cabal submodule Updates a variety of tests as Cabal is now more strict about Cabal file form. - - - - - ceed994a by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Drop Windows Vista support, require Windows 7 - - - - - 00a23bfd by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Update Windows FileSystem wrapper utilities. - - - - - 459e1c5f by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Use SlimReaderLocks and ConditonalVariables provided by the OS instead of emulated ones - - - - - 763088fc by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Small linker comment and ifdef cleanups - - - - - 1a228ff9 by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Flush event logs eagerly. - - - - - e9e04dda by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Refactor Buffer structures to be able to track async operations - - - - - 356dc3fe by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Implement new Console API - - - - - 90e69f77 by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Add IOPort synchronization primitive - - - - - 71245fcc by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Add new io-manager cmdline options - - - - - d548a3b3 by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Init Windows console Codepage to UTF-8. - - - - - 58ef6366 by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Add unsafeSplat to GHC.Event.Array - - - - - d660725e by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Add size and iterate to GHC.Event.IntTable. - - - - - 050da6dd by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Switch Testsuite to test winio by default - - - - - 4bf542bf by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Multiple refactorings and support changes. - - - - - 4489af6b by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: core threaded I/O manager - - - - - 64d8f2fe by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: core non-threaded I/O manager - - - - - 8da15a09 by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: Fix a scheduler bug with the threaded-runtime. - - - - - 84ea3d14 by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: Relaxing some constraints in io-manager. - - - - - ccf0d107 by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: Fix issues with non-threaded I/O manager after split. - - - - - b492fe6e by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: Remove some barf statements that are a bit strict. - - - - - 01423fd2 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Expand comments describing non-threaded loop - - - - - 4b69004f by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: fix FileSize unstat-able handles - - - - - 9b384270 by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: Implement new tempfile routines for winio - - - - - f1e0be82 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix input truncation when reading from handle. This was caused by not upholding the read buffer invariant that bufR == bufL == 0 for empty read buffers. - - - - - e176b625 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix output truncation for writes larger than buffer size - - - - - a831ce0e by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Rewrite bufWrite. I think it's far easier to follow the code now. It's also correct now as I had still missed a spot where we didn't update the offset. - - - - - 6aefdf62 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix offset set by bufReadEmpty. bufReadEmpty returns the bytes read *including* content that was already buffered, But for calculating the offset we only care about the number of bytes read into the new buffer. - - - - - 750ebaee by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Clean up code surrounding IOPort primitives. According to phyx these should only be read and written once per object. Not neccesarily in that order. To strengthen that guarantee the primitives will now throw an exception if we violate this invariant. As a consequence we can eliminate some code from their primops. In particular code dealing with multiple queued readers/writers now simply checks the invariant and throws an exception if it was violated. That is in contrast to mvars which will do things like wake up all readers, queue multi writers etc. - - - - - ffd31db9 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix multi threaded threadDelay and a few other small changes. Multithreaded threadDelay suffered from a race condition based on the ioManagerStatus. Since the status isn't needed for WIO I removed it completely. This resulted in a light refactoring, as consequence we will always wake up the IO manager using interruptSystemManager, which uses `postQueuedCompletionStatus` internally. I also added a few comments which hopefully makes the code easier to dive into for the next person diving in. - - - - - 6ec26df2 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 wionio: Make IO subsystem check a no-op on non-windows platforms. - - - - - 29bcd936 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Set handle offset when opening files in Append mode. Otherwise we would truncate the file. - - - - - 55c29700 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Remove debug event log trace - - - - - 9acb9f40 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix sqrt and openFile009 test cases - - - - - 57017cb7 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Allow hp2ps to build with -DDEBUG - - - - - b8cd9995 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Update output of T9681 since we now actually run it. - - - - - 10af5b14 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: A few more improvements to the IOPort primitives. - - - - - 39afc4a7 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix expected tempfiles output. Tempfiles now works properly on windows, as such we can delete the win32 specific output. - - - - - 99db46e0 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Assign thread labels to IOManager threads. - - - - - be6af732 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Properly check for the tso of an incall to be zero. - - - - - e2c6dac7 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Mark FD instances as unsupported under WINIO. - - - - - fd02ceed by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix threadDelay maxBound invocations. Instead of letting the ns timer overflow now clamp it at (maxBound :: Word64) ns. That still gives a few hundred years. - - - - - bc79f9f1 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Add comments/cleanup an import in base - - - - - 1d197f4b by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Mark outstanding_service_requests volatile. As far as I know C(99) gives no guarantees for code like bool condition; ... while(condition) sleep(); that condition will be updated if it's changed by another thread. So we are explicit here and mark it as volatile, this will force a reload from memory on each iteration. - - - - - dc438186 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Make last_event a local variable - - - - - 2fc957c5 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Add comment about thread safety of processCompletion. - - - - - 4c026b6c by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: nonthreaded: Create io processing threads in main thread. We now set a flag in the IO thread. The scheduler when looking for work will check the flag and create/queue threads accordingly. We used to create these in the IO thread. This improved performance but caused frequent segfaults. Thread creation/allocation is only safe to do if nothing currently accesses the storeagemanager. However without locks in the non-threaded runtime this can't be guaranteed. This shouldn't change performance all too much. In the past we had: * IO: Create/Queue thread. * Scheduler: Runs a few times. Eventually picks up IO processing thread. Now it's: * IO: Set flag to queue thread. * Scheduler: Pick up flag, if set create/queue thread. Eventually picks up IO processing thread. - - - - - f47c7208 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Add an exported isHeapAlloced function to the RTS - - - - - cc5d7bb1 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Queue IO processing threads at the front of the queue. This will unblock the IO thread sooner hopefully leading to higher throughput in some situations. - - - - - e7630115 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: ThreadDelay001: Use higher resolution timer. - - - - - 451b5f96 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Update T9681 output, disable T4808 on windows. T4808 tests functionality of the FD interface which won't be supported under WINIO. T9681 just has it's expected output tweaked. - - - - - dd06f930 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Wake io manager once per registerTimeout. Which is implicitly done in editTimeouts, so need to wake it up twice. - - - - - e87d0bf9 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Update placeholder comment with actual function name. - - - - - fc9025db by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Always lock win32 event queue - - - - - c24c9a1f by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Display thread labels when tracing scheduler events. - - - - - 06542b03 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Refactor non-threaded runner thread and scheduler interface. Only use a single communication point (registerAlertableWait) to inform the C side aobut both timeouts to use as well as outstanding requests. Also queue a haskell processing thread after each return from alertable waits. This way there is no risk of us missing a timer event. - - - - - 256299b1 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Remove outstanding_requests from runner. We used a variable to keep track of situations where we got entries from the IO port, but all of them had already been canceled. While we can avoid some work that way this case seems quite rare. So we give up on tracking this and instead always assume at least one of the returned entries is valid. If that's not the case no harm is done, we just perform some additional work. But it makes the runner easier to reason about. In particular we don't need to care if another thread modifies oustanding_requests after we return from waiting on the IO Port. - - - - - 3ebd8ad9 by Tamar Christina at 2020-07-15T16:41:03-04:00 winio: Various fixes related to rebase and testdriver - - - - - 6be6bcba by Tamar Christina at 2020-07-15T16:41:03-04:00 winio: Fix rebase artifacts - - - - - 2c649dc3 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Rename unsafeSplat to unsafeCopyFromBuffer - - - - - a18b73f3 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Remove unused size/iterate operations from IntTable - - - - - 16bab48e by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Detect running IO Backend via peeking at RtsConfig - - - - - 8b8405a0 by Tamar Christina at 2020-07-15T16:41:03-04:00 winio: update temp path so GCC etc can handle it. Also fix PIPE support, clean up error casting, fix memory leaks - - - - - 2092bc54 by Ben Gamari at 2020-07-15T16:41:03-04:00 winio: Minor comments/renamings - - - - - a5b5b6c0 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Checking if an error code indicates completion is now a function. - - - - - 362176fd by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Small refactor in withOverlappedEx - - - - - 32e20597 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: A few comments and commented out dbxIO - - - - - a4bfc1d9 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Don't drop buffer offset in byteView/cwcharView - - - - - b3ad2a54 by Tamar Christina at 2020-07-15T16:41:03-04:00 winio: revert BHandle changes. - - - - - 3dcd87e2 by Ben Gamari at 2020-07-15T16:41:03-04:00 winio: Fix imports - - - - - 5a371890 by Tamar Christina at 2020-07-15T16:41:03-04:00 winio: update ghc-cabal to handle new Cabal submodule bump - - - - - d07ebe0d by Ben Gamari at 2020-07-15T16:41:03-04:00 winio: Only compile sources on Windows - - - - - dcb42393 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Actually return Nothing on EOF for non-blocking read - - - - - 895a3beb by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Deduplicate logic in encodeMultiByte[Raw]IO. - - - - - e06e6734 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Deduplicate openFile logic - - - - - b59430c0 by Tamar Christina at 2020-07-15T16:41:03-04:00 winio: fix -werror issue in encoding file - - - - - f8d39a51 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Don't mention windows specific functions when building on Linux. - - - - - 6a533d2a by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: add a note about file locking in the RTS. - - - - - cf37ce34 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Add version to @since annotation - - - - - 0fafa2eb by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Rename GHC.Conc.IOCP -> GHC.Conc.WinIO - - - - - 1854fc23 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Expand GHC.Conc.POSIX description It now explains users may not use these functions when using the old IO manager. - - - - - fcc7ba41 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Fix potential spaceleak in __createUUIDTempFileErrNo - - - - - 6b3fd9fa by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Remove redundant -Wno-missing-signatures pragmas - - - - - 916fc861 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Make it explicit that we only create one IO manager - - - - - f260a721 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Note why we don't use blocking waits. - - - - - aa0a4bbf by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Remove commented out pragma - - - - - d679b544 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Remove redundant buffer write in Handle/Text.hs:bufReadEmpty - - - - - d3f94368 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Rename SmartHandles to StdHandles - - - - - bd6b8ec1 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: add comment stating failure behaviour for getUniqueFileInfo. - - - - - 12846b85 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Update IOPort haddocks. - - - - - 9f39fb14 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Add a note cross reference - - - - - 62dd5a73 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Name Haskell/OS I/O Manager explicitly in Note - - - - - fa807828 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Expand BlockedOnIOCompletion description. - - - - - f0880a1d by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Remove historical todos - - - - - 8e58e714 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Update note, remove debugging pragma. - - - - - aa4d84d5 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: flushCharReadBuffer shouldn't need to adjust offsets. - - - - - e580893a by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Remove obsolete comment about cond. variables - - - - - d54e9d79 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: fix initial linux validate build - - - - - 3cd4de46 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Fix ThreadDelay001 CPP - - - - - c88b1b9f by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Fix openFile009 merge conflict leftover - - - - - 849e8889 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Accept T9681 output. GHC now reports String instead of [Char]. - - - - - e7701818 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Fix cabal006 after upgrading cabal submodule Demand cabal 2.0 syntax instead of >= 1.20 as required by newer cabal versions. - - - - - a44f0373 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Fix stderr output for ghci/linking/dyn tests. We used to filter rtsopts, i opted to instead just accept the warning of it having no effect. This works both for -rtsopts, as well as -with-rtsopts which winio adds. - - - - - 515d9896 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Adjust T15261b stdout for --io-manager flag. - - - - - 949aaacc by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Adjust T5435_dyn_asm stderr The warning about rtsopts having no consequences is expected. So accept new stderr. - - - - - 7d424e1e by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Also accept T7037 stderr - - - - - 1f009768 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: fix cabal04 by filtering rts args - - - - - 981a9f2e by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: fix cabal01 by accepting expected stderr - - - - - b7b0464e by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: fix safePkg01 by accepting expected stderr - - - - - 32734b29 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: fix T5435_dyn_gcc by accepting expected stderr - - - - - acc5cebf by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: fix tempfiles test on linux - - - - - c577b789 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Accept accepted stderr for T3807 - - - - - c108c527 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Accept accepted stderr for linker_unload - - - - - 2b0b9a08 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Accept accepted stderr for linker_unload_multiple_objs - - - - - 67afb03c by Tamar Christina at 2020-07-15T16:41:04-04:00 winio: clarify wording on conditional variables. - - - - - 3bd41572 by Tamar Christina at 2020-07-15T16:41:04-04:00 winio: clarify comment on cooked mode. - - - - - ded58a03 by Tamar Christina at 2020-07-15T16:41:04-04:00 winio: update lockfile signature and remove mistaken symbol in rts. - - - - - 2143c492 by Ben Gamari at 2020-07-15T16:41:04-04:00 testsuite: Add winio and winio_threaded ways Reverts many of the testsuite changes - - - - - c0979cc5 by Ben Gamari at 2020-07-16T10:56:54-04:00 Merge remote-tracking branch 'origin/wip/winio' - - - - - 750a1595 by Ben Gamari at 2020-07-18T07:26:41-04:00 rts: Add --copying-gc flag to reverse effect of --nonmoving-gc Fixes #18281. - - - - - 6ba6a881 by Hécate at 2020-07-18T07:26:42-04:00 Implement `fullCompilerVersion` Follow-up of https://gitlab.haskell.org/ghc/ghc/-/issues/18403 This MR adds `fullCompilerVersion`, a function that shares the same backend as the `--numeric-version` GHC flag, exposing a full, three-digit version datatype. - - - - - e6cf27df by Hécate at 2020-07-18T07:26:43-04:00 Add a Lint hadrian rule and an .hlint.yaml file in base/ - - - - - bcb177dd by Simon Peyton Jones at 2020-07-18T07:26:43-04:00 Allow multiple case branches to have a higher rank type As #18412 points out, it should be OK for multiple case alternatives to have a higher rank type, provided they are all the same. This patch implements that change. It sweeps away GHC.Tc.Gen.Match.tauifyMultipleBranches, and friends, replacing it with an enhanced version of fillInferResult. The basic change to fillInferResult is to permit the case in which another case alternative has already filled in the result; and in that case simply unify. It's very simple actually. See the new Note [fillInferResult] in TcMType Other refactoring: - Move all the InferResult code to one place, in GHC.Tc.Utils.TcMType (previously some of it was in Unify) - Move tcInstType and friends from TcMType to Instantiate, where it more properly belongs. (TCMType was getting very long.) - - - - - e5525a51 by Simon Peyton Jones at 2020-07-18T07:26:43-04:00 Improve typechecking of NPlusK patterns This patch (due to Richard Eisenberg) improves documentation of the wrapper returned by tcSubMult (see Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify). And, more substantially, it cleans up the multiplicity handling in the typechecking of NPlusKPat - - - - - 12f90352 by Krzysztof Gogolewski at 2020-07-18T07:26:45-04:00 Remove {-# CORE #-} pragma (part of #18048) This pragma has no effect since 2011. It was introduced for External Core, which no longer exists. Updates haddock submodule. - - - - - e504c913 by Simon Peyton Jones at 2020-07-18T07:26:45-04:00 Refactor the simplification of join binders This MR (for #18449) refactors the Simplifier's treatment of join-point binders. Specifically, it puts together, into GHC.Core.Opt.Simplify.Env.adjustJoinPointType two currently-separate ways in which we adjust the type of a join point. As the comment says: -- (adjustJoinPointType mult new_res_ty join_id) does two things: -- -- 1. Set the return type of the join_id to new_res_ty -- See Note [Return type for join points] -- -- 2. Adjust the multiplicity of arrows in join_id's type, as -- directed by 'mult'. See Note [Scaling join point arguments] I think this actually fixes a latent bug, by ensuring that the seIdSubst and seInScope have the right multiplicity on the type of join points. I did some tidying up while I was at it. No more setJoinResTy, or modifyJoinResTy: instead it's done locally in Simplify.Env.adjustJoinPointType - - - - - 49b265f0 by Chaitanya Koparkar at 2020-07-18T07:26:46-04:00 Fix minor typos in a Core.hs note - - - - - 8d59aed6 by Stefan Schulze Frielinghaus at 2020-07-18T07:26:47-04:00 GHCi: Fix isLittleEndian - - - - - c26e81d1 by Ben Gamari at 2020-07-18T07:26:47-04:00 testsuite: Mark ghci tests as fragile under unreg compiler In particular I have seen T16012 fail repeatedly under the unregisterised compiler. - - - - - 868e4523 by Moritz Angermann at 2020-07-20T04:30:38-04:00 Revert "AArch32 symbols only on aarch32." This reverts commit cdfeb3f24f76e8fd30452016676e56fbc827789a. Signed-off-by: Moritz Angermann <moritz.angermann at gmail.com> - - - - - c915ba84 by Moritz Angermann at 2020-07-20T04:30:38-04:00 Revert "Fix (1)" This reverts commit 7abffced01f5680efafe44f6be2733eab321b039. Signed-off-by: Moritz Angermann <moritz.angermann at gmail.com> - - - - - 777c452a by Moritz Angermann at 2020-07-20T04:30:38-04:00 Revert "better if guards." This reverts commit 3f60b94de1f460ca3f689152860b108a19ce193e. Signed-off-by: Moritz Angermann <moritz.angermann at gmail.com> - - - - - 0dd40552 by Moritz Angermann at 2020-07-20T04:30:38-04:00 Revert "[linker/rtsSymbols] More linker symbols" This reverts commit 686e72253aed3880268dd6858eadd8c320f09e97. Signed-off-by: Moritz Angermann <moritz.angermann at gmail.com> - - - - - 30caeee7 by Sylvain Henry at 2020-07-21T06:39:33-04:00 DynFlags: remove use of sdocWithDynFlags from GHC.Stg.* (#17957) * add StgPprOpts datatype * remove Outputable instances for types that need `StgPprOpts` to be pretty-printed and explicitly call type specific ppr functions * add default `panicStgPprOpts` for panic messages (when it's not convenient to thread StgPprOpts or DynFlags down to the ppr function call) - - - - - 863c544c by Mark at 2020-07-21T06:39:34-04:00 Fix a typo in existential_quantification.rst - - - - - 05910be1 by Krzysztof Gogolewski at 2020-07-21T14:47:07-04:00 Add release notes entry for #17816 [skip ci] - - - - - a6257192 by Matthew Pickering at 2020-07-21T14:47:19-04:00 Use a newtype `Code` for the return type of typed quotations (Proposal #195) There are three problems with the current API: 1. It is hard to properly write instances for ``Quote m => m (TExp a)`` as the type is the composition of two type constructors. Doing so in your program involves making your own newtype and doing a lot of wrapping/unwrapping. For example, if I want to create a language which I can either run immediately or generate code from I could write the following with the new API. :: class Lang r where _int :: Int -> r Int _if :: r Bool -> r a -> r a -> r a instance Lang Identity where _int = Identity _if (Identity b) (Identity t) (Identity f) = Identity (if b then t else f) instance Quote m => Lang (Code m) where _int = liftTyped _if cb ct cf = [|| if $$cb then $$ct else $$cf ||] 2. When doing code generation it is common to want to store code fragments in a map. When doing typed code generation, these code fragments contain a type index so it is desirable to store them in one of the parameterised map data types such as ``DMap`` from ``dependent-map`` or ``MapF`` from ``parameterized-utils``. :: compiler :: Env -> AST a -> Code Q a data AST a where ... data Ident a = ... type Env = MapF Ident (Code Q) newtype Code m a = Code (m (TExp a)) In this example, the ``MapF`` maps an ``Ident String`` directly to a ``Code Q String``. Using one of these map types currently requires creating your own newtype and constantly wrapping every quotation and unwrapping it when using a splice. Achievable, but it creates even more syntactic noise than normal metaprogramming. 3. ``m (TExp a)`` is ugly to read and write, understanding ``Code m a`` is easier. This is a weak reason but one everyone can surely agree with. Updates text submodule. - - - - - 58235d46 by Ben Gamari at 2020-07-21T14:47:28-04:00 users-guide: Fix :rts-flag:`--copying-gc` documentation It was missing a newline. - - - - - 19e80b9a by Vladislav Zavialov at 2020-07-21T14:50:01-04:00 Accumulate Haddock comments in P (#17544, #17561, #8944) Haddock comments are, first and foremost, comments. It's very annoying to incorporate them into the grammar. We can take advantage of an important property: adding a Haddock comment does not change the parse tree in any way other than wrapping some nodes in HsDocTy and the like (and if it does, that's a bug). This patch implements the following: * Accumulate Haddock comments with their locations in the P monad. This is handled in the lexer. * After parsing, do a pass over the AST to associate Haddock comments with AST nodes using location info. * Report the leftover comments to the user as a warning (-Winvalid-haddock). - - - - - 4c719460 by David Binder at 2020-07-22T20:17:35-04:00 Fix dead link to haskell prime discussion - - - - - f2f817e4 by BinderDavid at 2020-07-22T20:17:35-04:00 Replace broken links to old haskell-prime site by working links to gitlab instance. [skip ci] - - - - - 0bf8980e by Daniel Gröber at 2020-07-22T20:18:11-04:00 Remove length field from FastString - - - - - 1010c33b by Daniel Gröber at 2020-07-22T20:18:11-04:00 Use ShortByteString for FastString There are multiple reasons we want this: - Fewer allocations: ByteString has 3 fields, ShortByteString just has one. - ByteString memory is pinned: - This can cause fragmentation issues (see for example #13110) but also - makes using FastStrings in compact regions impossible. Metric Decrease: T5837 T12150 T12234 T12425 - - - - - 8336ba78 by Daniel Gröber at 2020-07-22T20:18:11-04:00 Pass specialised utf8DecodeChar# to utf8DecodeLazy# for performance Currently we're passing a indexWord8OffAddr# type function to utf8DecodeLazy# which then passes it on to utf8DecodeChar#. By passing one of utf8DecodeCharAddr# or utf8DecodeCharByteArray# instead we benefit from the inlining and specialization already done for those. - - - - - 7484a9a4 by Daniel Gröber at 2020-07-22T20:18:11-04:00 Encoding: Add comment about tricky ForeignPtr lifetime - - - - - 5536ed28 by Daniel Gröber at 2020-07-22T20:18:11-04:00 Use IO constructor instead of `stToIO . ST` - - - - - 5b8902e3 by Daniel Gröber at 2020-07-22T20:18:11-04:00 Encoding: Remove redundant use of withForeignPtr - - - - - 5976a161 by Daniel Gröber at 2020-07-22T20:18:11-04:00 Encoding: Reformat utf8EncodeShortByteString to be more consistent - - - - - 9ddf1614 by Daniel Gröber at 2020-07-22T20:18:11-04:00 FastString: Reintroduce character count cache Metric Increase: ManyConstructors Metric Decrease: T4029 - - - - - e9491668 by Ben Gamari at 2020-07-22T20:18:46-04:00 get-win32-tarballs: Fix detection of missing tarballs This fixes the error message given by configure when the user attempts to configure without first download the win32 tarballs. - - - - - 9f3ff8fd by Andreas Klebinger at 2020-07-22T20:19:22-04:00 Enable BangPatterns, ScopedTypeVariables for ghc and hadrian by default. This is only for their respective codebases. - - - - - 0f17b930 by Sylvain Henry at 2020-07-22T20:19:59-04:00 Remove unused "ncg" flag This flag has been removed in 066b369de2c6f7da03c88206288dca29ab061b31 in 2011. - - - - - bab4ec8f by Sylvain Henry at 2020-07-22T20:19:59-04:00 Don't panic if the NCG isn't built (it is always built) - - - - - 8ea33edb by Sylvain Henry at 2020-07-22T20:19:59-04:00 Remove unused sGhcWithNativeCodeGen - - - - - e079bb72 by Sylvain Henry at 2020-07-22T20:19:59-04:00 Correctly test active backend Previously we used a platform settings to detect if the native code generator was used. This was wrong. We need to use the `DynFlags.hscTarget` field instead. - - - - - 735f9d6b by Sylvain Henry at 2020-07-22T20:19:59-04:00 Replace ghcWithNativeCodeGen with a proper Backend datatype * Represent backends with a `Backend` datatype in GHC.Driver.Backend * Don't detect the default backend to use for the target platform at compile time in Hadrian/make but at runtime. It makes "Settings" simpler and it is a step toward making GHC multi-target. * The latter change also fixes hadrian which has not been updated to take into account that the NCG now supports AIX and PPC64 (cf df26b95559fd467abc0a3a4151127c95cb5011b9 and d3c1dda60d0ec07fc7f593bfd83ec9457dfa7984) * Also we don't treat iOS specifically anymore (cf cb4878ffd18a3c70f98bdbb413cd3c4d1f054e1f) - - - - - f7cc4313 by Sylvain Henry at 2020-07-22T20:19:59-04:00 Replace HscTarget with Backend They both have the same role and Backend name is more explicit. Metric Decrease: T3064 Update Haddock submodule - - - - - 15ce1804 by Andreas Klebinger at 2020-07-22T20:20:34-04:00 Deprecate -fdmd-tx-dict-sel. It's behaviour is now unconditionally enabled as it's slightly beneficial. There are almost no benchmarks which benefit from disabling it, so it's not worth the keep this configurable. This fixes #18429. - - - - - ff1b7710 by Sylvain Henry at 2020-07-22T20:21:11-04:00 Add test for #18064 It has been fixed by 0effc57d48ace6b719a9f4cbeac67c95ad55010b - - - - - cfa89149 by Krzysztof Gogolewski at 2020-07-22T20:21:48-04:00 Define type Void# = (# #) (#18441) There's one backwards compatibility issue: GHC.Prim no longer exports Void#, we now manually re-export it from GHC.Exts. - - - - - 02f40b0d by Sebastian Graf at 2020-07-22T20:22:23-04:00 Add regression test for #18478 !3392 backported !2993 to GHC 8.10.2 which most probably is responsible for fixing #18478, which triggered a pattern match checker performance regression in GHC 8.10.1 as first observed in #17977. - - - - - 7f44df1e by Sylvain Henry at 2020-07-22T20:23:00-04:00 Minor refactoring of Unit display * for consistency, try to always use UnitPprInfo to display units to users * remove some uses of `unitPackageIdString` as it doesn't show the component name and it uses String - - - - - dff1cb3d by Moritz Angermann at 2020-07-23T07:55:29-04:00 [linker] Fix out of range relocations. mmap may return address all over the place. mmap_next will ensure we get the next free page after the requested address. This is especially important for linking on aarch64, where the memory model with PIC admits relocations in the +-4GB range, and as such we can't work with arbitrary object locations in memory. Of note: we map the rts into process space, so any mapped objects must not be ouside of the 4GB from the processes address space. - - - - - cdd0ff16 by Tamar Christina at 2020-07-24T18:12:23-04:00 winio: restore console cp on exit - - - - - c1f4f81d by Tamar Christina at 2020-07-24T18:13:00-04:00 winio: change memory allocation strategy and fix double free errors. - - - - - ba205046 by Simon Peyton Jones at 2020-07-24T18:13:35-04:00 Care with occCheckExpand in kind of occurrences Issue #18451 showed that we could get an infinite type, through over-use of occCheckExpand in the kind of an /occurrence/ of a type variable. See Note [Occurrence checking: look inside kinds] in GHC.Core.Type This patch fixes the problem by making occCheckExpand less eager to expand synonyms in kinds. It also improves pretty printing of kinds, by *not* suppressing the kind on a tyvar-binder like (a :: Const Type b) where type Const p q = p. Even though the kind of 'a' is Type, we don't want to suppress the kind ascription. Example: the error message for polykinds/T18451{a,b}. See GHC.Core.TyCo.Ppr Note [Suppressing * kinds]. - - - - - 02133353 by Zubin Duggal at 2020-07-25T00:44:30-04:00 Simplify XRec definition Change `Located X` usage to `XRec pass X` This increases the scope of the LPat experiment to almost all of GHC. Introduce UnXRec and MapXRec classes Fixes #17587 and #18408 Updates haddock submodule Co-authored-by: Philipp Krüger <philipp.krueger1 at gmail.com> - - - - - e443846b by Sylvain Henry at 2020-07-25T00:45:07-04:00 DynFlags: store printer in TraceBinIfaceReading We don't need to pass the whole DynFlags, just pass the logging function, if any. - - - - - 15b2b44f by Sylvain Henry at 2020-07-25T00:45:08-04:00 Rename GHC.Driver.Ways into GHC.Platform.Ways - - - - - 342a01af by Sylvain Henry at 2020-07-25T00:45:08-04:00 Add GHC.Platform.Profile - - - - - 6333d739 by Sylvain Henry at 2020-07-25T00:45:08-04:00 Put PlatformConstants into Platform - - - - - 9dfeca6c by Sylvain Henry at 2020-07-25T00:45:08-04:00 Remove platform constant wrappers Platform constant wrappers took a DynFlags parameter, hence implicitly used the target platform constants. We removed them to allow support for several platforms at once (#14335) and to avoid having to pass the full DynFlags to every function (#17957). Metric Decrease: T4801 - - - - - 73145d57 by Sylvain Henry at 2020-07-25T00:45:08-04:00 Remove dead code in utils/derivConstants - - - - - 7721b923 by Sylvain Henry at 2020-07-25T00:45:08-04:00 Move GHC.Platform into the compiler Previously it was in ghc-boot so that ghc-pkg could use it. However it wasn't necessary because ghc-pkg only uses a subset of it: reading target arch and OS from the settings file. This is now done via GHC.Platform.ArchOS (was called PlatformMini before). - - - - - 459afeb5 by Sylvain Henry at 2020-07-25T00:45:08-04:00 Fix build systems - - - - - 9e2930c3 by Sylvain Henry at 2020-07-25T00:45:08-04:00 Bump CountParserDeps - - - - - 6e2db34b by Sylvain Henry at 2020-07-25T00:45:08-04:00 Add accessors to ArchOS - - - - - fc0f6fbc by Stefan Schulze Frielinghaus at 2020-07-25T00:45:45-04:00 Require SMP support in order to build a threaded stage1 Fixes 18266 - - - - - a7c4439a by Matthias Andreas Benkard at 2020-07-26T13:23:24-04:00 Document loadFramework changes. (#18446) Adds commentary on the rationale for the changes made in merge request !3689. - - - - - da7269a4 by Ben Gamari at 2020-07-26T13:23:59-04:00 rts/win32: Exit with EXIT_HEAPOVERFLOW if memory commit fails Since switching to the two-step allocator, the `outofmem` test fails via `osCommitMemory` failing to commit. However, this was previously exiting with `EXIT_FAILURE`, rather than `EXIT_HEAPOVERFLOW`. I think the latter is a more reasonable exit code for this case and matches the behavior on POSIX platforms. - - - - - f153a1d0 by Ben Gamari at 2020-07-26T13:23:59-04:00 testsuite: Update win32 output for parseTree - - - - - e91672f0 by Ben Gamari at 2020-07-26T13:23:59-04:00 testsuite: Normalise WinIO error message differences Previously the old Windows IO manager threw different errors than WinIO. We now canonicalise these to the WinIO errors. - - - - - 9cbfe086 by Ben Gamari at 2020-07-26T13:23:59-04:00 gitlab-ci: Kill ssh-agent after pushing test metrics Otherwise the Windows builds hang forever waiting for the process to terminate. - - - - - 8236925f by Tamar Christina at 2020-07-26T13:24:35-04:00 winio: remove dead argument to stg_newIOPortzh - - - - - ce0a1d67 by Tamar Christina at 2020-07-26T13:25:11-04:00 winio: fix detection of tty terminals - - - - - 52685cf7 by Tamar Christina at 2020-07-26T13:25:48-04:00 winio: update codeowners - - - - - aee45d9e by Vladislav Zavialov at 2020-07-27T07:06:56-04:00 Improve NegativeLiterals (#18022, GHC Proposal #344) Before this patch, NegativeLiterals used to parse x-1 as x (-1). This may not be what the user expects, and now it is fixed: x-1 is parsed as (-) x 1. We achieve this by the following requirement: * When lexing a negative literal, it must not be preceded by a 'closing token'. This also applies to unboxed literals, e.g. -1#. See GHC Proposal #229 for the definition of a closing token. A nice consequence of this change is that -XNegativeLiterals becomes a subset of -XLexicalNegation. In other words, enabling both of those extensions has the same effect as enabling -XLexicalNegation alone. - - - - - 667ab69e by leiftw at 2020-07-27T07:07:32-04:00 fix typo referring to non-existent `-ohidir` flag, should be `-hidir` I think - - - - - 6ff89c17 by Vladislav Zavialov at 2020-07-27T07:08:07-04:00 Refactor the parser a little * Create a dedicated production for type operators * Create a dedicated type for the UNPACK pragma * Remove an outdated part of Note [Parsing data constructors is hard] - - - - - aa054d32 by Ben Gamari at 2020-07-27T20:09:07-04:00 Drop 32-bit Windows support As noted in #18487, we have reached the end of this road. - - - - - 6da73bbf by Michalis Pardalos at 2020-07-27T20:09:44-04:00 Add minimal test for #12492 - - - - - 47680cb7 by Michalis Pardalos at 2020-07-27T20:09:44-04:00 Use allocate, not ALLOC_PRIM_P for unpackClosure# ALLOC_PRIM_P fails for large closures, by directly using allocate we can handle closures which are larger than the block size. Fixes #12492 - - - - - 3d345c96 by Simon Peyton Jones at 2020-07-27T20:10:19-04:00 Eta-expand the Simplifier monad This patch eta-expands the Simplifier's monad, using the method explained in GHC.Core.Unify Note [The one-shot state monad trick]. It's part of the exta-expansion programme in #18202. It's a tiny patch, but is worth a 1-2% reduction in bytes-allocated by the compiler. Here's the list, based on the compiler-performance tests in perf/compiler: Reduction in bytes allocated T10858(normal) -0.7% T12425(optasm) -1.3% T13056(optasm) -1.8% T14683(normal) -1.1% T15164(normal) -1.3% T15630(normal) -1.4% T17516(normal) -2.3% T18282(normal) -1.6% T18304(normal) -0.8% T1969(normal) -0.6% T4801(normal) -0.8% T5321FD(normal) -0.7% T5321Fun(normal) -0.5% T5642(normal) -0.9% T6048(optasm) -1.1% T9020(optasm) -2.7% T9233(normal) -0.7% T9675(optasm) -0.5% T9961(normal) -2.9% WWRec(normal) -1.2% Metric Decrease: T12425 T9020 T9961 - - - - - 57aca6bb by Ben Gamari at 2020-07-27T20:10:54-04:00 gitlab-ci: Ensure that Hadrian jobs don't download artifacts Previously the Hadrian jobs had the default dependencies, meaning that they would download artifacts from all jobs of earlier stages. This is unneccessary. - - - - - 0a815cea by Ben Gamari at 2020-07-27T20:10:54-04:00 gitlab-ci: Bump bootstrap compiler to 8.8.4 Hopefully this will make the Windows jobs a bit more reliable. - - - - - 0bd60059 by Simon Peyton Jones at 2020-07-28T02:01:49-04:00 This patch addresses the exponential blow-up in the simplifier. Specifically: #13253 exponential inlining #10421 ditto #18140 strict constructors #18282 another nested-function call case This patch makes one really significant changes: change the way that mkDupableCont handles StrictArg. The details are explained in GHC.Core.Opt.Simplify Note [Duplicating StrictArg]. Specific changes * In mkDupableCont, when making auxiliary bindings for the other arguments of a call, add extra plumbing so that we don't forget the demand on them. Otherwise we haev to wait for another round of strictness analysis. But actually all the info is to hand. This change affects: - Make the strictness list in ArgInfo be [Demand] instead of [Bool], and rename it to ai_dmds. - Add as_dmd to ValArg - Simplify.makeTrivial takes a Demand - mkDupableContWithDmds takes a [Demand] There are a number of other small changes 1. For Ids that are used at most once in each branch of a case, make the occurrence analyser record the total number of syntactic occurrences. Previously we recorded just OneBranch or MultipleBranches. I thought this was going to be useful, but I ended up barely using it; see Note [Note [Suppress exponential blowup] in GHC.Core.Opt.Simplify.Utils Actual changes: * See the occ_n_br field of OneOcc. * postInlineUnconditionally 2. I found a small perf buglet in SetLevels; see the new function GHC.Core.Opt.SetLevels.hasFreeJoin 3. Remove the sc_cci field of StrictArg. I found I could get its information from the sc_fun field instead. Less to get wrong! 4. In ArgInfo, arrange that ai_dmds and ai_discs have a simpler invariant: they line up with the value arguments beyond ai_args This allowed a bit of nice refactoring; see isStrictArgInfo, lazyArgcontext, strictArgContext There is virtually no difference in nofib. (The runtime numbers are bogus -- I tried a few manually.) Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- fft +0.0% -2.0% -48.3% -49.4% 0.0% multiplier +0.0% -2.2% -50.3% -50.9% 0.0% -------------------------------------------------------------------------------- Min -0.4% -2.2% -59.2% -60.4% 0.0% Max +0.0% +0.1% +3.3% +4.9% 0.0% Geometric Mean +0.0% -0.0% -33.2% -34.3% -0.0% Test T18282 is an existing example of these deeply-nested strict calls. We get a big decrease in compile time (-85%) because so much less inlining takes place. Metric Decrease: T18282 - - - - - 6ee07b49 by Sylvain Henry at 2020-07-28T02:02:27-04:00 Bignum: add support for negative shifts (fix #18499) shiftR/shiftL support negative arguments despite Haskell 2010 report saying otherwise. We explicitly test for negative values which is bad (it gets in the way of constant folding, etc.). Anyway, for consistency we fix Bits instancesof Integer/Natural. - - - - - f305bbfd by Peter Trommler at 2020-07-28T02:03:02-04:00 config: Fix Haskell platform constructor w/ params Fixes #18505 - - - - - 318bb17c by Oleg Grenrus at 2020-07-28T20:54:13-04:00 Fix typo in haddock Spotted by `vilpan` on `#haskell` - - - - - 39c89862 by Sergei Trofimovich at 2020-07-28T20:54:50-04:00 ghc/mk: don't build gmp packages for BIGNUM_BACKEND=native Before this change make-based `BIGNUM_BACKEND=native` build was failing as: ``` x86_64-pc-linux-gnu-gcc: error: libraries/ghc-bignum/gmp/objs/*.o: No such file or directory ``` This happens because ghc.mk was pulling in gmp-dependent ghc-bignum library unconditionally. The change avoid building ghc-bignum. Bug: https://gitlab.haskell.org/ghc/ghc/-/issues/18437 Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - b9a880fc by Felix Wiemuth at 2020-07-29T15:06:35-04:00 Fix typo - - - - - c59064b0 by Brandon Chinn at 2020-07-29T15:07:11-04:00 Add regression test for #16341 - - - - - a61411ca by Brandon Chinn at 2020-07-29T15:07:11-04:00 Pass dit_rep_tc_args to dsm_stock_gen_fn - - - - - a26498da by Brandon Chinn at 2020-07-29T15:07:11-04:00 Pass tc_args to gen_fn - - - - - 44b11bad by Brandon Chinn at 2020-07-29T15:07:11-04:00 Filter out unreachable constructors when deriving stock instances (#16431) - - - - - bbc51916 by Simon Peyton Jones at 2020-07-29T15:07:47-04:00 Kill off sc_mult and as_mult fields They are readily derivable from other fields, so this is more efficient, and less error prone. Fixes #18494 - - - - - e3db4b4c by Peter Trommler at 2020-07-29T15:08:22-04:00 configure: Fix build system on ARM - - - - - 96c31ea1 by Sylvain Henry at 2020-07-29T15:09:02-04:00 Fix bug in Natural multiplication (fix #18509) A bug was lingering in Natural multiplication (inverting two limbs) despite QuickCheck tests used during the development leading to wrong results (independently of the selected backend). - - - - - e1dc3d7b by Krzysztof Gogolewski at 2020-07-29T15:09:39-04:00 Fix validation errors (#18510) Test T2632 is a stage1 test that failed because of the Q => Quote change. The remaining tests did not use quotation and failed when the path contained a space. - - - - - 6c68a842 by John Ericson at 2020-07-30T07:11:02-04:00 For `-fkeep-going` do not duplicate dependency edge code We now compute the deps for `-fkeep-going` the same way that the original graph calculates them, so the edges are correct. Upsweep really ought to take the graph rather than a topological sort so we are never recalculating anything, but at least things are recaluclated consistently now. - - - - - 502de556 by cgibbard at 2020-07-30T07:11:02-04:00 Add haddock comment for unfilteredEdges and move the note about drop_hs_boot_nodes into it. - - - - - 01c948eb by Ryan Scott at 2020-07-30T07:11:37-04:00 Clean up the inferred type variable restriction This patch primarily: * Documents `checkInferredVars` (previously called `check_inferred_vars`) more carefully. This is the function which throws an error message if a user quantifies an inferred type variable in a place where specificity cannot be observed. See `Note [Unobservably inferred type variables]` in `GHC.Rename.HsType`. Note that I now invoke `checkInferredVars` _alongside_ `rnHsSigType`, `rnHsWcSigType`, etc. rather than doing so _inside_ of these functions. This results in slightly more call sites for `checkInferredVars`, but it makes it much easier to enumerate the spots where the inferred type variable restriction comes into effect. * Removes the inferred type variable restriction for default method type signatures, per the discussion in #18432. As a result, this patch fixes #18432. Along the way, I performed some various cleanup: * I moved `no_nested_foralls_contexts_err` into `GHC.Rename.Utils` (under the new name `noNestedForallsContextsErr`), since it now needs to be invoked from multiple modules. I also added a helper function `addNoNestedForallsContextsErr` that throws the error message after producing it, as this is a common idiom. * In order to ensure that users cannot sneak inferred type variables into `SPECIALISE instance` pragmas by way of nested `forall`s, I now invoke `addNoNestedForallsContextsErr` when renaming `SPECIALISE instance` pragmas, much like when we rename normal instance declarations. (This probably should have originally been done as a part of the fix for #18240, but this task was somehow overlooked.) As a result, this patch fixes #18455 as a side effect. - - - - - d47324ce by Ryan Scott at 2020-07-30T07:12:16-04:00 Don't mark closed type family equations as occurrences Previously, `rnFamInstEqn` would mark the name of the type/data family used in an equation as an occurrence, regardless of what sort of family it is. Most of the time, this is the correct thing to do. The exception is closed type families, whose equations constitute its definition and therefore should not be marked as occurrences. Overzealously counting the equations of a closed type family as occurrences can cause certain warnings to not be emitted, as observed in #18470. See `Note [Type family equations and occurrences]` in `GHC.Rename.Module` for the full story. This fixes #18470 with a little bit of extra-casing in `rnFamInstEqn`. To accomplish this, I added an extra `ClosedTyFamInfo` field to the `NonAssocTyFamEqn` constructor of `AssocTyFamInfo` and refactored the relevant call sites accordingly so that this information is propagated to `rnFamInstEqn`. While I was in town, I moved `wrongTyFamName`, which checks that the name of a closed type family matches the name in an equation for that family, from the renamer to the typechecker to avoid the need for an `ASSERT`. As an added bonus, this lets us simplify the details of `ClosedTyFamInfo` a bit. - - - - - ebe2cf45 by Simon Peyton Jones at 2020-07-30T07:12:52-04:00 Remove an incorrect WARN in extendLocalRdrEnv I noticed this warning going off, and discovered that it's really fine. This small patch removes the warning, and docments what is going on. - - - - - 9f71f697 by Simon Peyton Jones at 2020-07-30T07:13:27-04:00 Add two bangs to improve perf of flattening This tiny patch improves the compile time of flatten-heavy programs by 1-2%, by adding two bangs. Addresses (somewhat) #18502 This reduces allocation by T9872b -1.1% T9872d -3.3% T5321Fun -0.2% T5631 -0.2% T5837 +0.1% T6048 +0.1% Metric Decrease: T9872b T9872d - - - - - 7c274cd5 by Sylvain Henry at 2020-07-30T22:54:48-04:00 Fix minimal imports dump for boot files (fix #18497) - - - - - 175cb5b4 by Sylvain Henry at 2020-07-30T22:55:25-04:00 DynFlags: don't use sdocWithDynFlags in datacon ppr We don't need to use `sdocWithDynFlags` to know whether we should display linear types for datacon types, we already have `sdocLinearTypes` field in `SDocContext`. Moreover we want to remove `sdocWithDynFlags` (#10143, #17957)). - - - - - 380638a3 by Sylvain Henry at 2020-07-30T22:56:03-04:00 Bignum: fix powMod for gmp backend (#18515) Also reenable integerPowMod test which had never been reenabled by mistake. - - - - - 56a7c193 by Sylvain Henry at 2020-07-31T19:32:09+02:00 Refactor CLabel pretty-printing Pretty-printing CLabel relies on sdocWithDynFlags that we want to remove (#10143, #17957). It uses it to query the backend and the platform. This patch exposes Clabel ppr functions specialised for each backend so that backend code can directly use them. - - - - - 3b15dc3c by Sylvain Henry at 2020-07-31T19:32:09+02:00 DynFlags: don't use sdocWithDynFlags in GHC.CmmToAsm.Dwarf.Types - - - - - e30fed6c by Vladislav Zavialov at 2020-08-01T04:23:04-04:00 Test case for #17652 The issue was fixed by 19e80b9af252eee760dc047765a9930ef00067ec - - - - - 22641742 by Ryan Scott at 2020-08-02T16:44:11-04:00 Remove ConDeclGADTPrefixPs This removes the `ConDeclGADTPrefixPs` per the discussion in #18517. Most of this patch simply removes code, although the code in the `rnConDecl` case for `ConDeclGADTPrefixPs` had to be moved around a bit: * The nested `forall`s check now lives in the `rnConDecl` case for `ConDeclGADT`. * The `LinearTypes`-specific code that used to live in the `rnConDecl` case for `ConDeclGADTPrefixPs` now lives in `GHC.Parser.PostProcess.mkGadtDecl`, which is now monadic so that it can check if `-XLinearTypes` is enabled. Fixes #18157. - - - - - f2d1accf by Leon Schoorl at 2020-08-02T16:44:47-04:00 Fix GHC_STAGE definition generated by make Fixes #18070 GHC_STAGE is the stage of the compiler we're building, it should be 1,2(,3?). But make was generating 0 and 1. Hadrian does this correctly using a similar `+ 1`: https://gitlab.haskell.org/ghc/ghc/-/blob/eb8115a8c4cbc842b66798480fefc7ab64d31931/hadrian/src/Rules/Generate.hs#L245 - - - - - 947206f4 by Niklas Hambüchen at 2020-08-03T07:52:33+02:00 hadrian: Fix running stage0/bin/ghc with wrong package DB. Fixes #17468. In the invocation of `cabal configure`, `--ghc-pkg-option=--global-package-db` was already given correctly to tell `stage0/bin/ghc-pkg` that it should use the package DB in `stage1/`. However, `ghc` needs to be given this information as well, not only `ghc-pkg`! Until now that was not the case; the package DB in `stage0` was given to `ghc` instead. This was wrong, because there is no binary compatibility guarantee that says that the `stage0` DB's `package.cache` (which is written by the stage0 == system-provided ghc-pkg) can be deserialised by the `ghc-pkg` from the source code tree. As a result, when trying to add fields to `InstalledPackageInfo` that get serialised into / deserialised from the `package.cache`, errors like _build/stage0/lib/package.conf.d/package.cache: GHC.PackageDb.readPackageDb: inappropriate type (Not a valid Unicode code point!) would appear. This was because the `stage0/bin/ghc would try to deserialise the newly added fields from `_build/stage0/lib/package.conf.d/package.cache`, but they were not in there because the system `ghc-pkg` doesn't know about them and thus didn't write them there. It would try to do that because any GHC by default tries to read the global package db in `../lib/package.conf.d/package.cache`. For `stage0/bin/ghc` that *can never work* as explained above, so we must disable this default via `-no-global-package-db` and give it the correct package DB explicitly. This is the same problem as #16534, and the same fix as in MR !780 (but in another context; that one was for developers trying out the `stage0/bin/ghc` == `_build/ghc-stage1` interactively, while this fix is for a `cabal configure` invocation). I also noticed that the fix for #16534 forgot to pass `-no-global-package-db`, and have fixed that in this commit as well. It only worked until now because nobody tried to add a new ghc-pkg `.conf` field since the introduction of Hadrian. - - - - - ef2ae81a by Alex Biehl at 2020-08-03T07:52:33+02:00 Hardcode RTS includes to cope with unregistered builds - - - - - d613ed76 by Sylvain Henry at 2020-08-05T03:59:27-04:00 Bignum: add backward compat integer-gmp functions Also enhance bigNatCheck# and isValidNatural test - - - - - 3f2f7718 by Sylvain Henry at 2020-08-05T03:59:27-04:00 Bignum: add more BigNat compat functions in integer-gmp - - - - - 5e12cd17 by Krzysztof Gogolewski at 2020-08-05T04:00:04-04:00 Rename Core.Opt.Driver -> Core.Opt.Pipeline Closes #18504. - - - - - 2bff2f87 by Ben Gamari at 2020-08-05T04:00:39-04:00 Revert "iserv: Don't pass --export-dynamic on FreeBSD" This reverts commit 2290eb02cf95e9cfffcb15fc9c593d5ef79c75d9. - - - - - 53ce0db5 by Ben Gamari at 2020-08-05T04:00:39-04:00 Refactor handling of object merging Previously to merge a set of object files we would invoke the linker as usual, adding -r to the command-line. However, this can result in non-sensical command-lines which causes lld to balk (#17962). To avoid this we introduce a new tool setting into GHC, -pgmlm, which is the linker which we use to merge object files. - - - - - eb7013c3 by Hécate at 2020-08-05T04:01:15-04:00 Remove all the unnecessary LANGUAGE pragmas - - - - - fbcb886d by Ryan Scott at 2020-08-05T04:01:51-04:00 Make CodeQ and TExpQ levity polymorphic The patch is quite straightforward. The only tricky part is that `Language.Haskell.TH.Lib.Internal` now must be `Trustworthy` instead of `Safe` due to the `GHC.Exts` import (in order to import `TYPE`). Since `CodeQ` has yet to appear in any released version of `template-haskell`, I didn't bother mentioning the change to `CodeQ` in the `template-haskell` release notes. Fixes #18521. - - - - - 686e06c5 by Vladislav Zavialov at 2020-08-06T13:34:05-04:00 Grammar for types and data/newtype constructors Before this patch, we parsed types into a reversed sequence of operators and operands. For example, (F x y + G a b * X) would be parsed as [X, *, b, a, G, +, y, x, F], using a simple grammar: tyapps : tyapp | tyapps tyapp tyapp : atype | PREFIX_AT atype | tyop | unpackedness Then we used a hand-written state machine to assemble this either into a type, using 'mergeOps', or into a constructor, using 'mergeDataCon'. This is due to a syntactic ambiguity: data T1 a = MkT1 a data T2 a = Ord a => MkT2 a In T1, what follows after the = sign is a data/newtype constructor declaration. However, in T2, what follows is a type (of kind Constraint). We don't know which of the two we are parsing until we encounter =>, and we cannot check for => without unlimited lookahead. This poses a few issues when it comes to e.g. infix operators: data I1 = Int :+ Bool :+ Char -- bad data I2 = Int :+ Bool :+ Char => MkI2 -- fine By this issue alone we are forced into parsing into an intermediate representation and doing a separate validation pass. However, should that intermediate representation be as low-level as a flat sequence of operators and operands? Before GHC Proposal #229, the answer was Yes, due to some particularly nasty corner cases: data T = ! A :+ ! B -- used to be fine, hard to parse data T = ! A :+ ! B => MkT -- bad However, now the answer is No, as this corner case is gone: data T = ! A :+ ! B -- bad data T = ! A :+ ! B => MkT -- bad This means we can write a proper grammar for types, overloading it in the DisambECP style, see Note [Ambiguous syntactic categories]. With this patch, we introduce a new class, DisambTD. Just like DisambECP is used to disambiguate between expressions, commands, and patterns, DisambTD is used to disambiguate between types and data/newtype constructors. This way, we get a proper, declarative grammar for constructors and types: infixtype : ftype | ftype tyop infixtype | unpackedness infixtype ftype : atype | tyop | ftype tyarg | ftype PREFIX_AT tyarg tyarg : atype | unpackedness atype And having a grammar for types means we are a step closer to using a single grammar for types and expressions. - - - - - 6770e199 by Vladislav Zavialov at 2020-08-06T13:34:05-04:00 Clean up the story around runPV/runECP_P/runECP_PV This patch started as a small documentation change, an attempt to make Note [Parser-Validator] and Note [Ambiguous syntactic categories] more clear and up-to-date. But it turned out that runECP_P/runECP_PV are weakly motivated, and it's easier to remove them than to find a good rationale/explanation for their existence. As the result, there's a bit of refactoring in addition to a documentation update. - - - - - 826d07db by Vladislav Zavialov at 2020-08-06T13:34:06-04:00 Fix debug_ppr_ty ForAllTy (#18522) Before this change, GHC would pretty-print forall k. forall a -> () as forall @k a. () which isn't even valid Haskell. - - - - - 0ddb4384 by Vladislav Zavialov at 2020-08-06T13:34:06-04:00 Fix visible forall in ppr_ty (#18522) Before this patch, this type: T :: forall k -> (k ~ k) => forall j -> k -> j -> Type was printed incorrectly as: T :: forall k j -> (k ~ k) => k -> j -> Type - - - - - d2a43225 by Richard Eisenberg at 2020-08-06T13:34:06-04:00 Fail eagerly on a lev-poly datacon arg Close #18534. See commentary in the patch. - - - - - 63348155 by Sylvain Henry at 2020-08-06T13:34:08-04:00 Use a type alias for Ways - - - - - 9570c212 by Takenobu Tani at 2020-08-06T19:46:46-04:00 users-guide: Rename 8.12 to 9.0 GHC 8.12.1 has been renamed to GHC 9.0.1. See also: https://mail.haskell.org/pipermail/ghc-devs/2020-July/019083.html [skip ci] - - - - - 3907ee01 by Cale Gibbard at 2020-08-07T08:34:46-04:00 A fix to an error message in monad comprehensions, and a move of dsHandleMonadicFailure as suggested by comments on !2330. - - - - - fa9bb70a by Cale Gibbard at 2020-08-07T08:34:46-04:00 Add some tests for fail messages in do-expressions and monad-comprehensions. - - - - - 5f036063 by Ben Gamari at 2020-08-07T08:35:21-04:00 cmm: Clean up Notes a bit - - - - - 6402c124 by Ben Gamari at 2020-08-07T08:35:21-04:00 CmmLint: Check foreign call argument register invariant As mentioned in Note [Register parameter passing] the arguments of foreign calls cannot refer to caller-saved registers. - - - - - 15b36de0 by Ben Gamari at 2020-08-07T08:35:21-04:00 nativeGen: One approach to fix #18527 Previously the code generator could produce corrupt C call sequences due to register overlap between MachOp lowerings and the platform's calling convention. We fix this using a hack described in Note [Evaluate C-call arguments before placing in destination registers]. - - - - - 3847ae0c by Ben Gamari at 2020-08-07T08:35:21-04:00 testsuite: Add test for #18527 - - - - - dd51d53b by Ben Gamari at 2020-08-07T08:35:21-04:00 testsuite: Fix prog001 Previously it failed as the `ghc` package was not visible. - - - - - e4f1b73a by Alan Zimmerman at 2020-08-07T23:58:10-04:00 ApiAnnotations; tweaks for ghc-exactprint update Remove unused ApiAnns, add one for linear arrow. Include API Annotations for trailing comma in export list. - - - - - 8a665db6 by Ben Gamari at 2020-08-07T23:58:45-04:00 configure: Fix double-negation in ld merge-objects check We want to only run the check if ld is gold. Fixes the fix to #17962. - - - - - a11c9678 by Adam Sandberg Ericsson at 2020-08-09T11:32:25+02:00 hadrian: depend on boot compiler version #18001 - - - - - c8873b52 by Alan Zimmerman at 2020-08-09T21:17:54-04:00 Api Annotations : Adjust SrcSpans for prefix bang (!). And prefix ~ (cherry picked from commit 8dbee2c578b1f642d45561be3f416119863e01eb) - - - - - 77398b67 by Sylvain Henry at 2020-08-09T21:18:34-04:00 Avoid allocations in `splitAtList` (#18535) As suspected by @simonpj in #18535, avoiding allocations in `GHC.Utils.Misc.splitAtList` when there are no leftover arguments is beneficial for performance: On CI validate-x86_64-linux-deb9-hadrian: T12227 -7% T12545 -12.3% T5030 -10% T9872a -2% T9872b -2.1% T9872c -2.5% Metric Decrease: T12227 T12545 T5030 T9872a T9872b T9872c - - - - - 8ba41a0f by Felix Yan at 2020-08-10T20:23:29-04:00 Correct a typo in ghc.mk - - - - - 1c469264 by Felix Yan at 2020-08-10T20:23:29-04:00 Add a closing parenthesis too - - - - - acf537f9 by Sylvain Henry at 2020-08-10T20:24:09-04:00 Make splitAtList strict in its arguments Also fix its slightly wrong comment Metric Decrease: T5030 T12227 T12545 - - - - - ab4d1589 by Ben Gamari at 2020-08-11T22:18:03-04:00 typecheck: Drop SPECIALISE pragmas when there is no unfolding Previously the desugarer would instead fall over when it realized that there was no unfolding for an imported function with a SPECIALISE pragma. We now rather drop the SPECIALISE pragma and throw a warning. Fixes #18118. - - - - - 0ac8c0a5 by Ben Gamari at 2020-08-11T22:18:03-04:00 testsuite: Add test for #18118 - - - - - c43078d7 by Sven Tennie at 2020-08-11T22:18:38-04:00 Add hie.yaml to ghc-heap This enables IDE support by haskell-language-server for ghc-heap. - - - - - f1088b3f by Ben Gamari at 2020-08-11T22:19:15-04:00 testsuite: Specify metrics collected by T17516 Previously it collected everything, including "max bytes used". This is problematic since the test makes no attempt to control for deviations in GC timing, resulting in high variability. Fix this by only collecting "bytes allocated". - - - - - accbc242 by Sylvain Henry at 2020-08-12T03:50:12-04:00 DynFlags: disentangle Outputable - put panic related functions into GHC.Utils.Panic - put trace related functions using DynFlags in GHC.Driver.Ppr One step closer making Outputable fully independent of DynFlags. Bump haddock submodule - - - - - db6dd810 by Ben Gamari at 2020-08-12T03:50:48-04:00 testsuite: Increase tolerance of T16916 T16916 (testing #16916) has been slightly fragile in CI due to its reliance on CPU times. While it's hard to see how to eliminate the time-dependence entirely, we can nevertheless make it more tolerant. Fixes #16966. - - - - - bee43aca by Sylvain Henry at 2020-08-12T20:52:50-04:00 Rewrite and move the monad-state hack note The note has been rewritten by @simonpj in !3851 [skip ci] - - - - - 25fdf25e by Alan Zimmerman at 2020-08-12T20:53:26-04:00 ApiAnnotations: Fix parser for new GHC 9.0 features - - - - - 7831fe05 by Ben Gamari at 2020-08-13T03:44:17-04:00 parser: Suggest ImportQualifiedPost in prepositive import warning As suggested in #18545. - - - - - 55dec4dc by Sebastian Graf at 2020-08-13T03:44:52-04:00 PmCheck: Better long-distance info for where bindings (#18533) Where bindings can see evidence from the pattern match of the `GRHSs` they belong to, but not from anything in any of the guards (which belong to one of possibly many RHSs). Before this patch, we did *not* consider said evidence, causing #18533, where the lack of considering type information from a case pattern match leads to failure to resolve the vanilla COMPLETE set of a data type. Making available that information required a medium amount of refactoring so that `checkMatches` can return a `[(Deltas, NonEmpty Deltas)]`; one `(Deltas, NonEmpty Deltas)` for each `GRHSs` of the match group. The first component of the pair is the covered set of the pattern, the second component is one covered set per RHS. Fixes #18533. Regression test case: T18533 - - - - - cf97889a by Hécate at 2020-08-13T03:45:29-04:00 Re-add BangPatterns to CodePage.hs - - - - - ffc0d578 by Sylvain Henry at 2020-08-13T09:49:56-04:00 Add HomeUnit type Since Backpack the "home unit" is much more involved than what it was before (just an identifier obtained with `-this-unit-id`). Now it is used in conjunction with `-component-id` and `-instantiated-with` to configure module instantiations and to detect if we are type-checking an indefinite unit or compiling a definite one. This patch introduces a new HomeUnit datatype which is much easier to understand. Moreover to make GHC support several packages in the same instances, we will need to handle several HomeUnits so having a dedicated (documented) type is helpful. Finally in #14335 we will also need to handle the case where we have no HomeUnit at all because we are only loading existing interfaces for plugins which live in a different space compared to units used to produce target code. Several functions will have to be refactored to accept "Maybe HomeUnit" parameters instead of implicitly querying the HomeUnit fields in DynFlags. Having a dedicated type will make this easier. Bump haddock submodule - - - - - 8a51b2ab by Sylvain Henry at 2020-08-13T21:09:15-04:00 Make IOEnv monad one-shot (#18202) On CI (x86_64-linux-deb9-hadrian, compile_time/bytes_allocated): T10421 -1.8% (threshold: +/- 1%) T10421a -1.7% (threshold: +/- 1%) T12150 -4.9% (threshold: +/- 2%) T12227 -1.6 (threshold: +/- 1%) T12425 -1.5% (threshold: +/- 1%) T12545 -3.8% (threshold: +/- 1%) T12707 -3.0% (threshold: +/- 1%) T13035 -3.0% (threshold: +/- 1%) T14683 -10.3% (threshold: +/- 2%) T3064 -6.9% (threshold: +/- 2%) T4801 -4.3% (threshold: +/- 2%) T5030 -2.6% (threshold: +/- 2%) T5321FD -3.6% (threshold: +/- 2%) T5321Fun -4.6% (threshold: +/- 2%) T5631 -19.7% (threshold: +/- 2%) T5642 -13.0% (threshold: +/- 2%) T783 -2.7 (threshold: +/- 2%) T9020 -11.1 (threshold: +/- 2%) T9961 -3.4% (threshold: +/- 2%) T1969 (compile_time/bytes_allocated) -2.2% (threshold: +/-1%) T1969 (compile_time/max_bytes_used) +24.4% (threshold: +/-20%) Additionally on other CIs: haddock.Cabal -10.0% (threshold: +/- 5%) haddock.compiler -9.5% (threshold: +/- 5%) haddock.base (max bytes used) +24.6% (threshold: +/- 15%) T10370 (max bytes used, i386) +18.4% (threshold: +/- 15%) Metric Decrease: T10421 T10421a T12150 T12227 T12425 T12545 T12707 T13035 T14683 T3064 T4801 T5030 T5321FD T5321Fun T5631 T5642 T783 T9020 T9961 haddock.Cabal haddock.compiler Metric Decrease 'compile_time/bytes allocated': T1969 Metric Increase 'compile_time/max_bytes_used': T1969 T10370 haddock.base - - - - - 9f66fdf6 by Ben Gamari at 2020-08-14T15:50:34-04:00 testsuite: Drop --io-manager flag from testsuite configuration This is no longer necessary as there are now dedicated testsuite ways which run tests with WinIO. - - - - - 55fd1dc5 by Ben Gamari at 2020-08-14T15:51:10-04:00 llvm-targets: Add i686 targets Addresses #18422. - - - - - f4cc57fa by Ben Gamari at 2020-08-18T15:38:55-04:00 Allow unsaturated runRW# applications Previously we had a very aggressive Core Lint check which caught unsaturated applications of runRW#. However, there is nothing wrong with such applications and they may naturally arise in desugared Core. For instance, the desugared Core of Data.Primitive.Array.runArray# from the `primitive` package contains: case ($) (runRW# @_ @_) (\s -> ...) of ... In this case it's almost certain that ($) will be inlined, turning the application into a saturated application. However, even if this weren't the case there isn't a problem: CorePrep (after deleting an unnecessary case) can simply generate code in its usual way, resulting in a call to the Haskell definition of runRW#. Fixes #18291. - - - - - 3ac6ae7c by Ben Gamari at 2020-08-18T15:38:55-04:00 testsuite: Add test for #18291 - - - - - a87a0b49 by Eli Schwartz at 2020-08-18T15:39:30-04:00 install: do not install sphinx doctrees These files are 100% not needed at install time, and they contain unreproducible info. See https://reproducible-builds.org/ for why this matters. - - - - - 194b25ee by Ben Gamari at 2020-08-18T15:40:05-04:00 testsuite: Allow baseline commit to be set explicitly - - - - - fdcf7645 by Ben Gamari at 2020-08-18T15:40:05-04:00 gitlab-ci: Use MR base commit as performance baseline - - - - - 9ad5cab3 by Fendor at 2020-08-18T15:40:42-04:00 Expose UnitInfoMap as it is part of the public API - - - - - aa4b744d by Ben Gamari at 2020-08-18T22:11:36-04:00 testsuite: Only run llvm ways if llc is available As noted in #18560, we previously would always run the LLVM ways since `configure` would set `SettingsLlcCommand` to something non-null when it otherwise couldn't find the `llc` executable. Now we rather probe for the existence of the `llc` executable in the testsuite driver. Fixes #18560. - - - - - 0c5ed5c7 by Sylvain Henry at 2020-08-18T22:12:13-04:00 DynFlags: refactor GHC.CmmToAsm (#17957, #10143) This patch removes the use of `sdocWithDynFlags` from GHC.CmmToAsm.*.Ppr To do that I've had to make some refactoring: * X86' and PPC's `Instr` are no longer `Outputable` as they require a `Platform` argument * `Instruction` class now exposes `pprInstr :: Platform -> instr -> SDoc` * as a consequence, I've refactored some modules to avoid .hs-boot files * added (derived) functor instances for some datatypes parametric in the instruction type. It's useful for pretty-printing as we just have to map `pprInstr` before pretty-printing the container datatype. - - - - - 731c8d3b by nineonine at 2020-08-19T18:47:39-04:00 Implement -Wredundant-bang-patterns (#17340) Add new flag '-Wredundant-bang-patterns' that enables checks for "dead" bangs. Dead bangs are the ones that under no circumstances can force a thunk that wasn't already forced. Dead bangs are a form of redundant bangs. The new check is performed in Pattern-Match Coverage Checker along with other checks (namely, redundant and inaccessible RHSs). Given f :: Bool -> Int f True = 1 f !x = 2 we can detect dead bang patterns by checking whether @x ~ ⊥@ is satisfiable where the PmBang appears in 'checkGrdTree'. If not, then clearly the bang is dead. Such a dead bang is then indicated in the annotated pattern-match tree by a 'RedundantSrcBang' wrapping. In 'redundantAndInaccessibles', we collect all dead bangs to warn about. Note that we don't want to warn for a dead bang that appears on a redundant clause. That is because in that case, we recommend to delete the clause wholly, including its leading pattern match. Dead bang patterns are redundant. But there are bang patterns which are redundant that aren't dead, for example f !() = 0 the bang still forces the match variable, before we attempt to match on (). But it is redundant with the forcing done by the () match. We currently don't detect redundant bangs that aren't dead. - - - - - eb9bdaef by Simon Peyton Jones at 2020-08-19T18:48:14-04:00 Add right-to-left rule for pattern bindings Fix #18323 by adding a few lines of code to handle non-recursive pattern bindings. see GHC.Tc.Gen.Bind Note [Special case for non-recursive pattern bindings] Alas, this confused the pattern-match overlap checker; see #18323. Note that this patch only affects pattern bindings like that for (x,y) in this program combine :: (forall a . [a] -> a) -> [forall a. a -> a] -> ((forall a . [a] -> a), [forall a. a -> a]) breaks = let (x,y) = combine head ids in x y True We need ImpredicativeTypes for those [forall a. a->a] types to be valid. And with ImpredicativeTypes the old, unprincipled "allow unification variables to unify with a polytype" story actually works quite well. So this test compiles fine (if delicatedly) with old GHCs; but not with QuickLook unless we add this patch - - - - - 293c7fba by Sylvain Henry at 2020-08-21T09:36:38-04:00 Put CFG weights into their own module (#17957) It avoids having to query DynFlags to get them - - - - - 50eb4460 by Sylvain Henry at 2020-08-21T09:36:38-04:00 Don't use DynFlags in CmmToAsm.BlockLayout (#17957) - - - - - 659eb31b by Sylvain Henry at 2020-08-21T09:36:38-04:00 NCG: Dwarf configuration * remove references to DynFlags in GHC.CmmToAsm.Dwarf * add specific Dwarf options in NCGConfig instead of directly querying the debug level - - - - - 2d8ca917 by Sylvain Henry at 2020-08-21T09:37:15-04:00 Fix -ddump-stg flag -ddump-stg was dumping the initial STG (just after Core-to-STG pass) which was misleading because we want the final STG to know if a function allocates or not. Now we have a new flag -ddump-stg-from-core for this and -ddump-stg is deprecated. - - - - - fddddbf4 by Vladislav Zavialov at 2020-08-21T09:37:49-04:00 Import qualified Prelude in Cmm/Parser.y In preparation for the next version of 'happy', c95920 added a qualified import to GHC/Parser.y but for some reason neglected GHC/Cmm/Parser.y This patch adds the missing qualified import to GHC/Cmm/Parser.y and also adds a clarifying comment to explain why this import is needed. - - - - - 989c1c27 by Ben Gamari at 2020-08-21T11:27:53-04:00 gitlab-ci: Test master branch as well While these builds are strictly speaking redundant (since every commit is tested by @marge-bot before making it into `master`), they are nevertheless useful as they are displayed in the branch's commit list in GitLab's web interface. Fixes #18595. - - - - - e67ae884 by Aditya Gupta at 2020-08-22T03:29:00-04:00 mkUnique refactoring (#18362) Move uniqFromMask from Unique.Supply to Unique. Move the the functions that call mkUnique from Unique to Builtin.Uniques - - - - - 03cfcfd4 by Wander Hillen at 2020-08-22T03:29:36-04:00 Add ubuntu 20.04 jobs for nightly and release - - - - - 3f501545 by Craig Ferguson at 2020-08-22T03:30:13-04:00 Utils: clarify docs slightly The previous comment implies `nTimes n f` is either `f^{n+1}` or `f^{2^n}` (when in fact it's `f^n`). - - - - - 8b865092 by Krzysztof Gogolewski at 2020-08-23T14:12:53+02:00 Do not print synonyms in :i (->), :i Type (#18594) This adds a new printing flag `sdocPrintTypeAbbreviations` that is used specifically to avoid ghci printing 'type (->) = (->)' and 'type Type = Type'. - - - - - d8f61182 by Krzysztof Gogolewski at 2020-08-23T14:12:56+02:00 Move pprTyTcApp' inside pprTyTcApp No semantic change - - - - - 364258e0 by Krzysztof Gogolewski at 2020-08-24T00:32:31-04:00 Fix types in silly shifts (#18589) Patch written by Simon. I have only added a testcase. - - - - - b1eb38a0 by Sylvain Henry at 2020-08-24T00:33:13-04:00 Perf: make SDoc monad one-shot (#18202) With validate-x86_64-linux-deb9-hadrian: T1969 -3.4% (threshold: +/-1%) T3294 -3.3% (threshold: +/-1%) T12707 -1.4% (threshold: +/-1%) Additionally with validate-x86_64-linux-deb9-unreg-hadrian: T4801 -2.4% (threshold: +/-2%) T13035 -1.4% (threshold: +/-1%) T13379 -2.4% (threshold: +/-2%) ManyAlternatives -2.5% (threshold: +/-2%) ManyConstructors -3.0% (threshold: +/-2%) Metric Decrease: T12707 T1969 T3294 ManyAlternatives ManyConstructors T13035 T13379 T4801 - - - - - a77b9ec2 by Krzysztof Gogolewski at 2020-08-24T10:04:20-04:00 Add a test for #18397 The bug was fixed by !3421. - - - - - 05550a5a by Sylvain Henry at 2020-08-24T10:04:59-04:00 Avoid roundtrip through SDoc As found by @monoidal on https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3885#note_295126 - - - - - 0a1ecc5f by Ben Gamari at 2020-08-25T07:37:05-04:00 SysTools.Process: Handle exceptions in readCreateProcessWithExitCode' In #18069 we are observing MVar deadlocks from somewhere in ghc.exe. This use of MVar stood out as being one of the more likely culprits. Here we make sure that it is exception-safe. - - - - - db8793ad by Richard Eisenberg at 2020-08-25T07:37:40-04:00 Use tcView, not coreView, in the pure unifier. Addresses a lingering point within #11715. - - - - - fb77207a by Simon Peyton Jones at 2020-08-25T07:38:16-04:00 Use LIdP rather than (XRec p (IdP p)) This patch mainly just replaces use of XRec p (IdP p) with LIdP p One slightly more significant change is to parameterise HsPatSynDetails over the pass rather than the argument type, so that it's uniform with HsConDeclDetails and HsConPatDetails. I also got rid of the dead code GHC.Hs.type.conDetailsArgs But this is all just minor refactoring. No change in functionality. - - - - - 8426a136 by Krzysztof Gogolewski at 2020-08-25T07:38:54-04:00 Add a test for #18585 - - - - - 2d635a50 by Takenobu Tani at 2020-08-26T04:50:21-04:00 linters: Make CPP linter skip image files This patch adds an exclusion rule for `docs/users_guide/images`, to avoid lint errors of PDF files. - - - - - b7d98cb2 by Takenobu Tani at 2020-08-26T04:50:21-04:00 users-guide: Color the logo on the front page of the PDF This patch updates the logo with a recent color scheme. This affects only the PDF version of the user's guide. See also: * https://mail.haskell.org/pipermail/ghc-devs/2020-August/019139.html * https://gitlab.haskell.org/ghc/ghc/-/wikis/logo - - - - - 0b17fa18 by Sylvain Henry at 2020-08-26T04:50:58-04:00 Refactor UnitId pretty-printing When we pretty-print a UnitId for the user, we try to map it back to its origin package name, version and component to print "package-version:component" instead of some hash. The UnitId type doesn't carry these information, so we have to look into a UnitState to find them. This is why the Outputable instance of UnitId used `sdocWithDynFlags` in order to access the `unitState` field of DynFlags. This is wrong for several reasons: 1. The DynFlags are accessed when the message is printed, not when it is generated. So we could imagine that the unitState may have changed in-between. Especially if we want to allow unit unloading. 2. We want GHC to support several independent sessions at once, hence several UnitState. The current approach supposes there is a unique UnitState as a UnitId doesn't indicate which UnitState to use. See the Note [Pretty-printing UnitId] in GHC.Unit for the new approach implemented by this patch. One step closer to remove `sdocDynFlags` field from `SDocContext` (#10143). Fix #18124. Also fix some Backpack code to use SDoc instead of String. - - - - - dc476a50 by Sylvain Henry at 2020-08-26T04:51:35-04:00 Bignum: fix BigNat subtraction (#18604) There was a confusion between the boolean expected by withNewWordArrayTrimedMaybe and the boolean returned by subtracting functions. - - - - - fcb10b6c by Peter Trommler at 2020-08-26T10:42:30-04:00 PPC and X86: Portable printing of IEEE floats GNU as and the AIX assembler support floating point literals. SPARC seems to have support too but I cannot test on SPARC. Curiously, `doubleToBytes` is also used in the LLVM backend. To avoid endianness issues when cross-compiling float and double literals are printed as C-style floating point values. The assembler then takes care of memory layout and endianness. This was brought up in #18431 by @hsyl20. - - - - - 770100e0 by Krzysztof Gogolewski at 2020-08-26T10:43:13-04:00 primops: Remove Monadic and Dyadic categories There were four categories of primops: Monadic, Dyadic, Compare, GenPrimOp. The compiler does not treat Monadic and Dyadic in any special way, we can just replace them with GenPrimOp. Compare is still used in isComparisonPrimOp. - - - - - 01ff8c89 by Aditya Gupta at 2020-08-27T14:19:26-04:00 Consolidate imports in getMinimalImports (#18264) - - - - - bacccb73 by Ryan Scott at 2020-08-27T14:20:01-04:00 Make {hsExpr,hsType,pat}NeedsParens aware of boxed 1-tuples `hsExprNeedsParens`, `hsTypeNeedsParens`, and `patNeedsParens` previously assumed that all uses of explicit tuples in the source syntax never need to be parenthesized. This is true save for one exception: boxed one-tuples, which use the `Solo` data type from `GHC.Tuple` instead of special tuple syntax. This patch adds the necessary logic to the three `*NeedsParens` functions to handle `Solo` correctly. Fixes #18612. - - - - - c6f50cea by Krzysztof Gogolewski at 2020-08-28T02:22:36-04:00 Add missing primop documentation (#18454) - Add three pseudoops to primops.txt.pp, so that Haddock renders the documentation - Update comments - Remove special case for "->" - it's no longer exported from GHC.Prim - Remove reference to Note [Compiling GHC.Prim] - the ad-hoc fix is no longer there after updates to levity polymorphism. - Document GHC.Prim - Remove the comment that lazy is levity-polymorphic. As far as I can tell, it never was: in 80e399639, only the unfolding was given an open type variable. - Remove haddock hack in GHC.Magic - no longer neccessary after adding realWorld# to primops.txt.pp. - - - - - f065b6b0 by Tamar Christina at 2020-08-28T02:23:13-04:00 Fix use distro toolchian - - - - - 4517a382 by Tamar Christina at 2020-08-28T02:23:13-04:00 document how build system find toolchains on Windows - - - - - 329f7cb9 by Ben Gamari at 2020-08-31T22:59:14-04:00 base: Better error message on invalid getSystemTimerManager call Previously we would produce a rather unhelpful pattern match failure error in the case where the user called `getSystemTimerManager` in a program which isn't built with `-threaded`. This understandably confused the user in #15616. Fixes #15616. - - - - - f6d70a8f by Roland Senn at 2020-08-31T22:59:50-04:00 Add tests for #15617. Avoid a similar regression in the future. - - - - - e5969fd0 by Roland Senn at 2020-08-31T23:00:27-04:00 Add additional tests for #18172 (Followup MR 3543) There was still one active discussion [thread](https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3543#note_284325) when MR !3543 got merged. This MR adds the requested tests exercising the changes in `compiler/GHC/HsToCore/Match/Literal.hs:warnAboutEmptyEnumerations` and its sub-functions. - - - - - fe18b482 by Ben Gamari at 2020-08-31T23:01:02-04:00 Bump Win32 and process submodules - - - - - 2da93308 by Sylvain Henry at 2020-08-31T23:01:39-04:00 Hadrian: fix slow-validate flavour (#18586) - - - - - 85e13008 by Andreas Klebinger at 2020-08-31T23:02:15-04:00 Update dominator code with fixes from the dom-lt package. Two bugs turned out in the package that have been fixed since. This MR includes this fixes in the GHC port of the code. - - - - - dffb38fa by Andreas Klebinger at 2020-08-31T23:02:15-04:00 Dominators.hs: Use unix line endings - - - - - 6189cc04 by Moritz Angermann at 2020-08-31T23:02:50-04:00 [fixup 3433] move debugBelch into IF_DEBUG(linker) The commit in dff1cb3d9c111808fec60190747272b973547c52 incorrectly left the `debugBelch` function without a comment or IF_DEBUG(linker,) decoration. This rectifies it. Needs at least a 8.10 backport, as it was backported in 6471cc6aff80d5deebbdb1bf7b677b31ed2af3d5 - - - - - bcb68a3f by Sylvain Henry at 2020-08-31T23:03:27-04:00 Don't store HomeUnit in UnitConfig Allow the creation of a UnitConfig (hence of a UnitState) without having a HomeUnit. It's required for #14335. - - - - - 0a372387 by Sylvain Henry at 2020-08-31T23:04:04-04:00 Fix documentation and fix "check" bignum backend (#18604) - - - - - eb85f125 by Moritz Angermann at 2020-08-31T23:04:39-04:00 Set the dynamic-system-linker flag to Manual This flag should be user controllable, hence Manual: True. - - - - - 380ef845 by Sven Tennie at 2020-08-31T23:05:14-04:00 Ignore more files Ignore files from "new style" cabal builds (dist-newstyle folders) and from clangd (C language server). - - - - - 74a7fbff by Takenobu Tani at 2020-08-31T23:05:51-04:00 Limit upper version of Happy for ghc-9.0 and earlier (#18620) This patch adds the upper bound of a happy version for ghc-9.0 and earlier. Currently, we can't use happy-1.20.0 for ghc-9.0. See #18620. - - - - - a4473f02 by Takenobu Tani at 2020-08-31T23:05:51-04:00 Limit upper version of Happy for ghc-9.2 (#18620) This patch adds the upper bound of a happy version for ghc-9.2. Currently, We can use happy-1.19 or happy-1.20 for ghc-9.2. See #18620. - - - - - a8a2568b by Sylvain Henry at 2020-08-31T23:06:28-04:00 Bignum: add BigNat compat functions (#18613) - - - - - 884245dd by Sylvain Henry at 2020-09-01T12:39:36-04:00 Fix FastString lexicographic ordering (fix #18562) - - - - - 4b4fbc58 by Sylvain Henry at 2020-09-01T12:39:36-04:00 Remove "Ord FastString" instance FastStrings can be compared in 2 ways: by Unique or lexically. We don't want to bless one particular way with an "Ord" instance because it leads to bugs (#18562) or to suboptimal code (e.g. using lexical comparison while a Unique comparison would suffice). UTF-8 encoding has the advantage that sorting strings by their encoded bytes also sorts them by their Unicode code points, without having to decode the actual code points. BUT GHC uses Modified UTF-8 which diverges from UTF-8 by encoding \0 as 0xC080 instead of 0x00 (to avoid null bytes in the middle of a String so that the string can still be null-terminated). This patch adds a new `utf8CompareShortByteString` function that performs sorting by bytes but that also takes Modified UTF-8 into account. It is much more performant than decoding the strings into [Char] to perform comparisons (which we did in the previous patch). Bump haddock submodule - - - - - b4edcde7 by Ben Gamari at 2020-09-01T14:53:42-04:00 testsuite: Add broken test for #18302 - - - - - bfab2a30 by Sebastian Graf at 2020-09-02T15:54:55-04:00 Turn on -XMonoLocalBinds by default (#18430) And fix the resulting type errors. Co-authored-by: Krzysztof Gogolewski <krz.gogolewski at gmail.com> Metric Decrease: parsing001 - - - - - c30cc0e9 by David Feuer at 2020-09-02T15:55:31-04:00 Remove potential space leak from Data.List.transpose Previously, `transpose` produced a list of heads and a list of tails independently. This meant that a function using only some heads, and only some tails, could potentially leak space. Use `unzip` to work around the problem by producing pairs and selector thunks instead. Time and allocation behavior will be worse, but there should be no more leak potential. - - - - - ffc3da47 by Sylvain Henry at 2020-09-02T15:56:11-04:00 Remove outdated note - - - - - 85e62123 by Sylvain Henry at 2020-09-02T15:56:48-04:00 Bignum: add missing compat import/export functions - - - - - 397c2b03 by Ben Gamari at 2020-09-03T17:31:47-04:00 configure: Work around Raspbian's silly packaging decisions See #17856. - - - - - 4891c18a by Kathryn Spiers at 2020-09-03T17:32:24-04:00 expected-undocumented-flags remove kill flags It looks like the flags were removed in https://gitlab.haskell.org/ghc/ghc/-/commit/3e27205a66b06a4501d87eb31e285eadbc693eb7 and can safely be removed here - - - - - 1d6d6488 by Sylvain Henry at 2020-09-04T16:24:20-04:00 Don't rely on CLabel's Outputable instance in CmmToC This is in preparation of the removal of sdocWithDynFlags (#10143), hence of the refactoring of CLabel's Outputable instance. - - - - - 89ce7cdf by Sylvain Henry at 2020-09-04T16:24:59-04:00 DynFlags: use Platform in foldRegs* - - - - - 220ad8d6 by Sylvain Henry at 2020-09-04T16:24:59-04:00 DynFlags: don't pass DynFlags to cmmImplementSwitchPlans - - - - - c1e54439 by Ryan Scott at 2020-09-04T16:25:35-04:00 Introduce isBoxedTupleDataCon and use it to fix #18644 The code that converts promoted tuple data constructors to `IfaceType`s in `GHC.CoreToIface` was using `isTupleDataCon`, which conflates boxed and unboxed tuple data constructors. To avoid this, this patch introduces `isBoxedTupleDataCon`, which is like `isTupleDataCon` but only works for _boxed_ tuple data constructors. While I was in town, I was horribly confused by the fact that there were separate functions named `isUnboxedTupleCon` and `isUnboxedTupleTyCon` (similarly, `isUnboxedSumCon` and `isUnboxedSumTyCon`). It turns out that the former only works for data constructors, despite its very general name! I opted to rename `isUnboxedTupleCon` to `isUnboxedTupleDataCon` (similarly, I renamed `isUnboxedSumCon` to `isUnboxedSumDataCon`) to avoid this potential confusion, as well as to be more consistent with the naming convention I used for `isBoxedTupleDataCon`. Fixes #18644. - - - - - 07bdcac3 by GHC GitLab CI at 2020-09-04T22:26:25-04:00 configure: Avoid hard-coded ld path on Windows The fix to #17962 ended up regressing on Windows as it failed to replicate the logic responsible for overriding the toolchain paths on Windows. This resulted in a hard-coded path to a directory that likely doesn't exist on the user's system (#18550). - - - - - 0be8e746 by Benjamin Maurer at 2020-09-04T22:27:01-04:00 Documented the as of yet undocumented '--print-*' GHC flags, as well as `-split-objs`, since that is related to `--print-object-splitting-supported`. See #18641 - - - - - 4813486f by Sylvain Henry at 2020-09-04T22:27:44-04:00 Move Hadrian's wiki pages in tree (fix #16165) Only the debugging page contains interesting stuff. Some of this stuff looks old (e.g. recommending "cabal install")... - - - - - 7980ae23 by GHC GitLab CI at 2020-09-05T14:50:52-04:00 rts: Consistently use stgMallocBytes instead of malloc This can help in debugging RTS memory leaks since all allocations go through the same interface. - - - - - 67059893 by Ben Gamari at 2020-09-05T14:51:27-04:00 configure: Fix whitespace - - - - - be2cc0ad by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: More intelligent detection of locale availability Previously ci.sh would unconditionally use C.UTF-8. However, this fails on Centos 7, which appears not to provide this locale. Now we first try C.UTF-8, then try en_US.UTF-8, then fail. Works around #18607. - - - - - 15dca847 by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: Rename RELEASE variable to RELEASE_JOB This interfered with the autoconf variable of the same name, breaking pre-release builds. - - - - - bec0d170 by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: Bump Windows toolchain version This should have been done when we bumped the bootstrap compiler to 8.8.4. - - - - - 9fbaee21 by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: Drop Windows make job These are a significant burden on our CI resources and end up failing quite often due to #18274. Here I drop the make jobs during validaion; it is now run only during the nightly builds. - - - - - 869f6e19 by Ben Gamari at 2020-09-05T14:51:27-04:00 testsuite: Drop Windows-specific output for parseTree The normalise_slashes normaliser should handle this. - - - - - 2c9f743c by Ben Gamari at 2020-09-05T14:51:28-04:00 testsuite: Mark T5975[ab] as broken on Windows Due to #7305. - - - - - 643785e3 by Ben Gamari at 2020-09-05T14:51:28-04:00 gitlab-ci: Fix typo A small typo in a rule regular expression. - - - - - c5413fc6 by Wander Hillen at 2020-09-07T09:33:54-04:00 Add clarification regarding poll/kqueue flags - - - - - 10434d60 by Ben Gamari at 2020-09-07T09:34:32-04:00 gitlab-ci: Configure bignum backend in Hadrian builds - - - - - d4bc9f0d by Ben Gamari at 2020-09-07T09:34:32-04:00 gitlab-ci: Use hadrian builds for Windows release artifacts - - - - - 4ff93292 by Moritz Angermann at 2020-09-07T21:18:39-04:00 [macOS] improved runpath handling In b592bd98ff25730bbe3c13d6f62a427df8c78e28 we started using -dead_strip_dylib on macOS when lining dynamic libraries and binaries. The underlying reason being the Load Command Size Limit in macOS Sierra (10.14) and later. GHC will produce @rpath/libHS... dependency entries together with a corresponding RPATH entry pointing to the location of the libHS... library. Thus for every library we produce two Load Commands. One to specify the dependent library, and one with the path where to find it. This makes relocating libraries and binaries easier, as we just need to update the RPATH entry with the install_name_tool. The dynamic linker will then subsitute each @rpath with the RPATH entries it finds in the libraries load commands or the environement, when looking up @rpath relative libraries. -dead_strip_dylibs intructs the linker to drop unused libraries. This in turn help us reduce the number of referenced libraries, and subsequently the size of the load commands. This however does not remove the RPATH entries. Subsequently we can end up (in extreme cases) with only a single @rpath/libHS... entry, but 100s or more RPATH entries in the Load Commands. This patch rectifies this (slighly unorthodox) by passing *no* -rpath arguments to the linker at link time, but -headerpad 8000. The headerpad argument is in hexadecimal and the maxium 32k of the load command size. This tells the linker to pad the load command section enough for us to inject the RPATHs later. We then proceed to link the library or binary with -dead_strip_dylibs, and *after* the linking inspect the library to find the left over (non-dead-stripped) dependencies (using otool). We find the corresponding RPATHs for each @rpath relative dependency, and inject them into the library or binary using the install_name_tool. Thus achieving a deadstripped dylib (and rpaths) build product. We can not do this in GHC, without starting to reimplement a dynamic linker as we do not know which symbols and subsequently libraries are necessary. Commissioned-by: Mercury Technologies, Inc. (mercury.com) - - - - - df04b81e by Sylvain Henry at 2020-09-07T21:19:20-04:00 Move DynFlags test into updateModDetailsIdInfos's caller (#17957) - - - - - ea1cbb8f by Ben Gamari at 2020-09-08T15:42:02-04:00 rts: Add stg_copyArray_barrier to RtsSymbols list It's incredible that this wasn't noticed until now. - - - - - d7b2f799 by Daishi Nakajima at 2020-09-08T15:42:41-04:00 testsuite: Output performance test results in tabular format this was suggested in #18417. Change the print format of the values. * Shorten commit hash * Reduce precision of the "Value" field * Shorten metrics name * e.g. runtime/bytes allocated -> run/alloc * Shorten "MetricsChange" * e.g. unchanged -> unch, increased -> incr And, print the baseline environment if there are baselines that were measured in a different environment than the current environment. If all "Baseline commit" are the same, print it once. - - - - - 44472daf by Ryan Scott at 2020-09-08T15:43:16-04:00 Make the forall-or-nothing rule only apply to invisible foralls (#18660) This fixes #18660 by changing `isLHsForAllTy` to `isLHsInvisForAllTy`, which is sufficient to make the `forall`-or-nothing rule only apply to invisible `forall`s. I also updated some related documentation and Notes while I was in the neighborhood. - - - - - 0c61cbff by Ben Gamari at 2020-09-08T15:43:54-04:00 gitlab-ci: Handle distributions without locales Previously we would assume that the `locale` utility exists. However, this is not so on Alpine as musl's locale support is essentially non-existent. (cherry picked from commit 17cdb7ac3b557a245fee1686e066f9f770ddc21e) - - - - - d989c842 by Ben Gamari at 2020-09-08T15:43:55-04:00 gitlab-ci: Accept Centos 7 C.utf8 locale Centos apparently has C.utf8 rather than C.UTF-8. (cherry picked from commit d9f85dd25a26a04d3485470afb3395ee2dec6464) - - - - - e5a2899c by John Ericson at 2020-09-09T00:46:05-04:00 Use "to" instead of "2" in internal names of conversion ops Change the constructors for the primop union, and also names of the literal conversion functions. "2" runs into trouble when we need to do conversions from fixed-width types, and end up with thing like "Int642Word". Only the names internal to GHC are changed, as I don't want to worry about breaking changes ATM. - - - - - 822f1057 by Ryan Scott at 2020-09-09T00:46:41-04:00 Postpone associated tyfam default checks until after typechecking Previously, associated type family defaults were validity-checked during typechecking. Unfortunately, the error messages that these checks produce run the risk of printing knot-tied type constructors, which will cause GHC to diverge. In order to preserve the current error message's descriptiveness, this patch postpones these validity checks until after typechecking, which are now located in the new function `GHC.Tc.Validity.checkValidAssocTyFamDeflt`. Fixes #18648. - - - - - 8c892689 by Sylvain Henry at 2020-09-09T11:19:24-04:00 DynFlags: add OptCoercionOpts Use OptCoercionOpts to avoid threading DynFlags all the way down to GHC.Core.Coercion.Opt - - - - - 3f32a9c0 by Sylvain Henry at 2020-09-09T11:19:24-04:00 DynFlags: add UnfoldingOpts and SimpleOpts Milestone: after this patch, we only use 'unsafeGlobalDynFlags' for the state hack and for debug in Outputable. - - - - - b3df72a6 by Sylvain Henry at 2020-09-09T11:19:24-04:00 DynFlags: add sm_pre_inline field into SimplMode (#17957) It avoids passing and querying DynFlags down in the simplifier. - - - - - ffae5792 by Sylvain Henry at 2020-09-09T11:19:24-04:00 Add comments about sm_dflags and simpleOptExpr - - - - - 7911d0d9 by Alan Zimmerman at 2020-09-09T11:20:03-04:00 Remove GENERATED pragma, as it is not being used @alanz pointed out on ghc-devs that the payload of this pragma does not appear to be used anywhere. I (@bgamari) did some digging and traced the pragma's addition back to d386e0d2 (way back in 2006!). It appears that it was intended to be used by code generators for use in informing the code coveraging checker about generated code provenance. When it was added it used the pragma's "payload" fields as source location information to build an "ExternalBox". However, it looks like this was dropped a year later in 55a5d8d9. At this point it seems like the pragma serves no useful purpose. Given that it also is not documented, I think we should remove it. Updates haddock submodule Closes #18639 - - - - - 5aae5b32 by Ben Gamari at 2020-09-09T18:31:40-04:00 gitlab-ci: Bump Docker images We now generate our Docker images via Dhall definitions, as described in ghc/ci-images!52. Additionally, we are far more careful about where tools come from, using the ALEX, HAPPY, HSCOLOR, and GHC environment variables (set in the Dockerfiles) to find bootstrapping tools. - - - - - 4ce9fe88 by Ben Gamari at 2020-09-09T18:31:40-04:00 hadrian: Fix leakage of GHC in PATH into build Previously hadrian would use GHC on PATH when configuring packages (or fail if there is no such GHC). Fix this. Unfortunately this runs into another bug in Cabal which we workaround. - - - - - 291a15dd by Ben Gamari at 2020-09-09T18:31:40-04:00 utils: Bump cabal-version of hp2ps and unlit - - - - - 4798caa0 by David Himmelstrup at 2020-09-09T18:32:16-04:00 rts comment: RTS_TICKY_SYMBOLS moved from rts/Linker.c to rts/RtsSymbols.c - - - - - 67ce72da by Sebastian Graf at 2020-09-10T10:35:33-04:00 Add long-distance info for pattern bindings (#18572) We didn't consider the RHS of a pattern-binding before, which led to surprising warnings listed in #18572. As can be seen from the regression test T18572, we get the expected output now. - - - - - 1207576a by Sebastian Graf at 2020-09-10T10:35:33-04:00 PmCheck: Big refactor using guard tree variants more closely following source syntax (#18565) Previously, we desugared and coverage checked plain guard trees as described in Lower Your Guards. That caused (in !3849) quite a bit of pain when we need to partially recover tree structure of the input syntax to return covered sets for long-distance information, for example. In this refactor, I introduced a guard tree variant for each relevant source syntax component of a pattern-match (mainly match groups, match, GRHS, empty case, pattern binding). I made sure to share as much coverage checking code as possible, so that the syntax-specific checking functions are just wrappers around the more substantial checking functions for the LYG primitives (`checkSequence`, `checkGrds`). The refactoring payed off in clearer code and elimination of all panics related to assumed guard tree structure and thus fixes #18565. I also took the liberty to rename and re-arrange the order of functions and comments in the module, deleted some dead and irrelevant Notes, wrote some new ones and gave an overview module haddock. - - - - - 95455982 by GHC GitLab CI at 2020-09-10T10:36:09-04:00 hadrian: Don't include -fdiagnostics-color in argument hash Otherwise the input hash will vary with whether colors are requested, which changed with `isatty`. Fixes #18672. - - - - - 6abe4a1c by Sebastian Graf at 2020-09-10T17:02:00+02:00 .gitignore *.hiedb files - - - - - 3777be14 by Sebastian Graf at 2020-09-10T17:03:12+02:00 PmCheck: Handle ⊥ and strict fields correctly (#18341) In #18341, we discovered an incorrect digression from Lower Your Guards. This MR changes what's necessary to support properly fixing #18341. In particular, bottomness constraints are now properly tracked in the oracle/inhabitation testing, as an additional field `vi_bot :: Maybe Bool` in `VarInfo`. That in turn allows us to model newtypes as advertised in the Appendix of LYG and fix #17725. Proper handling of ⊥ also fixes #17977 (once again) and fixes #18670. For some reason I couldn't follow, this also fixes #18273. I also added a couple of regression tests that were missing. Most of them were already fixed before. In summary, this patch fixes #18341, #17725, #18273, #17977 and #18670. Metric Decrease: T12227 - - - - - 1bd28931 by David Himmelstrup at 2020-09-11T09:59:43-04:00 Define TICKY_TICKY when compiling cmm RTS files. - - - - - 15e67801 by David Himmelstrup at 2020-09-11T09:59:43-04:00 Fix typos in TICKY_TICKY symbol names. - - - - - 8a5a91cb by David Himmelstrup at 2020-09-11T09:59:43-04:00 Enable TICKY_TICKY for debug builds when building with makefiles. - - - - - fc965c09 by Sandy Maguire at 2020-09-12T00:31:36-04:00 Add clamp function to Data.Ord - - - - - fb6e29e8 by Sandy Maguire at 2020-09-12T00:31:37-04:00 Add tests - - - - - 2a942285 by Sebastian Graf at 2020-09-12T00:32:13-04:00 PmCheck: Disattach COMPLETE pragma lookup from TyCons By not attaching COMPLETE pragmas with a particular TyCon and instead assume that every COMPLETE pragma is applicable everywhere, we can drastically simplify the logic that tries to initialise available COMPLETE sets of a variable during the pattern-match checking process, as well as fixing a few bugs. Of course, we have to make sure not to report any of the ill-typed/unrelated COMPLETE sets, which came up in a few regression tests. In doing so, we fix #17207, #18277 and #14422. There was a metric decrease in #18478 by ~20%. Metric Decrease: T18478 - - - - - 389a6683 by Ben Gamari at 2020-09-12T00:32:49-04:00 hadrian: Pass input file to makeindex Strangely I find that on Alpine (and apparently only on Alpine) the latex makeindex command expects to be given a filename, lest it reads from stdin. - - - - - 853d121a by Ryan Scott at 2020-09-12T00:33:25-04:00 Don't quote argument to Hadrian's test-env flag (#18656) Doing so causes the name of the test environment to gain an extra set of double quotes, which changes the name entirely. Fixes #18656. - - - - - 8440b5fa by Krzysztof Gogolewski at 2020-09-12T00:33:25-04:00 Make sure we can read past perf notes See #18656. - - - - - 2157be52 by theobat at 2020-09-12T21:27:04-04:00 Avoid iterating twice in `zipTyEnv` (#18535) zipToUFM is a new function to replace `listToUFM (zipEqual ks vs)`. An explicit recursion is preferred due to the sensible nature of fusion. T12227 -6.0% T12545 -12.3% T5030 -9.0% T9872a -1.6% T9872b -1.6% T9872c -2.0% ------------------------- Metric Decrease: T12227 T12545 T5030 T9872a T9872b T9872c ------------------------- - - - - - 69ea2fee by Sebastian Graf at 2020-09-12T21:27:40-04:00 Make `tcCheckSatisfiability` incremental (#18645) By taking and returning an `InertSet`. Every new `TcS` session can then pick up where a prior session left with `setTcSInerts`. Since we don't want to unflatten the Givens (and because it leads to infinite loops, see !3971), we introduced a new variant of `runTcS`, `runTcSInerts`, that takes and returns the `InertSet` and makes sure not to unflatten the Givens after running the `TcS` action. Fixes #18645 and #17836. Metric Decrease: T17977 T18478 - - - - - a77e48d2 by Sebastian Graf at 2020-09-12T21:27:40-04:00 Extract definition of DsM into GHC.HsToCore.Types `DsM` was previously defined in `GHC.Tc.Types`, along with `TcM`. But `GHC.Tc.Types` is in the set of transitive dependencies of `GHC.Parser`, a set which we aim to minimise. Test case `CountParserDeps` checks for that. Having `DsM` in that set means the parser also depends on the innards of the pattern-match checker in `GHC.HsToCore.PmCheck.Types`, which is the reason we have that module in the first place. In the previous commit, we represented the `TyState` by an `InertSet`, but that pulls the constraint solver as well as 250 more modules into the set of dependencies, triggering failure of `CountParserDeps`. Clearly, we want to evolve the pattern-match checker (and the desugarer) without being concerned by this test, so this patch includes a small refactor that puts `DsM` into its own module. - - - - - fd5d622a by Sebastian Graf at 2020-09-12T21:27:40-04:00 Hackily decouple the parser from the desugarer In a hopefully temporary hack, I re-used the idea from !1957 of using a nullary type family to break the dependency from GHC.Driver.Hooks on the definition of DsM ("Abstract Data"). This in turn broke the last dependency from the parser to the desugarer. More details in `Note [The Decoupling Abstract Data Hack]`. In the future, we hope to undo this hack again in favour of breaking the dependency from the parser to DynFlags altogether. - - - - - 35a7b7ec by Adam Sandberg Eriksson at 2020-09-14T17:46:16-04:00 docs: -B rts option sounds the bell on every GC (#18351) - - - - - 5ae8212c by Wander Hillen at 2020-09-14T17:46:54-04:00 Populate gitlab cache after building - - - - - a5ffb39a by Wander Hillen at 2020-09-14T17:46:54-04:00 Move ahead cabal cache restoration to before use of cabal - - - - - e8b37c21 by Wander Hillen at 2020-09-14T17:46:54-04:00 Do the hadrian rebuild multicore - - - - - 07762eb5 by Wander Hillen at 2020-09-14T17:46:54-04:00 Also cache other hadrian builds - - - - - 8610bcbe by DenisFrezzato at 2020-09-15T15:19:08-04:00 Fix rtsopts documentation - - - - - c7182a5c by Simon Peyton Jones at 2020-09-15T15:19:44-04:00 Care with implicit-parameter superclasses Two bugs, #18627 and #18649, had the same cause: we were not account for the fact that a constaint tuple might hide an implicit parameter. The solution is not hard: look for implicit parameters in superclasses. See Note [Local implicit parameters] in GHC.Core.Predicate. Then we use this new function in two places * The "short-cut solver" in GHC.Tc.Solver.Interact.shortCutSolver which simply didn't handle implicit parameters properly at all. This fixes #18627 * The specialiser, which should not specialise on implicit parameters This fixes #18649 There are some lingering worries (see Note [Local implicit parameters]) but things are much better. - - - - - 0f3884b0 by Zubin Duggal at 2020-09-15T15:20:23-04:00 Export enrichHie from GHC.Iface.Ext.Ast This is useful for `ghcide` - - - - - b3143f5a by Sylvain Henry at 2020-09-15T15:21:06-04:00 Enhance metrics output - - - - - 4283feaa by Ryan Scott at 2020-09-15T15:21:43-04:00 Introduce and use DerivClauseTys (#18662) This switches `deriv_clause_tys` so that instead of using a list of `LHsSigType`s to represent the types in a `deriving` clause, it now uses a sum type. `DctSingle` represents a `deriving` clause with no enclosing parentheses, while `DctMulti` represents a clause with enclosing parentheses. This makes pretty-printing easier and avoids confusion between `HsParTy` and the enclosing parentheses in `deriving` clauses, which are different semantically. Fixes #18662. - - - - - 90229c4b by Ryan Scott at 2020-09-16T04:53:22-04:00 Include -f{write,validate}-ide-info in the User's Guide flag reference Previously, these were omitted from the flag reference due to a layout oversight in `docs/users_guide/flags.{rst,py}`. Fixes #18426. - - - - - ce42e187 by Ben Gamari at 2020-09-16T04:53:59-04:00 rts: Fix erroneous usage of vsnprintf As pointed out in #18685, this should be snprintf not vsnprintf. This appears to be due to a cut-and-paste error. Fixes #18658. - - - - - b695e7d7 by Sylvain Henry at 2020-09-16T04:54:38-04:00 Rename ghci flag into internal-interpreter "ghci" as a flag name was confusing because it really enables the internal-interpreter. Even the ghci library had a "ghci" flag... - - - - - 8af954d2 by Sylvain Henry at 2020-09-16T04:55:17-04:00 Make ghc-boot reexport modules from ghc-boot-th Packages don't have to import both ghc-boot and ghc-boot-th. It makes the dependency graph easier to understand and to refactor. - - - - - 6baa67f5 by Adam Sandberg Eriksson at 2020-09-16T07:45:47-04:00 docs: correct haddock reference [skip ci] - - - - - 7cf09ab0 by Simon Peyton Jones at 2020-09-17T01:27:25-04:00 Do absence analysis on stable unfoldings Ticket #18638 showed that Very Bad Things happen if we fail to do absence analysis on stable unfoldings. It's all described in Note [Absence analysis for stable unfoldings and RULES]. I'm a bit surprised this hasn't bitten us before. Fortunately the fix is pretty simple. - - - - - 76d3bcbc by Leif Metcalf at 2020-09-17T01:28:01-04:00 Replace deprecated git --recursive The --recursive flag of git-clone has been replaced by the --recurse-submodules flag since git 1.7.4, released in 2011. - - - - - da8f4ddd by Richard Eisenberg at 2020-09-17T01:28:38-04:00 Document IfaceTupleTy - - - - - 3c94c816 by HaskellMouse at 2020-09-17T08:49:51-04:00 Added explicit fixity to (~). Solves #18252 - - - - - b612e396 by Cary Robbins at 2020-09-17T08:50:30-04:00 Make the 'IsString (Const a b)' instance polykinded on 'b' - - - - - 8d0c26c4 by Ben Gamari at 2020-09-17T08:51:08-04:00 rts/win32: Fix missing #include's These slipped through CI. - - - - - 76009ec8 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump Win32 submodule to 2.9.0.0 Also bumps Cabal, directory - - - - - 147bb598 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump version to 9.0 Bumps haskeline and haddock submodules. (cherry picked from commit f218cfc92f7b1a1e01190851972bb9a0e0f3c682) - - - - - 5c7387f6 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Make Z-encoding comment into a note - - - - - c12b3041 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Cosmetic - - - - - 4f461e1a by Vladislav Zavialov at 2020-09-17T08:52:19-04:00 Parser.y: clarify treatment of @{-# UNPACK #-} Before this patch, we had this parser production: ftype : ... | ftype PREFIX_AT tyarg { ... } And 'tyarg' is defined as follows: tyarg : atype { ... } | unpackedness atype { ... } So one might get the (false) impression that that parser production is intended to parse things like: F @{-# UNPACK #-} X However, the lexer wouldn't produce PREFIX_AT followed by 'unpackedness', as the '@' operator followed by '{-' is not considered prefix. Thus there's no point using 'tyarg' after PREFIX_AT, and a simple 'atype' will suffice: ftype : ... | ftype PREFIX_AT atype { ... } This change has no user-facing consequences. It just makes the grammar a bit more clear. - - - - - 9dec8600 by Benjamin Maurer at 2020-09-17T08:52:56-04:00 Documented '-m' flags for machine specific instruction extensions. See #18641 'Documenting the Expected Undocumented Flags' - - - - - ca48076a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Introduce OutputableP Some types need a Platform value to be pretty-printed: CLabel, Cmm types, instructions, etc. Before this patch they had an Outputable instance and the Platform value was obtained via sdocWithDynFlags. It meant that the *renderer* of the SDoc was responsible of passing the appropriate Platform value (e.g. via the DynFlags given to showSDoc). It put the burden of passing the Platform value on the renderer while the generator of the SDoc knows the Platform it is generating the SDoc for and there is no point passing a different Platform at rendering time. With this patch, we introduce a new OutputableP class: class OutputableP a where pdoc :: Platform -> a -> SDoc With this class we still have some polymorphism as we have with `ppr` (i.e. we can use `pdoc` on a variety of types instead of having a dedicated `pprXXX` function for each XXX type). One step closer removing `sdocWithDynFlags` (#10143) and supporting several platforms (#14335). - - - - - e45c8544 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Generalize OutputableP Add a type parameter for the environment required by OutputableP. It avoids tying Platform with OutputableP. - - - - - 37aa224a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Add note about OutputableP - - - - - 7f2785f2 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Remove pprPrec from Outputable (unused) - - - - - b689f3db by Sylvain Henry at 2020-09-17T20:04:46-04:00 Bignum: add clamping naturalToWord (fix #18697) - - - - - 0799b3de by Ben Gamari at 2020-09-18T15:55:50-04:00 rts/nonmoving: Add missing STM write barrier When updating a TRec for a TVar already part of a transaction we previously neglected to add the old value to the update remembered set. I suspect this was the cause of #18587. - - - - - c4921349 by Ben Gamari at 2020-09-18T15:56:25-04:00 rts: Refactor foreign export tracking This avoids calling `libc` in the initializers which are responsible for registering foreign exports. We believe this should avoid the corruption observed in #18548. See Note [Tracking foreign exports] in rts/ForeignExports.c for an overview of the new scheme. - - - - - 40dc9106 by Ben Gamari at 2020-09-18T15:56:25-04:00 rts: Refactor unloading of foreign export StablePtrs Previously we would allocate a linked list cell for each foreign export. Now we can avoid this by taking advantage of the fact that they are already broken into groups. - - - - - 45fa8218 by Simon Jakobi at 2020-09-19T06:57:36-04:00 Deprecate Data.Semigroup.Option Libraries email: https://mail.haskell.org/pipermail/libraries/2018-April/028724.html GHC issue: https://gitlab.haskell.org/ghc/ghc/issues/15028 Corresponding PRs for deepseq: * https://github.com/haskell/deepseq/pull/55 * https://github.com/haskell/deepseq/pull/57 Bumps the deepseq submodule. - - - - - 2229d570 by Vladislav Zavialov at 2020-09-19T15:47:24-04:00 Require happy >=1.20 - - - - - a89c2fba by Ben Gamari at 2020-09-19T15:47:24-04:00 ci.sh: Enforce minimum happy/alex versions Also, always invoke cabal-install to ensure that happy/alex symlinks are up-to-date. - - - - - 2f7ef2fb by Ben Gamari at 2020-09-19T15:47:24-04:00 gitlab-ci: Ensure that cabal-install overwrites existing executables Previously cabal-install wouldn't overwrite toolchain executables if they already existed (as they likely would due to caching). - - - - - ac213d26 by Ryan Scott at 2020-09-19T15:48:01-04:00 Wire in constraint tuples This wires in the definitions of the constraint tuple classes. The key changes are in: * `GHC.Builtin.Types`, where the `mk_ctuple` function is used to define constraint tuple type constructors, data constructors, and superclass selector functions, and * `GHC.Builtin.Uniques`. In addition to wiring in the `Unique`s for constraint tuple type and data constructors, we now must wire in the superclass selector functions. Luckily, this proves to be not that challenging. See the newly added comments. Historical note: constraint tuples used to be wired-in until about five years ago, when commit 130e93aab220bdf14d08028771f83df210da340b turned them into known-key names. This was done as part of a larger refactor to reduce the number of special cases for constraint tuples, but the commit message notes that the main reason that constraint tuples were made known-key (as opposed to boxed/unboxed tuples, which are wired in) is because it was awkward to wire in the superclass selectors. This commit solves the problem of wiring in superclass selectors. Fixes #18635. ------------------------- Metric Decrease: T10421 T12150 T12227 T12234 T12425 T13056 T13253-spj T18282 T18304 T5321FD T5321Fun T5837 T9961 Metric Decrease (test_env='x86_64-linux-deb9-unreg-hadrian'): T12707 Metric Decrease (test_env='x86_64-darwin'): T4029 ------------------------- - - - - - e195dae6 by Wander Hillen at 2020-09-19T15:48:41-04:00 Export singleton function from Data.List Data.OldList exports a monomorphized singleton function but it is not re-exported by Data.List. Adding the export to Data.List causes a conflict with a 14-year old function of the same name and type by SPJ in GHC.Utils.Misc. We can't just remove this function because that leads to a problems when building GHC with a stage0 compiler that does not have singleton in Data.List yet. We also can't hide the function in GHC.Utils.Misc since it is not possible to hide a function from a module if the module does not export the function. To work around this, all places where the Utils.Misc singleton was used now use a qualified version like Utils.singleton and in GHC.Utils.Misc we are very specific about which version we export. - - - - - 9c1b8ad9 by Sylvain Henry at 2020-09-19T15:49:19-04:00 Bump Stack resolver - - - - - d05d13ce by John Ericson at 2020-09-19T15:49:57-04:00 Cinch -fno-warn-name-shadowing down to specific GHCi module - - - - - f1accd00 by Sylvain Henry at 2020-09-19T15:49:57-04:00 Add quick-validate Hadrian flavour (quick + -Werror) - - - - - 8f8d51f1 by Andreas Klebinger at 2020-09-19T15:50:33-04:00 Fix docs who misstated how the RTS treats size suffixes. They are parsed as multiples of 1024. Not 1000. The docs used to imply otherwise. See decodeSize in rts/RtsFlags.c for the logic for this. - - - - - 2ae0edbd by Andreas Klebinger at 2020-09-19T15:50:33-04:00 Fix a codeblock in ghci.rst - - - - - 4df3aa95 by Ben Gamari at 2020-09-19T15:51:07-04:00 users guide: Fix various documentation issues - - - - - 885ecd18 by Ben Gamari at 2020-09-19T15:51:07-04:00 hadrian: Fail on Sphinx syntax errors Specifically the "Inline literal start-string without end-string" warning, which typically means that the user neglected to separate an inline code block from suffix text with a backslash. - - - - - b26cd867 by David Feuer at 2020-09-19T15:51:44-04:00 Unpack the MVar in Compact The `MVar` lock in `Compact` was unnecessarily lazy, creating an extra indirection and wasting two words. Make it strict. - - - - - 760307cf by Artyom Kuznetsov at 2020-09-19T15:52:21-04:00 Remove GADT self-reference check (#11554, #12081, #12174, fixes #15942) Reverts 430f5c84dac1eab550110d543831a70516b5cac8 - - - - - 057db94c by Ben Gamari at 2020-09-19T15:52:56-04:00 rts: Drop field initializer on thread_basic_info_data_t This struct has a number of fields and we only care that the value is initialized with zeros. This eliminates the warnings noted in #17905. - - - - - 87e2e2b1 by Vladislav Zavialov at 2020-09-19T23:55:30+03:00 Resolve shift/reduce conflicts with %shift (#17232) - - - - - 66cba46e by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Unmark T12971 as broken on Windows It's unclear why, but this no longer seems to fail. Closes #17945. - - - - - 816811d4 by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Unmark T5975[ab] as broken on Windows Sadly it's unclear *why* they have suddenly started working. Closes #7305. - - - - - 43a43d39 by Ben Gamari at 2020-09-20T20:30:57-04:00 base/testsuite: Add missing LANGUAGE pragma in ThreadDelay001 Only affected the Windows codepath. - - - - - ced8f113 by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Update expected output for outofmem on Windows The error originates from osCommitMemory rather than getMBlocks. - - - - - ea08aead by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Mark some GHCi/Makefile tests as broken on Windows See #18718. - - - - - caf6a5a3 by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Fix WinIO error message normalization This wasn't being applied to stderr. - - - - - 93ab3e8d by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Mark tempfiles as broken on Win32 without WinIO The old POSIX emulation appears to ignore the user-requested prefix. - - - - - 9df77fed by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Mark TH_spliceE5_prof as broken on Windows Due to #18721. - - - - - 1a0f8243 by Ryan Scott at 2020-09-21T16:45:47-04:00 Remove unused ThBrackCtxt and ResSigCtxt Fixes #18715. - - - - - 2f222b12 by Ryan Scott at 2020-09-21T16:45:47-04:00 Disallow constraints in KindSigCtxt This patch cleans up how `GHC.Tc.Validity` classifies `UserTypeCtxt`s that can only refer to kind-level positions, which is important for rejecting certain classes of programs. In particular, this patch: * Introduces a new `TypeOrKindCtxt` data type and `typeOrKindCtxt :: UserTypeCtxt -> TypeOrKindCtxt` function, which determines whether a `UserTypeCtxt` can refer to type-level contexts, kind-level contexts, or both. * Defines the existing `allConstraintsAllowed` and `vdqAllowed` functions in terms of `typeOrKindCtxt`, which avoids code duplication and ensures that they stay in sync in the future. The net effect of this patch is that it fixes #18714, in which it was discovered that `allConstraintsAllowed` incorrectly returned `True` for `KindSigCtxt`. Because `typeOrKindCtxt` now correctly classifies `KindSigCtxt` as a kind-level context, this bug no longer occurs. - - - - - aaa51dcf by Ben Gamari at 2020-09-21T16:46:22-04:00 hadrian: Add extra-deps: happy-1.20 to stack.yaml GHC now requires happy-1.20, which isn't available in LTS-16.14. Fixes #18726. - - - - - 6de40f83 by Simon Peyton Jones at 2020-09-22T05:37:24-04:00 Better eta-expansion (again) and don't specilise DFuns This patch fixes #18223, which made GHC generate an exponential amount of code. There are three quite separate changes in here 1. Re-engineer eta-expansion (again). The eta-expander was generating lots of intermediate stuff, which could be optimised away, but which choked the simplifier meanwhile. Relatively easy to kill it off at source. See Note [The EtaInfo mechanism] in GHC.Core.Opt.Arity. The main new thing is the use of pushCoArg in getArg_maybe. 2. Stop Specialise specalising DFuns. This is the cause of a huge (and utterly unnecessary) blowup in program size in #18223. See Note [Do not specialise DFuns] in GHC.Core.Opt.Specialise. I also refactored the Specialise monad a bit... it was silly, because it passed on unchanging values as if they were mutable state. 3. Do an extra Simplifer run, after SpecConstra and before late-Specialise. I found (investigating perf/compiler/T16473) that failing to do this was crippling *both* SpecConstr *and* Specialise. See Note [Simplify after SpecConstr] in GHC.Core.Opt.Pipeline. This change does mean an extra run of the Simplifier, but only with -O2, and I think that's acceptable. T16473 allocates *three* times less with this change. (I changed it to check runtime rather than compile time.) Some smaller consequences * I moved pushCoercion, pushCoArg and friends from SimpleOpt to Arity, because it was needed by the new etaInfoApp. And pushCoValArg now returns a MCoercion rather than Coercion for the argument Coercion. * A minor, incidental improvement to Core pretty-printing This does fix #18223, (which was otherwise uncompilable. Hooray. But there is still a big intermediate because there are some very deeply nested types in that program. Modest reductions in compile-time allocation on a couple of benchmarks T12425 -2.0% T13253 -10.3% Metric increase with -O2, due to extra simplifier run T9233 +5.8% T12227 +1.8% T15630 +5.0% There is a spurious apparent increase on heap residency on T9630, on some architectures at least. I tried it with -G1 and the residency is essentially unchanged. Metric Increase T9233 T12227 T9630 Metric Decrease T12425 T13253 - - - - - 416bd50e by Simon Peyton Jones at 2020-09-22T05:37:59-04:00 Fix the occurrence analyser Ticket #18603 demonstrated that the occurrence analyser's handling of local RULES for imported Ids (which I now call IMP-RULES) was inadequate. It led the simplifier into an infnite loop by failing to label a binder as a loop breaker. The main change in this commit is to treat IMP-RULES in a simple and uniform way: as extra rules for the local binder. See Note [IMP-RULES: local rules for imported functions] This led to quite a bit of refactoring. The result is still tricky, but it's much better than before, and better documented I think. Oh, and it fixes the bug. - - - - - 6fe8a0c7 by Sebastian Graf at 2020-09-22T05:38:35-04:00 PmCheck - Comments only: Replace /~ by ≁ - - - - - e9501547 by Sebastian Graf at 2020-09-22T05:38:35-04:00 PmCheck: Rewrite inhabitation test We used to produce inhabitants of a pattern-match refinement type Nabla in the checker in at least two different and mostly redundant ways: 1. There was `provideEvidence` (now called `generateInhabitingPatterns`) which is used by `GHC.HsToCore.PmCheck` to produce non-exhaustive patterns, which produces inhabitants of a Nabla as a sub-refinement type where all match variables are instantiated. 2. There also was `ensure{,All}Inhabited` (now called `inhabitationTest`) which worked slightly different, but was whenever new type constraints or negative term constraints were added. See below why `provideEvidence` and `ensureAllInhabited` can't be the same function, the main reason being performance. 3. And last but not least there was the `nonVoid` test, which tested that a given type was inhabited. We did use this for strict fields and -XEmptyCase in the past. The overlap of (3) with (2) was always a major pet peeve of mine. The latter was quite efficient and proven to work for recursive data types, etc, but could not handle negative constraints well (e.g. we often want to know if a *refined* type is empty, such as `{ x:[a] | x /= [] }`). Lower Your Guards suggested that we could get by with just one, by replacing both functions with `inhabitationTest` in this patch. That was only possible by implementing the structure of φ constraints as in the paper, namely the semantics of φ constructor constraints. This has a number of benefits: a. Proper handling of unlifted types and strict fields, fixing #18249, without any code duplication between `GHC.HsToCore.PmCheck.Oracle.instCon` (was `mkOneConFull`) and `GHC.HsToCore.PmCheck.checkGrd`. b. `instCon` can perform the `nonVoid` test (3) simply by emitting unliftedness constraints for strict fields. c. `nonVoid` (3) is thus simply expressed by a call to `inhabitationTest`. d. Similarly, `ensureAllInhabited` (2), which we called after adding type info, now can similarly be expressed as the fuel-based `inhabitationTest`. See the new `Note [Why inhabitationTest doesn't call generateInhabitingPatterns]` why we still have tests (1) and (2). Fixes #18249 and brings nice metric decreases for `T17836` (-76%) and `T17836b` (-46%), as well as `T18478` (-8%) at the cost of a few very minor regressions (< +2%), potentially due to the fact that `generateInhabitingPatterns` does more work to suggest the minimal COMPLETE set. Metric Decrease: T17836 T17836b - - - - - 086ef018 by Hécate at 2020-09-23T06:52:08-04:00 Remove the list of loaded modules from the ghci prompt - - - - - d7385f70 by Ben Gamari at 2020-09-23T06:52:44-04:00 Bump submodules * Bump bytestring to 0.10.12.0 * Bump Cabal to 3.4.0.0-rc3 * Bump Win32 to 2.10.0.0 - - - - - 667d6355 by Sylvain Henry at 2020-09-23T20:43:48-04:00 Refactor CLabel pretty-printing * Don't depend on the selected backend to know if we print Asm or C labels: we already have PprStyle to determine this. Moreover even when a native backend is used (NCG, LLVM) we may want to C headers containing pretty-printed labels, so it wasn't a good predicate anyway. * Make pretty-printing code clearer and avoid partiality - - - - - a584366b by Sylvain Henry at 2020-09-23T20:43:48-04:00 Remove sdocWithDynFlags (fix #10143) - - - - - a997fa01 by Sylvain Henry at 2020-09-23T20:43:48-04:00 Preliminary work towards removing DynFlags -> Driver.Ppr dependency - - - - - 31fea307 by Hécate at 2020-09-23T20:44:24-04:00 Remove redundant "do", "return" and language extensions from base - - - - - 04d64331 by syd at cs-syd.eu at 2020-09-24T13:15:54-04:00 Update Lock.hs with more documentation to make sure that the Boolean return value is clear. [skip ci] - - - - - 97cff919 by Simon Peyton Jones at 2020-09-24T13:16:32-04:00 Implement Quick Look impredicativity This patch implements Quick Look impredicativity (#18126), sticking very closely to the design in A quick look at impredicativity, Serrano et al, ICFP 2020 The main change is that a big chunk of GHC.Tc.Gen.Expr has been extracted to two new modules GHC.Tc.Gen.App GHC.Tc.Gen.Head which deal with typechecking n-ary applications, and the head of such applications, respectively. Both contain a good deal of documentation. Three other loosely-related changes are in this patch: * I implemented (partly by accident) points (2,3)) of the accepted GHC proposal "Clean up printing of foralls", namely https://github.com/ghc-proposals/ghc-proposals/blob/ master/proposals/0179-printing-foralls.rst (see #16320). In particular, see Note [TcRnExprMode] in GHC.Tc.Module - :type instantiates /inferred/, but not /specified/, quantifiers - :type +d instantiates /all/ quantifiers - :type +v is killed off That completes the implementation of the proposal, since point (1) was done in commit df08468113ab46832b7ac0a7311b608d1b418c4d Author: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> Date: Mon Feb 3 21:17:11 2020 +0100 Always display inferred variables using braces * HsRecFld (which the renamer introduces for record field selectors), is now preserved by the typechecker, rather than being rewritten back to HsVar. This is more uniform, and turned out to be more convenient in the new scheme of things. * The GHCi debugger uses a non-standard unification that allows the unification variables to unify with polytypes. We used to hack this by using ImpredicativeTypes, but that doesn't work anymore so I introduces RuntimeUnkTv. See Note [RuntimeUnkTv] in GHC.Runtime.Heap.Inspect Updates haddock submodule. WARNING: this patch won't validate on its own. It was too hard to fully disentangle it from the following patch, on type errors and kind generalisation. Changes to tests * Fixes #9730 (test added) * Fixes #7026 (test added) * Fixes most of #8808, except function `g2'` which uses a section (which doesn't play with QL yet -- see #18126) Test added * Fixes #1330. NB Church1.hs subsumes Church2.hs, which is now deleted * Fixes #17332 (test added) * Fixes #4295 * This patch makes typecheck/should_run/T7861 fail. But that turns out to be a pre-existing bug: #18467. So I have just made T7861 into expect_broken(18467) - - - - - 9fa26aa1 by Simon Peyton Jones at 2020-09-24T13:16:32-04:00 Improve kind generalisation, error messages This patch does two things: * It refactors GHC.Tc.Errors a bit. In debugging Quick Look I was forced to look in detail at error messages, and ended up doing a bit of refactoring, esp in mkTyVarEqErr'. It's still quite a mess, but a bit better, I think. * It makes a significant improvement to the kind checking of type and class declarations. Specifically, we now ensure that if kind checking fails with an unsolved constraint, all the skolems are in scope. That wasn't the case before, which led to some obscure error messages; and occasional failures with "no skolem info" (eg #16245). Both of these, and the main Quick Look patch itself, affect a /lot/ of error messages, as you can see from the number of files changed. I've checked them all; I think they are as good or better than before. Smaller things * I documented the various instances of VarBndr better. See Note [The VarBndr tyep and its uses] in GHC.Types.Var * Renamed GHC.Tc.Solver.simpl_top to simplifyTopWanteds * A bit of refactoring in bindExplicitTKTele, to avoid the footwork with Either. Simpler now. * Move promoteTyVar from GHC.Tc.Solver to GHC.Tc.Utils.TcMType Fixes #16245 (comment 211369), memorialised as typecheck/polykinds/T16245a Also fixes the three bugs in #18640 - - - - - 6d0ce0eb by Sebastian Graf at 2020-09-24T13:17:07-04:00 PmCheck: Desugar string literal patterns with -XRebindableSyntax correctly (#18708) Fixes #18708. - - - - - 007940d2 by Hécate at 2020-09-24T13:17:44-04:00 Namespace the Hadrian linting rule for base - - - - - 5b727189 by Andreas Klebinger at 2020-09-25T21:10:20-04:00 Make sizeExpr strict in the size threshold to facilitate WW. - - - - - dd664031 by Ben Gamari at 2020-09-25T21:10:56-04:00 ci.sh: Factor out common utilities - - - - - 5b78e865 by Ben Gamari at 2020-09-25T21:10:56-04:00 ci: Add ad-hoc performance testing rule - - - - - 29885f07 by Zubin Duggal at 2020-09-25T21:11:32-04:00 Stop removing definitions of record fields in GHC.Iface.Ext.Ast - - - - - 0d6519d9 by Ben Gamari at 2020-09-25T21:12:08-04:00 gitlab-ci: Drop Darwin cleanup job We now have a proper periodic clean-up script installed on the runners. - - - - - 277d20af by Sebastian Graf at 2020-09-25T21:12:44-04:00 Add regression tests for #18371 They have been fixed by !3959, I believe. Fixes #18371. - - - - - 8edf6056 by Sebastian Graf at 2020-09-25T21:12:44-04:00 Add a regression test for #18609 The egregious performance hits are gone since !4050. So we fix #18609. - - - - - 4a1b89a4 by Sebastian Graf at 2020-09-25T21:12:44-04:00 Accept new test output for #17218 The expected test output was plain wrong. It has been fixed for a long time. Thus we can close #17218. - - - - - 51606236 by Sven Tennie at 2020-09-25T21:13:19-04:00 Print RET_BIG stack closures A RET_BIG closure has a large bitmap that describes it's payload and can be printed with printLargeBitmap(). Additionally, the output for payload closures of small and big bitmaps is changed: printObj() is used to print a bit more information about what's on the stack. - - - - - 2707c4ea by Arnaud Spiwack at 2020-09-25T21:13:58-04:00 Pattern guards BindStmt always use multiplicity Many Fixes #18439 . The rhs of the pattern guard was consumed with multiplicity one, while the pattern assumed it was Many. We use Many everywhere instead. This is behaviour consistent with that of `case` expression. See #18738. - - - - - 92daad24 by Sylvain Henry at 2020-09-25T21:14:36-04:00 Bignum: refactor backend modules * move backends into GHC.Num.Backend.* * split backend selection into GHC.Num.Backend and GHC.Num.Backend.Selected to avoid duplication with the Check backend - - - - - 04bc50b3 by Sylvain Henry at 2020-09-25T21:14:36-04:00 Bignum: implement extended GCD (#18427) - - - - - 6a7dae4b by Krzysztof Gogolewski at 2020-09-25T21:15:14-04:00 Fix typed holes causing linearity errors (#18491) - - - - - 83407ffc by Krzysztof Gogolewski at 2020-09-25T21:15:53-04:00 Various documentation fixes * Remove UnliftedFFITypes from conf. Some time ago, this extension was undocumented and we had to silence a warning. This is no longer needed. * Use r'' in conf.py. This fixes a Sphinx warning: WARNING: Support for evaluating Python 2 syntax is deprecated and will be removed in Sphinx 4.0. Convert docs/users_guide/conf.py to Python 3 syntax. * Mark GHCForeignImportPrim as documented * Fix formatting in template_haskell.rst * Remove 'recursive do' from the list of unsupported items in TH - - - - - af1e84e7 by Sebastian Graf at 2020-09-26T05:36:46-04:00 PmCheck: Big refactor of module structure * Move everything from `GHC.HsToCore.PmCheck.*` to `GHC.HsToCore.Pmc.*` in analogy to `GHC.Tc`, rename exported `covCheck*` functions to `pmc*` * Rename `Pmc.Oracle` to `Pmc.Solver` * Split off the LYG desugaring and checking steps into their own modules (`Pmc.Desugar` and `Pmc.Check` respectively) * Split off a `Pmc.Utils` module with stuff shared by `Pmc.{,Desugar,Check,Solver}` * Move `Pmc.Types` to `Pmc.Solver.Types`, add a new `Pmc.Types` module with all the LYG types, which form the interfaces between `Pmc.{Desugar,Check,Solver,}`. - - - - - f08f98e8 by Sebastian Graf at 2020-09-26T05:36:46-04:00 Extract SharedIdEnv into its own module It's now named `GHC.Types.Unique.SDFM.UniqSDFM`. The implementation is more clear about its stated goals and supported operations. - - - - - 1cde295c by Sylvain Henry at 2020-09-26T05:37:23-04:00 Bignum: add bigNatFromWordArray Reimplementation of integer-gmp's byteArrayToBigNat# - - - - - bda55fa0 by Krzysztof Gogolewski at 2020-09-26T13:18:22-04:00 Make 'undefined x' linear in 'x' (#18731) - - - - - 160fba4a by Krzysztof Gogolewski at 2020-09-26T13:19:00-04:00 Disallow linear types in FFI (#18472) - - - - - e124f2a7 by Krzysztof Gogolewski at 2020-09-26T13:19:36-04:00 Fix handling of function coercions (#18747) This was broken when we added multiplicity to the function type. - - - - - 7ff43382 by Vladislav Zavialov at 2020-09-27T03:01:31+03:00 Comments: change outdated reference to mergeOps As of 686e06c59c3aa6b66895e8a501c7afb019b09e36, GHC.Parser.PostProcess.mergeOps no longer exists. [ci skip] - - - - - 4edf5527 by Vladislav Zavialov at 2020-09-27T10:04:12-04:00 Don't rearrange (->) in the renamer The parser produces an AST where the (->) is already associated correctly: 1. (->) has the least possible precedence 2. (->) is right-associative Thus we don't need to handle it in mkHsOpTyRn. - - - - - a9ce159b by Vladislav Zavialov at 2020-09-27T10:04:12-04:00 Remove outdated comment in rnHsTyKi This comment dates back to 3df40b7b78044206bbcffe3e2c0a57d901baf5e8 and does not seem relevant anymore. - - - - - 583a2070 by Richard Eisenberg at 2020-09-29T00:31:27-04:00 Optimize NthCo (FunCo ...) in coercion opt We were missing this case previously. Close #18528. Metric Decrease: T18223 T5321Fun - - - - - b31a3360 by Krzysztof Gogolewski at 2020-09-29T00:32:05-04:00 Linear types: fix kind inference when checking datacons - - - - - 5830a12c by Vladislav Zavialov at 2020-09-29T00:32:05-04:00 New linear types syntax: a %p -> b (#18459) Implements GHC Proposal #356 Updates the haddock submodule. - - - - - bca4d36d by Vladislav Zavialov at 2020-09-29T00:32:05-04:00 Improve error messages for (a %m) without LinearTypes Detect when the user forgets to enable the LinearTypes extension and produce a better error message. Steals the (a %m) syntax from TypeOperators, the workaround is to write (a % m) instead. - - - - - b9635d0a by Benjamin Maurer at 2020-09-29T00:32:43-04:00 Description of flag `-H` was in 'verbosity options', moved to 'misc'. Fixes #18699 - - - - - 74c797f6 by Benjamin Maurer at 2020-09-29T00:33:20-04:00 Workaround for #18623: GHC crashes bc. under rlimit for vmem it will reserve _all_ of it, leaving nothing for, e.g., thread stacks. Fix will only allocate 2/3rds and check whether remainder is at least large enough for minimum amount of thread stacks. - - - - - 4365d77a by Ryan Scott at 2020-09-29T00:33:57-04:00 Add regression test #18501 ghc/ghc!3220 ended up fixing #18501. This patch adds a regression test for #18501 to ensure that it stays fixed. - - - - - 8e3f00dd by Sylvain Henry at 2020-09-29T17:24:03+02:00 Make the parser module less dependent on DynFlags Bump haddock submodule - - - - - 3ab0d8f7 by Sebastian Graf at 2020-09-30T02:48:27-04:00 PmCheck: Long-distance information for LocalBinds (#18626) Now `desugarLocalBind` (formerly `desugarLet`) reasons about * `FunBind`s that * Have no pattern matches (so which aren't functions) * Have a singleton match group with a single GRHS * (which may have guards) * and looks through trivial post-typechecking `AbsBinds` in doing so to pick up the introduced renamings. And desugars to `PmLet` LYG-style guards. Since GRHSs are no longer denoted simply by `NonEmpty PmGRHS`, but also need to carry a `[PmGrd]` for the `PmLet`s from `LocalBind`s, I added `PmGRHSs` to capture that. Since we call out to the desugarer more often, I found that there were superfluous warnings emitted when desugaring e.g. case expressions. Thus, I made sure that we deactivate any warnings in the LYG desugaring steps by the new wrapper function `noCheckDs`. There's a regression test in `T18626`. Fixes #18626. - - - - - f8f60efc by Ben Gamari at 2020-09-30T02:49:03-04:00 testsuite: Mark T12971 as broken on Windows Due to #17945. - - - - - 6527fc57 by Ben Gamari at 2020-09-30T02:49:03-04:00 Bump Cabal, hsc2hs, directory, process submodules Necessary for recent Win32 bump. - - - - - df3f5880 by Sylvain Henry at 2020-09-30T02:49:41-04:00 Remove unsafeGlobalDynFlags (#17957, #14597) There are still global variables but only 3 booleans instead of a single DynFlags. - - - - - 9befd94d by Sylvain Henry at 2020-09-30T02:49:41-04:00 Remove unused global variables Some removed globals variables were still declared in the RTS. They were removed in the following commits: * 4fc6524a2a4a0003495a96c8b84783286f65c198 * 0dc7985663efa1739aafb480759e2e2e7fca2a36 * bbd3c399939311ec3e308721ab87ca6b9443f358 - - - - - 7c98699f by Richard Eisenberg at 2020-09-30T02:50:17-04:00 Omit redundant kind equality check in solver See updated Note [Use loose types in inert set] in GHC.Tc.Solver.Monad. Close #18753. - - - - - 39549826 by Sebastian Graf at 2020-09-30T02:50:54-04:00 Pmc: Don't call exprType on type arguments (#18767) Fixes #18767. - - - - - 235e410f by Richard Eisenberg at 2020-09-30T02:51:29-04:00 Regression test for #10709. Close #10709 - - - - - 5c32655f by Ben Gamari at 2020-09-30T22:31:55-04:00 hadrian/doc: Clarify documentation of key-value configuration - - - - - 0bb02873 by Sylvain Henry at 2020-10-01T18:34:53-04:00 Add test for T18574 - - - - - e393f213 by Sylvain Henry at 2020-10-01T18:34:53-04:00 Allow fusion with catMaybes (#18574) Metric Decrease: T18574 - - - - - d2cfad96 by Fendor at 2020-10-01T18:35:33-04:00 Add mainModuleNameIs and demote mainModIs Add `mainModuleNameIs` to DynFlags and demote `mainModIs` to function which uses the homeUnit from DynFlags it is created from. - - - - - fc351ab8 by Fendor at 2020-10-01T18:35:33-04:00 Use HomeUnit for main module without module declaration - - - - - dca1cb22 by Fendor at 2020-10-01T18:35:33-04:00 Remove mAIN completely - - - - - a5aaceec by Sylvain Henry at 2020-10-01T18:36:11-04:00 Use ADTs for parser errors/warnings Haskell and Cmm parsers/lexers now report errors and warnings using ADTs defined in GHC.Parser.Errors. They can be printed using functions in GHC.Parser.Errors.Ppr. Some of the errors provide hints with a separate ADT (e.g. to suggest to turn on some extension). For now, however, hints are not consistent across all messages. For example some errors contain the hints in the main message. I didn't want to change any message with this patch. I expect these changes to be discussed and implemented later. Surprisingly, this patch enhances performance. On CI (x86_64/deb9/hadrian, ghc/alloc): parsing001 -11.5% T13719 -2.7% MultiLayerModules -3.5% Naperian -3.1% Bump haddock submodule Metric Decrease: MultiLayerModules Naperian T13719 parsing001 - - - - - a946c7ef by Sylvain Henry at 2020-10-01T18:36:11-04:00 Less DynFlags in Header parsing - - - - - dafe7943 by Sylvain Henry at 2020-10-01T18:36:11-04:00 Parser: remove some unused imports These are not reported by GHC because Happy adds {-# OPTIONS_GHC -w #-} - - - - - 93d5de16 by Sylvain Henry at 2020-10-01T18:36:11-04:00 Don't import GHC.Unit to reduce the number of dependencies - - - - - e3655f81 by Sebastian Graf at 2020-10-01T18:36:47-04:00 Don't attach CPR signatures to NOINLINE data structures (#18154) Because the generated `KindRep`s don't have an unfolding, !3230 did not actually stop to compute, attach and serialise unnecessary CPR signatures for them. As already said in `Note [CPR for data structures]`, that leads to bloated interface files which is ultimately quadratic for Nested CPR. So we don't attach any CPR signature to bindings that * Are not thunks (because thunks are not in WHNF) * Have arity 0 (which means the top-level constructor is not a lambda) If the data structure has an unfolding, we continue to look through it. If not (as is the case for `KindRep`s), we look at the unchanged CPR signature and see `topCprType`, as expected. - - - - - ba5965eb by Richard Eisenberg at 2020-10-01T18:37:23-04:00 Add regression test for #18755. Close #18755 - - - - - a8018c17 by Vladislav Zavialov at 2020-10-01T18:37:58-04:00 Fix pretty-printing of the mult-polymorphic arrow A follow-up to !4020 (5830a12c46e7227c276a8a71213057595ee4fc04) - - - - - e5523324 by Sylvain Henry at 2020-10-01T18:38:35-04:00 Bignum: add integerNegate RULE - - - - - 1edd6d21 by Vladislav Zavialov at 2020-10-01T18:39:10-04:00 Refactor: remove rnHsDoc It did not do any useful work. - - - - - a9ae83af by Krzysztof Gogolewski at 2020-10-02T08:00:25-04:00 Fix typos in comments [skip ci] - - - - - b81350bb by Icelandjack at 2020-10-02T08:01:01-04:00 Replaced MkT1 with T1 in type signatures. - - - - - 3c9beab7 by Vladislav Zavialov at 2020-10-02T13:51:58-04:00 Minor TTG clean-up: comments, unused families, bottom 1. Fix and update section headers in GHC/Hs/Extension.hs 2. Delete the unused 'XCoreAnn' and 'XTickPragma' families 3. Avoid calls to 'panic' in 'pprStmt' - - - - - 12c06927 by Sylvain Henry at 2020-10-02T13:52:38-04:00 Bignum: implement integerRecipMod (#18427) - - - - - 8dd4f405 by Sylvain Henry at 2020-10-02T13:52:38-04:00 Bignum: implement integerPowMod (#18427) Incidentally fix powModInteger which was crashing in integer-gmp for negative exponents when the modular multiplicative inverse for the base didn't exist. Now we compute it explicitly with integerRecipMod so that every backend returns the same result without crashing. - - - - - 1033a720 by Krzysztof Gogolewski at 2020-10-02T13:53:23-04:00 Reject linearity in kinds in checkValidType (#18780) Patch taken from https://gitlab.haskell.org/ghc/ghc/-/issues/18624#note_300673 - - - - - b0ccba66 by Krzysztof Gogolewski at 2020-10-03T19:33:02-04:00 Small documentation fixes - Fix formatting of code blocks and a few sphinx warnings - Move the Void# change to 9.2, it was done right after the branch was cut - Fix typo in linear types documentation - Note that -Wincomplete-uni-patterns affects lazy patterns [skip ci] - - - - - 70dc2f09 by Karel Gardas at 2020-10-03T19:33:06-04:00 fix rts.cabal to use real arch names and not aliasses (fixes #18654) - - - - - bc5de347 by Sebastian Graf at 2020-10-05T13:59:24-04:00 Inline `integerDecodeDouble#` and constant-fold `decodeDouble_Int64#` instead Currently, `integerDecodeDouble#` is known-key so that it can be recognised in constant folding. But that is very brittle and doesn't survive worker/wrapper, which we even do for `NOINLINE` things since #13143. Also it is a trade-off: The implementation of `integerDecodeDouble#` allocates an `Integer` box that never cancels aways if we don't inline it. Hence we recognise the `decodeDouble_Int64#` primop instead in constant folding, so that we can inline `integerDecodeDouble#`. As a result, `integerDecodeDouble#` no longer needs to be known-key. While doing so, I realised that we don't constant-fold `decodeFloat_Int#` either, so I also added a RULE for it. `integerDecodeDouble` is dead, so I deleted it. Part of #18092. This improves the 32-bit `realToFrac`/`toRational`: Metric Decrease: T10359 - - - - - 802b5e6f by Krzysztof Gogolewski at 2020-10-05T13:59:33-04:00 Fix linear types in TH splices (#18465) - - - - - 18a3ddf7 by Ben Gamari at 2020-10-05T13:59:33-04:00 rts: Fix integer width in TICK_BUMP_BY Previously `TICK_BUMP_BY` was defined as ```c #define TICK_BUMP_BY(ctr,n) CLong[ctr] = CLong[ctr] + n ``` Yet the tickers themselves were defined as `StgInt`s. This happened to work out correctly on Linux, where `CLong` is 64-bits. However, it failed on Windows, where `CLong` is 32-bits, resulting in #18782. Fixes #18783. - - - - - 5fc4243b by Rachel at 2020-10-07T14:59:45-04:00 Document profiling flags, warning flags, and no-pie - - - - - b41f7c38 by Andreas Klebinger at 2020-10-07T15:00:20-04:00 WinIO: Small changes related to atomic request swaps. Move the atomix exchange over the Ptr type to an internal module. Fix a bug caused by us passing ptr-to-ptr instead of ptr to atomic exchange. Renamed interlockedExchange to exchangePtr. I've also added an cas primitive. It turned out we don't need it for WinIO but I'm leaving it in as it's useful for other things. - - - - - 948a14e1 by Ben Gamari at 2020-10-07T15:00:55-04:00 gitlab-ci: Fix name of Ubuntu 20.04 image - - - - - 74d4017b by Sylvain Henry at 2020-10-07T15:01:35-04:00 Fix -flink-rts (#18651) Before this patch -flink-rts could link with GHC's rts instead of the selected one. - - - - - 0e8b923d by Sylvain Henry at 2020-10-07T15:01:35-04:00 Apply suggestion to compiler/GHC/SysTools.hs - - - - - d6dff830 by Alan Zimmerman at 2020-10-07T15:02:10-04:00 Preserve as-parsed arrow type for HsUnrestrictedArrow When linear types are disabled, HsUnrestrictedArrow is treated as HslinearArrow. Move this adjustment into the type checking phase, so that the parsed source accurately represents the source as parsed. Closes #18791 - - - - - 030c5ce0 by Karel Gardas at 2020-10-07T15:02:48-04:00 hadrian: use stage0 linker to merge objects when done during the stage0 Fixes #18800. - - - - - a94db588 by Ben Gamari at 2020-10-07T15:03:23-04:00 testsuite: Allow whitespace before "Metric (in|de)crease" Several people have struggled with metric change annotations in their commit messages not being recognized due to the fact that GitLab's job log inserts a space at the beginning of each line. Teach the regular expression to accept this whitespace. - - - - - e91ddddd by Krzysztof Gogolewski at 2020-10-07T15:04:07-04:00 Misc cleanup * Include funTyCon in exposedPrimTyCons. Every single place using exposedPrimTyCons was adding funTyCon manually. * Remove unused synTyConResKind and ieLWrappedName * Add recordSelectorTyCon_maybe * In exprType, panic instead of giving a trace message and dummy output. This prevents #18767 reoccurring. * Fix compilation error in fragile concprog001 test (part of #18732) - - - - - 386c2d7f by Sylvain Henry at 2020-10-09T08:40:33-04:00 Use UnitId in the backend instead of Unit In Cmm we can only have real units identified with an UnitId. Other units (on-the-fly instantiated units and holes) are only used in type-checking backpack sessions that don't produce Cmm. - - - - - a566c83d by Simon Jakobi at 2020-10-09T08:41:09-04:00 Update containers to v0.6.4.1 Updates containers submodule. - - - - - fd984d68 by Tamar Christina at 2020-10-09T08:41:50-04:00 rts: fix race condition in StgCRun On windows the stack has to be allocated 4k at a time, otherwise we get a segfault. This is done by using a helper ___chkstk_ms that is provided by libgcc. The Haskell side already knows how to handle this but we need to do the same from STG. Previously we would drop the stack in StgRun but would only make it valid whenever the scheduler loop ran. This approach was fundamentally broken in that it falls apart when you take a signal from the OS. We see it less often because you initially get allocated a 1MB stack block which you have to blow past first. Concretely this means we must always keep the stack valid. Fixes #18601. - - - - - accdb24a by Sylvain Henry at 2020-10-09T08:42:31-04:00 Expose RTS-only ways (#18651) Some RTS ways are exposed via settings (ghcThreaded, ghcDebugged) but not all. It's simpler if the RTS exposes them all itself. - - - - - d360f343 by MaxGabriel at 2020-10-09T08:43:11-04:00 Document -Wderiving-typeable Tracking: #18641 - - - - - e48cab2a by Krzysztof Gogolewski at 2020-10-09T08:43:49-04:00 Add a flag to indicate that gcc supports -no-pie Fixes #17919. - - - - - f7e2fff9 by Hécate at 2020-10-09T08:44:26-04:00 Add linting of `base` to the CI - - - - - 45a1d493 by Andreas Klebinger at 2020-10-09T08:45:05-04:00 Use proper RTS flags when collecting residency in perf tests. Replace options like collect_stats(['peak_megabytes_allocated'],4) with collect_runtime_residency(4) and so forth. Reason being that the later also supplies some default RTS arguments which make sure residency does not fluctuate too much. The new flags mean we get new (hopefully more accurate) baselines so accept the stat changes. ------------------------- Metric Decrease: T4029 T4334 T7850 Metric Increase: T13218 T7436 ------------------------- - - - - - ef65b154 by Andreas Klebinger at 2020-10-09T08:45:42-04:00 testsuite/timeout: Fix windows specific errors. We now seem to use -Werror there. Which caused some long standing warnings to become errors. I applied changes to remove the warnings allowing the testsuite to run on windows as well. - - - - - e691a5a0 by Sylvain Henry at 2020-10-09T08:46:22-04:00 Hadrian: add quick-debug flavour - - - - - 12191a99 by Sylvain Henry at 2020-10-09T08:47:00-04:00 Bignum: match on small Integer/Natural Previously we only matched on *variables* whose unfoldings were a ConApp of the form `IS lit#` or `NS lit##`. But we forgot to match on the ConApp directly... As a consequence, constant folding only worked after the FloatOut pass which creates bindings for most sub-expressions. With this patch, matching on bignums works even with -O0 (see bignumMatch test). - - - - - 36787bba by Alan Zimmerman at 2020-10-09T08:47:36-04:00 ApiAnnotations : preserve parens in GADTs A cleanup in 7f418acf61e accidentally discarded some parens in ConDeclGADT. Make sure these stay in the AST in a usable format. Also ensure the AnnLolly does not get lost in a GADT. - - - - - 32dc7698 by Krzysztof Gogolewski at 2020-10-09T08:48:15-04:00 Linear types: fix roles in GADTs (#18799) - - - - - 9657f6f3 by Ben Gamari at 2020-10-09T08:48:52-04:00 sdist: Include hadrian sources in source distribution Previously the make build system's source distribution rules neglected to include Hadrian's sources. Fixes #18794. - - - - - c832f7e2 by Tamar Christina at 2020-10-09T08:49:33-04:00 winio: fixed timeouts non-threaded. - - - - - 6f0243ae by Tamar Christina at 2020-10-09T08:50:13-04:00 winio: fix array splat - - - - - 0fd3d360 by Tamar Christina at 2020-10-09T08:50:51-04:00 winio: fixed bytestring reading interface. - - - - - dfaef1ca by Tamar Christina at 2020-10-09T08:51:30-04:00 winio: fixed more data error. - - - - - bfdccac6 by Simon Peyton Jones at 2020-10-09T08:52:07-04:00 Fix desugaring of record updates on data families This fixes a long-standing bug in the desugaring of record updates for data families, when the latter involves a GADT. It's all explained in Note [Update for GADTs] in GHC.HsToCore.Expr. Building the correct cast is surprisingly tricky, as that Note explains. Fixes #18809. The test case (in indexed-types/should_compile/T18809) contains several examples that exercise the dark corners. - - - - - e5c7c9c8 by Ben Gamari at 2020-10-09T08:52:43-04:00 Bump win32-tarballs version to 0.3 This should fix #18774. - - - - - ef950b19 by Andreas Klebinger at 2020-10-09T08:53:21-04:00 Add TyCon Set/Env and use them in a few places. Firstly this improves code clarity. But it also has performance benefits as we no longer go through the name of the TyCon to get at it's unique. In order to make this work the recursion check for TyCon has been moved into it's own module in order to avoid import cycles. - - - - - fd302e93 by Krzysztof Gogolewski at 2020-10-09T08:54:02-04:00 Add -pgmlm and -optlm flags !3798 added documentation and semantics for the flags, but not parsing. - - - - - db236ffc by Sylvain Henry at 2020-10-09T08:54:41-04:00 Testsuite: increase timeout for T18223 (#18795) - - - - - 6a243e9d by Sylvain Henry at 2020-10-09T08:55:21-04:00 Cache HomeUnit in HscEnv (#17957) Instead of recreating the HomeUnit from the DynFlags every time we need it, we store it in the HscEnv. - - - - - 5884fd32 by Fendor at 2020-10-09T19:46:28+02:00 Move File Target parser to library #18596 - - - - - ea59fd4d by Hécate at 2020-10-10T14:49:59-04:00 Lint the compiler for extraneous LANGUAGE pragmas - - - - - 22f218b7 by Krzysztof Gogolewski at 2020-10-10T14:50:42-04:00 Linear types: fix quantification in GADTs (#18790) - - - - - 74ee1237 by Sylvain Henry at 2020-10-10T14:51:20-04:00 Bignum: fix bigNatCompareWord# bug (#18813) - - - - - 274e21f0 by Hécate at 2020-10-11T10:55:56+02:00 Remove the dependency on the ghc-linters stage - - - - - 990ea991 by Daniel Rogozin at 2020-10-11T22:20:04+03:00 Fall back to types when looking up data constructors (#18740) Before this patch, referring to a data constructor in a term-level context led to a scoping error: ghci> id Int <interactive>:1:4: error: Data constructor not in scope: Int After this patch, the renamer falls back to the type namespace and successfully finds the Int. It is then rejected in the type checker with a more useful error message: <interactive>:1:4: error: • Illegal term-level use of the type constructor ‘Int’ imported from ‘Prelude’ (and originally defined in ‘GHC.Types’) • In the first argument of ‘id’, namely ‘Int’ In the expression: id Int We also do this for type variables. - - - - - 9bbc84d2 by Sylvain Henry at 2020-10-12T18:21:51-04:00 DynFlags: refactor DmdAnal Make demand analysis usable without having to provide DynFlags. - - - - - 7fdcce6d by Wander Hillen at 2020-10-13T00:12:47-04:00 Initial ShortText code and conversion of package db code Metric Decrease: Naperian T10421 T10421a T10547 T12150 T12234 T12425 T13035 T18140 T18304 T5837 T6048 T13253-spj T18282 T18223 T3064 T9961 Metric Increase T13701 HFSKJH - - - - - 0a5f2918 by Sylvain Henry at 2020-10-13T00:13:28-04:00 Parser: don't require the HomeUnitId The HomeUnitId is only used by the Cmm parser and this one has access to the DynFlags, so it can grab the UnitId of the HomeUnit from them. Bump haddock submodule - - - - - 8f4f5794 by HaskellMouse at 2020-10-13T13:05:49+03:00 Unification of Nat and Naturals This commit removes the separate kind 'Nat' and enables promotion of type 'Natural' for using as type literal. It partially solves #10776 Now the following code will be successfully typechecked: data C = MkC Natural type CC = MkC 1 Before this change we had to create the separate type for promotion data C = MkC Natural data CP = MkCP Nat type CC = MkCP 1 But CP is uninhabited in terms. For backward compatibility type synonym `Nat` has been made: type Nat = Natural The user's documentation and tests have been updated. The haddock submodule also have been updated. - - - - - 0fc1cb54 by Ben Gamari at 2020-10-14T03:42:50-04:00 gitlab-ci: Verify that Hadrian builds with Stack As noted in #18726, this regularly breaks. Let's test it. Note that we don't actually perform a build of GHC itself; we merely test that the Hadrian executable builds and works (by invoking `hadrian --version`). - - - - - 89f4d8e9 by Ben Gamari at 2020-10-14T12:03:57-04:00 Bump LLVM version to 10.0 Fixes #18267. - - - - - 716385c9 by Ryan Scott at 2020-10-14T12:04:34-04:00 Make DataKinds the sole arbiter of kind-level literals (and friends) Previously, the use of kind-level literals, promoted tuples, and promoted lists required enabling both `DataKinds` and `PolyKinds`. This made sense back in a `TypeInType` world, but not so much now that `TypeInType`'s role has been superseded. Nowadays, `PolyKinds` only controls kind polymorphism, so let's make `DataKinds` the thing that controls the other aspects of `TypeInType`, which include literals, promoted tuples and promoted lists. There are some other things that overzealously required `PolyKinds`, which this patch fixes as well: * Previously, using constraints in kinds (e.g., `data T :: () -> Type`) required `PolyKinds`, despite the fact that this is orthogonal to kind polymorphism. This now requires `DataKinds` instead. * Previously, using kind annotations in kinds (e.g., `data T :: (Type :: Type) -> Type`) required both `KindSignatures` and `PolyKinds`. This doesn't make much sense, so it only requires `KindSignatures` now. Fixes #18831. - - - - - ac300a0d by Vladislav Zavialov at 2020-10-14T12:05:11-04:00 Remove "Operator sections" from docs/users_guide/bugs.rst The issue described in that section was fixed by 2b89ca5b850b4097447cc4908cbb0631011ce979 - - - - - bf2411a3 by Vladislav Zavialov at 2020-10-14T12:05:11-04:00 Fix PostfixOperators (#18151) This fixes a regression introduced in 2b89ca5b850b4097447cc4908cbb0631011ce979 See the new T18151x test case. - - - - - e60ae8a3 by Fumiaki Kinoshita at 2020-10-14T18:06:12-04:00 Add -Wnoncanonical-{monad,monoid}-instances to standardWarnings ------------------------- Metric Decrease: T12425 Metric Increase: T17516 ------------------------- - - - - - 15d2340c by Simon Peyton Jones at 2020-10-14T18:06:48-04:00 Fix some missed opportunities for preInlineUnconditionally There are two signficant changes here: * Ticket #18815 showed that we were missing some opportunities for preInlineUnconditionally. The one-line fix is in the code for GHC.Core.Opt.Simplify.Utils.preInlineUnconditionally, which now switches off only for INLINE pragmas. I expanded Note [Stable unfoldings and preInlineUnconditionally] to explain. * When doing this I discovered a way in which preInlineUnconditionally was occasionally /too/ eager. It's all explained in Note [Occurrences in stable unfoldings] in GHC.Core.Opt.OccurAnal, and the one-line change adding markAllMany to occAnalUnfolding. I also got confused about what NoUserInline meant, so I've renamed it to NoUserInlinePrag, and changed its pretty-printing slightly. That led to soem error messate wibbling, and touches quite a few files, but there is no change in functionality. I did a nofib run. As expected, no significant changes. Program Size Allocs ---------------------------------------- sphere -0.0% -0.4% ---------------------------------------- Min -0.0% -0.4% Max -0.0% +0.0% Geometric Mean -0.0% -0.0% I'm allowing a max-residency increase for T10370, which seems very irreproducible. (See comments on !4241.) There is always sampling error for max-residency measurements; and in any case the change shows up on some platforms but not others. Metric Increase: T10370 - - - - - 0c4bfed8 by Ben Gamari at 2020-10-14T18:07:25-04:00 users-guide: Add missing :ghc-flag: directive - - - - - 51c4b851 by Krzysztof Gogolewski at 2020-10-15T04:30:27-04:00 Remove Proxy# argument in Data.Typeable.Internal No longer neccessary - TypeRep is now indexed, there is no ambiguity. Also fix a comment in Evidence.hs, IsLabel no longer takes a Proxy#. - - - - - 809f09e8 by Sylvain Henry at 2020-10-15T04:31:07-04:00 Fix parsing of PIE flags -fPIE and -fno-PIE flags were (un)setting Opt_PIC instead of Opt_PIE. Original commit: 3625728a0e3a9b56c2b85ae7ea8bcabdd83ece6a - - - - - 3d7db148 by Ben Gamari at 2020-10-15T04:31:42-04:00 testsuite: Add missing #include on <stdlib.h> This otherwise fails on newer Clangs, which warn more aggressively on undeclared symbols. - - - - - 998803dc by Andrzej Rybczak at 2020-10-15T11:40:32+02:00 Add flags for annotating Generic{,1} methods INLINE[1] (#11068) Makes it possible for GHC to optimize away intermediate Generic representation for more types. Metric Increase: T12227 - - - - - 6b14c418 by GHC GitLab CI at 2020-10-15T21:57:50-04:00 Extend mAX_TUPLE_SIZE to 64 As well a ctuples and sums. - - - - - d495f36a by Ben Gamari at 2020-10-15T21:58:27-04:00 rts: Clean-up whitespace in Interpreter - - - - - cf10becd by Ben Gamari at 2020-10-15T21:58:27-04:00 compiler/ByteCode: Use strict Maps in bytecode assembler - - - - - ae146b53 by Ben Gamari at 2020-10-15T21:58:27-04:00 compiler/ByteCode: Make LocalLabel a newtype - - - - - cc536288 by Ben Gamari at 2020-10-15T21:58:27-04:00 compiler/ByteCode: Allow 2^32 local labels This widens LocalLabel to 2^16, avoiding the crash observed in #14334. Closes #14334. - - - - - 1bb0512f by Ben Gamari at 2020-10-16T00:15:31-04:00 mingw: Extract zst toolchain archives This should have been done when the toolchain was bumped. - - - - - bf7c5b6d by Ben Gamari at 2020-10-16T00:15:31-04:00 base: Reintroduce necessary LANGUAGE pragmas These were incorrectly removed in a recent cleanup commit. - - - - - c6b4be4b by Ben Gamari at 2020-10-16T00:15:31-04:00 testsuite: Sort metrics by metric type Closes #18838. - - - - - c7989c93 by Ben Gamari at 2020-10-16T00:15:31-04:00 testsuite: Account for -Wnoncanonical-monoid-instances changes on Windows - - - - - 330a5433 by Ben Gamari at 2020-10-16T00:15:31-04:00 rts: Add __mingw_vfprintf to RtsSymbols.c Following the model of the other printf symbols. See Note [Symbols for MinGW's printf]. - - - - - c4a69f37 by Ben Gamari at 2020-10-16T00:15:31-04:00 gitlab-ci: Remove allow_failure from Windows jobs - - - - - 9a9679db by Ben Gamari at 2020-10-16T00:15:31-04:00 gitlab-ci: Fix Hadrian bindist names - - - - - 07b0db86 by f-a at 2020-10-16T10:14:39-04:00 Clarify Eq documentation #18713 - - - - - aca0e63b by Ben Gamari at 2020-10-17T10:20:31-04:00 gitlab-ci: Allow doc-tarball job to fail Currently the Hadrian build appears not to package documentation correctly, causing doc-tarball to fail due to the Windows build. - - - - - b02a9ea7 by Ben Gamari at 2020-10-17T13:26:24-04:00 gitlab-ci: s/allow_newer/allow_failure Silly mistake on my part. - - - - - 59d7c9f4 by John Ericson at 2020-10-17T22:01:38-04:00 Skip type family defaults with hs-boot and hsig files Works around #17190, possible resolution for #17224. New design is is according to accepted [GHC Propoal 320]. Instances in signatures currently unconditionally opt into associated family defaults if no explicit instance is given. This is bad for two reasons: 1. It constrains possible instantiations to use the default, rather than possibly define the associated family differently. 2. It breaks compilation as type families are unsupported in signatures. This PR simply turns off the filling in of defaults in those cases. Additionally, it squelches a missing definition warning for hs-boot too that was only squelched for hsig before. The downsides are: 1. There is no way to opt into the default, other than copying its definition. 2. If we fixed type classes in signatures, and wanted instances to have to explicitly *out of* rather than into the default, that would now be a breaking change. The change that is most unambiguously goood is harmonizing the warning squelching between hs-boot or hsig. Maybe they should have the warning (opt out of default) maybe they shouldn't (opt in to default), but surely it should be the same for both. Add hs-boot version of a backpack test regarding class-specified defaults in instances that appear in an hs-boot file. The metrics increase is very slight and makes no sense --- at least no one has figured anything out after this languishing for a while, so I'm just going to accept it. Metric Increase: T10421a [GHC proposal 320]: https://github.com/ghc-proposals/ghc-proposals/pull/320 - - - - - 7eb46a09 by Sebastian Graf at 2020-10-17T22:02:13-04:00 Arity: Refactor fixed-point iteration in GHC.Core.Opt.Arity Arity analysis used to propagate optimistic arity types during fixed-point interation through the `ArityEnv`'s `ae_cheap_fun` field, which is like `GHC.Core.Utils.exprIsCheap`, but also considers the current iteration's optimistic arity, for the binder in question only. In #18793, we have seen that this is a problematic design, because it doesn't allow us to look through PAP bindings of that binder. Hence this patch refactors to a more traditional form with an explicit signature environment, in which we record the optimistic `ArityType` of the binder in question (and at the moment is the *only* binder that is recorded in the arity environment). - - - - - 6b3eb06a by Sebastian Graf at 2020-10-17T22:02:13-04:00 Arity: Record arity types for non-recursive lets In #18793, we saw a compelling example which requires us to look at non-recursive let-bindings during arity analysis and unleash their arity types at use sites. After the refactoring in the previous patch, the needed change is quite simple and very local to `arityType`'s defn for non-recurisve `Let`. Apart from that, we had to get rid of the second item of `Note [Dealing with bottoms]`, which was entirely a safety measure and hindered optimistic fixed-point iteration. Fixes #18793. The following metric increases are all caused by this commit and a result of the fact that we just do more work now: Metric Increase: T3294 T12545 T12707 - - - - - 451455fd by Sebastian Graf at 2020-10-17T22:02:13-04:00 Testsuite: Add dead arity analysis tests We didn't seem to test these old tests at all, judging from their expected output. - - - - - 50e9df49 by Dylan Yudaken at 2020-10-17T22:02:50-04:00 When using rts_setInCallCapability, lock incall threads This diff makes sure that incall threads, when using `rts_setInCallCapability`, will be created as locked. If the thread is not locked, the thread might end up being scheduled to a different capability. While this is mentioned in the docs for `rts_setInCallCapability,`, it makes the method significantly less useful as there is no guarantees on the capability being used. This commit also adds a test to make sure things stay on the correct capability. - - - - - 0b995759 by DylanZA at 2020-10-17T22:02:50-04:00 Apply suggestion to testsuite/tests/ffi/should_run/all.T - - - - - a91dcb66 by Sylvain Henry at 2020-10-17T22:04:02-04:00 Don't get host RTS ways via settings (#18651) To correctly perform a linking hack for Windows we need to link with the RTS GHC is currently using. We used to query the RTS ways via the "settings" file but it is fragile (#18651). The hack hasn't been fixed to take into account all the ways (Tracing) and it makes linking of GHC with another RTS more difficult (we need to link with another RTS and to regenerate the settings file). So this patch uses the ways reported by the RTS itself (GHC.Platform.Ways.hostWays) instead of the "settings" file. - - - - - d858a3ae by Hécate at 2020-10-17T22:04:38-04:00 Linting corrections * Bring back LANGUAGE pragmas in GHC.IO.Handle.Lock.Windows * Exclude some modules that are wrongfully reported - - - - - b5b3e34e by Vladislav Zavialov at 2020-10-19T18:16:20-04:00 Implement -Woperator-whitespace (#18834) This patch implements two related warnings: -Woperator-whitespace-ext-conflict warns on uses of infix operators that would be parsed differently were a particular GHC extension enabled -Woperator-whitespace warns on prefix, suffix, and tight infix uses of infix operators Updates submodules: haddock, containers. - - - - - 9648d680 by Sylvain Henry at 2020-10-19T18:16:58-04:00 Remove pdocPrec pdocPrec was only used in GHC.Cmm.DebugBlock.pprUnwindExpr, so remove it. OutputableP becomes a one-function class which might be better for performance. - - - - - ee5dcdf9 by Ben Gamari at 2020-10-20T00:47:54-04:00 testsuite: Add test for #18346 This was fixed by 4291bddaea3148908c55f235ee8978e1d9aa6f20. - - - - - 6c7a5c0c by Krzysztof Gogolewski at 2020-10-20T00:48:29-04:00 Minor comments, update linear types docs - Update comments: placeHolderTypeTc no longer exists "another level check problem" was a temporary comment from linear types - Use Mult type synonym (reported in #18676) - Mention multiplicity-polymorphic fields in linear types docs - - - - - 58a1ca38 by nineonine at 2020-10-20T00:49:07-04:00 Compile modules with `-fobject-code` enabled to byte-code when loaded with `*` prefix in ghci (#8042) The documentation states that when using :add and :load, the `*` prefix forces a module to be loaded as byte-code. However, this seems to be ignored when -fobject-code has been enabled. In that case, the compiled code is always used, regardless of whether the *-form is used. The idea is to consult the Targets in HscEnv and check the 'targetAllowObjCode' flag. If the flag for given module is set, then patch up DynFlags and select compilation backend accordingly. This would require a linear scan of course, but that shouldn't be too costly. - - - - - 59b08a5d by Ben Gamari at 2020-10-20T00:49:41-04:00 gitlab-ci: Rename FLAVOUR -> BUILD_FLAVOUR Previously the Hadrian jobs used the `FLAVOUR` environment variable to communicate which flavour `ci.sh` should build whereas `make` used `BUILD_FLAVOUR`. This caused unnecessary confusion. Consolidate these two. - - - - - ea736839 by Alan Zimmerman at 2020-10-20T08:35:34+01:00 API Annotations: Keep track of unicode for linear arrow notation The linear arrow can be parsed as `%1 ->` or a direct single token unicode equivalent. Make sure that this distinction is captured in the parsed AST by using IsUnicodeSyntax where it appears, and introduce a new API Annotation, AnnMult to represent its location when unicode is not used. Updated haddock submodule - - - - - cf3c3bcd by Ben Gamari at 2020-10-20T22:56:31-04:00 testsuite: Mark T12971 as fragile on Windows Due to #17945. - - - - - e2c4a947 by Vladislav Zavialov at 2020-10-21T16:00:30+03:00 Parser regression tests, close #12862 #12446 These issues were fixed by earlier parser changes, most likely related to whitespace-sensitive parsing. - - - - - 711929e6 by Simon Peyton Jones at 2020-10-23T02:42:59-04:00 Fix error message location in tcCheckPatSynDecl Ticket #18856 showed that we were failing to set the right location for an error message. Easy to fix, happily. Turns out that this also improves the error location in test T11010, which was bogus before but we had never noticed. - - - - - 730bb590 by Ben Gamari at 2020-10-23T02:43:33-04:00 cmm: Add Note reference to ForeignHint - - - - - b9d4dd9c by Ben Gamari at 2020-10-24T20:44:17-04:00 SMP.h: Add C11-style atomic operations - - - - - ccf2d4b0 by Ben Gamari at 2020-10-24T20:59:39-04:00 rts: Infrastructure for testing with ThreadSanitizer - - - - - a61f66d6 by Ben Gamari at 2020-10-24T20:59:39-04:00 rts/CNF: Initialize all bdescrs in group It seems wise and cheap to ensure that the whole bdescr of all blocks of a compact group is valid, even if most cases only look at the flags field. - - - - - 65136c13 by Ben Gamari at 2020-10-24T20:59:39-04:00 rts/Capability: Intialize interrupt field Previously this was left uninitialized. Also clarify some comments. - - - - - b3ce6aca by Ben Gamari at 2020-10-24T20:59:39-04:00 rts/Task: Make comments proper Notes - - - - - d3890ac7 by Ben Gamari at 2020-10-24T20:59:39-04:00 rts/SpinLock: Move to proper atomics This is fairly straightforward; we just needed to use relaxed operations for the PROF_SPIN counters and a release store instead of a write barrier. - - - - - ef88712f by Ben Gamari at 2020-10-24T20:59:39-04:00 rts/OSThreads: Fix data race Previously we would race on the cached processor count. Avoiding this is straightforward; just use relaxed operations. - - - - - 33a719c3 by Ben Gamari at 2020-10-24T20:59:39-04:00 rts/ClosureMaros: Use relaxed atomics - - - - - f08951fd by Ben Gamari at 2020-10-24T20:59:39-04:00 configure: Bump minimum-supported gcc version to 4.7 Since the __atomic_* builtins are not supported until gcc 4.7. Given that this version was released in 2012 I think this is acceptable. - - - - - d584923a by Ben Gamari at 2020-10-24T20:59:39-04:00 testsuite: Fix thread leak in hs_try_putmvar00[13] - - - - - bf1b0bc7 by Ben Gamari at 2020-10-24T20:59:39-04:00 rts: Introduce SET_HDR_RELEASE Also ensure that we also store the info table pointer last to ensure that the synchronization covers all stores. - - - - - 1a2e9f5e by Ben Gamari at 2020-10-24T21:00:19-04:00 gitlab-ci: Add nightly-x86_64-linux-deb9-tsan job - - - - - 58a5b0e5 by GHC GitLab CI at 2020-10-24T21:00:19-04:00 testsuite: Mark setnumcapabilities001 as broken with TSAN Due to #18808. - - - - - d9bc7dea by GHC GitLab CI at 2020-10-24T21:00:19-04:00 testsuite: Skip divbyzero and derefnull under TSAN ThreadSanitizer changes the output of these tests. - - - - - fcc42a10 by Ben Gamari at 2020-10-24T21:00:19-04:00 testsuite: Skip high memory usage tests with TSAN ThreadSanitizer significantly increases the memory footprint of tests, so much so that it can send machines into OOM. - - - - - cae4bb3e by Ben Gamari at 2020-10-24T21:00:19-04:00 testsuite: Mark hie002 as high_memory_usage This test has a peak residency of 1GByte; this is large enough to classify as "high" in my book. - - - - - dae1b86a by Ben Gamari at 2020-10-24T21:00:19-04:00 testsuite: Mark T9872[abc] as high_memory_usage These all have a maximum residency of over 2 GB. - - - - - c5a0bb22 by Ben Gamari at 2020-10-24T21:00:19-04:00 gitlab-ci: Disable documentation in TSAN build Haddock chews through enough memory to cause the CI builders to OOM and there's frankly no reason to build documentation in this job anyways. - - - - - 4cb1232e by Ben Gamari at 2020-10-24T21:00:19-04:00 TSANUtils: Ensure that C11 atomics are supported - - - - - 7ed15f7f by Ben Gamari at 2020-10-24T21:00:19-04:00 testsuite: Mark T3807 as broken with TSAN Due to #18883. - - - - - f7e6f012 by Ben Gamari at 2020-10-24T21:00:19-04:00 testsuite: Mark T13702 as broken with TSAN due to #18884 - - - - - 16b136b0 by Ben Gamari at 2020-10-24T21:00:36-04:00 rts: Factor out logic to identify a good capability for running a task Not only does this make the control flow a bit clearer but it also allows us to add a TSAN suppression on this logic, which requires (harmless) data races. - - - - - 2781d68c by Ben Gamari at 2020-10-24T21:00:36-04:00 rts: Annotate benign race in waitForCapability - - - - - f6b4b492 by Ben Gamari at 2020-10-24T21:00:36-04:00 rts: Clarify locking behavior of releaseCapability_ - - - - - 65219810 by Ben Gamari at 2020-10-24T21:00:36-04:00 rts: Add assertions for task ownership of capabilities - - - - - 31fa87ec by Ben Gamari at 2020-10-24T21:00:36-04:00 rts: Use relaxed atomics on n_returning_tasks This mitigates the warning of a benign race on n_returning_tasks in shouldYieldCapability. See #17261. - - - - - 6517a2ea by Ben Gamari at 2020-10-24T21:00:36-04:00 rts: Mitigate races in capability interruption logic - - - - - 2e9ba3f2 by Ben Gamari at 2020-10-24T21:00:36-04:00 rts/Capability: Use relaxed operations for last_free_capability - - - - - e10dde37 by Ben Gamari at 2020-10-24T21:00:37-04:00 rts: Use relaxed operations for cap->running_task (TODO) This shouldn't be necessary since only the owning thread of the capability should be touching this. - - - - - 855325cd by Ben Gamari at 2020-10-24T21:00:37-04:00 rts/Schedule: Use relaxed operations for sched_state - - - - - 811f915d by Ben Gamari at 2020-10-24T21:00:37-04:00 rts: Accept data race in work-stealing implementation This race is okay since the task is owned by the capability pushing it. By Note [Ownership of Task] this means that the capability is free to write to `task->cap` without taking `task->lock`. Fixes #17276. - - - - - 8d2b3c3d by Ben Gamari at 2020-10-24T21:00:37-04:00 rts: Eliminate data races on pending_sync - - - - - f8871018 by Ben Gamari at 2020-10-24T21:00:37-04:00 rts/Schedule: Eliminate data races on recent_activity We cannot safely use relaxed atomics here. - - - - - d079b943 by Ben Gamari at 2020-10-24T21:00:37-04:00 rts: Avoid data races in message handling - - - - - 06f80497 by Ben Gamari at 2020-10-24T21:00:37-04:00 rts/Messages: Drop incredibly fishy write barrier executeMessage previously had a write barrier at the beginning of its loop apparently in an attempt to synchronize with another thread's writes to the Message. I would guess that the author had intended to use a load barrier here given that there are no globally-visible writes done in executeMessage. I've removed the redundant barrier since the necessary load barrier is now provided by the ACQUIRE_LOAD. - - - - - d4a87779 by Ben Gamari at 2020-10-24T21:00:38-04:00 rts/ThreadPaused: Avoid data races - - - - - 56778ab3 by Ben Gamari at 2020-10-24T21:00:38-04:00 rts/Schedule: Eliminate data races in run queue management - - - - - 086521f7 by Ben Gamari at 2020-10-24T21:00:38-04:00 rts: Eliminate shutdown data race on task counters - - - - - abad9778 by Ben Gamari at 2020-10-24T21:00:38-04:00 rts/Threads: Avoid data races (TODO) Replace barriers with appropriate ordering. Drop redundant barrier in tryWakeupThread (the RELEASE barrier will be provided by sendMessage's mutex release). We use relaxed operations on why_blocked and the stack although it's not clear to me why this is necessary. - - - - - 2f56be8a by Ben Gamari at 2020-10-24T21:00:39-04:00 rts/Messages: Annotate benign race - - - - - 7c0cdab1 by Ben Gamari at 2020-10-24T21:00:39-04:00 rts/RaiseAsync: Synchronize what_next read - - - - - 6cc2a8a5 by Ben Gamari at 2020-10-24T21:00:39-04:00 rts/Task: Move debugTrace to avoid data race Specifically, we need to hold all_tasks_mutex to read taskCount. - - - - - bbaec97d by Ben Gamari at 2020-10-24T21:00:39-04:00 Disable flawed assertion - - - - - dd175a92 by Ben Gamari at 2020-10-24T21:00:39-04:00 Document schedulePushWork race - - - - - 3416244b by Ben Gamari at 2020-10-24T21:00:40-04:00 Capabiliity: Properly fix data race on n_returning_tasks There is a real data race but can be made safe by using proper atomic (but relaxed) accesses. - - - - - dffd9432 by Ben Gamari at 2020-10-24T21:00:40-04:00 rts: Make write of to_cap->inbox atomic This is necessary since emptyInbox may read from to_cap->inbox without taking cap->lock. - - - - - 1f4cbc29 by Ben Gamari at 2020-10-24T21:00:57-04:00 rts/BlockAlloc: Use relaxed operations - - - - - d0d07cff by Ben Gamari at 2020-10-24T21:00:57-04:00 rts: Rework handling of mutlist scavenging statistics - - - - - 9e5c7f6d by Ben Gamari at 2020-10-24T21:00:57-04:00 rts: Avoid data races in StablePtr implementation This fixes two potentially problematic data races in the StablePtr implementation: * We would fail to RELEASE the stable pointer table when enlarging it, causing other cores to potentially see uninitialized memory. * We would fail to ACQUIRE when dereferencing a stable pointer. - - - - - 316add67 by Ben Gamari at 2020-10-24T21:00:57-04:00 rts/Storage: Use atomics - - - - - 5c23bc4c by Ben Gamari at 2020-10-24T21:00:58-04:00 rts/Updates: Use proper atomic operations - - - - - 3d0f033c by Ben Gamari at 2020-10-24T21:00:58-04:00 rts/Weak: Eliminate data races By taking all_tasks_mutex in stat_exit. Also better-document the fact that the task statistics are protected by all_tasks_mutex. - - - - - edb4b92b by Ben Gamari at 2020-10-24T21:01:18-04:00 rts/WSDeque: Rewrite with proper atomics After a few attempts at shoring up the previous implementation, I ended up turning to the literature and now use the proven implementation, > N.M. Lê, A. Pop, A.Cohen, and F.Z. Nardelli. "Correct and Efficient > Work-Stealing for Weak Memory Models". PPoPP'13, February 2013, > ACM 978-1-4503-1922/13/02. Note only is this approach formally proven correct under C11 semantics but it is also proved to be a bit faster in practice. - - - - - d39bbd3d by Ben Gamari at 2020-10-24T21:01:33-04:00 rts: Use relaxed atomics for whitehole spin stats - - - - - 8f802f38 by Ben Gamari at 2020-10-24T21:01:33-04:00 rts: Avoid lock order inversion during fork Fixes #17275. - - - - - cef667b0 by GHC GitLab CI at 2020-10-24T21:01:34-04:00 rts: Use proper relaxe operations in getCurrentThreadCPUTime Here we are doing lazy initialization; it's okay if we do the check more than once, hence relaxed operation is fine. - - - - - 8cf50eb1 by Ben Gamari at 2020-10-24T21:01:54-04:00 rts/STM: Use atomics This fixes a potentially harmful race where we failed to synchronize before looking at a TVar's current_value. Also did a bit of refactoring to avoid abstract over management of max_commits. - - - - - 88a7ce38 by Ben Gamari at 2020-10-24T21:01:54-04:00 rts/stm: Strengthen orderings to SEQ_CST instead of volatile Previously the `current_value`, `first_watch_queue_entry`, and `num_updates` fields of `StgTVar` were marked as `volatile` in an attempt to provide strong ordering. Of course, this isn't sufficient. We now use proper atomic operations. In most of these cases I strengthen the ordering all the way to SEQ_CST although it's possible that some could be weakened with some thought. - - - - - f97c59ce by Ben Gamari at 2020-10-24T21:02:11-04:00 Mitigate data races in event manager startup/shutdown - - - - - c7c3f8aa by Ben Gamari at 2020-10-24T21:02:22-04:00 rts: Accept benign races in Proftimer - - - - - 5a98dfca by Ben Gamari at 2020-10-24T21:02:22-04:00 rts: Pause timer while changing capability count This avoids #17289. - - - - - 01d95525 by Ben Gamari at 2020-10-24T21:02:22-04:00 Fix #17289 - - - - - 9a528985 by Ben Gamari at 2020-10-24T21:02:23-04:00 suppress #17289 (ticker) race - - - - - 1726ec41 by Ben Gamari at 2020-10-24T21:02:23-04:00 rts: Fix timer initialization Previously `initScheduler` would attempt to pause the ticker and in so doing acquire the ticker mutex. However, initTicker, which is responsible for initializing said mutex, hadn't been called yet. - - - - - bfbe4366 by Ben Gamari at 2020-10-24T21:02:23-04:00 rts: Fix races in Pthread timer backend shudown We can generally be pretty relaxed in the barriers here since the timer thread is a loop. - - - - - 297acc71 by Ben Gamari at 2020-10-24T21:02:44-04:00 rts/Stats: Hide a few unused unnecessarily global functions - - - - - 9ad51bc9 by David Beacham at 2020-10-27T13:59:35-04:00 Fix `instance Bounded a => Bounded (Down a)` (#18716) * Flip `minBound` and `maxBound` to respect the change in ordering * Remove awkward `Enum` (and hence `Integral`) instances for `Data.Ord.Down` * Update changelog - - - - - eedec53d by Vladislav Zavialov at 2020-10-27T14:00:11-04:00 Version bump: base-4.16 (#18712) Also bumps upper bounds on base in boot libraries (incl. submodules). - - - - - 412018c1 by Tamar Christina at 2020-10-27T14:00:49-04:00 winio: simplify logic remove optimization step. - - - - - 4950dd07 by Ben Gamari at 2020-10-27T14:01:24-04:00 hadrian: Suppress xelatex output unless it fails As noted in #18835, xelatex produces an absurd amount of output, nearly all of which is meaningless. Silence this. Fixes #18835. - - - - - f3d8ab2e by Ben Gamari at 2020-10-27T14:02:00-04:00 build system: Clean mingw tarballs Tamar noticed in !4293 that the build systems fail to clean up the mingw tarballs directory (`ghc-tarballs`). Fix this in both the make build system and Hadrian. - - - - - 0b3d23af by Simon Peyton Jones at 2020-10-27T14:02:34-04:00 Fix two constraint solving problems This patch fixes two problems in the constraint solver. * An actual bug #18555: we were floating out a constraint to eagerly, and that was ultimately fatal. It's explained in Note [Do not float blocked constraints] in GHC.Core.Constraint. This is all very delicate, but it's all going to become irrelevant when we stop floating constraints (#17656). * A major performance infelicity in the flattener. When flattening (ty |> co) we *never* generated Refl, even when there was nothing at all to do. Result: we would gratuitously rewrite the constraint to exactly the same thing, wasting work. Described in #18413, and came up again in #18855. Solution: exploit the special case by calling the new function castCoercionKind1. See Note [castCoercionKind1] in GHC.Core.Coercion - - - - - f76c5a08 by Sergei Trofimovich at 2020-10-27T14:03:14-04:00 ghc.mk: amend 'make sdist' Noticed 'make sdist' failure seen as: ``` "rm" -rf sdistprep/ghc/ghc-9.1.0.20201020/hadrian/_build/ (SRC_DIST_GHC_DIR)/hadrian/dist-newstyle/ /bin/sh: -c: line 0: syntax error near unexpected token `(' ``` commit 9657f6f34 ("sdist: Include hadrian sources in source distribution") added a new cleanup path without a variable expantion. The change adds variable reference. While at it move directory cleanup to a separate statement. Amends #18794 Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - 78b52c88 by David Eichmann at 2020-10-27T14:03:51-04:00 Use config.run_ways for multi_compile_and_run tests - - - - - e3fdd419 by Alan Zimmerman at 2020-10-27T14:04:26-04:00 Api Annotations: Introduce AnnPercent for HsExplicitMult For the case foo :: a %p -> b The location of the '%' is captured, separate from the 'p' - - - - - d2a25f42 by Ben Gamari at 2020-10-27T14:05:02-04:00 gitlab-ci: Bump ci-images Bumps bootstrap compiler to 8.10.1. - - - - - 28f98b01 by Sebastian Graf at 2020-10-27T14:05:37-04:00 DmdAnal: Kill `is_thunk` case in `splitFV` The `splitFV` function implements the highly dubious hack described in `Note [Lazy und unleashable free variables]` in GHC.Core.Opt.DmdAnal. It arranges it so that demand signatures only carry strictness info on free variables. Usage info is released through other means, see the Note. It's purely for analysis performance reasons. It turns out that `splitFV` has a quite involved case for thunks that produces slightly different usage signatures and it's not clear why we need it: `splitFV` is only relevant in the LetDown case and the only time we call it on thunks is for top-level or local recursive thunks. Since usage signatures of top-level thunks can only reference other top-level bindings and we completely discard demand info we have on top-level things (see the lack of `setIdDemandInfo` in `dmdAnalTopBind`), the `is_thunk` case is completely irrelevant here. For local, recursive thunks, the added benefit of the `is_thunk` test is marginal: We get used-multiple-times in some cases where previously we had used-once if a recursive thunk has multiple call sites. It's very unlikely and not a case to optimise for. So we kill the `is_thunk` case and inline `splitFV` at its call site, exposing `isWeakDmd` from `GHC.Types.Demand` instead. The NoFib summary supports this decision: ``` Min 0.0% -0.0% Max 0.0% +0.0% Geometric Mean -0.0% -0.0% ``` - - - - - 60322f93 by Ben Gamari at 2020-10-28T21:11:39-04:00 hadrian: Don't quote metric baseline argument Previously this was quoted inappropriately. - - - - - c85eb372 by Alan Zimmerman at 2020-10-28T21:12:15-04:00 API Annotations: put constructors in alphabetical order - - - - - 795908dc by John Ericson at 2020-10-29T03:53:14-04:00 Widen acceptance threshold for T10421a Progress towards #18842. As @sgraf812 points out, widening the window is dangerous until the exponential described in #17658 is fixed. But this test has caused enough misery and is low stakes enough that we and @bgamari think it's worth it in this one case for the time being. - - - - - 0e9f6def by Sylvain Henry at 2020-10-29T03:53:52-04:00 Split GHC.Driver.Types I was working on making DynFlags stateless (#17957), especially by storing loaded plugins into HscEnv instead of DynFlags. It turned out to be complicated because HscEnv is in GHC.Driver.Types but LoadedPlugin isn't: it is in GHC.Driver.Plugins which depends on GHC.Driver.Types. I didn't feel like introducing yet another hs-boot file to break the loop. Additionally I remember that while we introduced the module hierarchy (#13009) we talked about splitting GHC.Driver.Types because it contained various unrelated types and functions, but we never executed. I didn't feel like making GHC.Driver.Types bigger with more unrelated Plugins related types, so finally I bit the bullet and split GHC.Driver.Types. As a consequence this patch moves a lot of things. I've tried to put them into appropriate modules but nothing is set in stone. Several other things moved to avoid loops. * Removed Binary instances from GHC.Utils.Binary for random compiler things * Moved Typeable Binary instances into GHC.Utils.Binary.Typeable: they import a lot of things that users of GHC.Utils.Binary don't want to depend on. * put everything related to Units/Modules under GHC.Unit: GHC.Unit.Finder, GHC.Unit.Module.{ModGuts,ModIface,Deps,etc.} * Created several modules under GHC.Types: GHC.Types.Fixity, SourceText, etc. * Split GHC.Utils.Error (into GHC.Types.Error) * Finally removed GHC.Driver.Types Note that this patch doesn't put loaded plugins into HscEnv. It's left for another patch. Bump haddock submodule - - - - - 22f5d9a9 by Sylvain Henry at 2020-10-29T03:53:52-04:00 GC: Avoid data race (#18717, #17964) - - - - - 2ef2fac4 by Ryan Scott at 2020-10-29T04:18:52-04:00 Check for large tuples more thoroughly This fixes #18723 by: * Moving the existing `GHC.Tc.Gen.HsType.bigConstraintTuple` validity check to `GHC.Rename.Utils.checkCTupSize` for consistency with `GHC.Rename.Utils.checkTupSize`, and * Using `check(C)TupSize` when checking tuple _types_, in addition to checking names, expressions, and patterns. Note that I put as many of these checks as possible in the typechecker so that GHC can properly distinguish between boxed and constraint tuples. The exception to this rule is checking names, which I perform in the renamer (in `GHC.Rename.Env`) so that we can rule out `(,, ... ,,)` and `''(,, ... ,,)` alike in one fell swoop. While I was in town, I also removed the `HsConstraintTuple` and `HsBoxedTuple` constructors of `HsTupleSort`, which are functionally unused. This requires a `haddock` submodule bump. - - - - - 7f8be3eb by Richard Eisenberg at 2020-10-29T22:08:13-04:00 Remove unnecessary gender from comments/docs While, say, alternating "he" and "she" in sequential writing may be nicer than always using "they", reading code/documentation is almost never sequential. If this small change makes individuals feel more welcome in GHC's codebase, that's a good thing. - - - - - aad1f803 by Ben Gamari at 2020-10-30T00:41:14-04:00 rts/GC: Use atomics - - - - - d0bc0517 by Ben Gamari at 2020-10-30T00:41:14-04:00 rts: Use RELEASE ordering in unlockClosure - - - - - d44f5232 by Ben Gamari at 2020-10-30T00:41:14-04:00 rts/Storage: Accept races on heap size counters - - - - - 4e4a7386 by Ben Gamari at 2020-10-30T00:41:14-04:00 rts: Join to concurrent mark thread during shutdown Previously we would take all capabilities but fail to join on the thread itself, potentially resulting in a leaked thread. - - - - - a80cc857 by GHC GitLab CI at 2020-10-30T00:41:14-04:00 rts: Fix race in GC CPU time accounting Ensure that the GC leader synchronizes with workers before calling stat_endGC. - - - - - 9902d9ec by Viktor Dukhovni at 2020-10-30T05:28:30-04:00 [skip ci] Fix typo in `callocBytes` haddock. - - - - - 105d43db by Ben Gamari at 2020-10-30T14:02:19-04:00 rts/SpinLock: Separate out slow path Not only is this in general a good idea, but it turns out that GCC unrolls the retry loop, resulting is massive code bloat in critical parts of the RTS (e.g. `evacuate`). - - - - - f7b45cde by Ben Gamari at 2020-10-30T14:02:19-04:00 rts: Use relaxed ordering on spinlock counters - - - - - 31fcb55f by Ryan Scott at 2020-10-30T18:52:50-04:00 Split HsConDecl{H98,GADT}Details Haskell98 and GADT constructors both use `HsConDeclDetails`, which includes `InfixCon`. But `InfixCon` is never used for GADT constructors, which results in an awkward unrepresentable state. This removes the unrepresentable state by: * Renaming the existing `HsConDeclDetails` synonym to `HsConDeclH98Details`, which emphasizes the fact that it is now only used for Haskell98-style data constructors, and * Creating a new `HsConDeclGADTDetails` data type with `PrefixConGADT` and `RecConGADT` constructors that closely resemble `PrefixCon` and `InfixCon` in `HsConDeclH98Details`. The key difference is that `HsConDeclGADTDetails` lacks any way to represent infix constructors. The rest of the patch is refactoring to accommodate the new structure of `HsConDecl{H98,GADT}Details`. Some highlights: * The `getConArgs` and `hsConDeclArgTys` functions have been removed, as there is no way to implement these functions uniformly for all `ConDecl`s. For the most part, their previous call sites now pattern match on the `ConDecl`s directly and do different things for `ConDeclH98`s and `ConDeclGADT`s. I did introduce one new function to make the transition easier: `getRecConArgs_maybe`, which extracts the arguments from a `RecCon(GADT)`. This is still possible since `RecCon(GADT)`s still use the same representation in both `HsConDeclH98Details` and `HsConDeclGADTDetails`, and since the pattern that `getRecConArgs_maybe` implements is used in several places, I thought it worthwhile to factor it out into its own function. * Previously, the `con_args` fields in `ConDeclH98` and `ConDeclGADT` were both of type `HsConDeclDetails`. Now, the former is of type `HsConDeclH98Details`, and the latter is of type `HsConDeclGADTDetails`, which are distinct types. As a result, I had to rename the `con_args` field in `ConDeclGADT` to `con_g_args` to make it typecheck. A consequence of all this is that the `con_args` field is now partial, so using `con_args` as a top-level field selector is dangerous. (Indeed, Haddock was using `con_args` at the top-level, which caused it to crash at runtime before I noticed what was wrong!) I decided to add a disclaimer in the 9.2.1 release notes to advertise this pitfall. Fixes #18844. Bumps the `haddock` submodule. - - - - - 57c3db96 by Ryan Scott at 2020-10-31T02:53:55-04:00 Make typechecker equality consider visibility in ForAllTys Previously, `can_eq_nc'` would equate `ForAllTy`s regardless of their `ArgFlag`, including `forall i -> i -> Type` and `forall i. i -> Type`! To fix this, `can_eq_nc'` now uses the `sameVis` function to first check if the `ArgFlag`s are equal modulo specificity. I have also updated `tcEqType`'s implementation to match this behavior. For more explanation on the "modulo specificity" part, see the new `Note [ForAllTy and typechecker equality]` in `GHC.Tc.Solver.Canonical`. While I was in town, I fixed some related documentation issues: * I added `Note [Typechecker equality]` to `GHC.Tc.Utils.TcType` to describe what exactly distinguishes `can_eq_nc'` and `tcEqType` (which implement typechecker equality) from `eqType` (which implements definitional equality, which does not care about the `ArgFlags` of `ForAllTy`s at all). * The User's Guide had some outdated prose on the specified/inferred distinction being different for types and kinds, a holdover from #15079. This is no longer the case on today's GHC, so I removed this prose, added some new prose to take its place, and added a regression test for the programs in #15079. * The User's Guide had some _more_ outdated prose on inferred type variables not being allowed in `default` type signatures for class methods, which is no longer true as of the resolution of #18432. * The related `Note [Deferred Unification]` was being referenced as `Note [Deferred unification]` elsewhere, which made it harder to `grep` for. I decided to change the name of the Note to `Deferred unification` for consistency with the capitalization style used for most other Notes. Fixes #18863. - - - - - a98593f0 by Sylvain Henry at 2020-10-31T02:54:34-04:00 Refactor numeric constant folding rules Avoid the use of global pattern synonyms. 1) I think it's going to be helpful to implement constant folding for other numeric types, especially Natural which doesn't have a wrapping behavior. We'll have to refactor these rules even more so we'd better make them less cryptic. 2) It should also be slightly faster because global pattern synonyms matched operations for every numeric types instead of the current one: e.g., ":**:" pattern was matching multiplication for both Int# and Word# types. As we will probably want to implement constant folding for other numeric types (Int8#, Int16#, etc.), it is more efficient to only match primops for a given type as we do now. - - - - - 730ef38f by Sylvain Henry at 2020-10-31T02:54:34-04:00 Simplify constant-folding (#18032) See #18032 for the details. * Use `Lit (LitNumber _ i)` instead of `isLitValue_maybe` which does more work but that is not needed for constant-folding * Don't export `GHC.Types.Literal.isLitValue_maybe` * Kill `GHC.Types.Literal.isLitValue` which isn't used - - - - - d5a53c1a by Ben Gamari at 2020-10-31T02:55:10-04:00 primops.txt.pp: Move ByteArray# primops to separate file This file will be generated. - - - - - b4278a41 by Ben Gamari at 2020-10-31T02:55:10-04:00 primops: Generate ByteArray# index/read/write primops Previously these were mostly undocumented and was ripe for potential inconsistencies. - - - - - 08e6993a by Sylvain Henry at 2020-10-31T02:55:50-04:00 Move loadDecl into IfaceToCore - - - - - cb1f755c by Tamar Christina at 2020-10-31T09:26:56-04:00 winio: Fix unused variables warnings - - - - - eb368078 by Andrzej Rybczak at 2020-10-31T09:27:34-04:00 Add testcase for #816 - - - - - bd4abdc9 by Ben Gamari at 2020-11-01T01:10:31-04:00 testsuite: Add performance test for #18698 - - - - - dfd27445 by Hécate at 2020-11-01T01:11:09-04:00 Add the proper HLint rules and remove redundant keywords from compiler - - - - - ce1bb995 by Hécate at 2020-11-01T08:52:08-05:00 Fix a leak in `transpose` This patch was authored by David Feuer <david.feuer at gmail.com> - - - - - e63db32c by Ben Gamari at 2020-11-01T08:52:44-05:00 Scav: Use bd->gen_no instead of bd->gen->no This potentially saves a cache miss per scavenge. - - - - - b1dda153 by Ben Gamari at 2020-11-01T12:58:36-05:00 rts/Stats: Protect with mutex While on face value this seems a bit heavy, I think it's far better than enforcing ordering on every access. - - - - - 5c2e6bce by Ben Gamari at 2020-11-01T12:58:36-05:00 rts: Tear down stats_mutex after exitHeapProfiling Since the latter wants to call getRTSStats. - - - - - ef25aaa1 by Ben Gamari at 2020-11-01T13:02:11-05:00 rts: Annotate hopefully "benign" races in freeGroup - - - - - 3a181553 by Ben Gamari at 2020-11-01T13:02:18-05:00 Strengthen ordering in releaseGCThreads - - - - - af474f62 by Ben Gamari at 2020-11-01T13:05:38-05:00 Suppress data race due to close This suppresses the other side of a race during shutdown. - - - - - b4686bff by Ben Gamari at 2020-11-01T13:09:59-05:00 Merge branch 'wip/tsan/ci' into wip/tsan/all - - - - - b8e66e0e by Ben Gamari at 2020-11-01T13:10:01-05:00 Merge branch 'wip/tsan/storage' into wip/tsan/all - - - - - 375512cf by Ben Gamari at 2020-11-01T13:10:02-05:00 Merge branch 'wip/tsan/wsdeque' into wip/tsan/all - - - - - 65ebf07e by Ben Gamari at 2020-11-01T13:10:03-05:00 Merge branch 'wip/tsan/misc' into wip/tsan/all - - - - - 55c375d0 by Ben Gamari at 2020-11-01T13:10:04-05:00 Merge branch 'wip/tsan/stm' into wip/tsan/all - - - - - a9f75fe2 by Ben Gamari at 2020-11-01T13:10:06-05:00 Merge branch 'wip/tsan/event-mgr' into wip/tsan/all - - - - - 8325d658 by Ben Gamari at 2020-11-01T13:10:24-05:00 Merge branch 'wip/tsan/timer' into wip/tsan/all - - - - - 07e82ba5 by Ben Gamari at 2020-11-01T13:10:35-05:00 Merge branch 'wip/tsan/stats' into wip/tsan/all - - - - - 4ce2f7d6 by GHC GitLab CI at 2020-11-02T23:45:06-05:00 testsuite: Add --top flag to driver This allows us to make `config.top` a proper Path. Previously it was a str, which caused the Ghostscript detection logic to break. - - - - - 0b772221 by Ben Gamari at 2020-11-02T23:45:42-05:00 Document that ccall convention doesn't support varargs We do not support foreign "C" imports of varargs functions. While this works on amd64, in general the platform's calling convention may need more type information that our Cmm representation can currently provide. For instance, this is the case with Darwin's AArch64 calling convention. Document this fact in the users guide and fix T5423 which makes use of a disallowed foreign import. Closes #18854. - - - - - 81006a06 by David Eichmann at 2020-11-02T23:46:19-05:00 RtsAPI: pause and resume the RTS The `rts_pause` and `rts_resume` functions have been added to `RtsAPI.h` and allow an external process to completely pause and resume the RTS. Co-authored-by: Sven Tennie <sven.tennie at gmail.com> Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> Co-authored-by: Ben Gamari <bgamari.foss at gmail.com> - - - - - bfb1e272 by Ryan Scott at 2020-11-02T23:46:55-05:00 Display results of GHC.Core.Lint.lint* functions consistently Previously, the functions in `GHC.Core.Lint` used a patchwork of different ways to display Core Lint errors: * `lintPassResult` (which is the source of most Core Lint errors) renders Core Lint errors with a distinctive banner (e.g., `*** Core Lint errors : in result of ... ***`) that sets them apart from ordinary GHC error messages. * `lintAxioms`, in contrast, uses a completely different code path that displays Core Lint errors in a rather confusing manner. For example, the program in #18770 would give these results: ``` Bug.hs:1:1: error: Bug.hs:12:1: warning: Non-*-like kind when *-like expected: RuntimeRep when checking the body of forall: 'TupleRep '[r] In the coercion axiom Bug.N:T :: []. Bug.T ~_R Any Substitution: [TCvSubst In scope: InScope {r} Type env: [axl :-> r] Co env: []] | 1 | {-# LANGUAGE DataKinds #-} | ^ ``` * Further digging reveals that `GHC.IfaceToCore` displays Core Lint errors for iface unfoldings as though they were a GHC panic. See, for example, this excerpt from #17723: ``` ghc: panic! (the 'impossible' happened) (GHC version 8.8.2 for x86_64-unknown-linux): Iface Lint failure In interface for Lib ... ``` This patch makes all of these code paths display Core Lint errors and warnings consistently. I decided to adopt the conventions that `lintPassResult` currently uses, as they appear to have been around the longest (and look the best, in my subjective opinion). We now use the `displayLintResult` function for all three scenarios mentioned above. For example, here is what the Core Lint error for the program in #18770 looks like after this patch: ``` [1 of 1] Compiling Bug ( Bug.hs, Bug.o ) *** Core Lint errors : in result of TcGblEnv axioms *** Bug.hs:12:1: warning: Non-*-like kind when *-like expected: RuntimeRep when checking the body of forall: 'TupleRep '[r_axn] In the coercion axiom N:T :: []. T ~_R Any Substitution: [TCvSubst In scope: InScope {r_axn} Type env: [axn :-> r_axn] Co env: []] *** Offending Program *** axiom N:T :: T = Any -- Defined at Bug.hs:12:1 *** End of Offense *** <no location info>: error: Compilation had errors ``` Fixes #18770. - - - - - a9e5f52c by Simon Peyton Jones at 2020-11-02T23:47:31-05:00 Expand type synonyms with :kind! The User's Guide claims that `:kind!` should expand type synonyms, but GHCi wasn't doing this in practice. Let's just update the implementation to match the specification in the User's Guide. Fixes #13795. Fixes #18828. Co-authored-by: Ryan Scott <ryan.gl.scott at gmail.com> - - - - - 1370eda7 by Ben Gamari at 2020-11-02T23:48:06-05:00 hadrian: Don't capture RunTest output There are a few reasons why capturing the output of the RunTest builder is undesirable: * there is a large amount of output which then gets unnecessarily duplicated by Hadrian if the builder fails * the output may contain codepoints which are unrepresentable in the current codepage on Windows, causing Hadrian to crash * capturing the output causes the testsuite driver to disable its colorisation logic, making the output less legible. - - - - - 78f2767d by Matthew Pickering at 2020-11-03T17:39:53-05:00 Update inlining flags documentation - - - - - 14ce454f by Sylvain Henry at 2020-11-03T17:40:34-05:00 Linker: reorganize linker related code Move linker related code into GHC.Linker. Previously it was scattered into GHC.Unit.State, GHC.Driver.Pipeline, GHC.Runtime.Linker, etc. Add documentation in GHC.Linker - - - - - 616bec0d by Alan Zimmerman at 2020-11-03T17:41:10-05:00 Restrict Linear arrow %1 to exactly literal 1 only This disallows `a %001 -> b`, and makes sure the type literal is printed from its SourceText so it is clear why. Closes #18888 - - - - - 3486ebe6 by Sylvain Henry at 2020-11-03T17:41:48-05:00 Hadrian: don't fail if ghc-tarballs dir doesn't exist - - - - - 37f0434d by Sylvain Henry at 2020-11-03T17:42:26-05:00 Constant-folding: don't pass through GHC's Int/Word (fix #11704) Constant-folding rules for integerToWord/integerToInt were performing the following coercions at compilation time: integerToWord: target's Integer -> ghc's Word -> target's Word integerToInt : target's Integer -> ghc's Int -> target's Int 1) It was wrong for cross-compilers when GHC's word size is smaller than the target one. This patch avoids passing through GHC's word-sized types: integerToWord: target's Integer -> ghc's Integer -> target's Word integerToInt : target's Integer -> ghc's Integer -> target's Int 2) Additionally we didn't wrap the target word/int literal to make it fit into the target's range! This broke the invariant of literals only containing values in range. The existing code is wrong only with a 64-bit cross-compiling GHC, targeting a 32-bit platform, and performing constant folding on a literal that doesn't fit in a 32-bit word. If GHC was built with DEBUG, the assertion in GHC.Types.Literal.mkLitWord would fail. Otherwise the bad transformation would go unnoticed. - - - - - bff74de7 by Sylvain Henry at 2020-11-03T17:43:03-05:00 Bignum: make GMP's bignat_add not recursive bignat_add was a loopbreaker with an INLINE pragma (spotted by @mpickering). This patch makes it non recursive to avoid the issue. - - - - - bb100805 by Andreas Klebinger at 2020-11-04T16:47:24-05:00 NCG: Fix 64bit int comparisons on 32bit x86 We no compare these by doing 64bit subtraction and checking the resulting flags. We used to do this differently but the old approach was broken when the high bits compared equal and the comparison was one of >= or <=. The new approach should be both correct and faster. - - - - - b790b7f9 by Andreas Klebinger at 2020-11-04T16:47:59-05:00 Testsuite: Support for user supplied package dbs We can now supply additional package dbs to the testsuite. For make the package db can be supplied by passing PACKAGE_DB=/path/to/db. In the testsuite driver it's passed via the --test-package-db argument. - - - - - 81560981 by Sylvain Henry at 2020-11-04T16:48:42-05:00 Don't use LEA with 8-bit registers (#18614) - - - - - 17d5c518 by Viktor Dukhovni at 2020-11-05T00:50:23-05:00 Naming, value types and tests for Addr# atomics The atomic Exchange and CAS operations on integral types are updated to take and return more natural `Word#` rather than `Int#` values. These are bit-block not arithmetic operations, and the sign bit plays no special role. Standardises the names to `atomic<OpType><ValType>Addr#`, where `OpType` is one of `Cas` or `Exchange` and `ValType` is presently either `Word` or `Addr`. Eventually, variants for `Word32` and `Word64` can and should be added, once #11953 and related issues (e.g. #13825) are resolved. Adds tests for `Addr#` CAS that mirror existing tests for `MutableByteArray#`. - - - - - 2125b1d6 by Ryan Scott at 2020-11-05T00:51:01-05:00 Add a regression test for #18920 Commit f594a68a5500696d94ae36425bbf4d4073aca3b2 (`Use level numbers for generalisation`) ended up fixing #18920. Let's add a regression test to ensure that it stays fixed. Fixes #18920. - - - - - e07e383a by Ryan Scott at 2020-11-06T03:45:28-05:00 Replace HsImplicitBndrs with HsOuterTyVarBndrs This refactors the GHC AST to remove `HsImplicitBndrs` and replace it with `HsOuterTyVarBndrs`, a type which records whether the outermost quantification in a type is explicit (i.e., with an outermost, invisible `forall`) or implicit. As a result of this refactoring, it is now evident in the AST where the `forall`-or-nothing rule applies: it's all the places that use `HsOuterTyVarBndrs`. See the revamped `Note [forall-or-nothing rule]` in `GHC.Hs.Type` (previously in `GHC.Rename.HsType`). Moreover, the places where `ScopedTypeVariables` brings lexically scoped type variables into scope are a subset of the places that adhere to the `forall`-or-nothing rule, so this also makes places that interact with `ScopedTypeVariables` easier to find. See the revamped `Note [Lexically scoped type variables]` in `GHC.Hs.Type` (previously in `GHC.Tc.Gen.Sig`). `HsOuterTyVarBndrs` are used in type signatures (see `HsOuterSigTyVarBndrs`) and type family equations (see `HsOuterFamEqnTyVarBndrs`). The main difference between the former and the latter is that the former cares about specificity but the latter does not. There are a number of knock-on consequences: * There is now a dedicated `HsSigType` type, which is the combination of `HsOuterSigTyVarBndrs` and `HsType`. `LHsSigType` is now an alias for an `XRec` of `HsSigType`. * Working out the details led us to a substantial refactoring of the handling of explicit (user-written) and implicit type-variable bindings in `GHC.Tc.Gen.HsType`. Instead of a confusing family of higher order functions, we now have a local data type, `SkolemInfo`, that controls how these binders are kind-checked. It remains very fiddly, not fully satisfying. But it's better than it was. Fixes #16762. Bumps the Haddock submodule. Co-authored-by: Simon Peyton Jones <simonpj at microsoft.com> Co-authored-by: Richard Eisenberg <rae at richarde.dev> Co-authored-by: Zubin Duggal <zubin at cmi.ac.in> - - - - - c85f4928 by Sylvain Henry at 2020-11-06T03:46:08-05:00 Refactor -dynamic-too handling 1) Don't modify DynFlags (too much) for -dynamic-too: now when we generate dynamic outputs for "-dynamic-too", we only set "dynamicNow" boolean field in DynFlags instead of modifying several other fields. These fields now have accessors that take dynamicNow into account. 2) Use DynamicTooState ADT to represent -dynamic-too state. It's much clearer than the undocumented "DynamicTooConditional" that was used before. As a result, we can finally remove the hscs_iface_dflags field in HscRecomp. There was a comment on this field saying: "FIXME (osa): I don't understand why this is necessary, but I spent almost two days trying to figure this out and I couldn't .. perhaps someone who understands this code better will remove this later." I don't fully understand the details, but it was needed because of the changes made to the DynFlags for -dynamic-too. There is still something very dubious in GHC.Iface.Recomp: we have to disable the "dynamicNow" flag at some point for some Backpack's "heinous hack" to continue to work. It may be because interfaces for indefinite units are always non-dynamic, or because we mix and match dynamic and non-dynamic interfaces (#9176), or something else, who knows? - - - - - 2cb87909 by Moritz Angermann at 2020-11-06T03:46:44-05:00 [AArch64] Aarch64 Always PIC - - - - - b1d2c1f3 by Ben Gamari at 2020-11-06T03:47:19-05:00 rts/Sanity: Avoid nasty race in weak pointer sanity-checking See Note [Racing weak pointer evacuation] for all of the gory details. - - - - - 638f38c5 by Ben Gamari at 2020-11-08T09:29:16-05:00 Merge remote-tracking branch 'origin/wip/tsan/all' - - - - - 22888798 by Ben Gamari at 2020-11-08T12:08:40-05:00 Fix haddock submodule The previous merge mistakenly reverted it. - - - - - d445cf05 by Ben Gamari at 2020-11-10T10:26:20-05:00 rts/linker: Fix relocation overflow in PE linker Previously the overflow check for the IMAGE_REL_AMD64_ADDR32NB relocation failed to account for the signed nature of the value. Specifically, the overflow check was: uint64_t v; v = S + A; if (v >> 32) { ... } However, `v` ultimately needs to fit into 32-bits as a signed value. Consequently, values `v > 2^31` in fact overflow yet this is not caught by the existing overflow check. Here we rewrite the overflow check to rather ensure that `INT32_MIN <= v <= INT32_MAX`. There is now quite a bit of repetition between the `IMAGE_REL_AMD64_REL32` and `IMAGE_REL_AMD64_ADDR32` cases but I am leaving fixing this for future work. This bug was first noticed by @awson. Fixes #15808. - - - - - 4c407f6e by Sylvain Henry at 2020-11-10T10:27:00-05:00 Export SPEC from GHC.Exts (#13681) - - - - - 7814cd5b by David Eichmann at 2020-11-10T10:27:35-05:00 ghc-heap: expose decoding from heap representation Co-authored-by: Sven Tennie <sven.tennie at gmail.com> Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> Co-authored-by: Ben Gamari <bgamari.foss at gmail.com> - - - - - fa344d33 by Richard Eisenberg at 2020-11-10T10:28:10-05:00 Add test case for #17186. This got fixed sometime recently; not worth it trying to figure out which commit. - - - - - 2e63a0fb by David Eichmann at 2020-11-10T10:28:46-05:00 Add code comments for StgInfoTable and StgStack structs - - - - - fcfda909 by Ben Gamari at 2020-11-11T03:19:59-05:00 nativeGen: Make makeImportsDoc take an NCGConfig rather than DynFlags It appears this was an oversight as there is no reason the full DynFlags is necessary. - - - - - 6e23695e by Ben Gamari at 2020-11-11T03:19:59-05:00 Move this_module into NCGConfig In various places in the NCG we need the Module currently being compiled. Let's move this into the environment instead of chewing threw another register. - - - - - c6264a2d by Ben Gamari at 2020-11-11T03:20:00-05:00 codeGen: Produce local symbols for module-internal functions It turns out that some important native debugging/profiling tools (e.g. perf) rely only on symbol tables for function name resolution (as opposed to using DWARF DIEs). However, previously GHC would emit temporary symbols (e.g. `.La42b`) to identify module-internal entities. Such symbols are dropped during linking and therefore not visible to runtime tools (in addition to having rather un-helpful unique names). For instance, `perf report` would often end up attributing all cost to the libc `frame_dummy` symbol since Haskell code was no covered by any proper symbol (see #17605). We now rather follow the model of C compilers and emit descriptively-named local symbols for module internal things. Since this will increase object file size this behavior can be disabled with the `-fno-expose-internal-symbols` flag. With this `perf record` can finally be used against Haskell executables. Even more, with `-g3` `perf annotate` provides inline source code. - - - - - 584058dd by Ben Gamari at 2020-11-11T03:20:00-05:00 Enable -fexpose-internal-symbols when debug level >=2 This seems like a reasonable default as the object file size increases by around 5%. - - - - - c34a4b98 by Ömer Sinan Ağacan at 2020-11-11T03:20:35-05:00 Fix and enable object unloading in GHCi Fixes #16525 by tracking dependencies between object file symbols and marking symbol liveness during garbage collection See Note [Object unloading] in CheckUnload.c for details. - - - - - 2782487f by Ray Shih at 2020-11-11T03:20:35-05:00 Add loadNativeObj and unloadNativeObj (This change is originally written by niteria) This adds two functions: * `loadNativeObj` * `unloadNativeObj` and implements them for Linux. They are useful if you want to load a shared object with Haskell code using the system linker and have GHC call dlclose() after the code is no longer referenced from the heap. Using the system linker allows you to load the shared object above outside the low-mem region. It also loads the DWARF sections in a way that `perf` understands. `dl_iterate_phdr` is what makes this implementation Linux specific. - - - - - 7a65f9e1 by GHC GitLab CI at 2020-11-11T03:20:35-05:00 rts: Introduce highMemDynamic - - - - - e9e1b2e7 by GHC GitLab CI at 2020-11-11T03:20:35-05:00 Introduce test for dynamic library unloading This uses the highMemDynamic flag introduced earlier to verify that dynamic objects are properly unloaded. - - - - - 5506f134 by Krzysztof Gogolewski at 2020-11-11T03:21:14-05:00 Force argument in setIdMult (#18925) - - - - - 787e93ae by Ben Gamari at 2020-11-11T23:14:11-05:00 testsuite: Add testcase for #18733 - - - - - 5353fd50 by Ben Gamari at 2020-11-12T10:05:30-05:00 compiler: Fix recompilation checking In ticket #18733 we noticed a rather serious deficiency in the current fingerprinting logic for recursive groups. I have described the old fingerprinting story and its problems in Note [Fingerprinting recursive groups] and have reworked the story accordingly to avoid these issues. Fixes #18733. - - - - - 63fa3997 by Sebastian Graf at 2020-11-13T14:29:39-05:00 Arity: Rework `ArityType` to fix monotonicity (#18870) As we found out in #18870, `andArityType` is not monotone, with potentially severe consequences for termination of fixed-point iteration. That showed in an abundance of "Exciting arity" DEBUG messages that are emitted whenever we do more than one step in fixed-point iteration. The solution necessitates also recording `OneShotInfo` info for `ABot` arity type. Thus we get the following definition for `ArityType`: ``` data ArityType = AT [OneShotInfo] Divergence ``` The majority of changes in this patch are the result of refactoring use sites of `ArityType` to match the new definition. The regression test `T18870` asserts that we indeed don't emit any DEBUG output anymore for a function where we previously would have. Similarly, there's a regression test `T18937` for #18937, which we expect to be broken for now. Fixes #18870. - - - - - 197d59fa by Sebastian Graf at 2020-11-13T14:29:39-05:00 Arity: Emit "Exciting arity" warning only after second iteration (#18937) See Note [Exciting arity] why we emit the warning at all and why we only do after the second iteration now. Fixes #18937. - - - - - de7ec9dd by David Eichmann at 2020-11-13T14:30:16-05:00 Add rts_listThreads and rts_listMiscRoots to RtsAPI.h These are used to find the current roots of the garbage collector. Co-authored-by: Sven Tennie's avatarSven Tennie <sven.tennie at gmail.com> Co-authored-by: Matthew Pickering's avatarMatthew Pickering <matthewtpickering at gmail.com> Co-authored-by: default avatarBen Gamari <bgamari.foss at gmail.com> - - - - - 24a86f09 by Ben Gamari at 2020-11-13T14:30:51-05:00 gitlab-ci: Cache cabal store in linting job - - - - - 0a7e592c by Ben Gamari at 2020-11-15T03:35:45-05:00 nativeGen/dwarf: Fix procedure end addresses Previously the `.debug_aranges` and `.debug_info` (DIE) DWARF information would claim that procedures (represented with a `DW_TAG_subprogram` DIE) would only span the range covered by their entry block. This omitted all of the continuation blocks (represented by `DW_TAG_lexical_block` DIEs), confusing `perf`. Fix this by introducing a end-of-procedure label and using this as the `DW_AT_high_pc` of procedure `DW_TAG_subprogram` DIEs Fixes #17605. - - - - - 1e19183d by Ben Gamari at 2020-11-15T03:35:45-05:00 nativeGen/dwarf: Only produce DW_AT_source_note DIEs in -g3 Standard debugging tools don't know how to understand these so let's not produce them unless asked. - - - - - ad73370f by Ben Gamari at 2020-11-15T03:35:45-05:00 nativeGen/dwarf: Use DW_AT_linkage instead of DW_AT_MIPS_linkage - - - - - a2539650 by Ben Gamari at 2020-11-15T03:35:45-05:00 gitlab-ci: Add DWARF release jobs for Debian 10, Fedora27 - - - - - d61adb3d by Ryan Scott at 2020-11-15T03:36:21-05:00 Name (tc)SplitForAll- functions more consistently There is a zoo of `splitForAll-` functions in `GHC.Core.Type` (as well as `tcSplitForAll-` functions in `GHC.Tc.Utils.TcType`) that all do very similar things, but vary in the particular form of type variable that they return. To make things worse, the names of these functions are often quite misleading. Some particularly egregious examples: * `splitForAllTys` returns `TyCoVar`s, but `splitSomeForAllTys` returns `VarBndr`s. * `splitSomeForAllTys` returns `VarBndr`s, but `tcSplitSomeForAllTys` returns `TyVar`s. * `splitForAllTys` returns `TyCoVar`s, but `splitForAllTysInvis` returns `InvisTVBinder`s. (This in particular arose in the context of #18939, and this finally motivated me to bite the bullet and improve the status quo vis-à-vis how we name these functions.) In an attempt to bring some sanity to how these functions are named, I have opted to rename most of these functions en masse to use consistent suffixes that describe the particular form of type variable that each function returns. In concrete terms, this amounts to: * Functions that return a `TyVar` now use the suffix `-TyVar`. This caused the following functions to be renamed: * `splitTyVarForAllTys` -> `splitForAllTyVars` * `splitForAllTy_ty_maybe` -> `splitForAllTyVar_maybe` * `tcSplitForAllTys` -> `tcSplitForAllTyVars` * `tcSplitSomeForAllTys` -> `tcSplitSomeForAllTyVars` * Functions that return a `CoVar` now use the suffix `-CoVar`. This caused the following functions to be renamed: * `splitForAllTy_co_maybe` -> `splitForAllCoVar_maybe` * Functions that return a `TyCoVar` now use the suffix `-TyCoVar`. This caused the following functions to be renamed: * `splitForAllTy` -> `splitForAllTyCoVar` * `splitForAllTys` -> `splitForAllTyCoVars` * `splitForAllTys'` -> `splitForAllTyCoVars'` * `splitForAllTy_maybe` -> `splitForAllTyCoVar_maybe` * Functions that return a `VarBndr` now use the suffix corresponding to the most relevant type synonym. This caused the following functions to be renamed: * `splitForAllVarBndrs` -> `splitForAllTyCoVarBinders` * `splitForAllTysInvis` -> `splitForAllInvisTVBinders` * `splitForAllTysReq` -> `splitForAllReqTVBinders` * `splitSomeForAllTys` -> `splitSomeForAllTyCoVarBndrs` * `tcSplitForAllVarBndrs` -> `tcSplitForAllTyVarBinders` * `tcSplitForAllTysInvis` -> `tcSplitForAllInvisTVBinders` * `tcSplitForAllTysReq` -> `tcSplitForAllReqTVBinders` * `tcSplitForAllTy_maybe` -> `tcSplitForAllTyVarBinder_maybe` Note that I left the following functions alone: * Functions that split apart things besides `ForAllTy`s, such as `splitFunTys` or `splitPiTys`. Thankfully, there are far fewer of these functions than there are functions that split apart `ForAllTy`s, so there isn't much of a pressing need to apply the new naming convention elsewhere. * Functions that split apart `ForAllCo`s in `Coercion`s, such as `GHC.Core.Coercion.splitForAllCo_maybe`. We could theoretically apply the new naming convention here, but then we'd have to figure out how to disambiguate `Type`-splitting functions from `Coercion`-splitting functions. Ultimately, the `Coercion`-splitting functions aren't used nearly as much as the `Type`-splitting functions, so I decided to leave the former alone. This is purely refactoring and should cause no change in behavior. - - - - - 645444af by Ryan Scott at 2020-11-15T03:36:21-05:00 Use tcSplitForAllInvisTyVars (not tcSplitForAllTyVars) in more places The use of `tcSplitForAllTyVars` in `tcDataFamInstHeader` was the immediate cause of #18939, and replacing it with a new `tcSplitForAllInvisTyVars` function (which behaves like `tcSplitForAllTyVars` but only splits invisible type variables) fixes the issue. However, this led me to realize that _most_ uses of `tcSplitForAllTyVars` in GHC really ought to be `tcSplitForAllInvisTyVars` instead. While I was in town, I opted to replace most uses of `tcSplitForAllTys` with `tcSplitForAllTysInvis` to reduce the likelihood of such bugs in the future. I say "most uses" above since there is one notable place where we _do_ want to use `tcSplitForAllTyVars`: in `GHC.Tc.Validity.forAllTyErr`, which produces the "`Illegal polymorphic type`" error message if you try to use a higher-rank `forall` without having `RankNTypes` enabled. Here, we really do want to split all `forall`s, not just invisible ones, or we run the risk of giving an inaccurate error message in the newly added `T18939_Fail` test case. I debated at some length whether I wanted to name the new function `tcSplitForAllInvisTyVars` or `tcSplitForAllTyVarsInvisible`, but in the end, I decided that I liked the former better. For consistency's sake, I opted to rename the existing `splitPiTysInvisible` and `splitPiTysInvisibleN` functions to `splitInvisPiTys` and `splitPiTysInvisN`, respectively, so that they use the same naming convention. As a consequence, this ended up requiring a `haddock` submodule bump. Fixes #18939. - - - - - 8887102f by Moritz Angermann at 2020-11-15T03:36:56-05:00 AArch64/arm64 adjustments This addes the necessary logic to support aarch64 on elf, as well as aarch64 on mach-o, which Apple calls arm64. We change architecture name to AArch64, which is the official arm naming scheme. - - - - - fc644b1a by Ben Gamari at 2020-11-15T03:37:31-05:00 ghc-bin: Build with eventlogging by default We now have all sorts of great facilities using the eventlog which were previously unavailable without building a custom GHC. Fix this by linking with `-eventlog` by default. - - - - - 52114fa0 by Sylvain Henry at 2020-11-16T11:48:47+01:00 Add Addr# atomic primops (#17751) This reuses the codegen used for ByteArray#'s atomic primops. - - - - - 8150f654 by Sebastian Graf at 2020-11-18T23:38:40-05:00 PmCheck: Print types of uncovered patterns (#18932) In order to avoid confusion as in #18932, we display the type of the match variables in the non-exhaustiveness warning, e.g. ``` T18932.hs:14:1: warning: [-Wincomplete-patterns] Pattern match(es) are non-exhaustive In an equation for ‘g’: Patterns of type ‘T a’, ‘T a’, ‘T a’ not matched: (MkT2 _) (MkT1 _) (MkT1 _) (MkT2 _) (MkT1 _) (MkT2 _) (MkT2 _) (MkT2 _) (MkT1 _) (MkT2 _) (MkT2 _) (MkT2 _) ... | 14 | g (MkT1 x) (MkT1 _) (MkT1 _) = x | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ``` It also allows us to omit the type signature on wildcard matches which we previously showed in only some situations, particularly `-XEmptyCase`. Fixes #18932. - - - - - 165352a2 by Krzysztof Gogolewski at 2020-11-20T02:08:36-05:00 Export indexError from GHC.Ix (#18579) - - - - - b57845c3 by Kamil Dworakowski at 2020-11-20T02:09:16-05:00 Clarify interruptible FFI wrt masking state - - - - - 321d1bd8 by Sebastian Graf at 2020-11-20T02:09:51-05:00 Fix strictness signatures of `prefetchValue*#` primops Their strictness signatures said the primops are strict in their first argument, which is wrong: Handing it a thunk will prefetch the pointer to the thunk, but not evaluate it. Hence not strict. The regression test `T8256` actually tests for laziness in the first argument, so GHC apparently never exploited the strictness signature. See also https://gitlab.haskell.org/ghc/ghc/-/issues/8256#note_310867, where this came up. - - - - - 0aec78b6 by Sebastian Graf at 2020-11-20T02:09:51-05:00 Demand: Interleave usage and strictness demands (#18903) As outlined in #18903, interleaving usage and strictness demands not only means a more compact demand representation, but also allows us to express demands that we weren't easily able to express before. Call demands are *relative* in the sense that a call demand `Cn(cd)` on `g` says "`g` is called `n` times. *Whenever `g` is called*, the result is used according to `cd`". Example from #18903: ```hs h :: Int -> Int h m = let g :: Int -> (Int,Int) g 1 = (m, 0) g n = (2 * n, 2 `div` n) {-# NOINLINE g #-} in case m of 1 -> 0 2 -> snd (g m) _ -> uncurry (+) (g m) ``` Without the interleaved representation, we would just get `L` for the strictness demand on `g`. Now we are able to express that whenever `g` is called, its second component is used strictly in denoting `g` by `1C1(P(1P(U),SP(U)))`. This would allow Nested CPR to unbox the division, for example. Fixes #18903. While fixing regressions, I also discovered and fixed #18957. Metric Decrease: T13253-spj - - - - - 3a55b3a2 by Sebastian Graf at 2020-11-20T02:09:51-05:00 Update user's guide entry on demand analysis and worker/wrapper The demand signature notation has been undocumented for a long time. The only source to understand it, apart from reading the `Outputable` instance, has been an outdated wiki page. Since the previous commits have reworked the demand lattice, I took it as an opportunity to also write some documentation about notation. - - - - - fc963932 by Greg Steuck at 2020-11-20T02:10:31-05:00 Find hadrian location more reliably in cabal-install output Fix #18944 - - - - - 9f40cf6c by Ben Gamari at 2020-11-20T02:11:07-05:00 rts/linker: Align bssSize to page size when mapping symbol extras We place symbol_extras right after bss. We also need to ensure that symbol_extras can be mprotect'd independently from the rest of the image. To ensure this we round up the size of bss to a page boundary, thus ensuring that symbol_extras is also page-aligned. - - - - - b739c319 by Ben Gamari at 2020-11-20T02:11:43-05:00 gitlab-ci: Add usage message to ci.sh - - - - - 802e9180 by Ben Gamari at 2020-11-20T02:11:43-05:00 gitlab-ci: Add VERBOSE environment variable And change the make build system's default behavior to V=0, greatly reducing build log sizes. - - - - - 2a8a979c by Ben Gamari at 2020-11-21T01:13:26-05:00 users-guide: A bit of clean-up in profiling flag documentation - - - - - 56804e33 by Ben Gamari at 2020-11-21T01:13:26-05:00 testsuite: Refactor CountParserDeps - - - - - 53ad67ea by Ben Gamari at 2020-11-21T01:13:26-05:00 Introduce -fprof-callers flag This introducing a new compiler flag to provide a convenient way to introduce profiler cost-centers on all occurrences of the named identifier. Closes #18566. - - - - - ecfd0278 by Sylvain Henry at 2020-11-21T01:14:09-05:00 Move Plugins into HscEnv (#17957) Loaded plugins have nothing to do in DynFlags so this patch moves them into HscEnv (session state). "DynFlags plugins" become "Driver plugins" to still be able to register static plugins. Bump haddock submodule - - - - - 72f2257c by Sylvain Henry at 2020-11-21T01:14:09-05:00 Don't initialize plugins in the Core2Core pipeline Some plugins can be added via TH (cf addCorePlugin). Initialize them in the driver instead of in the Core2Core pipeline. - - - - - ddbeeb3c by Ryan Scott at 2020-11-21T01:14:44-05:00 Add regression test for #10504 This issue was fixed at some point between GHC 8.0 and 8.2. Let's add a regression test to ensure that it stays fixed. Fixes #10504. - - - - - a4a6dc2a by Ben Gamari at 2020-11-21T01:15:21-05:00 dwarf: Apply info table offset consistently Previously we failed to apply the info table offset to the aranges and DIEs, meaning that we often failed to unwind in gdb. For some reason this only seemed to manifest in the RTS's Cmm closures. Nevertheless, now we can unwind completely up to `main` - - - - - 69bfbc21 by Ben Gamari at 2020-11-21T01:15:56-05:00 hadrian: Disable stripping when debug information is enabled - - - - - 7e93ae8b by Ben Gamari at 2020-11-21T13:13:29-05:00 rts: Post ticky entry counts to the eventlog We currently only post the entry counters, not the other global counters as in my experience the former are more useful. We use the heap profiler's census period to decide when to dump. Also spruces up the documentation surrounding ticky-ticky a bit. - - - - - bc9c3916 by Ben Gamari at 2020-11-22T06:28:10-05:00 Implement -ddump-c-backend argument To dump output of the C backend. - - - - - 901bc220 by Ben Gamari at 2020-11-22T12:39:02-05:00 Bump time submodule to 1.11.1 Also bumps directory, Cabal, hpc, time, and unix submodules. Closes #18847. - - - - - 92c0afbf by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Dump STG when ticky is enabled This changes the "ticky" modifier to enable dumping of final STG as this is generally needed to make sense of the ticky profiles. - - - - - d23fef68 by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Introduce notion of flavour transformers This extends Hadrian's notion of "flavour", as described in #18942. - - - - - 179d0bec by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Add a viaLlvmBackend modifier Note that this also slightly changes the semantics of these flavours as we only use LLVM for >= stage1 builds. - - - - - d4d95e51 by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Add profiled_ghc and no_dynamic_ghc modifiers - - - - - 6815603f by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Drop redundant flavour definitions Drop the profiled, LLVM, and ThreadSanitizer flavour definitions as these can now be realized with flavour transformers. - - - - - f88f4339 by Ben Gamari at 2020-11-24T02:43:20-05:00 rts: Flush eventlog buffers from flushEventLog As noted in #18043, flushTrace failed flush anything beyond the writer. This means that a significant amount of data sitting in capability-local event buffers may never get flushed, despite the users' pleads for us to flush. Fix this by making flushEventLog flush all of the event buffers before flushing the writer. Fixes #18043. - - - - - 7c03cc50 by Ben Gamari at 2020-11-24T02:43:55-05:00 gitlab-ci: Run LLVM job on appropriately-labelled MRs Namely, those marked with the ~"LLVM backend" label - - - - - 9b95d815 by Ben Gamari at 2020-11-24T02:43:55-05:00 gitlab-ci: Run LLVM builds on Debian 10 The current Debian 9 image doesn't provide LLVM 7. - - - - - 2ed3e6c0 by Ben Gamari at 2020-11-24T02:43:55-05:00 CmmToLlvm: Declare signature for memcmp Otherwise `opt` fails with: error: use of undefined value '@memcmp$def' - - - - - be5d74ca by Moritz Angermann at 2020-11-26T16:00:32-05:00 [Sized Cmm] properly retain sizes. This replaces all Word<N> = W<N># Word# and Int<N> = I<N># Int# with Word<N> = W<N># Word<N># and Int<N> = I<N># Int<N>#, thus providing us with properly sized primitives in the codegenerator instead of pretending they are all full machine words. This came up when implementing darwinpcs for arm64. The darwinpcs reqires us to pack function argugments in excess of registers on the stack. While most procedure call standards (pcs) assume arguments are just passed in 8 byte slots; and thus the caller does not know the exact signature to make the call, darwinpcs requires us to adhere to the prototype, and thus have the correct sizes. If we specify CInt in the FFI call, it should correspond to the C int, and not just be Word sized, when it's only half the size. This does change the expected output of T16402 but the new result is no less correct as it eliminates the narrowing (instead of the `and` as was previously done). Bumps the array, bytestring, text, and binary submodules. Co-Authored-By: Ben Gamari <ben at well-typed.com> Metric Increase: T13701 T14697 - - - - - a84e53f9 by Andreas Klebinger at 2020-11-26T16:00:32-05:00 RTS: Fix failed inlining of copy_tag. On windows using gcc-10 gcc failed to inline copy_tag into evacuate. To fix this we now set the always_inline attribute for the various copy* functions in Evac.c. The main motivation here is not the overhead of the function call, but rather that this allows the code to "specialize" for the size of the closure we copy which is often known at compile time. An earlier commit also tried to avoid evacuate_large inlining. But didn't quite succeed. So I also marked evacuate_large as noinline. Fixes #12416 - - - - - cdbd16f5 by Sylvain Henry at 2020-11-26T16:00:33-05:00 Fix toArgRep to support 64-bit reps on all systems [This is @Ericson2314 writing a commit message for @hsyl20's patch.] (Progress towards #11953, #17377, #17375) `Int64Rep` and `Word64Rep` are currently broken on 64-bit systems. This is because they should use "native arg rep" but instead use "large arg rep" as they do on 32-bit systems, which is either a non-concept or a 128-bit rep depending on one's vantage point. Now, these reps currently aren't used during 64-bit compilation, so the brokenness isn't observed, but I don't think that constitutes reasons not to fix it. Firstly, the linked issues there is a clearly expressed desire to use explicit-bitwidth constructs in more places. Secondly, per [1], there are other bugs that *do* manifest from not threading explicit-bitwidth information all the way through the compilation pipeline. One can therefore view this as one piece of the larger effort to do that, improve ergnomics, and squash remaining bugs. Also, this is needed for !3658. I could just merge this as part of that, but I'm keen on merging fixes "as they are ready" so the fixes that aren't ready are isolated and easier to debug. [1]: https://mail.haskell.org/pipermail/ghc-devs/2020-October/019332.html - - - - - a9378e69 by Tim Barnes at 2020-11-26T16:00:34-05:00 Set dynamic users-guide TOC spacing (fixes #18554) - - - - - 86a59d93 by Ben Gamari at 2020-11-26T16:00:34-05:00 rts: Use RTS_LIKELY in CHECK Most compilers probably already infer that `barf` diverges but it nevertheless doesn't hurt to be explicit. - - - - - 5757e82b by Matthew Pickering at 2020-11-26T16:00:35-05:00 Remove special case for GHC.ByteCode.Instr This was added in https://github.com/nomeata/ghc-heap-view/commit/34935206e51b9c86902481d84d2f368a6fd93423 GHC.ByteCode.Instr.BreakInfo no longer exists so the special case is dead code. Any check like this can be easily dealt with in client code. - - - - - d9c8b5b4 by Matthew Pickering at 2020-11-26T16:00:35-05:00 Split Up getClosureDataFromHeapRep Motivation 1. Don't enforce the repeated decoding of an info table, when the client can cache it (ghc-debug) 2. Allow the constructor information decoding to be overridden, this casues segfaults in ghc-debug - - - - - 3e3555cc by Andreas Klebinger at 2020-11-26T16:00:35-05:00 RegAlloc: Add missing raPlatformfield to RegAllocStatsSpill Fixes #18994 Co-Author: Benjamin Maurer <maurer.benjamin at gmail.com> - - - - - a1a75aa9 by Ben Gamari at 2020-11-27T06:20:41-05:00 rts: Allocate MBlocks with MAP_TOP_DOWN on Windows As noted in #18991, we would previously allocate heap in low memory. Due to this the linker, which typically *needs* low memory, would end up competing with the heap. In longer builds we end up running out of low memory entirely, leading to linking failures. - - - - - 75fc1ed5 by Sylvain Henry at 2020-11-28T15:40:23-05:00 Hadrian: fix detection of ghc-pkg for cross-compilers - - - - - 7cb5df96 by Sylvain Henry at 2020-11-28T15:40:23-05:00 hadrian: fix ghc-pkg uses (#17601) Make sure ghc-pkg doesn't read the compiler "settings" file by passing --no-user-package-db. - - - - - e3fd4226 by Ben Gamari at 2020-11-28T15:40:23-05:00 gitlab-ci: Introduce a nightly cross-compilation job This adds a job to test cross-compilation from x86-64 to AArch64 with Hadrian. Fixes #18234 - - - - - 698d3d96 by Ben Gamari at 2020-11-28T15:41:00-05:00 gitlab-ci: Only deploy GitLab Pages in ghc/ghc> The deployments are quite large and yet are currently only served for the ghc/ghc> project. - - - - - 625726f9 by David Eichmann at 2020-11-28T15:41:37-05:00 ghc-heap: partial TSO/STACK decoding Co-authored-by: Sven Tennie <sven.tennie at gmail.com> Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> Co-authored-by: Ben Gamari <bgamari.foss at gmail.com> - - - - - 22ea9c29 by Andreas Klebinger at 2020-11-28T15:42:13-05:00 Small optimization to CmmSink. Inside `regsUsedIn` we can avoid some thunks by specializing the recursion. In particular we avoid the thunk for `(f e z)` in the MachOp/Load branches, where we know this will evaluate to z. Reduces allocations for T3294 by ~1%. - - - - - bba42c62 by John Ericson at 2020-11-28T15:42:49-05:00 Make primop handler indentation more consistent - - - - - c82bc8e9 by John Ericson at 2020-11-28T15:42:49-05:00 Cleanup some primop constructor names Harmonize the internal (big sum type) names of the native vs fixed-sized number primops a bit. (Mainly by renaming the former.) No user-facing names are changed. - - - - - ae14f160 by Ben Gamari at 2020-11-28T15:43:25-05:00 testsuite: Mark T14702 as fragile on Windows Due to #18953. - - - - - 1bc104b0 by Ben Gamari at 2020-11-29T15:33:18-05:00 withTimings: Emit allocations counter This will allow us to back out the allocations per compiler pass from the eventlog. Note that we dump the allocation counter rather than the difference since this will allow us to determine how much work is done *between* `withTiming` blocks. - - - - - e992ea84 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 ThreadPaused: Don't zero slop until free vars are pushed When threadPaused blackholes a thunk it calls `OVERWRITING_CLOSURE` to zero the slop for the benefit of the sanity checker. Previously this was done *before* pushing the thunk's free variables to the update remembered set. Consequently we would pull zero'd pointers to the update remembered set. - - - - - e82cd140 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Fix regression from TSAN work The TSAN rework (specifically aad1f803) introduced a subtle regression in GC.c, swapping `g0` in place of `gen`. Whoops! Fixes #18997. - - - - - 35a5207e by GHC GitLab CI at 2020-11-29T15:33:54-05:00 rts/Messages: Add missing write barrier in THROWTO message update After a THROWTO message has been handle the message closure is overwritten by a NULL message. We must ensure that the original closure's pointers continue to be visible to the nonmoving GC. - - - - - 0120829f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Add missing write barrier in shrinkSmallByteArray - - - - - 8a4d8fb6 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 Updates: Don't zero slop until closure has been pushed Ensure that the the free variables have been pushed to the update remembered set before we zero the slop. - - - - - 2793cfdc by GHC GitLab CI at 2020-11-29T15:33:54-05:00 OSThreads: Fix error code checking pthread_join returns its error code and apparently doesn't set errno. - - - - - e391a16f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Don't join to mark_thread on shutdown The mark thread is not joinable as we detach from it on creation. - - - - - 60d088ab by Ben Gamari at 2020-11-29T15:33:54-05:00 nonmoving: Add reference to Ueno 2016 - - - - - 3aa60362 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Ensure that evacuated large objects are marked See Note [Non-moving GC: Marking evacuated objects]. - - - - - 8d304a99 by Ben Gamari at 2020-11-30T10:15:22-05:00 rts/m32: Refactor handling of allocator seeding Previously, in an attempt to reduce fragmentation, each new allocator would map a region of M32_MAX_PAGES fresh pages to seed itself. However, this ends up being extremely wasteful since it turns out that we often use fewer than this. Consequently, these pages end up getting freed which, ends up fragmenting our address space more than than we would have if we had naively allocated pages on-demand. Here we refactor m32 to avoid this waste while achieving the fragmentation mitigation previously desired. In particular, we move all page allocation into the global m32_alloc_page, which will pull a page from the free page pool. If the free page pool is empty we then refill it by allocating a region of M32_MAP_PAGES and adding them to the pool. Furthermore, we do away with the initial seeding entirely. That is, the allocator starts with no active pages: pages are rather allocated on an as-needed basis. On the whole this ends up being a pleasingly simple change, simultaneously making m32 more efficient, more robust, and simpler. Fixes #18980. - - - - - b6629289 by Ben Gamari at 2020-11-30T10:15:58-05:00 rts: Use CHECK instead of assert Use the GHC wrappers instead of <assert.h>. - - - - - 9f4efa6a by Ben Gamari at 2020-11-30T10:15:58-05:00 rts/linker: Replace some ASSERTs with CHECK In the past some people have confused ASSERT, which is for checking internal invariants, which CHECK, which should be used when checking things that might fail due to bad input (and therefore should be enabled even in the release compiler). Change some of these cases in the linker to use CHECK. - - - - - 0f8a4655 by Ryan Scott at 2020-11-30T10:16:34-05:00 Allow deploy:pages job to fail See #18973. - - - - - 49ebe369 by chessai at 2020-11-30T19:47:40-05:00 Optimisations in Data.Foldable (T17867) This PR concerns the following functions from `Data.Foldable`: * minimum * maximum * sum * product * minimumBy * maximumBy - Default implementations of these functions now use `foldl'` or `foldMap'`. - All have been marked with INLINEABLE to make room for further optimisations. - - - - - 4d79ef65 by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - 6af074ce by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - ab334262 by Viktor Dukhovni at 2020-11-30T19:48:17-05:00 dirty MVAR after mutating TSO queue head While the original head and tail of the TSO queue may be in the same generation as the MVAR, interior elements of the queue could be younger after a GC run and may then be exposed by putMVar operation that updates the queue head. Resolves #18919 - - - - - 5eb163f3 by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Don't allow shared libraries to be loaded multiple times - - - - - 490aa14d by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Initialise CCSs from native shared objects - - - - - 6ac3db5f by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Move shared library loading logic into Elf.c - - - - - b6698d73 by GHC GitLab CI at 2020-11-30T19:48:53-05:00 rts/linker: Don't declare dynamic objects with image_mapped This previously resulted in warnings due to spurious unmap failures. - - - - - b94a65af by jneira at 2020-11-30T19:49:31-05:00 Include tried paths in findToolDir error - - - - - 72a87fbc by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Move core flattening algorithm to Core.Unify This sets the stage for a later change, where this algorithm will be needed from GHC.Core.InstEnv. This commit also splits GHC.Core.Map into GHC.Core.Map.Type and GHC.Core.Map.Expr, in order to avoid module import cycles with GHC.Core. - - - - - 0dd45d0a by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Bump the # of commits searched for perf baseline The previous value of 75 meant that a feature branch with more than 75 commits would get spurious CI passes. This affects #18692, but does not fix that ticket, because if a baseline cannot be found, we should fail, not succeed. - - - - - 8bb52d91 by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Remove flattening variables This patch redesigns the flattener to simplify type family applications directly instead of using flattening meta-variables and skolems. The key new innovation is the CanEqLHS type and the new CEqCan constraint (Ct). A CanEqLHS is either a type variable or exactly-saturated type family application; either can now be rewritten using a CEqCan constraint in the inert set. Because the flattener no longer reduces all type family applications to variables, there was some performance degradation if a lengthy type family application is now flattened over and over (not making progress). To compensate, this patch contains some extra optimizations in the flattener, leading to a number of performance improvements. Close #18875. Close #18910. There are many extra parts of the compiler that had to be affected in writing this patch: * The family-application cache (formerly the flat-cache) sometimes stores coercions built from Given inerts. When these inerts get kicked out, we must kick out from the cache as well. (This was, I believe, true previously, but somehow never caused trouble.) Kicking out from the cache requires adding a filterTM function to TrieMap. * This patch obviates the need to distinguish "blocking" coercion holes from non-blocking ones (which, previously, arose from CFunEqCans). There is thus some simplification around coercion holes. * Extra commentary throughout parts of the code I read through, to preserve the knowledge I gained while working. * A change in the pure unifier around unifying skolems with other types. Unifying a skolem now leads to SurelyApart, not MaybeApart, as documented in Note [Binding when looking up instances] in GHC.Core.InstEnv. * Some more use of MCoercion where appropriate. * Previously, class-instance lookup automatically noticed that e.g. C Int was a "unifier" to a target [W] C (F Bool), because the F Bool was flattened to a variable. Now, a little more care must be taken around checking for unifying instances. * Previously, tcSplitTyConApp_maybe would split (Eq a => a). This is silly, because (=>) is not a tycon in Haskell. Fixed now, but there are some knock-on changes in e.g. TrieMap code and in the canonicaliser. * New function anyFreeVarsOf{Type,Co} to check whether a free variable satisfies a certain predicate. * Type synonyms now remember whether or not they are "forgetful"; a forgetful synonym drops at least one argument. This is useful when flattening; see flattenView. * The pattern-match completeness checker invokes the solver. This invocation might need to look through newtypes when checking representational equality. Thus, the desugarer needs to keep track of the in-scope variables to know what newtype constructors are in scope. I bet this bug was around before but never noticed. * Extra-constraints wildcards are no longer simplified before printing. See Note [Do not simplify ConstraintHoles] in GHC.Tc.Solver. * Whether or not there are Given equalities has become slightly subtler. See the new HasGivenEqs datatype. * Note [Type variable cycles in Givens] in GHC.Tc.Solver.Canonical explains a significant new wrinkle in the new approach. * See Note [What might match later?] in GHC.Tc.Solver.Interact, which explains the fix to #18910. * The inert_count field of InertCans wasn't actually used, so I removed it. Though I (Richard) did the implementation, Simon PJ was very involved in design and review. This updates the Haddock submodule to avoid #18932 by adding a type signature. ------------------------- Metric Decrease: T12227 T5030 T9872a T9872b T9872c Metric Increase: T9872d ------------------------- - - - - - d66660ba by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Rename the flattener to become the rewriter. Now that flattening doesn't produce flattening variables, it's not really flattening anything: it's rewriting. This change also means that the rewriter can no longer be confused the core flattener (in GHC.Core.Unify), which is sometimes used during type-checking. - - - - - add0aeae by Ben Gamari at 2020-12-01T19:58:17-05:00 rts: Introduce mmapAnonForLinker Previously most of the uses of mmapForLinker were mapping anonymous memory, resulting in a great deal of unnecessary repetition. Factor this out into a new helper. Also fixes a few places where error checking was missing or suboptimal. - - - - - 97d71646 by Ben Gamari at 2020-12-01T19:58:17-05:00 rts/linker: Introduce munmapForLinker Consolidates munmap calls to ensure consistent error handling. - - - - - d8872af0 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/Linker: Introduce Windows implementations for mmapForLinker, et al. - - - - - c35d0e03 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/m32: Introduce NEEDS_M32 macro Instead of relying on RTS_LINKER_USE_MMAP - - - - - 41c64eb5 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/linker: Use m32 to allocate symbol extras in PEi386 - - - - - e0b08c5f by Ben Gamari at 2020-12-03T13:01:47-05:00 gitlab-ci: Fix copy-paste error Also be more consistent in quoting. - - - - - 33ec3a06 by Ben Gamari at 2020-12-03T23:11:31-05:00 gitlab-ci: Run linters through ci.sh Ensuring that the right toolchain is used. - - - - - 4a437bc1 by Shayne Fletcher at 2020-12-05T09:06:38-05:00 Fix bad span calculations of post qualified imports - - - - - 8fac4b93 by Ben Gamari at 2020-12-05T09:07:13-05:00 testsuite: Add a test for #18923 - - - - - 62ed6957 by Simon Peyton Jones at 2020-12-08T15:31:41-05:00 Fix kind inference for data types. Again. This patch fixes several aspects of kind inference for data type declarations, especially data /instance/ declarations Specifically 1. In kcConDecls/kcConDecl make it clear that the tc_res_kind argument is only used in the H98 case; and in that case there is no result kind signature; and hence no need for the disgusting splitPiTys in kcConDecls (now thankfully gone). The GADT case is a bit different to before, and much nicer. This is what fixes #18891. See Note [kcConDecls: kind-checking data type decls] 2. Do not look at the constructor decls of a data/newtype instance in tcDataFamInstanceHeader. See GHC.Tc.TyCl.Instance Note [Kind inference for data family instances]. This was a new realisation that arose when doing (1) This causes a few knock-on effects in the tests suite, because we require more information than before in the instance /header/. New user-manual material about this in "Kind inference in data type declarations" and "Kind inference for data/newtype instance declarations". 3. Minor improvement in kcTyClDecl, combining GADT and H98 cases 4. Fix #14111 and #8707 by allowing the header of a data instance to affect kind inferece for the the data constructor signatures; as described at length in Note [GADT return types] in GHC.Tc.TyCl This led to a modest refactoring of the arguments (and argument order) of tcConDecl/tcConDecls. 5. Fix #19000 by inverting the sense of the test in new_locs in GHC.Tc.Solver.Canonical.canDecomposableTyConAppOK. - - - - - 0abe3ddf by Adam Sandberg Ericsson at 2020-12-08T15:32:19-05:00 hadrian: build the _l and _thr_l rts flavours in the develN flavours The ghc binary requires the eventlog rts since fc644b1a643128041cfec25db84e417851e28bab - - - - - 51e3bb6d by Andreas Klebinger at 2020-12-08T22:43:21-05:00 CodeGen: Make folds User/DefinerOfRegs INLINEABLE. Reduces allocation for the test case I was looking at by about 1.2%. Mostly from avoiding allocation of some folding functions which turn into let-no-escape bindings which just reuse their environment instead. We also force inlining in a few key places in CmmSink which helps a bit more. - - - - - 69ae10c3 by Andreas Klebinger at 2020-12-08T22:43:21-05:00 CmmSink: Force inlining of foldRegsDefd Helps avoid allocating the folding function. Improves perf for T3294 by about 1%. - - - - - 6e3da800 by Andreas Klebinger at 2020-12-08T22:43:21-05:00 Cmm: Make a few types and utility function slightly stricter. About 0.6% reduction in allocations for the code I was looking at. Not a huge difference but no need to throw away performance. - - - - - aef44d7f by Andreas Klebinger at 2020-12-08T22:43:21-05:00 Cmm.Sink: Optimize retaining of assignments, live sets. Sinking requires us to track live local regs after each cmm statement. We used to do this via "Set LocalReg". However we can replace this with a solution based on IntSet which is overall more efficient without losing much. The thing we lose is width of the variables, which isn't used by the sinking pass anyway. I also reworked how we keep assignments to regs mentioned in skipped assignments. I put the details into Note [Keeping assignemnts mentioned in skipped RHSs]. The gist of it is instead of keeping track of it via the use count which is a `IntMap Int` we now use the live regs set (IntSet) which is quite a bit faster. I think it also matches the semantics a lot better. The skipped (not discarded) assignment does in fact keep the regs on it's rhs alive so keeping track of this in the live set seems like the clearer solution as well. Improves allocations for T3294 by yet another 1%. - - - - - 59f2249b by Andreas Klebinger at 2020-12-08T22:43:21-05:00 GHC.Cmm.Opt: Be stricter in results. Optimization either returns Nothing if nothing is to be done or `Just <cmmExpr>` otherwise. There is no point in being lazy in `cmmExpr`. We usually inspect this element so the thunk gets forced not long after. We might eliminate it as dead code once in a blue moon but that's not a case worth optimizing for. Overall the impact of this is rather low. As Cmm.Opt doesn't allocate much (compared to the rest of GHC) to begin with. - - - - - 54b88eac by Andreas Klebinger at 2020-12-08T22:43:57-05:00 Bump time submodule. This should fix #19002. - - - - - 35e7b0c6 by Kirill Elagin at 2020-12-10T01:45:54-05:00 doc: Clarify the default for -fomit-yields “Yield points enabled” is confusing (and probably wrong? I am not 100% sure what it means). Change it to a simple “on”. Undo this change from 2c23fff2e03e77187dc4d01f325f5f43a0e7cad2. - - - - - 3551c554 by Kirill Elagin at 2020-12-10T01:45:54-05:00 doc: Extra-clarify -fomit-yields Be more clear on what this optimisation being on by default means in terms of yields. - - - - - 6484f0d7 by Sergei Trofimovich at 2020-12-10T01:46:33-05:00 rts/linker/Elf.c: add missing <dlfcn.h> include (musl support) The change fixes build failure on musl: ``` rts/linker/Elf.c:2031:3: error: warning: implicit declaration of function 'dlclose'; did you mean 'close'? [-Wimplicit-function-declaration] 2031 | dlclose(nc->dlopen_handle); | ^~~~~~~ | close ``` Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - ab24ed9b by Ben Gamari at 2020-12-11T03:55:51-05:00 users guide: Fix syntax errors Fixes errors introduced by 3a55b3a2574f913d046f3a6f82db48d7f6df32e3. - - - - - d3a24d31 by Ben Gamari at 2020-12-11T03:55:51-05:00 users guide: Describe GC lifecycle events Every time I am asked about how to interpret these events I need to figure it out from scratch. It's well past time that the users guide properly documents these. - - - - - 741309b9 by Ben Gamari at 2020-12-11T03:56:27-05:00 gitlab-ci: Fix incorrect Docker image for nightly cross job Also refactor the job definition to eliminate the bug by construction. - - - - - 19703bc8 by Ben Gamari at 2020-12-11T03:56:27-05:00 gitlab-ci: Fix name of flavour in ThreadSanitizer job It looks like I neglected to update this after introduce flavour transformers. - - - - - 381eb660 by Sylvain Henry at 2020-12-11T12:57:35-05:00 Display FFI labels (fix #18539) - - - - - 4548d1f8 by Aaron Allen at 2020-12-11T12:58:14-05:00 Elide extraneous messages for :doc command (#15784) Do not print `<has no documentation>` alongside a valid doc. Additionally, if two matching symbols lack documentation then the message will only be printed once. Hence, `<has no documentation>` will be printed at most once and only if all matching symbols are lacking docs. - - - - - 5eba91b6 by Aaron Allen at 2020-12-11T12:58:14-05:00 Add :doc test case for duplicate record fields Tests that the output of the `:doc` command is correct for duplicate record fields defined using -XDuplicateRecordFields. - - - - - 5feb9b2d by Ryan Scott at 2020-12-11T22:39:29-05:00 Delete outdated Note [Kind-checking tyvar binders for associated types] This Note has severely bitrotted, as it has no references anywhere in the codebase, and none of the functions that it mentions exist anymore. Let's just delete this. While I was in town, I deleted some outdated comments from `checkFamPatBinders` of a similar caliber. Fixes #19008. [ci skip] - - - - - f9f9f030 by Sylvain Henry at 2020-12-11T22:40:08-05:00 Arrows: correctly query arrow methods (#17423) Consider the following code: proc (C x y) -> ... Before this patch, the evidence binding for the Arrow dictionary was attached to the C pattern: proc (C x y) { $dArrow = ... } -> ... But then when we desugar this, we use arrow operations ("arr", ">>>"...) specialised for this arrow: let arr_xy = arr $dArrow -- <-- Not in scope! ... in arr_xy (\(C x y) { $dArrow = ... } -> ...) This patch allows arrow operations to be type-checked before the proc itself, avoiding this issue. Fix #17423 - - - - - aaa8f00f by Sylvain Henry at 2020-12-11T22:40:48-05:00 Validate script: fix configure command when using stack - - - - - b4a929a1 by Sylvain Henry at 2020-12-11T22:41:30-05:00 Hadrian: fix libffi tarball parsing Fix parsing of "libffi-3.3.tar.gz". NB: switch to a newer libffi isn't done in this patch - - - - - 690c8946 by Sylvain Henry at 2020-12-11T22:42:09-05:00 Parser: move parser utils into their own module Move code unrelated to runtime evaluation out of GHC.Runtime.Eval - - - - - 76be0e32 by Sylvain Henry at 2020-12-11T22:42:48-05:00 Move SizedSeq into ghc-boot - - - - - 3a16d764 by Sylvain Henry at 2020-12-11T22:42:48-05:00 ghci: don't compile unneeded modules - - - - - 2895fa60 by Sylvain Henry at 2020-12-11T22:42:48-05:00 ghci: reuse Arch from ghc-boot - - - - - 480a38d4 by Sylvain Henry at 2020-12-11T22:43:30-05:00 rts: don't use siginterrupt (#19019) - - - - - 4af6126d by Sylvain Henry at 2020-12-11T22:44:11-05:00 Use static array in zeroCount - - - - - 5bd71bfd by Sebastian Graf at 2020-12-12T04:45:09-05:00 DmdAnal: Annotate top-level function bindings with demands (#18894) It's useful to annotate a non-exported top-level function like `g` in ```hs module Lib (h) where g :: Int -> Int -> (Int,Int) g m 1 = (m, 0) g m n = (2 * m, 2 `div` n) {-# NOINLINE g #-} h :: Int -> Int h 1 = 0 h m | odd m = snd (g m 2) | otherwise = uncurry (+) (g 2 m) ``` with its demand `UCU(CS(P(1P(U),SP(U))`, which tells us that whenever `g` was called, the second component of the returned pair was evaluated strictly. Since #18903 we do so for local functions, where we can see all calls. For top-level functions, we can assume that all *exported* functions are demanded according to `topDmd` and thus get sound demands for non-exported top-level functions. The demand on `g` is crucial information for Nested CPR, which may the go on and unbox `g` for the second pair component. That is true even if that pair component may diverge, as is the case for the call site `g 13 0`, which throws a div-by-zero exception. In `T18894b`, you can even see the new demand annotation enabling us to eta-expand a function that we wouldn't be able to eta-expand without Call Arity. We only track bindings of function type in order not to risk huge compile-time regressions, see `isInterestingTopLevelFn`. There was a CoreLint check that rejected strict demand annotations on recursive or top-level bindings, which seems completely unjustified. All the cases I investigated were fine, so I removed it. Fixes #18894. - - - - - 3aae036e by Sebastian Graf at 2020-12-12T04:45:09-05:00 Demand: Simplify `CU(U)` to `U` (#19005) Both sub-demands encode the same information. This is a trivial change and already affects a few regression tests (e.g. `T5075`), so no separate regression test is necessary. - - - - - c6477639 by Adam Sandberg Ericsson at 2020-12-12T04:45:48-05:00 hadrian: correctly copy the docs dir into the bindist #18669 - - - - - e033dd05 by Adam Sandberg Ericsson at 2020-12-12T10:52:19+00:00 mkDocs: support hadrian bindists #18973 - - - - - 78580ba3 by John Ericson at 2020-12-13T07:14:50-05:00 Remove old .travis.yml - - - - - c696bb2f by Cale Gibbard at 2020-12-14T13:37:09-05:00 Implement type applications in patterns The haddock submodule is also updated so that it understands the changes to patterns. - - - - - 7e9debd4 by Ben Gamari at 2020-12-14T13:37:09-05:00 Optimise nullary type constructor usage During the compilation of programs GHC very frequently deals with the `Type` type, which is a synonym of `TYPE 'LiftedRep`. This patch teaches GHC to avoid expanding the `Type` synonym (and other nullary type synonyms) during type comparisons, saving a good amount of work. This optimisation is described in `Note [Comparing nullary type synonyms]`. To maximize the impact of this optimisation, we introduce a few special-cases to reduce `TYPE 'LiftedRep` to `Type`. See `Note [Prefer Type over TYPE 'LiftedPtrRep]`. Closes #17958. Metric Decrease: T18698b T1969 T12227 T12545 T12707 T14683 T3064 T5631 T5642 T9020 T9630 T9872a T13035 haddock.Cabal haddock.base - - - - - 92377c27 by Ben Gamari at 2020-12-14T13:41:58-05:00 Revert "Optimise nullary type constructor usage" This was inadvertently merged. This reverts commit 7e9debd4ceb068effe8ac81892d2cabcb8f55850. - - - - - d0e8c10d by Sylvain Henry at 2020-12-14T19:45:13+01:00 Move Unit related fields from DynFlags to HscEnv The unit database cache, the home unit and the unit state were stored in DynFlags while they ought to be stored in the compiler session state (HscEnv). This patch fixes this. It introduces a new UnitEnv type that should be used in the future to handle separate unit environments (especially host vs target units). Related to #17957 Bump haddock submodule - - - - - af855ac1 by Andreas Klebinger at 2020-12-14T15:22:13-05:00 Optimize dumping of consecutive whitespace. The naive way of putting out n characters of indent would be something like `hPutStr hdl (replicate n ' ')`. However this is quite inefficient as we allocate an absurd number of strings consisting of simply spaces as we don't cache them. To improve on this we now track if we can simply write ascii spaces via hPutBuf instead. This is the case when running with -ddump-to-file where we force the encoding to be UTF8. This avoids both the cost of going through encoding as well as avoiding allocation churn from all the white space. Instead we simply use hPutBuf on a preallocated unlifted string. When dumping stg like this: > nofib/spectral/simple/Main.hs -fforce-recomp -ddump-stg-final -ddump-to-file -c +RTS -s Allocations went from 1,778 MB to 1,702MB. About a 4% reduction of allocation! I did not measure the difference in runtime but expect it to be similar. Bumps the haddock submodule since the interface of GHC's Pretty slightly changed. ------------------------- Metric Decrease: T12227 ------------------------- - - - - - dad87210 by Ben Gamari at 2020-12-14T15:22:29-05:00 Optimise nullary type constructor usage During the compilation of programs GHC very frequently deals with the `Type` type, which is a synonym of `TYPE 'LiftedRep`. This patch teaches GHC to avoid expanding the `Type` synonym (and other nullary type synonyms) during type comparisons, saving a good amount of work. This optimisation is described in `Note [Comparing nullary type synonyms]`. To maximize the impact of this optimisation, we introduce a few special-cases to reduce `TYPE 'LiftedRep` to `Type`. See `Note [Prefer Type over TYPE 'LiftedPtrRep]`. Closes #17958. Metric Decrease: T18698b T1969 T12227 T12545 T12707 T14683 T3064 T5631 T5642 T9020 T9630 T9872a T13035 haddock.Cabal haddock.base - - - - - 6c2eb223 by Andrew Martin at 2020-12-14T18:48:51-05:00 Implement BoxedRep proposal This implements the BoxedRep proposal, refacoring the `RuntimeRep` hierarchy from: ```haskell data RuntimeRep = LiftedPtrRep | UnliftedPtrRep | ... ``` to ```haskell data RuntimeRep = BoxedRep Levity | ... data Levity = Lifted | Unlifted ``` Closes #17526. - - - - - 3ee696cc by Sebastian Graf at 2020-12-15T10:53:31-05:00 Add regression test for #19053 - - - - - 535dae66 by Ben Gamari at 2020-12-15T10:53:58-05:00 testsuite: Mark divbyzero, derefnull as fragile Due to #18548. - - - - - 331f5568 by Ben Gamari at 2020-12-15T11:21:06-05:00 Revert "Implement BoxedRep proposal" This was inadvertently merged. This reverts commit 6c2eb2232b39ff4720fda0a4a009fb6afbc9dcea. - - - - - 50fae07d by Ben Gamari at 2020-12-15T15:15:16-05:00 Roll-back broken haddock commit Updates haddock submodule to revert a commit that does not build. - - - - - e9b18a75 by Ben Gamari at 2020-12-15T15:55:38-05:00 Revert haddock submodule yet again - - - - - b58cb63a by GHC GitLab CI at 2020-12-16T03:46:31+00:00 Bump haddock submodule To adapt haddock for the nullary tyconapp optimisation patch. - - - - - 1302e5ee by Ben Gamari at 2020-12-16T15:01:12-05:00 testsuite: Fix two shell quoting issues Fixes two ancient bugs in the testsuite driver makefiles due to insufficient quoting. I have no idea how these went unnoticed for so long. Thanks to @tomjaguarpaw for testing. - - - - - 15 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - + .gitlab/common.sh - .gitlab/linters/check-cpp.py - .gitlab/test-metrics.sh - .gitmodules - − .travis.yml - CODEOWNERS - Makefile - README.md - aclocal.m4 - + compiler/.hlint.yaml - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8afa32b87cfad193d25183bd0b95127733ae7504...1302e5ee764209273bad061a0c811e961cc50ed0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8afa32b87cfad193d25183bd0b95127733ae7504...1302e5ee764209273bad061a0c811e961cc50ed0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 16 20:05:54 2020 From: gitlab at gitlab.haskell.org (Richard Eisenberg) Date: Wed, 16 Dec 2020 15:05:54 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/cite-kind-inference Message-ID: <5fda68a2f3486_6b218662044197966f@gitlab.mail> Richard Eisenberg pushed new branch wip/cite-kind-inference at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/cite-kind-inference You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 16 20:38:03 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 16 Dec 2020 15:38:03 -0500 Subject: [Git][ghc/ghc][wip/boxed-rep] 3 commits: Revert haddock submodule yet again Message-ID: <5fda702b86ec5_6b2174471c1985867@gitlab.mail> Ben Gamari pushed to branch wip/boxed-rep at Glasgow Haskell Compiler / GHC Commits: e9b18a75 by Ben Gamari at 2020-12-15T15:55:38-05:00 Revert haddock submodule yet again - - - - - b58cb63a by GHC GitLab CI at 2020-12-16T03:46:31+00:00 Bump haddock submodule To adapt haddock for the nullary tyconapp optimisation patch. - - - - - 26c9f7a0 by Andrew Martin at 2020-12-16T15:36:28-05:00 Implement BoxedRep proposal This implements the BoxedRep proposal, refacoring the `RuntimeRep` hierarchy from: ```haskell data RuntimeRep = LiftedPtrRep | UnliftedPtrRep | ... ``` to ```haskell data RuntimeRep = BoxedRep Levity | ... data Levity = Lifted | Unlifted ``` Updates binary, haddock submodules. Closes #17526. - - - - - 30 changed files: - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Instance/Typeable.hs - compiler/GHC/Types/RepType.hs - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/Binary/Typeable.hs - docs/users_guide/9.2.1-notes.rst - docs/users_guide/exts/levity_polymorphism.rst - docs/users_guide/exts/typed_holes.rst - libraries/base/Data/Typeable.hs - libraries/base/Data/Typeable/Internal.hs - libraries/base/GHC/Enum.hs - libraries/base/GHC/Exts.hs - libraries/base/GHC/Show.hs - libraries/base/Unsafe/Coerce.hs - libraries/base/tests/T11334a.hs - libraries/base/tests/T11334a.stdout - libraries/binary - libraries/ghc-heap/GHC/Exts/Heap.hs - libraries/ghc-heap/tests/ClosureSizeUtils.hs - libraries/ghc-prim/GHC/Types.hs - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - testsuite/tests/backpack/should_run/T13955.bkp The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cafd4c7b7a0a77de717942fdc38a491810b96455...26c9f7a0cecc731afe9fb74e8fa6ecd9715779f4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cafd4c7b7a0a77de717942fdc38a491810b96455...26c9f7a0cecc731afe9fb74e8fa6ecd9715779f4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 16 20:47:23 2020 From: gitlab at gitlab.haskell.org (David Eichmann) Date: Wed, 16 Dec 2020 15:47:23 -0500 Subject: [Git][ghc/ghc][wip/T19078] 2 commits: rts/eventlog: Fix erroneous marker on restarting logging Message-ID: <5fda725b9427_6b2150168501988153@gitlab.mail> David Eichmann pushed to branch wip/T19078 at Glasgow Haskell Compiler / GHC Commits: 0515b269 by Ben Gamari at 2020-12-16T20:43:51+00:00 rts/eventlog: Fix erroneous marker on restarting logging Previously calling endEventLogging() followed by startEventLogging() would produce an invalid eventlog due to an erroneous block markers left over in the header used to push the headers. Here we fix this by clarifying the invariants surrounding the eventlog buffers and ensuring that the buffers are cleared when we finish logging. Fixes #19078. - - - - - 3bbaf0e1 by David Eichmann at 2020-12-16T20:43:58+00:00 Test start/endEventlogging: first header must be EVENT_HEADER_BEGIN - - - - - 5 changed files: - rts/eventlog/EventLog.c - + testsuite/tests/rts/RestartEventLogging.hs - + testsuite/tests/rts/RestartEventLogging.stdout - + testsuite/tests/rts/RestartEventLogging_c.c - testsuite/tests/rts/all.T Changes: ===================================== rts/eventlog/EventLog.c ===================================== @@ -579,11 +579,19 @@ eventLogStatus(void) } } +/* + * Preconditions: + * - initEventLogging has been called + * - all buffers are empty + * + * N.B. the eventlog format requires that the header not be preceded by a block marker. + * c.f. #19078. + */ static bool startEventLogging_(void) { initEventLogWriter(); - + ASSERT(eventBuf.begin == eventBuf.pos); postHeaderEvents(); // Flush capEventBuf with header. @@ -594,7 +602,9 @@ startEventLogging_(void) printAndClearEventBuf(&eventBuf); for (uint32_t c = 0; c < get_n_capabilities(); ++c) { - postBlockMarker(&capEventBuf[c]); + EventsBuf *eb = &capEventBuf[c]; + ASSERT(eb->begin == eb->pos); // buffers must be empty + postBlockMarker(eb); } return true; } @@ -632,6 +642,7 @@ endEventLogging(void) // Flush all events remaining in the buffers. for (uint32_t c = 0; c < n_capabilities; ++c) { printAndClearEventBuf(&capEventBuf[c]); + resetEventsBuf(&capEventBuf[c]); } printAndClearEventBuf(&eventBuf); resetEventsBuf(&eventBuf); // we don't want the block marker @@ -642,6 +653,9 @@ endEventLogging(void) // Flush the end of data marker. printAndClearEventBuf(&eventBuf); + // Ensure the buffer is clear in case we later restart logging + resetEventsBuf(&eventBuf); + stopEventLogWriter(); event_log_writer = NULL; eventlog_enabled = false; ===================================== testsuite/tests/rts/RestartEventLogging.hs ===================================== @@ -0,0 +1,13 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +import System.IO + +-- Test that the start/end/restartEventLog interface works as expected. +main :: IO () +main = do + putStrLn "Restarting eventlog..." + hFlush stdout + c_restart_eventlog + +foreign import ccall unsafe "c_restart_eventlog" + c_restart_eventlog :: IO () ===================================== testsuite/tests/rts/RestartEventLogging.stdout ===================================== @@ -0,0 +1,22 @@ +Restarting eventlog... +init +Event log started with EVENT_HEADER_BEGIN +write +write +write +write +stop +init +Event log started with EVENT_HEADER_BEGIN +write +write +write +write +stop +init +Event log started with EVENT_HEADER_BEGIN +write +write +write +write +stop ===================================== testsuite/tests/rts/RestartEventLogging_c.c ===================================== @@ -0,0 +1,69 @@ +#include +#include +#include + +#define STOPPED 0 +#define STARTED 1 +#define WRITTEN 2 + +static int32_t state = STOPPED; + +void test_init(void) { + if (state != STOPPED) { + printf("test_init was not called first or directly after test_stop\n"); + } + + state = STARTED; + printf("init\n"); + fflush(stdout); +} + +bool test_write(void *eventlog, size_t eventlog_size) { + if (state == STOPPED) { + printf("test_init was not called\n"); + } + if (state == STARTED) { + // Note that the order of bytes is reversed compared with EVENT_HEADER_BEGIN + int32_t header = *((int32_t *)eventlog); + if (header != 0x62726468) { + printf("ERROR: event does not start with EVENT_HEADER_BEGIN\n"); + } + else { + printf("Event log started with EVENT_HEADER_BEGIN\n"); + } + } + + state = WRITTEN; + + printf("write\n"); + fflush(stdout); + return true; +} + +void test_flush(void) { + printf("flush\n"); + fflush(stdout); +} + +void test_stop(void) { + state = STOPPED; + printf("stop\n"); + fflush(stdout); +} + +const EventLogWriter writer = { + .initEventLogWriter = test_init, + .writeEventLog = test_write, + .flushEventLog = test_flush, + .stopEventLogWriter = test_stop +}; + +void c_restart_eventlog(void) { + for (int i = 0; i < 3; i++) { + if (!startEventLogging(&writer)) { + printf("failed to start eventlog\n"); + } + endEventLogging(); + } +} + ===================================== testsuite/tests/rts/all.T ===================================== @@ -419,6 +419,9 @@ test('T13676', test('InitEventLogging', [only_ways(['normal']), extra_run_opts('+RTS -RTS')], compile_and_run, ['-eventlog InitEventLogging_c.c']) +test('RestartEventLogging', + [only_ways(['normal']), extra_run_opts('+RTS -RTS')], + compile_and_run, ['-eventlog RestartEventLogging_c.c']) test('T17088', [only_ways(['normal']), extra_run_opts('+RTS -c -A256k -RTS')], View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d2dfb7b918cc49df021c56fffce79c372045b862...3bbaf0e1b0bac4f9074fc5fbdc9e42f15fa6d984 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d2dfb7b918cc49df021c56fffce79c372045b862...3bbaf0e1b0bac4f9074fc5fbdc9e42f15fa6d984 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 16 21:36:18 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 16 Dec 2020 16:36:18 -0500 Subject: [Git][ghc/ghc][wip/T18995] 2 commits: Bump haddock submodule Message-ID: <5fda7dd2d2c82_6b217c5d454200172b@gitlab.mail> Ben Gamari pushed to branch wip/T18995 at Glasgow Haskell Compiler / GHC Commits: b58cb63a by GHC GitLab CI at 2020-12-16T03:46:31+00:00 Bump haddock submodule To adapt haddock for the nullary tyconapp optimisation patch. - - - - - 92134ab6 by Simon Peyton Jones at 2020-12-16T16:36:16-05:00 Make noinline more reliable This patch makes the desugarer rewrite noinline (f d) --> noinline f d This makes 'noinline' much more reliable: see #18995 It's explained in the improved Note [noinlineId magic] in GHC.Types.Id.Make - - - - - 7 changed files: - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Types/Id/Make.hs - + testsuite/tests/simplCore/should_compile/T18995.hs - + testsuite/tests/simplCore/should_compile/T18995.stderr - testsuite/tests/simplCore/should_compile/all.T - utils/haddock Changes: ===================================== compiler/GHC/CoreToStg/Prep.hs ===================================== @@ -768,7 +768,10 @@ cpeApp top_env expr -> UniqSM (Floats, CpeRhs) cpe_app env (Var f) (CpeApp Type{} : CpeApp arg : args) depth | f `hasKey` lazyIdKey -- Replace (lazy a) with a, and + -- See Note [lazyId magic] in GHC.Types.Id.Make || f `hasKey` noinlineIdKey -- Replace (noinline a) with a + -- See Note [noinlineId magic] in GHC.Types.Id.Make + -- Consider the code: -- -- lazy (f x) y ===================================== compiler/GHC/HsToCore/Utils.hs ===================================== @@ -494,6 +494,13 @@ mkCoreAppDs _ (Var f `App` Type _r `App` Type ty1 `App` Type ty2 `App` arg1) arg -> v1 -- Note [Desugaring seq], points (2) and (3) _ -> mkWildValBinder Many ty1 +mkCoreAppDs _ (Var f `App` Type _r) arg + | f `hasKey` noinlineIdKey -- See Note [noinlineId magic] in GHC.Types.Id.Make + , (fun, args) <- collectArgs arg + , not (null args) + = (Var f `App` Type (exprType fun) `App` fun) + `mkCoreApps` args + mkCoreAppDs s fun arg = mkCoreApp s fun arg -- The rest is done in GHC.Core.Make -- NB: No argument can be levity polymorphic ===================================== compiler/GHC/Types/Id/Make.hs ===================================== @@ -1657,18 +1657,36 @@ Implementing 'lazy' is a bit tricky: Note [noinlineId magic] ~~~~~~~~~~~~~~~~~~~~~~~ -noinline :: forall a. a -> a - 'noinline' is used to make sure that a function f is never inlined, -e.g., as in 'noinline f x'. Ordinarily, the identity function with NOINLINE -could be used to achieve this effect; however, this has the unfortunate -result of leaving a (useless) call to noinline at runtime. So we have -a little bit of magic to optimize away 'noinline' after we are done -running the simplifier. - -'noinline' needs to be wired-in because it gets inserted automatically -when we serialize an expression to the interface format. See -Note [Inlining and hs-boot files] in GHC.CoreToIface +e.g., as in 'noinline f x'. We won't inline f because we never inline +lone variables (see Note [Lone variables] in GHC.Core.Unfold + +You might think that we could implement noinline like this: + {-# NOINLINE #-} + noinline :: forall a. a -> a + noinline x = x + +But actually we give 'noinline' a wired-in name for three distinct reasons: + +1. We don't want to leave a (useless) call to noinline in the final program, + to be executed at runtime. So we have a little bit of magic to + optimize away 'noinline' after we are done running the simplifier. + This is done in GHC.CoreToStg.Prep.cpeApp. + +2. 'noinline' sometimes gets inserted automatically when we serialize an + expression to the interface format, in GHC.CoreToIface.toIfaceVar. + See Note [Inlining and hs-boot files] in GHC.CoreToIface + +3. Given foo :: Eq a => [a] -> Bool, the expression + noinline foo x xs + where x::Int, will naturally desugar to + noinline @Int (foo @Int dEqInt) x xs + But now it's entirely possible htat (foo @Int dEqInt) will inline foo, + since 'foo' is no longer a lone variable -- see #18995 + + Solution: in the desugarer, rewrite + noinline (f x y) ==> noinline f x y + This is done in GHC.HsToCore.Utils.mkCoreAppDs. Note that noinline as currently implemented can hide some simplifications since it hides strictness from the demand analyser. Specifically, the demand analyser ===================================== testsuite/tests/simplCore/should_compile/T18995.hs ===================================== @@ -0,0 +1,6 @@ +module T18995 where + +import GHC.Magic ( noinline ) + +foo :: IO () +foo = (noinline print) True ===================================== testsuite/tests/simplCore/should_compile/T18995.stderr ===================================== @@ -0,0 +1,66 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core + = {terms: 19, types: 14, coercions: 12, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18995.$trModule4 :: GHC.Prim.Addr# +[GblId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +T18995.$trModule4 = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18995.$trModule3 :: GHC.Types.TrName +[GblId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18995.$trModule3 = GHC.Types.TrNameS T18995.$trModule4 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18995.$trModule2 :: GHC.Prim.Addr# +[GblId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +T18995.$trModule2 = "T18995"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18995.$trModule1 :: GHC.Types.TrName +[GblId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18995.$trModule1 = GHC.Types.TrNameS T18995.$trModule2 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18995.$trModule :: GHC.Types.Module +[GblId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T18995.$trModule + = GHC.Types.Module T18995.$trModule3 T18995.$trModule1 + +-- RHS size: {terms: 4, types: 7, coercions: 12, joins: 0/0} +foo :: IO () +[GblId, + Unf=Unf{Src=, TopLvl=True, Value=False, ConLike=False, + WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 40 0}] +foo + = noinline + @(forall a. Show a => a -> IO ()) + (System.IO.print1 + `cast` (forall (a :: <*>_N). + _R + %<'Many>_N ->_R _R + %<'Many>_N ->_R Sym (GHC.Types.N:IO[0] <()>_R) + :: (forall {a}. + Show a => + a + -> GHC.Prim.State# GHC.Prim.RealWorld + -> (# GHC.Prim.State# GHC.Prim.RealWorld, () #)) + ~R# (forall {a}. Show a => a -> IO ()))) + @Bool + GHC.Show.$fShowBool + GHC.Types.True + + + ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -341,4 +341,4 @@ test('T18649', normal, compile, ['-O -ddump-rules -Wno-simplifiable-class-constr test('T18747A', normal, compile, ['']) test('T18747B', normal, compile, ['']) test('T18815', only_ways(['optasm']), makefile_test, ['T18815']) - +test('T18995', [ grep_errmsg(r'print') ], compile, ['-O -ddump-simpl -dsuppress-uniques']) ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit c577da9cf5c531a3e5678760823c61db8a3adeb6 +Subproject commit 059acb11d6134ee0d896bcf73c870958557a3909 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/92963e297fddad21074cb55d6479976488535b81...92134ab6e5dfbaf3357802d744c54a23b667e28f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/92963e297fddad21074cb55d6479976488535b81...92134ab6e5dfbaf3357802d744c54a23b667e28f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 16 21:37:05 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 16 Dec 2020 16:37:05 -0500 Subject: [Git][ghc/ghc][wip/T19057] 5 commits: Revert "Implement BoxedRep proposal" Message-ID: <5fda7e01f0eeb_6b217be38c020024b0@gitlab.mail> Ben Gamari pushed to branch wip/T19057 at Glasgow Haskell Compiler / GHC Commits: 331f5568 by Ben Gamari at 2020-12-15T11:21:06-05:00 Revert "Implement BoxedRep proposal" This was inadvertently merged. This reverts commit 6c2eb2232b39ff4720fda0a4a009fb6afbc9dcea. - - - - - 50fae07d by Ben Gamari at 2020-12-15T15:15:16-05:00 Roll-back broken haddock commit Updates haddock submodule to revert a commit that does not build. - - - - - e9b18a75 by Ben Gamari at 2020-12-15T15:55:38-05:00 Revert haddock submodule yet again - - - - - b58cb63a by GHC GitLab CI at 2020-12-16T03:46:31+00:00 Bump haddock submodule To adapt haddock for the nullary tyconapp optimisation patch. - - - - - f1fa2b43 by Ben Gamari at 2020-12-16T16:37:04-05:00 rts: Fix typo in macro name THREADED_RTS was previously misspelled as THREADEDED_RTS. Fixes #19057. - - - - - 30 changed files: - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Instance/Typeable.hs - compiler/GHC/Types/RepType.hs - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/Binary/Typeable.hs - docs/users_guide/9.2.1-notes.rst - docs/users_guide/exts/levity_polymorphism.rst - docs/users_guide/exts/typed_holes.rst - libraries/base/Data/Typeable.hs - libraries/base/Data/Typeable/Internal.hs - libraries/base/GHC/Enum.hs - libraries/base/GHC/Exts.hs - libraries/base/GHC/Show.hs - libraries/base/Unsafe/Coerce.hs - libraries/base/tests/T11334a.hs - libraries/base/tests/T11334a.stdout - libraries/binary - libraries/ghc-heap/GHC/Exts/Heap.hs - libraries/ghc-heap/tests/ClosureSizeUtils.hs - libraries/ghc-prim/GHC/Types.hs - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - rts/RaiseAsync.c The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/58ec3598050fd98dc5b874179aaee4aedd2fd255...f1fa2b43d87f7aca18d07e62d9f42b0e4d7e386f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/58ec3598050fd98dc5b874179aaee4aedd2fd255...f1fa2b43d87f7aca18d07e62d9f42b0e4d7e386f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 16 21:44:26 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 16 Dec 2020 16:44:26 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 19 commits: Implement type applications in patterns Message-ID: <5fda7fba952f1_6b2167418542010679@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: c696bb2f by Cale Gibbard at 2020-12-14T13:37:09-05:00 Implement type applications in patterns The haddock submodule is also updated so that it understands the changes to patterns. - - - - - 7e9debd4 by Ben Gamari at 2020-12-14T13:37:09-05:00 Optimise nullary type constructor usage During the compilation of programs GHC very frequently deals with the `Type` type, which is a synonym of `TYPE 'LiftedRep`. This patch teaches GHC to avoid expanding the `Type` synonym (and other nullary type synonyms) during type comparisons, saving a good amount of work. This optimisation is described in `Note [Comparing nullary type synonyms]`. To maximize the impact of this optimisation, we introduce a few special-cases to reduce `TYPE 'LiftedRep` to `Type`. See `Note [Prefer Type over TYPE 'LiftedPtrRep]`. Closes #17958. Metric Decrease: T18698b T1969 T12227 T12545 T12707 T14683 T3064 T5631 T5642 T9020 T9630 T9872a T13035 haddock.Cabal haddock.base - - - - - 92377c27 by Ben Gamari at 2020-12-14T13:41:58-05:00 Revert "Optimise nullary type constructor usage" This was inadvertently merged. This reverts commit 7e9debd4ceb068effe8ac81892d2cabcb8f55850. - - - - - d0e8c10d by Sylvain Henry at 2020-12-14T19:45:13+01:00 Move Unit related fields from DynFlags to HscEnv The unit database cache, the home unit and the unit state were stored in DynFlags while they ought to be stored in the compiler session state (HscEnv). This patch fixes this. It introduces a new UnitEnv type that should be used in the future to handle separate unit environments (especially host vs target units). Related to #17957 Bump haddock submodule - - - - - af855ac1 by Andreas Klebinger at 2020-12-14T15:22:13-05:00 Optimize dumping of consecutive whitespace. The naive way of putting out n characters of indent would be something like `hPutStr hdl (replicate n ' ')`. However this is quite inefficient as we allocate an absurd number of strings consisting of simply spaces as we don't cache them. To improve on this we now track if we can simply write ascii spaces via hPutBuf instead. This is the case when running with -ddump-to-file where we force the encoding to be UTF8. This avoids both the cost of going through encoding as well as avoiding allocation churn from all the white space. Instead we simply use hPutBuf on a preallocated unlifted string. When dumping stg like this: > nofib/spectral/simple/Main.hs -fforce-recomp -ddump-stg-final -ddump-to-file -c +RTS -s Allocations went from 1,778 MB to 1,702MB. About a 4% reduction of allocation! I did not measure the difference in runtime but expect it to be similar. Bumps the haddock submodule since the interface of GHC's Pretty slightly changed. ------------------------- Metric Decrease: T12227 ------------------------- - - - - - dad87210 by Ben Gamari at 2020-12-14T15:22:29-05:00 Optimise nullary type constructor usage During the compilation of programs GHC very frequently deals with the `Type` type, which is a synonym of `TYPE 'LiftedRep`. This patch teaches GHC to avoid expanding the `Type` synonym (and other nullary type synonyms) during type comparisons, saving a good amount of work. This optimisation is described in `Note [Comparing nullary type synonyms]`. To maximize the impact of this optimisation, we introduce a few special-cases to reduce `TYPE 'LiftedRep` to `Type`. See `Note [Prefer Type over TYPE 'LiftedPtrRep]`. Closes #17958. Metric Decrease: T18698b T1969 T12227 T12545 T12707 T14683 T3064 T5631 T5642 T9020 T9630 T9872a T13035 haddock.Cabal haddock.base - - - - - 6c2eb223 by Andrew Martin at 2020-12-14T18:48:51-05:00 Implement BoxedRep proposal This implements the BoxedRep proposal, refacoring the `RuntimeRep` hierarchy from: ```haskell data RuntimeRep = LiftedPtrRep | UnliftedPtrRep | ... ``` to ```haskell data RuntimeRep = BoxedRep Levity | ... data Levity = Lifted | Unlifted ``` Closes #17526. - - - - - 3ee696cc by Sebastian Graf at 2020-12-15T10:53:31-05:00 Add regression test for #19053 - - - - - 535dae66 by Ben Gamari at 2020-12-15T10:53:58-05:00 testsuite: Mark divbyzero, derefnull as fragile Due to #18548. - - - - - 331f5568 by Ben Gamari at 2020-12-15T11:21:06-05:00 Revert "Implement BoxedRep proposal" This was inadvertently merged. This reverts commit 6c2eb2232b39ff4720fda0a4a009fb6afbc9dcea. - - - - - 50fae07d by Ben Gamari at 2020-12-15T15:15:16-05:00 Roll-back broken haddock commit Updates haddock submodule to revert a commit that does not build. - - - - - e9b18a75 by Ben Gamari at 2020-12-15T15:55:38-05:00 Revert haddock submodule yet again - - - - - b58cb63a by GHC GitLab CI at 2020-12-16T03:46:31+00:00 Bump haddock submodule To adapt haddock for the nullary tyconapp optimisation patch. - - - - - e28192d0 by David Eichmann at 2020-12-16T16:44:06-05:00 User guide minor typo [ci skip] - - - - - dd2c1762 by nineonine at 2020-12-16T16:44:09-05:00 Force module recompilation if '*' prefix was used to load modules in ghci (#8042) Usually pre-compiled code is preferred to be loaded in ghci if available, which means that if we try to load module with '*' prefix and compilation artifacts are available on disc (.o and .hi files) or the source code was untouched, the driver would think no recompilation is required. Therefore, we need to force recompilation so that desired byte-code is generated and loaded. Forcing in this case should be ok, since this is what happens for interpreted code anyways when reloading modules. - - - - - dee79fa0 by Ryan Scott at 2020-12-16T16:44:09-05:00 Reject dodgy scoping in associated family instance RHSes Commit e63518f5d6a93be111f9108c0990a1162f88d615 tried to push all of the logic of detecting out-of-scope type variables on the RHSes of associated type family instances to `GHC.Tc.Validity` by deleting a similar check in the renamer. Unfortunately, this commit went a little too far, as there are some corner cases that `GHC.Tc.Validity` doesn't detect. Consider this example: ```hs class C a where data D a instance forall a. C Int where data instance D Int = MkD a ``` If this program isn't rejected by the time it reaches the typechecker, then GHC will believe the `a` in `MkD a` is existentially quantified and accept it. This is almost surely not what the user wants! The simplest way to reject programs like this is to restore the old validity check in the renamer (search for `improperly_scoped` in `rnFamEqn`). Note that this is technically a breaking change, since the program in the `polykinds/T9574` test case (which previously compiled) will now be rejected: ```hs instance Funct ('KProxy :: KProxy o) where type Codomain 'KProxy = NatTr (Proxy :: o -> *) ``` This is because the `o` on the RHS will now be rejected for being out of scope. Luckily, this is simple to repair: ```hs instance Funct ('KProxy :: KProxy o) where type Codomain ('KProxy @o) = NatTr (Proxy :: o -> *) ``` All of the discussion is now a part of the revamped `Note [Renaming associated types]` in `GHC.Rename.Module`. A different design would be to make associated type family instances have completely separate scoping from the parent instance declaration, much like how associated type family default declarations work today. See the discussion beginning at https://gitlab.haskell.org/ghc/ghc/-/issues/18021#note_265729 for more on this point. This, however, would break even more programs that are accepted today and likely warrants a GHC proposal before going forward. In the meantime, this patch fixes the issue described in #18021 in the least invasive way possible. There are programs that are accepted today that will no longer be accepted after this patch, but they are arguably pathological programs, and they are simple to repair. Fixes #18021. - - - - - f8b7704b by Tom Ellis at 2020-12-16T16:44:11-05:00 submodule update: containers and stm Needed for https://gitlab.haskell.org/ghc/ghc/-/issues/15656 as it stops the packages triggering incomplete-uni-patterns and incomplete-record-updates - - - - - 49c2df48 by Richard Eisenberg at 2020-12-16T16:44:12-05:00 Unfortunate dirty hack to overcome #18998. See commentary in tcCheckUsage. Close #18998. Test case: typecheck/should_compile/T18998 - - - - - 04ad0cc9 by Sylvain Henry at 2020-12-16T16:44:16-05:00 Fix project version for ProjectVersionMunged (fix #19058) - - - - - 30 changed files: - .gitlab/linters/check-version-number.sh - compiler/GHC.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - + compiler/GHC/Builtin/Types/Prim.hs-boot - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Parser/Monad.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Env.hs - compiler/GHC/Driver/Hooks.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/MakeFile.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Monad.hs - compiler/GHC/Driver/Ppr.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Driver/Session.hs-boot - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e990a9aceb129ac0dc406a41e92633e23ec9753f...04ad0cc9fa6e33cfd6dccb5056355423009061d0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e990a9aceb129ac0dc406a41e92633e23ec9753f...04ad0cc9fa6e33cfd6dccb5056355423009061d0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 16 21:57:42 2020 From: gitlab at gitlab.haskell.org (Ryan Scott) Date: Wed, 16 Dec 2020 16:57:42 -0500 Subject: [Git][ghc/ghc][wip/T18914] Use HsOuterExplicit in instance sigs in deriving-generated code Message-ID: <5fda82d6221ca_6b217c5d45420211db@gitlab.mail> Ryan Scott pushed to branch wip/T18914 at Glasgow Haskell Compiler / GHC Commits: 3f4353cf by Ryan Scott at 2020-12-16T16:57:28-05:00 Use HsOuterExplicit in instance sigs in deriving-generated code Issue #18914 revealed that `GeneralizedNewtypeDeriving` would generate code that mentions unbound type variables, which is dangerously fragile. The problem (and fix) is described in the new `Wrinkle: Use HsOuterExplicit` in `Note [GND and QuantifiedConstraints]`. The gist of it: make sure to put the top-level `forall`s in `deriving`-generated instance signatures in an `HsOuterExplicit` to ensure that they scope over the bodies of methods correctly. A side effect of this process is that it will expand any type synonyms in the instance signature, which will surface any `forall`s that are hidden underneath type synonyms (such as in the test case for #18914). While I was in town, I also performed some maintenance on `NewHsTypeX`, which powers `GeneralizedNewtypeDeriving`: * I renamed `NewHsTypeX` to `HsCoreTy`, which more accurately describes its intended purpose (#15706). I also made `HsCoreTy` a type synonym instead of a newtype, as making it a distinct data type wasn't buying us much. * To make sure that mistakes similar to #18914 do not occur later, I added an additional validity check when renaming `HsCoreTy`s that complains if an `HsCoreTy`s contains an out-of-scope type variable. See the new `Note [Renaming HsCoreTys]` in `GHC.Rename.HsType` for the details. Fixes #15706. Fixes #18914. Bumps the `haddock` submodule. - - - - - 10 changed files: - compiler/GHC/Hs/Type.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Sig.hs - compiler/GHC/Tc/TyCl/Instance.hs - testsuite/tests/deriving/should_compile/T14578.stderr - + testsuite/tests/deriving/should_compile/T18914.hs - testsuite/tests/deriving/should_compile/all.T - utils/haddock Changes: ===================================== compiler/GHC/Hs/Type.hs ===================================== @@ -24,7 +24,7 @@ module GHC.Hs.Type ( HsArrow(..), arrowToHsType, hsLinear, hsUnrestricted, isUnrestricted, - HsType(..), NewHsTypeX(..), LHsType, HsKind, LHsKind, + HsType(..), HsCoreTy, LHsType, HsKind, LHsKind, HsForAllTelescope(..), HsTyVarBndr(..), LHsTyVarBndr, LHsQTyVars(..), HsOuterTyVarBndrs(..), HsOuterFamEqnTyVarBndrs, HsOuterSigTyVarBndrs, @@ -1040,12 +1040,6 @@ data HsType pass -- For details on above see note [Api annotations] in GHC.Parser.Annotation - -- | HsCoreTy (XCoreTy pass) Type -- An escape hatch for tunnelling a *closed* - -- -- Core Type through HsSyn. - -- -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : None - - -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | HsExplicitListTy -- A promoted explicit list (XExplicitListTy pass) PromotionFlag -- whether explicitly promoted, for pretty printer @@ -1078,16 +1072,13 @@ data HsType pass | XHsType (XXType pass) -data NewHsTypeX - = NHsCoreTy Type -- An escape hatch for tunnelling a *closed* - -- Core Type through HsSyn. - -- See also Note [Typechecking NHsCoreTys] in - -- GHC.Tc.Gen.HsType. - deriving Data - -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : None - -instance Outputable NewHsTypeX where - ppr (NHsCoreTy ty) = ppr ty +-- An escape hatch for tunnelling a Core 'Type' through 'HsType'. +-- For more details on how this works, see: +-- +-- * @Note [Renaming HsCoreTys]@ in "GHC.Rename.HsType" +-- +-- * @Note [Typechecking HsCoreTys]@ in "GHC.Tc.Gen.HsType" +type HsCoreTy = Type type instance XForAllTy (GhcPass _) = NoExtField type instance XQualTy (GhcPass _) = NoExtField @@ -1125,7 +1116,7 @@ type instance XTyLit (GhcPass _) = NoExtField type instance XWildCardTy (GhcPass _) = NoExtField -type instance XXType (GhcPass _) = NewHsTypeX +type instance XXType (GhcPass _) = HsCoreTy -- Note [Literal source text] in GHC.Types.Basic for SourceText fields in @@ -2256,7 +2247,7 @@ hsTypeNeedsParens p = go_hs_ty go_hs_ty (HsOpTy{}) = p >= opPrec go_hs_ty (HsParTy{}) = False go_hs_ty (HsDocTy _ (L _ t) _) = go_hs_ty t - go_hs_ty (XHsType (NHsCoreTy ty)) = go_core_ty ty + go_hs_ty (XHsType ty) = go_core_ty ty go_core_ty (TyVarTy{}) = False go_core_ty (AppTy{}) = p >= appPrec ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -41,6 +41,7 @@ import GHC.Prelude import {-# SOURCE #-} GHC.Rename.Splice( rnSpliceType ) +import GHC.Core.TyCo.FVs ( tyCoVarsOfTypeList ) import GHC.Driver.Session import GHC.Hs import GHC.Rename.Env @@ -50,6 +51,7 @@ import GHC.Rename.Utils ( HsDocContext(..), inHsDocContext, withHsDocContext , checkShadowedRdrNames ) import GHC.Rename.Fixity ( lookupFieldFixityRn, lookupFixityRn , lookupTyFixityRn ) +import GHC.Rename.Unbound ( notInScopeErr ) import GHC.Tc.Utils.Monad import GHC.Types.Name.Reader import GHC.Builtin.Names @@ -717,10 +719,20 @@ rnHsTyKi env (HsDocTy _ ty haddock_doc) = do { (ty', fvs) <- rnLHsTyKi env ty ; return (HsDocTy noExtField ty' haddock_doc, fvs) } -rnHsTyKi _ (XHsType (NHsCoreTy ty)) - = return (XHsType (NHsCoreTy ty), emptyFVs) - -- The emptyFVs probably isn't quite right - -- but I don't think it matters +-- See Note [Renaming HsCoreTys] +rnHsTyKi env (XHsType ty) + = do mapM_ (check_in_scope . nameRdrName) fvs_list + return (XHsType ty, fvs) + where + fvs_list = map getName $ tyCoVarsOfTypeList ty + fvs = mkFVs fvs_list + + check_in_scope :: RdrName -> RnM () + check_in_scope rdr_name = do + mb_name <- lookupLocalOccRn_maybe rdr_name + when (isNothing mb_name) $ + addErr $ withHsDocContext (rtke_ctxt env) $ + notInScopeErr rdr_name rnHsTyKi env ty@(HsExplicitListTy _ ip tys) = do { data_kinds <- xoptM LangExt.DataKinds @@ -744,6 +756,39 @@ rnHsArrow _env (HsLinearArrow u) = return (HsLinearArrow u, emptyFVs) rnHsArrow env (HsExplicitMult u p) = (\(mult, fvs) -> (HsExplicitMult u mult, fvs)) <$> rnLHsTyKi env p +{- +Note [Renaming HsCoreTys] +~~~~~~~~~~~~~~~~~~~~~~~~~ +HsCoreTy is an escape hatch that allows embedding Core Types in HsTypes. +As such, there's not much to be done in order to rename an HsCoreTy, +since it's already been renamed to some extent. However, in an attempt to +detect ill-formed HsCoreTys, the renamer checks to see if all free type +variables in an HsCoreTy are in scope. To see why this can matter, consider +this example from #18914: + + type T f = forall a. f a + + class C f where + m :: T f + + newtype N f a = MkN (f a) + deriving C + +Because of #18914, a previous GHC would generate the following code: + + instance C f => C (N f) where + m :: T (N f) + m = coerce @(f a) -- The type within @(...) is an HsCoreTy + @(N f a) -- So is this + (m @f) + +There are two HsCoreTys in play—(f a) and (N f a)—both of which have +`f` and `a` as free type variables. The `f` is in scope from the instance head, +but `a` is completely unbound, which is what led to #18914. To avoid this sort +of mistake going forward, the renamer will now detect that `a` is unbound and +throw an error accordingly. +-} + -------------- rnTyVar :: RnTyKiEnv -> RdrName -> RnM Name rnTyVar env rdr_name ===================================== compiler/GHC/Tc/Deriv/Generate.hs ===================================== @@ -1819,6 +1819,94 @@ a truly higher-rank type like so: Then the same situation will arise again. But at least it won't arise for the common case of methods with ordinary, prenex-quantified types. +----- +-- Wrinkle: Use HsOuterExplicit +----- + +One minor complication with the plan above is that we need to ensure that the +type variables from a method's instance signature properly scope over the body +of the method. For example, recall: + + instance (C m, forall p q. Coercible p q => Coercible (m p) (m q)) => + C (T m) where + join :: forall a. T m (T m a) -> T m a + join = coerce @( m (m a) -> m a) + @(T m (T m a) -> T m a) + join + +In the example above, it is imperative that the `a` in the instance signature +for `join` scope over the body of `join` by way of ScopedTypeVariables. +This might sound obvious, but note that in gen_Newtype_binds, which is +responsible for generating the code above, the type in `join`'s instance +signature is given as a Core type, whereas gen_Newtype_binds will eventually +produce HsBinds (i.e., source Haskell) that is renamed and typechecked. We +must ensure that `a` is in scope over the body of `join` during renaming +or else the generated code will be rejected. + +In short, we need to convert the instance signature from a Core type to an +HsType (i.e., a source Haskell type). Two possible options are: + +1. Convert the Core type entirely to an HsType (i.e., a source Haskell type). +2. Embed the entire Core type using HsCoreTy. + +Neither option is quite satisfactory: + +1. Converting a Core type to an HsType in full generality is surprisingly + complicated. Previous versions of GHCs did this, but it was the source of + numerous bugs (see #14579 and #16518, for instance). +2. While HsCoreTy is much less complicated that option (1), it's not quite + what we want. In order for `a` to be in scope over the body of `join` during + renaming, the `forall` must be contained in an HsOuterExplicit. + (See Note [Lexically scoped type variables] in GHC.Hs.Type.) HsCoreTy + bypasses HsOuterExplicit, so this won't work either. + +As a compromise, we adopt a combination of the two options above: + +* Split apart the top-level ForAllTys in the instance signature's Core type, +* Convert the top-level ForAllTys to an HsOuterExplicit, and +* Embed the remainder of the Core type in an HsCoreTy. + +This retains most of the simplicity of option (2) while still ensuring that +the type variables are correctly scoped. + +Note that splitting apart top-level ForAllTys will expand any type synonyms +in the Core type itself. This ends up being important to fix a corner case +observed in #18914. Consider this example: + + type T f = forall a. f a + + class C f where + m :: T f + + newtype N f a = MkN (f a) + deriving C + +What code should `deriving C` generate? It will have roughly the following +shape: + + instance C f => C (N f) where + m :: T (N f) + m = coerce @(...) (...) (m @f) + +At a minimum, we must instantiate `coerce` with `@(T f)` and `@(T (N f))`, but +with the `forall`s removed in order to make them monotypes. However, the +`forall` is hidden underneath the `T` type synonym, so we must first expand `T` +before we can strip of the `forall`. Expanding `T`, we get +`coerce @(forall a. f a) @(forall a. N f a)`, and after omitting the `forall`s, +we get `coerce @(f a) @(N f a)`. + +We can't stop there, however, or else we would end up with this code: + + instance C f => C (N f) where + m :: T (N f) + m = coerce @(f a) @(N f a) (m @f) + +Notice that the type variable `a` is completely unbound. In order to make sure +that `a` is in scope, we must /also/ expand the `T` in `m :: T (N f)` to get +`m :: forall a. N f a`. Fortunately, we will do just that in the plan outlined +above, since when we split off the top-level ForAllTys in the instance +signature, we must first expand the T type synonym. + Note [GND and ambiguity] ~~~~~~~~~~~~~~~~~~~~~~~~ We make an effort to make the code generated through GND be robust w.r.t. @@ -1891,13 +1979,30 @@ gen_Newtype_binds loc cls inst_tvs inst_tys rhs_ty , -- The derived instance signature, e.g., -- -- op :: forall c. a -> [T x] -> c -> Int + -- + -- Make sure that `forall c` is in an HsOuterExplicit so that it + -- scopes over the body of `op`. See "Wrinkle: Use HsOuterExplicit" in + -- Note [GND and QuantifiedConstraints]. L loc $ ClassOpSig noExtField False [loc_meth_RDR] - $ L loc $ mkHsImplicitSigType $ nlHsCoreTy to_ty + $ L loc $ mkHsExplicitSigType + (map mk_hs_tvb to_tvbs) + (nlHsCoreTy to_rho) ) where Pair from_ty to_ty = mkCoerceClassMethEqn cls inst_tvs inst_tys rhs_ty meth_id - (_, _, from_tau) = tcSplitSigmaTy from_ty - (_, _, to_tau) = tcSplitSigmaTy to_ty + (_, _, from_tau) = tcSplitSigmaTy from_ty + (to_tvbs, to_rho) = tcSplitForAllInvisTVBinders to_ty + (_, to_tau) = tcSplitPhiTy to_rho + -- The use of tcSplitForAllInvisTVBinders above expands type synonyms, + -- which is important to ensure correct type variable scoping. + -- See "Wrinkle: Use HsOuterExplicit" in + -- Note [GND and QuantifiedConstraints]. + + mk_hs_tvb :: VarBndr TyVar flag -> LHsTyVarBndr flag GhcPs + mk_hs_tvb (Bndr tv flag) = noLoc $ KindedTyVar noExtField + flag + (noLoc (getRdrName tv)) + (nlHsCoreTy (tyVarKind tv)) meth_RDR = getRdrName meth_id loc_meth_RDR = L loc meth_RDR @@ -1950,8 +2055,8 @@ nlHsAppType e s = noLoc (HsAppType noExtField e hs_ty) where hs_ty = mkHsWildCardBndrs $ parenthesizeHsType appPrec $ nlHsCoreTy s -nlHsCoreTy :: Type -> LHsType GhcPs -nlHsCoreTy = noLoc . XHsType . NHsCoreTy +nlHsCoreTy :: HsCoreTy -> LHsType GhcPs +nlHsCoreTy = noLoc . XHsType mkCoerceClassMethEqn :: Class -- the class being derived -> [TyVar] -- the tvs in the instance head (this includes @@ -2079,15 +2184,15 @@ genAuxBindSpecDup loc original_rdr_name dup_spec genAuxBindSpecSig :: SrcSpan -> AuxBindSpec -> LHsSigWcType GhcPs genAuxBindSpecSig loc spec = case spec of DerivCon2Tag tycon _ - -> mk_sig $ L loc $ XHsType $ NHsCoreTy $ + -> mk_sig $ L loc $ XHsType $ mkSpecSigmaTy (tyConTyVars tycon) (tyConStupidTheta tycon) $ mkParentType tycon `mkVisFunTyMany` intPrimTy DerivTag2Con tycon _ -> mk_sig $ L loc $ - XHsType $ NHsCoreTy $ mkSpecForAllTys (tyConTyVars tycon) $ + XHsType $ mkSpecForAllTys (tyConTyVars tycon) $ intTy `mkVisFunTyMany` mkParentType tycon DerivMaxTag _ _ - -> mk_sig (L loc (XHsType (NHsCoreTy intTy))) + -> mk_sig (L loc (XHsType intTy)) DerivDataDataType _ _ _ -> mk_sig (nlHsTyVar dataType_RDR) DerivDataConstr _ _ _ ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -947,8 +947,8 @@ tc_infer_hs_type mode (HsSpliceTy _ (HsSpliced _ _ (HsSplicedTy ty))) tc_infer_hs_type mode (HsDocTy _ ty _) = tc_infer_lhs_type mode ty --- See Note [Typechecking NHsCoreTys] -tc_infer_hs_type _ (XHsType (NHsCoreTy ty)) +-- See Note [Typechecking HsCoreTys] +tc_infer_hs_type _ (XHsType ty) = do env <- getLclEnv -- Raw uniques since we go from NameEnv to TvSubstEnv. let subst_prs :: [(Unique, TcTyVar)] @@ -972,21 +972,21 @@ tc_infer_hs_type mode other_ty ; return (ty', kv) } {- -Note [Typechecking NHsCoreTys] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -NHsCoreTy is an escape hatch that allows embedding Core Types in HsTypes. -As such, there's not much to be done in order to typecheck an NHsCoreTy, +Note [Typechecking HsCoreTys] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +HsCoreTy is an escape hatch that allows embedding Core Types in HsTypes. +As such, there's not much to be done in order to typecheck an HsCoreTy, since it's already been typechecked to some extent. There is one thing that we must do, however: we must substitute the type variables from the tcl_env. To see why, consider GeneralizedNewtypeDeriving, which is one of the main -clients of NHsCoreTy (example adapted from #14579): +clients of HsCoreTy (example adapted from #14579): newtype T a = MkT a deriving newtype Eq This will produce an InstInfo GhcPs that looks roughly like this: instance forall a_1. Eq a_1 => Eq (T a_1) where - (==) = coerce @( a_1 -> a_1 -> Bool) -- The type within @(...) is an NHsCoreTy + (==) = coerce @( a_1 -> a_1 -> Bool) -- The type within @(...) is an HsCoreTy @(T a_1 -> T a_1 -> Bool) -- So is this (==) @@ -1002,9 +1002,9 @@ environment (tcl_env) with [a_1 :-> a_2]. This gives us: To ensure that the body of this instance is well scoped, every occurrence of the `a` type variable should refer to a_2, the new skolem. However, the -NHsCoreTys mention a_1, not a_2. Luckily, the tcl_env provides exactly the +HsCoreTys mention a_1, not a_2. Luckily, the tcl_env provides exactly the substitution we need ([a_1 :-> a_2]) to fix up the scoping. We apply this -substitution to each NHsCoreTy and all is well: +substitution to each HsCoreTy and all is well: instance forall a_2. Eq a_2 => Eq (T a_2) where (==) = coerce @( a_2 -> a_2 -> Bool) @@ -1206,7 +1206,7 @@ tc_hs_type mode ty@(HsAppTy {}) ek = tc_infer_hs_type_ek mode ty ek tc_hs_type mode ty@(HsAppKindTy{}) ek = tc_infer_hs_type_ek mode ty ek tc_hs_type mode ty@(HsOpTy {}) ek = tc_infer_hs_type_ek mode ty ek tc_hs_type mode ty@(HsKindSig {}) ek = tc_infer_hs_type_ek mode ty ek -tc_hs_type mode ty@(XHsType (NHsCoreTy{})) ek = tc_infer_hs_type_ek mode ty ek +tc_hs_type mode ty@(XHsType {}) ek = tc_infer_hs_type_ek mode ty ek {- Note [Variable Specificity and Forall Visibility] ===================================== compiler/GHC/Tc/Gen/Sig.hs ===================================== @@ -291,7 +291,7 @@ no_anon_wc_ty lty = go lty HsTyLit{} -> True HsTyVar{} -> True HsStarTy{} -> True - XHsType (NHsCoreTy{}) -> True -- Core type, which does not have any wildcard + XHsType{} -> True -- HsCoreTy, which does not have any wildcard gos = all go ===================================== compiler/GHC/Tc/TyCl/Instance.hs ===================================== @@ -2082,7 +2082,7 @@ mkDefMethBind dfun_id clas sel_id dm_name mk_vta :: LHsExpr GhcRn -> Type -> LHsExpr GhcRn mk_vta fun ty = noLoc (HsAppType noExtField fun (mkEmptyWildCardBndrs $ nlHsParTy - $ noLoc $ XHsType $ NHsCoreTy ty)) + $ noLoc $ XHsType ty)) -- NB: use visible type application -- See Note [Default methods in instances] ===================================== testsuite/tests/deriving/should_compile/T14578.stderr ===================================== @@ -9,9 +9,8 @@ Derived class instances: GHC.Base.sconcat :: GHC.Base.NonEmpty (T14578.Wat f g a) -> T14578.Wat f g a GHC.Base.stimes :: - forall b. - GHC.Real.Integral b => - b -> T14578.Wat f g a -> T14578.Wat f g a + forall (b :: *). + GHC.Real.Integral b => b -> T14578.Wat f g a -> T14578.Wat f g a (GHC.Base.<>) = GHC.Prim.coerce @(T14578.App (Data.Functor.Compose.Compose f g) a @@ -38,8 +37,10 @@ Derived class instances: instance GHC.Base.Functor f => GHC.Base.Functor (T14578.App f) where GHC.Base.fmap :: - forall a b. (a -> b) -> T14578.App f a -> T14578.App f b - (GHC.Base.<$) :: forall a b. a -> T14578.App f b -> T14578.App f a + forall (a :: *) (b :: *). + (a -> b) -> T14578.App f a -> T14578.App f b + (GHC.Base.<$) :: + forall (a :: *) (b :: *). a -> T14578.App f b -> T14578.App f a GHC.Base.fmap = GHC.Prim.coerce @((a -> b) -> f a -> f b) @@ -51,17 +52,19 @@ Derived class instances: instance GHC.Base.Applicative f => GHC.Base.Applicative (T14578.App f) where - GHC.Base.pure :: forall a. a -> T14578.App f a + GHC.Base.pure :: forall (a :: *). a -> T14578.App f a (GHC.Base.<*>) :: - forall a b. + forall (a :: *) (b :: *). T14578.App f (a -> b) -> T14578.App f a -> T14578.App f b GHC.Base.liftA2 :: - forall a b c. + forall (a :: *) (b :: *) (c :: *). (a -> b -> c) -> T14578.App f a -> T14578.App f b -> T14578.App f c (GHC.Base.*>) :: - forall a b. T14578.App f a -> T14578.App f b -> T14578.App f b + forall (a :: *) (b :: *). + T14578.App f a -> T14578.App f b -> T14578.App f b (GHC.Base.<*) :: - forall a b. T14578.App f a -> T14578.App f b -> T14578.App f a + forall (a :: *) (b :: *). + T14578.App f a -> T14578.App f b -> T14578.App f a GHC.Base.pure = GHC.Prim.coerce @(a -> f a) @(a -> T14578.App f a) (GHC.Base.pure @f) ===================================== testsuite/tests/deriving/should_compile/T18914.hs ===================================== @@ -0,0 +1,12 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE RankNTypes #-} +module T18914 where + +type T f = forall a. f a + +class C f where + m1 :: T f + m2 :: forall a. f a + +newtype N f a = MkN (f a) + deriving C ===================================== testsuite/tests/deriving/should_compile/all.T ===================================== @@ -127,3 +127,4 @@ test('T17339', normal, compile, test('T17880', normal, compile, ['']) test('T18055', normal, compile, ['']) test('T18321', normal, compile, ['']) +test('T18914', normal, compile, ['']) ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 059acb11d6134ee0d896bcf73c870958557a3909 +Subproject commit c3b276d94e207717731512d1e1f8b59b729b653a View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3f4353cfc7951349648d0047eece89c5d773e315 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3f4353cfc7951349648d0047eece89c5d773e315 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 16 22:00:37 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 16 Dec 2020 17:00:37 -0500 Subject: [Git][ghc/ghc][wip/backports-8.10] 6 commits: Disable deprecation warnings in Cabal build Message-ID: <5fda8385a3066_6b218662044202311@gitlab.mail> Ben Gamari pushed to branch wip/backports-8.10 at Glasgow Haskell Compiler / GHC Commits: bc364f3e by Ben Gamari at 2020-12-16T17:00:31-05:00 Disable deprecation warnings in Cabal build - - - - - b3cc6847 by Ben Gamari at 2020-12-16T17:00:31-05:00 hadrian: Reindent Settings.Warnings The previous state was quite illegible. - - - - - afc39ff5 by Ben Gamari at 2020-12-16T17:00:31-05:00 hadrian: Pass -Werror before other arguments Previously we would append -Werror to the argument list. However, this ended up overriding the -Wno-error=... flags in Settings.Warnings. - - - - - 496a0d6d by Ben Gamari at 2020-12-16T17:00:31-05:00 users guide: Add release notes for 8.10.3 - - - - - 98d9f832 by Ben Gamari at 2020-12-16T17:00:31-05:00 Update autoconf scripts Scripts taken from autoconf 90b8cb42ba3b244250a6986b8b78c80f30ed197a - - - - - 6db6db46 by Ben Gamari at 2020-12-16T17:00:31-05:00 configure: Release 8.10.3 - - - - - 9 changed files: - config.guess - config.sub - configure.ac - + docs/users_guide/8.10.3-notes.rst - docs/users_guide/index.rst - hadrian/src/Flavour.hs - hadrian/src/Settings/Warnings.hs - libraries/base/config.guess - libraries/base/config.sub The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d44a2492eeaa3488d363bfe58b3e136de142ef1d...6db6db46af6f8e3e24d7d16b0b43a984a9a14677 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d44a2492eeaa3488d363bfe58b3e136de142ef1d...6db6db46af6f8e3e24d7d16b0b43a984a9a14677 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 16 23:25:59 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Wed, 16 Dec 2020 18:25:59 -0500 Subject: [Git][ghc/ghc][wip/T17656] 14 commits: Implement type applications in patterns Message-ID: <5fda9787e5ef2_6b21725bd702039499@gitlab.mail> Simon Peyton Jones pushed to branch wip/T17656 at Glasgow Haskell Compiler / GHC Commits: c696bb2f by Cale Gibbard at 2020-12-14T13:37:09-05:00 Implement type applications in patterns The haddock submodule is also updated so that it understands the changes to patterns. - - - - - 7e9debd4 by Ben Gamari at 2020-12-14T13:37:09-05:00 Optimise nullary type constructor usage During the compilation of programs GHC very frequently deals with the `Type` type, which is a synonym of `TYPE 'LiftedRep`. This patch teaches GHC to avoid expanding the `Type` synonym (and other nullary type synonyms) during type comparisons, saving a good amount of work. This optimisation is described in `Note [Comparing nullary type synonyms]`. To maximize the impact of this optimisation, we introduce a few special-cases to reduce `TYPE 'LiftedRep` to `Type`. See `Note [Prefer Type over TYPE 'LiftedPtrRep]`. Closes #17958. Metric Decrease: T18698b T1969 T12227 T12545 T12707 T14683 T3064 T5631 T5642 T9020 T9630 T9872a T13035 haddock.Cabal haddock.base - - - - - 92377c27 by Ben Gamari at 2020-12-14T13:41:58-05:00 Revert "Optimise nullary type constructor usage" This was inadvertently merged. This reverts commit 7e9debd4ceb068effe8ac81892d2cabcb8f55850. - - - - - d0e8c10d by Sylvain Henry at 2020-12-14T19:45:13+01:00 Move Unit related fields from DynFlags to HscEnv The unit database cache, the home unit and the unit state were stored in DynFlags while they ought to be stored in the compiler session state (HscEnv). This patch fixes this. It introduces a new UnitEnv type that should be used in the future to handle separate unit environments (especially host vs target units). Related to #17957 Bump haddock submodule - - - - - af855ac1 by Andreas Klebinger at 2020-12-14T15:22:13-05:00 Optimize dumping of consecutive whitespace. The naive way of putting out n characters of indent would be something like `hPutStr hdl (replicate n ' ')`. However this is quite inefficient as we allocate an absurd number of strings consisting of simply spaces as we don't cache them. To improve on this we now track if we can simply write ascii spaces via hPutBuf instead. This is the case when running with -ddump-to-file where we force the encoding to be UTF8. This avoids both the cost of going through encoding as well as avoiding allocation churn from all the white space. Instead we simply use hPutBuf on a preallocated unlifted string. When dumping stg like this: > nofib/spectral/simple/Main.hs -fforce-recomp -ddump-stg-final -ddump-to-file -c +RTS -s Allocations went from 1,778 MB to 1,702MB. About a 4% reduction of allocation! I did not measure the difference in runtime but expect it to be similar. Bumps the haddock submodule since the interface of GHC's Pretty slightly changed. ------------------------- Metric Decrease: T12227 ------------------------- - - - - - dad87210 by Ben Gamari at 2020-12-14T15:22:29-05:00 Optimise nullary type constructor usage During the compilation of programs GHC very frequently deals with the `Type` type, which is a synonym of `TYPE 'LiftedRep`. This patch teaches GHC to avoid expanding the `Type` synonym (and other nullary type synonyms) during type comparisons, saving a good amount of work. This optimisation is described in `Note [Comparing nullary type synonyms]`. To maximize the impact of this optimisation, we introduce a few special-cases to reduce `TYPE 'LiftedRep` to `Type`. See `Note [Prefer Type over TYPE 'LiftedPtrRep]`. Closes #17958. Metric Decrease: T18698b T1969 T12227 T12545 T12707 T14683 T3064 T5631 T5642 T9020 T9630 T9872a T13035 haddock.Cabal haddock.base - - - - - 6c2eb223 by Andrew Martin at 2020-12-14T18:48:51-05:00 Implement BoxedRep proposal This implements the BoxedRep proposal, refacoring the `RuntimeRep` hierarchy from: ```haskell data RuntimeRep = LiftedPtrRep | UnliftedPtrRep | ... ``` to ```haskell data RuntimeRep = BoxedRep Levity | ... data Levity = Lifted | Unlifted ``` Closes #17526. - - - - - 3ee696cc by Sebastian Graf at 2020-12-15T10:53:31-05:00 Add regression test for #19053 - - - - - 535dae66 by Ben Gamari at 2020-12-15T10:53:58-05:00 testsuite: Mark divbyzero, derefnull as fragile Due to #18548. - - - - - 331f5568 by Ben Gamari at 2020-12-15T11:21:06-05:00 Revert "Implement BoxedRep proposal" This was inadvertently merged. This reverts commit 6c2eb2232b39ff4720fda0a4a009fb6afbc9dcea. - - - - - 50fae07d by Ben Gamari at 2020-12-15T15:15:16-05:00 Roll-back broken haddock commit Updates haddock submodule to revert a commit that does not build. - - - - - e9b18a75 by Ben Gamari at 2020-12-15T15:55:38-05:00 Revert haddock submodule yet again - - - - - b58cb63a by GHC GitLab CI at 2020-12-16T03:46:31+00:00 Bump haddock submodule To adapt haddock for the nullary tyconapp optimisation patch. - - - - - 79c6c01a by Simon Peyton Jones at 2020-12-16T23:25:27+00:00 Kill floatEqualities completely This patch delivers on #17656, by entirel killing off the complex floatEqualities mechanism. Previously, floatEqualities would float an equality out of an implication, so that it could be solved at an outer level. But now we simply do unification in-place, without floating the constraint, relying on level numbers to determine untouchability. There are a number of important new Notes: * GHC.Tc.Utils.Unify Note [Unification preconditions] describes the preconditions for unification, including both skolem-escape and touchability. * GHC.Tc.Solver.Interact Note [Solve by unification] describes what we do when we do unify * GHC.Tc.Solver.Monad Note [The Unification Level Flag] describes how we control solver iteration under this new scheme * GHC.Tc.Solver.Monad Note [Tracking Given equalities] describes how we track when we have Given equalities * GHC.Tc.Types.Constraint Note [HasGivenEqs] is a new explanation of the ic_given_eqs field of an implication A big raft of subtle Notes in Solver, concerning floatEqualities, disappears. Main code changes: * GHC.Tc.Solver.floatEqualities disappears entirely * GHC.Tc.Solver.Monad: new fields in InertCans, inert_given_eq_lvl and inert_given_eq, updated by updateGivenEqs See Note [Tracking Given equalities]. * In exchange for updateGivenEqa, GHC.Tc.Solver.Monad.getHasGivenEqs is much simpler and more efficient * I found I could kill of metaTyVarUpdateOK entirely One test case T14683 showed a 5.1% decrease in compile-time allocation; and T5631 was down 2.2%. Other changes were small. Metric Decrease: T14683 T5631 - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - + compiler/GHC/Builtin/Types/Prim.hs-boot - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Parser/Monad.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Env.hs - compiler/GHC/Driver/Hooks.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/MakeFile.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Monad.hs - compiler/GHC/Driver/Ppr.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Driver/Session.hs-boot - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2aa777bf02e48255b7fc482b58505e60fbd843a6...79c6c01a7540a78ec6e492f86f84c8fec5f57bd1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2aa777bf02e48255b7fc482b58505e60fbd843a6...79c6c01a7540a78ec6e492f86f84c8fec5f57bd1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Dec 16 23:48:23 2020 From: gitlab at gitlab.haskell.org (Adam Gundry) Date: Wed, 16 Dec 2020 18:48:23 -0500 Subject: [Git][ghc/ghc][wip/amg/renamer-refactor] 8 commits: Minor review fixups Message-ID: <5fda9cc7dfe41_6b217c5d45420433a6@gitlab.mail> Adam Gundry pushed to branch wip/amg/renamer-refactor at Glasgow Haskell Compiler / GHC Commits: 3971faa2 by Adam Gundry at 2020-12-16T21:40:18+00:00 Minor review fixups - - - - - 819083b5 by Adam Gundry at 2020-12-16T22:08:51+00:00 Refactor IEThingWith to store fields in the TTG extension field This means we can avoid FieldLbl being parameterised, and enforces the invariant that the list of fields is present only in renamed syntax.. - - - - - 78204e3f by Adam Gundry at 2020-12-16T22:21:40+00:00 Drop the type parameter on FieldLbl so we have FieldLabel alone - - - - - a8f54e7c by Adam Gundry at 2020-12-16T22:58:30+00:00 Rename Child and related things - - - - - 15dd34a7 by Adam Gundry at 2020-12-16T23:12:24+00:00 Accept changed output of T14189 - - - - - e328fc71 by Adam Gundry at 2020-12-16T23:16:19+00:00 Edit Note [Record PatSyn Fields] - - - - - 9da9774c by Adam Gundry at 2020-12-16T23:27:09+00:00 Comments on FieldOcc - - - - - cfc3a281 by Adam Gundry at 2020-12-16T23:46:26+00:00 Yet more renaming and comments on printable vs mangled GreNames - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Rename.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Fixity.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/Tc/Errors/Hole.hs - compiler/GHC/Tc/Errors/Hole/FitTypes.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Utils/Backpack.hs - compiler/GHC/Types/Avail.hs - compiler/GHC/Types/FieldLabel.hs - compiler/GHC/Types/Name.hs-boot - compiler/GHC/Types/Name/Reader.hs - compiler/GHC/Types/Name/Shape.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/913a5076f54face20f249a224599ba7a1f50fbcd...cfc3a281ab261a4fcd555c5dc290071f06129087 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/913a5076f54face20f249a224599ba7a1f50fbcd...cfc3a281ab261a4fcd555c5dc290071f06129087 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 17 13:26:44 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Thu, 17 Dec 2020 08:26:44 -0500 Subject: [Git][ghc/ghc][wip/nested-cpr-2019] 2 commits: Nested CPR Message-ID: <5fdb5c94b2d88_6b217c5d4542090082@gitlab.mail> Sebastian Graf pushed to branch wip/nested-cpr-2019 at Glasgow Haskell Compiler / GHC Commits: 34d1c78d by Sebastian Graf at 2020-12-17T12:00:22+01:00 Nested CPR Move tests from stranal to cpranal Accept FacState Factor Cpr and Termination into a joint lattice As a result, we don't even have to export Termination from Cpr. Neat! Also I realised there is a simpler and more sound way to generate and unleash CPR signatures. Consider unboxing effects of WW better and get rid of hack stuff A slew of testsuite changes Fix T1600 Fix primop termination Test for DataCon wrapper CPR Fix CPR of bottoming functions/primops Fix DataConWrapperCpr and accept other test outputs Accept two more changed test outputs Update CaseBinderCPR with a new function Don't give the case binder the CPR property Prune CPR sigs to constant depth on all bindings Use variable length coding for ConTags Accept testuite output Don't attach CPR sigs to expandable bindings; transform their unfoldings instead Revert "Don't give the case binder the CPR property" This reverts commit 910edd76d5fe68b58c74f3805112f9faef4f2788. It seems we broke too much with this change. We lost our big win in `fish`. A more modular and configurable approach to optimistic case binder CPR Fix T9291 Document -fcase-binder-cpr-depth in the user's guide Testsuite changes Refactoring around cprAnalBind Fix case binder CPR by not looking into unfoldings of case binders Fix T16893 Accept new test output for T17673 Accepting metric changes to advance CI There are two ghc/alloc increases, which we might want to investigate later on. Metric Decrease: T1969 T9233 T9872a T9872b T9872c T9872d T12425 T12545 Metric Increase: T13253 T13701 T15164 Metric Increase ['max_bytes_used'] (test_env='x86_64-darwin'): T9675 Metric Increase ['max_bytes_used'] (test_env='x86_64-linux-deb9-dwarf'): T9675 Metric Increase ['max_bytes_used', 'peak_megabytes_allocated']: T10370 - - - - - 9873fa2a by Sebastian Graf at 2020-12-17T14:18:25+01:00 WorkWrap CPR: Consider how a function body is used Consider `T18894`: ```hs module T18894 (h) where g :: Int -> Int -> (Int,Int) g !m 1 = (2 + m, 0) g m n = (2 * m, 2 `div` n) {-# NOINLINE g #-} h :: Int -> Int h 1 = 0 h m | odd m = snd (g m 2) | otherwise = uncurry (+) (g 2 m) ``` We give `g` the CPR type `#c1(#c1(*), *c1(#))`. Previously, that wouldn't let us unbox the second component, because the division might diverge (throw a div-by-zero exception). But since #18894/!4493, we annotate `g` with its demand `UCU(CS(P(1P(U),SP(U))))`. Note that demand tells us that, *when* `g` is called, we always evaluate the second component of the returned pair. So it's OK for W/W to unbox it, because all call sites will force the division anyway! This is what this commit is implementing. The changes are entirely local to W/W. I also added a test case, `T18174`, that tracks everything Nested CPR is supposed to do (which is tracked in #18174). - - - - - 30 changed files: - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/CprAnal.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Data/Maybe.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Stg/Lift/Analysis.hs - compiler/GHC/Types/Cpr.hs - compiler/GHC/Types/Demand.hs - compiler/GHC/Types/Id/Info.hs - compiler/GHC/Types/Id/Make.hs - docs/users_guide/using-optimisation.rst - + testsuite/tests/cpranal/should_compile/T18174.hs - + testsuite/tests/cpranal/should_compile/T18174.stderr - testsuite/tests/cpranal/should_compile/all.T - testsuite/tests/stranal/sigs/CaseBinderCPR.hs → testsuite/tests/cpranal/sigs/CaseBinderCPR.hs - + testsuite/tests/cpranal/sigs/CaseBinderCPR.stderr - testsuite/tests/stranal/sigs/FacState.hs → testsuite/tests/cpranal/sigs/FacState.hs - + testsuite/tests/cpranal/sigs/FacState.stderr - + testsuite/tests/cpranal/sigs/Makefile - testsuite/tests/stranal/should_compile/T10694.hs → testsuite/tests/cpranal/sigs/T10694.hs - + testsuite/tests/cpranal/sigs/T10694.stderr - + testsuite/tests/cpranal/sigs/T1600.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4d8a46f0ce883b2611ca8aeb6d4cf35a00c61294...9873fa2ae3e41d6ffc180a05e0e36414006bcffb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4d8a46f0ce883b2611ca8aeb6d4cf35a00c61294...9873fa2ae3e41d6ffc180a05e0e36414006bcffb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 17 13:58:43 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Thu, 17 Dec 2020 08:58:43 -0500 Subject: [Git][ghc/ghc][wip/nested-cpr-2019] 17 commits: mkDocs: support hadrian bindists #18973 Message-ID: <5fdb641315ca0_6b21962d8e82092930@gitlab.mail> Sebastian Graf pushed to branch wip/nested-cpr-2019 at Glasgow Haskell Compiler / GHC Commits: e033dd05 by Adam Sandberg Ericsson at 2020-12-12T10:52:19+00:00 mkDocs: support hadrian bindists #18973 - - - - - 78580ba3 by John Ericson at 2020-12-13T07:14:50-05:00 Remove old .travis.yml - - - - - c696bb2f by Cale Gibbard at 2020-12-14T13:37:09-05:00 Implement type applications in patterns The haddock submodule is also updated so that it understands the changes to patterns. - - - - - 7e9debd4 by Ben Gamari at 2020-12-14T13:37:09-05:00 Optimise nullary type constructor usage During the compilation of programs GHC very frequently deals with the `Type` type, which is a synonym of `TYPE 'LiftedRep`. This patch teaches GHC to avoid expanding the `Type` synonym (and other nullary type synonyms) during type comparisons, saving a good amount of work. This optimisation is described in `Note [Comparing nullary type synonyms]`. To maximize the impact of this optimisation, we introduce a few special-cases to reduce `TYPE 'LiftedRep` to `Type`. See `Note [Prefer Type over TYPE 'LiftedPtrRep]`. Closes #17958. Metric Decrease: T18698b T1969 T12227 T12545 T12707 T14683 T3064 T5631 T5642 T9020 T9630 T9872a T13035 haddock.Cabal haddock.base - - - - - 92377c27 by Ben Gamari at 2020-12-14T13:41:58-05:00 Revert "Optimise nullary type constructor usage" This was inadvertently merged. This reverts commit 7e9debd4ceb068effe8ac81892d2cabcb8f55850. - - - - - d0e8c10d by Sylvain Henry at 2020-12-14T19:45:13+01:00 Move Unit related fields from DynFlags to HscEnv The unit database cache, the home unit and the unit state were stored in DynFlags while they ought to be stored in the compiler session state (HscEnv). This patch fixes this. It introduces a new UnitEnv type that should be used in the future to handle separate unit environments (especially host vs target units). Related to #17957 Bump haddock submodule - - - - - af855ac1 by Andreas Klebinger at 2020-12-14T15:22:13-05:00 Optimize dumping of consecutive whitespace. The naive way of putting out n characters of indent would be something like `hPutStr hdl (replicate n ' ')`. However this is quite inefficient as we allocate an absurd number of strings consisting of simply spaces as we don't cache them. To improve on this we now track if we can simply write ascii spaces via hPutBuf instead. This is the case when running with -ddump-to-file where we force the encoding to be UTF8. This avoids both the cost of going through encoding as well as avoiding allocation churn from all the white space. Instead we simply use hPutBuf on a preallocated unlifted string. When dumping stg like this: > nofib/spectral/simple/Main.hs -fforce-recomp -ddump-stg-final -ddump-to-file -c +RTS -s Allocations went from 1,778 MB to 1,702MB. About a 4% reduction of allocation! I did not measure the difference in runtime but expect it to be similar. Bumps the haddock submodule since the interface of GHC's Pretty slightly changed. ------------------------- Metric Decrease: T12227 ------------------------- - - - - - dad87210 by Ben Gamari at 2020-12-14T15:22:29-05:00 Optimise nullary type constructor usage During the compilation of programs GHC very frequently deals with the `Type` type, which is a synonym of `TYPE 'LiftedRep`. This patch teaches GHC to avoid expanding the `Type` synonym (and other nullary type synonyms) during type comparisons, saving a good amount of work. This optimisation is described in `Note [Comparing nullary type synonyms]`. To maximize the impact of this optimisation, we introduce a few special-cases to reduce `TYPE 'LiftedRep` to `Type`. See `Note [Prefer Type over TYPE 'LiftedPtrRep]`. Closes #17958. Metric Decrease: T18698b T1969 T12227 T12545 T12707 T14683 T3064 T5631 T5642 T9020 T9630 T9872a T13035 haddock.Cabal haddock.base - - - - - 6c2eb223 by Andrew Martin at 2020-12-14T18:48:51-05:00 Implement BoxedRep proposal This implements the BoxedRep proposal, refacoring the `RuntimeRep` hierarchy from: ```haskell data RuntimeRep = LiftedPtrRep | UnliftedPtrRep | ... ``` to ```haskell data RuntimeRep = BoxedRep Levity | ... data Levity = Lifted | Unlifted ``` Closes #17526. - - - - - 3ee696cc by Sebastian Graf at 2020-12-15T10:53:31-05:00 Add regression test for #19053 - - - - - 535dae66 by Ben Gamari at 2020-12-15T10:53:58-05:00 testsuite: Mark divbyzero, derefnull as fragile Due to #18548. - - - - - 331f5568 by Ben Gamari at 2020-12-15T11:21:06-05:00 Revert "Implement BoxedRep proposal" This was inadvertently merged. This reverts commit 6c2eb2232b39ff4720fda0a4a009fb6afbc9dcea. - - - - - 50fae07d by Ben Gamari at 2020-12-15T15:15:16-05:00 Roll-back broken haddock commit Updates haddock submodule to revert a commit that does not build. - - - - - e9b18a75 by Ben Gamari at 2020-12-15T15:55:38-05:00 Revert haddock submodule yet again - - - - - b58cb63a by GHC GitLab CI at 2020-12-16T03:46:31+00:00 Bump haddock submodule To adapt haddock for the nullary tyconapp optimisation patch. - - - - - c2a74c01 by Sebastian Graf at 2020-12-17T14:58:36+01:00 Nested CPR Move tests from stranal to cpranal Accept FacState Factor Cpr and Termination into a joint lattice As a result, we don't even have to export Termination from Cpr. Neat! Also I realised there is a simpler and more sound way to generate and unleash CPR signatures. Consider unboxing effects of WW better and get rid of hack stuff A slew of testsuite changes Fix T1600 Fix primop termination Test for DataCon wrapper CPR Fix CPR of bottoming functions/primops Fix DataConWrapperCpr and accept other test outputs Accept two more changed test outputs Update CaseBinderCPR with a new function Don't give the case binder the CPR property Prune CPR sigs to constant depth on all bindings Use variable length coding for ConTags Accept testuite output Don't attach CPR sigs to expandable bindings; transform their unfoldings instead Revert "Don't give the case binder the CPR property" This reverts commit 910edd76d5fe68b58c74f3805112f9faef4f2788. It seems we broke too much with this change. We lost our big win in `fish`. A more modular and configurable approach to optimistic case binder CPR Fix T9291 Document -fcase-binder-cpr-depth in the user's guide Testsuite changes Refactoring around cprAnalBind Fix case binder CPR by not looking into unfoldings of case binders Fix T16893 Accept new test output for T17673 Accepting metric changes to advance CI There are two ghc/alloc increases, which we might want to investigate later on. Metric Decrease: T1969 T9233 T9872a T9872b T9872c T9872d T12425 T12545 Metric Increase: T13253 T13701 T15164 Metric Increase ['max_bytes_used'] (test_env='x86_64-darwin'): T9675 Metric Increase ['max_bytes_used'] (test_env='x86_64-linux-deb9-dwarf'): T9675 Metric Increase ['max_bytes_used', 'peak_megabytes_allocated']: T10370 - - - - - 2682896b by Sebastian Graf at 2020-12-17T14:58:36+01:00 WorkWrap CPR: Consider how a function body is used Consider `T18894`: ```hs module T18894 (h) where g :: Int -> Int -> (Int,Int) g !m 1 = (2 + m, 0) g m n = (2 * m, 2 `div` n) {-# NOINLINE g #-} h :: Int -> Int h 1 = 0 h m | odd m = snd (g m 2) | otherwise = uncurry (+) (g 2 m) ``` We give `g` the CPR type `#c1(#c1(*), *c1(#))`. Previously, that wouldn't let us unbox the second component, because the division might diverge (throw a div-by-zero exception). But since #18894/!4493, we annotate `g` with its demand `UCU(CS(P(1P(U),SP(U))))`. Note that demand tells us that, *when* `g` is called, we always evaluate the second component of the returned pair. So it's OK for W/W to unbox it, because all call sites will force the division anyway! This is what this commit is implementing. The changes are entirely local to W/W. I also added a test case, `T18174`, that tracks everything Nested CPR is supposed to do (which is tracked in #18174). - - - - - 30 changed files: - − .travis.yml - compiler/GHC.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - + compiler/GHC/Builtin/Types/Prim.hs-boot - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Parser/Monad.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/CprAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Data/Maybe.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Env.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Hooks.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9873fa2ae3e41d6ffc180a05e0e36414006bcffb...2682896b1b0f4895c99b72346b646aada725a6ca -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9873fa2ae3e41d6ffc180a05e0e36414006bcffb...2682896b1b0f4895c99b72346b646aada725a6ca You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 17 16:01:50 2020 From: gitlab at gitlab.haskell.org (Andreas Klebinger) Date: Thu, 17 Dec 2020 11:01:50 -0500 Subject: [Git][ghc/ghc][wip/andreask/fix_rts_warnings] 49 commits: Fix kind inference for data types. Again. Message-ID: <5fdb80ee8168c_6b21962d8e821102e6@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/fix_rts_warnings at Glasgow Haskell Compiler / GHC Commits: 62ed6957 by Simon Peyton Jones at 2020-12-08T15:31:41-05:00 Fix kind inference for data types. Again. This patch fixes several aspects of kind inference for data type declarations, especially data /instance/ declarations Specifically 1. In kcConDecls/kcConDecl make it clear that the tc_res_kind argument is only used in the H98 case; and in that case there is no result kind signature; and hence no need for the disgusting splitPiTys in kcConDecls (now thankfully gone). The GADT case is a bit different to before, and much nicer. This is what fixes #18891. See Note [kcConDecls: kind-checking data type decls] 2. Do not look at the constructor decls of a data/newtype instance in tcDataFamInstanceHeader. See GHC.Tc.TyCl.Instance Note [Kind inference for data family instances]. This was a new realisation that arose when doing (1) This causes a few knock-on effects in the tests suite, because we require more information than before in the instance /header/. New user-manual material about this in "Kind inference in data type declarations" and "Kind inference for data/newtype instance declarations". 3. Minor improvement in kcTyClDecl, combining GADT and H98 cases 4. Fix #14111 and #8707 by allowing the header of a data instance to affect kind inferece for the the data constructor signatures; as described at length in Note [GADT return types] in GHC.Tc.TyCl This led to a modest refactoring of the arguments (and argument order) of tcConDecl/tcConDecls. 5. Fix #19000 by inverting the sense of the test in new_locs in GHC.Tc.Solver.Canonical.canDecomposableTyConAppOK. - - - - - 0abe3ddf by Adam Sandberg Ericsson at 2020-12-08T15:32:19-05:00 hadrian: build the _l and _thr_l rts flavours in the develN flavours The ghc binary requires the eventlog rts since fc644b1a643128041cfec25db84e417851e28bab - - - - - 51e3bb6d by Andreas Klebinger at 2020-12-08T22:43:21-05:00 CodeGen: Make folds User/DefinerOfRegs INLINEABLE. Reduces allocation for the test case I was looking at by about 1.2%. Mostly from avoiding allocation of some folding functions which turn into let-no-escape bindings which just reuse their environment instead. We also force inlining in a few key places in CmmSink which helps a bit more. - - - - - 69ae10c3 by Andreas Klebinger at 2020-12-08T22:43:21-05:00 CmmSink: Force inlining of foldRegsDefd Helps avoid allocating the folding function. Improves perf for T3294 by about 1%. - - - - - 6e3da800 by Andreas Klebinger at 2020-12-08T22:43:21-05:00 Cmm: Make a few types and utility function slightly stricter. About 0.6% reduction in allocations for the code I was looking at. Not a huge difference but no need to throw away performance. - - - - - aef44d7f by Andreas Klebinger at 2020-12-08T22:43:21-05:00 Cmm.Sink: Optimize retaining of assignments, live sets. Sinking requires us to track live local regs after each cmm statement. We used to do this via "Set LocalReg". However we can replace this with a solution based on IntSet which is overall more efficient without losing much. The thing we lose is width of the variables, which isn't used by the sinking pass anyway. I also reworked how we keep assignments to regs mentioned in skipped assignments. I put the details into Note [Keeping assignemnts mentioned in skipped RHSs]. The gist of it is instead of keeping track of it via the use count which is a `IntMap Int` we now use the live regs set (IntSet) which is quite a bit faster. I think it also matches the semantics a lot better. The skipped (not discarded) assignment does in fact keep the regs on it's rhs alive so keeping track of this in the live set seems like the clearer solution as well. Improves allocations for T3294 by yet another 1%. - - - - - 59f2249b by Andreas Klebinger at 2020-12-08T22:43:21-05:00 GHC.Cmm.Opt: Be stricter in results. Optimization either returns Nothing if nothing is to be done or `Just <cmmExpr>` otherwise. There is no point in being lazy in `cmmExpr`. We usually inspect this element so the thunk gets forced not long after. We might eliminate it as dead code once in a blue moon but that's not a case worth optimizing for. Overall the impact of this is rather low. As Cmm.Opt doesn't allocate much (compared to the rest of GHC) to begin with. - - - - - 54b88eac by Andreas Klebinger at 2020-12-08T22:43:57-05:00 Bump time submodule. This should fix #19002. - - - - - 35e7b0c6 by Kirill Elagin at 2020-12-10T01:45:54-05:00 doc: Clarify the default for -fomit-yields “Yield points enabled” is confusing (and probably wrong? I am not 100% sure what it means). Change it to a simple “on”. Undo this change from 2c23fff2e03e77187dc4d01f325f5f43a0e7cad2. - - - - - 3551c554 by Kirill Elagin at 2020-12-10T01:45:54-05:00 doc: Extra-clarify -fomit-yields Be more clear on what this optimisation being on by default means in terms of yields. - - - - - 6484f0d7 by Sergei Trofimovich at 2020-12-10T01:46:33-05:00 rts/linker/Elf.c: add missing <dlfcn.h> include (musl support) The change fixes build failure on musl: ``` rts/linker/Elf.c:2031:3: error: warning: implicit declaration of function 'dlclose'; did you mean 'close'? [-Wimplicit-function-declaration] 2031 | dlclose(nc->dlopen_handle); | ^~~~~~~ | close ``` Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - ab24ed9b by Ben Gamari at 2020-12-11T03:55:51-05:00 users guide: Fix syntax errors Fixes errors introduced by 3a55b3a2574f913d046f3a6f82db48d7f6df32e3. - - - - - d3a24d31 by Ben Gamari at 2020-12-11T03:55:51-05:00 users guide: Describe GC lifecycle events Every time I am asked about how to interpret these events I need to figure it out from scratch. It's well past time that the users guide properly documents these. - - - - - 741309b9 by Ben Gamari at 2020-12-11T03:56:27-05:00 gitlab-ci: Fix incorrect Docker image for nightly cross job Also refactor the job definition to eliminate the bug by construction. - - - - - 19703bc8 by Ben Gamari at 2020-12-11T03:56:27-05:00 gitlab-ci: Fix name of flavour in ThreadSanitizer job It looks like I neglected to update this after introduce flavour transformers. - - - - - 381eb660 by Sylvain Henry at 2020-12-11T12:57:35-05:00 Display FFI labels (fix #18539) - - - - - 4548d1f8 by Aaron Allen at 2020-12-11T12:58:14-05:00 Elide extraneous messages for :doc command (#15784) Do not print `<has no documentation>` alongside a valid doc. Additionally, if two matching symbols lack documentation then the message will only be printed once. Hence, `<has no documentation>` will be printed at most once and only if all matching symbols are lacking docs. - - - - - 5eba91b6 by Aaron Allen at 2020-12-11T12:58:14-05:00 Add :doc test case for duplicate record fields Tests that the output of the `:doc` command is correct for duplicate record fields defined using -XDuplicateRecordFields. - - - - - 5feb9b2d by Ryan Scott at 2020-12-11T22:39:29-05:00 Delete outdated Note [Kind-checking tyvar binders for associated types] This Note has severely bitrotted, as it has no references anywhere in the codebase, and none of the functions that it mentions exist anymore. Let's just delete this. While I was in town, I deleted some outdated comments from `checkFamPatBinders` of a similar caliber. Fixes #19008. [ci skip] - - - - - f9f9f030 by Sylvain Henry at 2020-12-11T22:40:08-05:00 Arrows: correctly query arrow methods (#17423) Consider the following code: proc (C x y) -> ... Before this patch, the evidence binding for the Arrow dictionary was attached to the C pattern: proc (C x y) { $dArrow = ... } -> ... But then when we desugar this, we use arrow operations ("arr", ">>>"...) specialised for this arrow: let arr_xy = arr $dArrow -- <-- Not in scope! ... in arr_xy (\(C x y) { $dArrow = ... } -> ...) This patch allows arrow operations to be type-checked before the proc itself, avoiding this issue. Fix #17423 - - - - - aaa8f00f by Sylvain Henry at 2020-12-11T22:40:48-05:00 Validate script: fix configure command when using stack - - - - - b4a929a1 by Sylvain Henry at 2020-12-11T22:41:30-05:00 Hadrian: fix libffi tarball parsing Fix parsing of "libffi-3.3.tar.gz". NB: switch to a newer libffi isn't done in this patch - - - - - 690c8946 by Sylvain Henry at 2020-12-11T22:42:09-05:00 Parser: move parser utils into their own module Move code unrelated to runtime evaluation out of GHC.Runtime.Eval - - - - - 76be0e32 by Sylvain Henry at 2020-12-11T22:42:48-05:00 Move SizedSeq into ghc-boot - - - - - 3a16d764 by Sylvain Henry at 2020-12-11T22:42:48-05:00 ghci: don't compile unneeded modules - - - - - 2895fa60 by Sylvain Henry at 2020-12-11T22:42:48-05:00 ghci: reuse Arch from ghc-boot - - - - - 480a38d4 by Sylvain Henry at 2020-12-11T22:43:30-05:00 rts: don't use siginterrupt (#19019) - - - - - 4af6126d by Sylvain Henry at 2020-12-11T22:44:11-05:00 Use static array in zeroCount - - - - - 5bd71bfd by Sebastian Graf at 2020-12-12T04:45:09-05:00 DmdAnal: Annotate top-level function bindings with demands (#18894) It's useful to annotate a non-exported top-level function like `g` in ```hs module Lib (h) where g :: Int -> Int -> (Int,Int) g m 1 = (m, 0) g m n = (2 * m, 2 `div` n) {-# NOINLINE g #-} h :: Int -> Int h 1 = 0 h m | odd m = snd (g m 2) | otherwise = uncurry (+) (g 2 m) ``` with its demand `UCU(CS(P(1P(U),SP(U))`, which tells us that whenever `g` was called, the second component of the returned pair was evaluated strictly. Since #18903 we do so for local functions, where we can see all calls. For top-level functions, we can assume that all *exported* functions are demanded according to `topDmd` and thus get sound demands for non-exported top-level functions. The demand on `g` is crucial information for Nested CPR, which may the go on and unbox `g` for the second pair component. That is true even if that pair component may diverge, as is the case for the call site `g 13 0`, which throws a div-by-zero exception. In `T18894b`, you can even see the new demand annotation enabling us to eta-expand a function that we wouldn't be able to eta-expand without Call Arity. We only track bindings of function type in order not to risk huge compile-time regressions, see `isInterestingTopLevelFn`. There was a CoreLint check that rejected strict demand annotations on recursive or top-level bindings, which seems completely unjustified. All the cases I investigated were fine, so I removed it. Fixes #18894. - - - - - 3aae036e by Sebastian Graf at 2020-12-12T04:45:09-05:00 Demand: Simplify `CU(U)` to `U` (#19005) Both sub-demands encode the same information. This is a trivial change and already affects a few regression tests (e.g. `T5075`), so no separate regression test is necessary. - - - - - c6477639 by Adam Sandberg Ericsson at 2020-12-12T04:45:48-05:00 hadrian: correctly copy the docs dir into the bindist #18669 - - - - - e033dd05 by Adam Sandberg Ericsson at 2020-12-12T10:52:19+00:00 mkDocs: support hadrian bindists #18973 - - - - - 78580ba3 by John Ericson at 2020-12-13T07:14:50-05:00 Remove old .travis.yml - - - - - c696bb2f by Cale Gibbard at 2020-12-14T13:37:09-05:00 Implement type applications in patterns The haddock submodule is also updated so that it understands the changes to patterns. - - - - - 7e9debd4 by Ben Gamari at 2020-12-14T13:37:09-05:00 Optimise nullary type constructor usage During the compilation of programs GHC very frequently deals with the `Type` type, which is a synonym of `TYPE 'LiftedRep`. This patch teaches GHC to avoid expanding the `Type` synonym (and other nullary type synonyms) during type comparisons, saving a good amount of work. This optimisation is described in `Note [Comparing nullary type synonyms]`. To maximize the impact of this optimisation, we introduce a few special-cases to reduce `TYPE 'LiftedRep` to `Type`. See `Note [Prefer Type over TYPE 'LiftedPtrRep]`. Closes #17958. Metric Decrease: T18698b T1969 T12227 T12545 T12707 T14683 T3064 T5631 T5642 T9020 T9630 T9872a T13035 haddock.Cabal haddock.base - - - - - 92377c27 by Ben Gamari at 2020-12-14T13:41:58-05:00 Revert "Optimise nullary type constructor usage" This was inadvertently merged. This reverts commit 7e9debd4ceb068effe8ac81892d2cabcb8f55850. - - - - - d0e8c10d by Sylvain Henry at 2020-12-14T19:45:13+01:00 Move Unit related fields from DynFlags to HscEnv The unit database cache, the home unit and the unit state were stored in DynFlags while they ought to be stored in the compiler session state (HscEnv). This patch fixes this. It introduces a new UnitEnv type that should be used in the future to handle separate unit environments (especially host vs target units). Related to #17957 Bump haddock submodule - - - - - af855ac1 by Andreas Klebinger at 2020-12-14T15:22:13-05:00 Optimize dumping of consecutive whitespace. The naive way of putting out n characters of indent would be something like `hPutStr hdl (replicate n ' ')`. However this is quite inefficient as we allocate an absurd number of strings consisting of simply spaces as we don't cache them. To improve on this we now track if we can simply write ascii spaces via hPutBuf instead. This is the case when running with -ddump-to-file where we force the encoding to be UTF8. This avoids both the cost of going through encoding as well as avoiding allocation churn from all the white space. Instead we simply use hPutBuf on a preallocated unlifted string. When dumping stg like this: > nofib/spectral/simple/Main.hs -fforce-recomp -ddump-stg-final -ddump-to-file -c +RTS -s Allocations went from 1,778 MB to 1,702MB. About a 4% reduction of allocation! I did not measure the difference in runtime but expect it to be similar. Bumps the haddock submodule since the interface of GHC's Pretty slightly changed. ------------------------- Metric Decrease: T12227 ------------------------- - - - - - dad87210 by Ben Gamari at 2020-12-14T15:22:29-05:00 Optimise nullary type constructor usage During the compilation of programs GHC very frequently deals with the `Type` type, which is a synonym of `TYPE 'LiftedRep`. This patch teaches GHC to avoid expanding the `Type` synonym (and other nullary type synonyms) during type comparisons, saving a good amount of work. This optimisation is described in `Note [Comparing nullary type synonyms]`. To maximize the impact of this optimisation, we introduce a few special-cases to reduce `TYPE 'LiftedRep` to `Type`. See `Note [Prefer Type over TYPE 'LiftedPtrRep]`. Closes #17958. Metric Decrease: T18698b T1969 T12227 T12545 T12707 T14683 T3064 T5631 T5642 T9020 T9630 T9872a T13035 haddock.Cabal haddock.base - - - - - 6c2eb223 by Andrew Martin at 2020-12-14T18:48:51-05:00 Implement BoxedRep proposal This implements the BoxedRep proposal, refacoring the `RuntimeRep` hierarchy from: ```haskell data RuntimeRep = LiftedPtrRep | UnliftedPtrRep | ... ``` to ```haskell data RuntimeRep = BoxedRep Levity | ... data Levity = Lifted | Unlifted ``` Closes #17526. - - - - - 3ee696cc by Sebastian Graf at 2020-12-15T10:53:31-05:00 Add regression test for #19053 - - - - - 535dae66 by Ben Gamari at 2020-12-15T10:53:58-05:00 testsuite: Mark divbyzero, derefnull as fragile Due to #18548. - - - - - 331f5568 by Ben Gamari at 2020-12-15T11:21:06-05:00 Revert "Implement BoxedRep proposal" This was inadvertently merged. This reverts commit 6c2eb2232b39ff4720fda0a4a009fb6afbc9dcea. - - - - - 50fae07d by Ben Gamari at 2020-12-15T15:15:16-05:00 Roll-back broken haddock commit Updates haddock submodule to revert a commit that does not build. - - - - - e9b18a75 by Ben Gamari at 2020-12-15T15:55:38-05:00 Revert haddock submodule yet again - - - - - b58cb63a by GHC GitLab CI at 2020-12-16T03:46:31+00:00 Bump haddock submodule To adapt haddock for the nullary tyconapp optimisation patch. - - - - - cbcd3597 by Andreas Klebinger at 2020-12-17T11:01:47-05:00 OSMem.c: Use proper type for mbinds mask argument. StgWord has different widths on 32/64bit. So use the proper type instead. - - - - - fc84dbb1 by Andreas Klebinger at 2020-12-17T11:01:47-05:00 rts: EventLog.c: Properly cast (potential) 32bit pointers to uint64_t - - - - - b7281ab6 by Andreas Klebinger at 2020-12-17T11:01:47-05:00 Rts/elf-linker: Upcast to 64bit to satisfy format string. The elf size is 32bit on 32bit builds and 64 otherwise. We just upcast to 64bits before printing now. - - - - - 30 changed files: - .gitlab-ci.yml - − .travis.yml - compiler/GHC.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - + compiler/GHC/Builtin/Types/Prim.hs-boot - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/Expr.hs - + compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Liveness.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Parser/Monad.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCon.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dadb803acc941c5e8e9f9ef1ed25041f6c4c3a39...b7281ab69c2e9f3624c4463e367499733b422b28 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dadb803acc941c5e8e9f9ef1ed25041f6c4c3a39...b7281ab69c2e9f3624c4463e367499733b422b28 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 17 16:09:42 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 17 Dec 2020 11:09:42 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/hadrian-deps Message-ID: <5fdb82c653101_6b217be38c0211095b@gitlab.mail> Ben Gamari pushed new branch wip/hadrian-deps at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/hadrian-deps You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 17 16:16:44 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Thu, 17 Dec 2020 11:16:44 -0500 Subject: [Git][ghc/ghc][wip/nested-cpr-2019] WorkWrap CPR: Consider how a function body is used Message-ID: <5fdb846ce19e4_6b216741854211778e@gitlab.mail> Sebastian Graf pushed to branch wip/nested-cpr-2019 at Glasgow Haskell Compiler / GHC Commits: 4c15c483 by Sebastian Graf at 2020-12-17T17:15:50+01:00 WorkWrap CPR: Consider how a function body is used Consider `T18894`: ```hs module T18894 (h) where g :: Int -> Int -> (Int,Int) g !m 1 = (2 + m, 0) g m n = (2 * m, 2 `div` n) {-# NOINLINE g #-} h :: Int -> Int h 1 = 0 h m | odd m = snd (g m 2) | otherwise = uncurry (+) (g 2 m) ``` We give `g` the CPR type `#c1(#c1(*), *c1(#))`. Previously, that wouldn't let us unbox the second component, because the division might diverge (throw a div-by-zero exception). But since #18894/!4493, we annotate `g` with its demand `UCU(CS(P(1P(U),SP(U))))`. Note that demand tells us that, *when* `g` is called, we always evaluate the second component of the returned pair. So it's OK for W/W to unbox it, because all call sites will force the division anyway! This is what this commit is implementing. The changes are entirely local to W/W. I also added a test case, `T18174`, that tracks everything Nested CPR is supposed to do (which is tracked in #18174). - - - - - 9 changed files: - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Types/Cpr.hs - + testsuite/tests/cpranal/should_compile/T18174.hs - + testsuite/tests/cpranal/should_compile/T18174.stderr - testsuite/tests/cpranal/should_compile/all.T - testsuite/tests/cpranal/sigs/T1600.hs - testsuite/tests/cpranal/sigs/T1600.stderr - testsuite/tests/stranal/should_compile/T18894.stderr Changes: ===================================== compiler/GHC/Core/Opt/WorkWrap.hs ===================================== @@ -482,7 +482,7 @@ tryWW dflags fam_envs is_rec fn_id rhs -- See Note [Don't w/w inline small non-loop-breaker things] | is_fun && is_eta_exp - = splitFun dflags fam_envs new_fn_id fn_info wrap_dmds div cpr rhs + = splitFun dflags fam_envs new_fn_id fn_info wrap_arg_dmds div forced_cpr rhs | isNonRec is_rec, is_thunk -- See Note [Thunk splitting] = splitThunk dflags fam_envs is_rec new_fn_id rhs @@ -491,9 +491,9 @@ tryWW dflags fam_envs is_rec fn_id rhs = return [ (new_fn_id, rhs) ] where - uf_opts = unfoldingOpts dflags - fn_info = idInfo fn_id - (wrap_dmds, div) = splitStrictSig (strictnessInfo fn_info) + uf_opts = unfoldingOpts dflags + fn_info = idInfo fn_id + (wrap_arg_dmds, div) = splitStrictSig (strictnessInfo fn_info) cpr_ty = getCprSig (cprInfo fn_info) -- Arity of the CPR sig should match idArity when it's not a join point. @@ -501,14 +501,21 @@ tryWW dflags fam_envs is_rec fn_id rhs cpr = ASSERT2( isJoinId fn_id || cpr_ty == topCprType || ct_arty cpr_ty == arityInfo fn_info , ppr fn_id <> colon <+> text "ct_arty:" <+> ppr (ct_arty cpr_ty) <+> text "arityInfo:" <+> ppr (arityInfo fn_info)) ct_cpr cpr_ty + -- Figure out the *least sub-demand* put on the function body by all call sites... + -- Sub-demand, because we can assume at least seq demand. + (_card1 :* fn_sd) = demandInfo fn_info -- describes how the function was called + (_card2, wrap_body_sd) = peelManyCalls (length wrap_arg_dmds) fn_sd + -- Force the recorded CPR (and Termination information!) according to how + -- the function is used. + (_tm, forced_cpr) = forceCpr wrap_body_sd cpr new_fn_id = zapIdUsedOnceInfo (zapIdUsageEnvInfo fn_id) -- See Note [Zapping DmdEnv after Demand Analyzer] and -- See Note [Zapping Used Once info WorkWrap] - is_fun = notNull wrap_dmds || isJoinId fn_id + is_fun = notNull wrap_arg_dmds || isJoinId fn_id -- See Note [Don't eta expand in w/w] - is_eta_exp = length wrap_dmds == manifestArity rhs + is_eta_exp = length wrap_arg_dmds == manifestArity rhs is_thunk = not is_fun && not (exprIsHNF rhs) && not (isJoinId fn_id) && not (isUnliftedType (idType fn_id)) @@ -586,10 +593,10 @@ See https://gitlab.haskell.org/ghc/ghc/merge_requests/312#note_192064. --------------------- splitFun :: DynFlags -> FamInstEnvs -> Id -> IdInfo -> [Demand] -> Divergence -> Cpr -> CoreExpr -> UniqSM [(Id, CoreExpr)] -splitFun dflags fam_envs fn_id fn_info wrap_dmds div cpr rhs - = WARN( not (wrap_dmds `lengthIs` arity), ppr fn_id <+> (ppr arity $$ ppr wrap_dmds $$ ppr cpr) ) do +splitFun dflags fam_envs fn_id fn_info wrap_arg_dmds div cpr rhs + = WARN( not (wrap_arg_dmds `lengthIs` arity), ppr fn_id <+> (ppr arity $$ ppr wrap_arg_dmds $$ ppr cpr) ) do -- The arity should match the signature - stuff <- mkWwBodies dflags fam_envs rhs_fvs fn_id wrap_dmds use_cpr + stuff <- mkWwBodies dflags fam_envs rhs_fvs fn_id wrap_arg_dmds use_cpr case stuff of Just (work_demands, join_arity, wrap_fn, work_fn) -> do work_uniq <- getUniqueM ===================================== compiler/GHC/Core/Opt/WorkWrap/Utils.hs ===================================== @@ -132,11 +132,12 @@ type WwResult mkWwBodies :: DynFlags -> FamInstEnvs - -> VarSet -- Free vars of RHS + -> VarSet -- ^ Free vars of RHS -- See Note [Freshen WW arguments] - -> Id -- The original function - -> [Demand] -- Strictness of original function - -> Cpr -- Info about function result + -> Id -- ^ The original function + -> [Demand] -- ^ Strictness of original function + -- (derived from 'idStrictness') + -> Cpr -- ^ Info about function result -> UniqSM (Maybe WwResult) -- wrap_fn_args E = \x y -> E @@ -150,12 +151,12 @@ mkWwBodies :: DynFlags -- let x = (a,b) in -- E -mkWwBodies dflags fam_envs rhs_fvs fun_id demands cpr_info +mkWwBodies dflags fam_envs rhs_fvs fun_id arg_dmds cpr_info = do { let empty_subst = mkEmptyTCvSubst (mkInScopeSet rhs_fvs) -- See Note [Freshen WW arguments] ; (wrap_args, wrap_fn_args, work_fn_args, res_ty) - <- mkWWargs empty_subst fun_ty demands + <- mkWWargs empty_subst fun_ty arg_dmds ; (useful1, work_args, wrap_fn_str, work_fn_str) <- mkWWstr dflags fam_envs has_inlineable_prag wrap_args @@ -168,7 +169,7 @@ mkWwBodies dflags fam_envs rhs_fvs fun_id demands cpr_info wrapper_body = wrap_fn_args . wrap_fn_cpr . wrap_fn_str . applyToVars work_call_args . Var worker_body = mkLams work_lam_args. work_fn_str . work_fn_cpr . work_fn_args - ; if isWorkerSmallEnough dflags (length demands) work_args + ; if isWorkerSmallEnough dflags (length arg_dmds) work_args && not (too_many_args_for_join_point wrap_args) && ((useful1 && not only_one_void_argument) || useful2) then return (Just (worker_args_dmds, length work_call_args, @@ -190,7 +191,7 @@ mkWwBodies dflags fam_envs rhs_fvs fun_id demands cpr_info -- Note [Do not split void functions] only_one_void_argument - | [d] <- demands + | [d] <- arg_dmds , Just (_, arg_ty1, _) <- splitFunTy_maybe fun_ty , isAbsDmd d && isVoidTy arg_ty1 = True @@ -221,9 +222,9 @@ isWorkerSmallEnough dflags old_n_args vars Note [Always do CPR w/w] ~~~~~~~~~~~~~~~~~~~~~~~~ At one time we refrained from doing CPR w/w for thunks, on the grounds that -we might duplicate work. But that is already handled by the demand analyser, +we might duplicate work. But that is already handled by CPR analysis, which doesn't give the CPR property if w/w might waste work: see -Note [CPR for thunks] in GHC.Core.Opt.DmdAnal. +Note [CPR for thunks] in GHC.Core.Opt.CprAnal. And if something *has* been given the CPR property and we don't w/w, it's a disaster, because then the enclosing function might say it has the CPR @@ -1085,9 +1086,7 @@ mkWWcpr opt_CprAnal fam_envs body_ty cpr | not opt_CprAnal = return (False, id, id, body_ty) -- CPR is turned on by default for -O and O2 | otherwise = do - -- We assume WHNF, so the outer layer always terminates. - let (_tm, cpr') = forceCpr seqDmd cpr - mb_stuff <- mkWWcpr_one_layer fam_envs body_ty cpr' + mb_stuff <- mkWWcpr_one_layer fam_envs body_ty cpr case mb_stuff of Nothing -> return (False, id, id, body_ty) Just stuff -> do ===================================== compiler/GHC/Types/Cpr.hs ===================================== @@ -475,8 +475,8 @@ forceTermM sd (Term tf l_sh) = do _ -> return l_sh -- just don't force anything return (Term Terminates l_sh') -forceCpr :: Demand -> Cpr -> (TerminationFlag, Cpr) -forceCpr dmd cpr = runTerminationM (idIfLazy forceCprM dmd cpr) +forceCpr :: SubDemand -> Cpr -> (TerminationFlag, Cpr) +forceCpr sd cpr = runTerminationM (forceCprM sd cpr) -- | 'lubTerm's the given outer @TerminationFlag@ on the @CprType at s 'ct_term'. bothCprType :: CprType -> TerminationFlag -> CprType ===================================== testsuite/tests/cpranal/should_compile/T18174.hs ===================================== @@ -0,0 +1,66 @@ +{-# OPTIONS_GHC -O2 -fforce-recomp #-} +{-# LANGUAGE BangPatterns #-} + +module T18174 (fac1, fac2, fac3, facIO, h1, h2) where + +---------------------------------------------------------------------- +-- First some basic examples that we want to CPR nestedly. + +-- pretty strict +fac1 :: Int -> a -> (a, Int) +fac1 n s | n < 2 = (s,1) + | otherwise = case fac1 (n-1) s of (s',n') -> let n'' = n*n' in n'' `seq` (s',n'') + +-- lazier, but Int still has CPR +fac2 :: Int -> a -> (a, Int) +fac2 n s | n < 2 = (s,1) + | otherwise = case fac2 (n-1) s of (s',n') -> (s',n'*n') + +-- even lazier, but evaluation of the Int doesn't terminate rapidly! +-- Thus, we may not WW for the nested Int. +-- Otherwise @fac3 99999 () `seq` ()@ (which should terminate rapidly) +-- evaluates more than necessary. +fac3 :: Int -> a -> (a, Int) +fac3 n s | n < 2 = (s,1) + | otherwise = let (s',n') = fac3 (n-1) s in (s',n'*n') + +facIO :: Int -> IO Int +facIO n | n < 2 = return 1 + | otherwise = do n' <- facIO (n-1); return (n*n') + +---------------------------------------------------------------------- +-- The following functions are copied from T18894. This test is about +-- *exploiting* the demand signatures that we assertedly (by T18894) +-- annotate. + +g1 :: Int -> (Int,Int) +g1 1 = (15, 0) +g1 n = (2 * n, 2 `div` n) +{-# NOINLINE g1 #-} + +-- | Sadly, the @g1 2@ subexpression will be floated to top-level, where we +-- don't see the specific demand placed on it by @snd at . Tracked in #19001. +h1 :: Int -> Int +h1 1 = 0 +h1 2 = snd (g1 2) +h1 m = uncurry (+) (g1 m) + +-- | So @g2@ here takes an additional argument m that prohibits floating to +-- top-level. We want that argument to have the CPR property, so we have +-- to add a bang so that it's used strictly and ultimately unboxed. +-- We expect the following CPR type: +-- +-- > #c1(#c1(#), *c1(#)) +-- +-- In combination with the the fact that all calls to @g2@ evaluate the second +-- component of the pair, we may unbox @g2@ to @(# Int#, Int# #)@. +g2 :: Int -> Int -> (Int,Int) +g2 !m 1 = (2 + m, 0) +g2 m n = (2 * m, 2 `div` n) +{-# NOINLINE g2 #-} + +h2 :: Int -> Int +h2 1 = 0 +h2 m + | odd m = snd (g2 m 2) + | otherwise = uncurry (+) (g2 2 m) ===================================== testsuite/tests/cpranal/should_compile/T18174.stderr ===================================== @@ -0,0 +1,167 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core = {terms: 336, types: 368, coercions: 6, joins: 0/1} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18174.$trModule4 :: GHC.Prim.Addr# +T18174.$trModule4 = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18174.$trModule3 :: GHC.Types.TrName +T18174.$trModule3 = GHC.Types.TrNameS T18174.$trModule4 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18174.$trModule2 :: GHC.Prim.Addr# +T18174.$trModule2 = "T18174"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18174.$trModule1 :: GHC.Types.TrName +T18174.$trModule1 = GHC.Types.TrNameS T18174.$trModule2 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18174.$trModule :: GHC.Types.Module +T18174.$trModule = GHC.Types.Module T18174.$trModule3 T18174.$trModule1 + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl_r1mk :: Int +lvl_r1mk = GHC.Types.I# 1# + +Rec { +-- RHS size: {terms: 38, types: 38, coercions: 0, joins: 0/1} +T18174.$wfac3 :: forall {a}. GHC.Prim.Int# -> a -> (# a, Int #) +T18174.$wfac3 + = \ (@a_s1d4) (ww_s1d9 :: GHC.Prim.Int#) (w_s1d6 :: a_s1d4) -> + case GHC.Prim.<# ww_s1d9 2# of { + __DEFAULT -> + let { + ds_s186 :: (a_s1d4, Int) + ds_s186 = case T18174.$wfac3 @a_s1d4 (GHC.Prim.-# ww_s1d9 1#) w_s1d6 of { (# ww2_s1dd, ww3_s1de #) -> (ww2_s1dd, ww3_s1de) } } in + (# case ds_s186 of { (s'_aXb, n'_aXc) -> s'_aXb }, case ds_s186 of { (s'_aXb, n'_aXc) -> case n'_aXc of { GHC.Types.I# ww2_s1d2 -> GHC.Types.I# (GHC.Prim.*# ww2_s1d2 ww2_s1d2) } } #); + 1# -> (# w_s1d6, lvl_r1mk #) + } +end Rec } + +-- RHS size: {terms: 14, types: 16, coercions: 0, joins: 0/0} +fac3 :: forall a. Int -> a -> (a, Int) +fac3 = \ (@a_s1d4) (w_s1d5 :: Int) (w1_s1d6 :: a_s1d4) -> case w_s1d5 of { GHC.Types.I# ww1_s1d9 -> case T18174.$wfac3 @a_s1d4 ww1_s1d9 w1_s1d6 of { (# ww3_s1dd, ww4_s1de #) -> (ww3_s1dd, ww4_s1de) } } + +Rec { +-- RHS size: {terms: 24, types: 21, coercions: 0, joins: 0/0} +T18174.$wfac2 :: forall {a}. GHC.Prim.Int# -> a -> (# a, GHC.Prim.Int# #) +T18174.$wfac2 + = \ (@a_s1dh) (ww_s1dm :: GHC.Prim.Int#) (w_s1dj :: a_s1dh) -> + case GHC.Prim.<# ww_s1dm 2# of { + __DEFAULT -> case T18174.$wfac2 @a_s1dh (GHC.Prim.-# ww_s1dm 1#) w_s1dj of { (# ww2_s1ds, ww3_s1du #) -> (# ww2_s1ds, GHC.Prim.*# ww3_s1du ww3_s1du #) }; + 1# -> (# w_s1dj, 1# #) + } +end Rec } + +-- RHS size: {terms: 15, types: 16, coercions: 0, joins: 0/0} +fac2 :: forall a. Int -> a -> (a, Int) +fac2 = \ (@a_s1dh) (w_s1di :: Int) (w1_s1dj :: a_s1dh) -> case w_s1di of { GHC.Types.I# ww1_s1dm -> case T18174.$wfac2 @a_s1dh ww1_s1dm w1_s1dj of { (# ww3_s1ds, ww4_s1du #) -> (ww3_s1ds, GHC.Types.I# ww4_s1du) } } + +Rec { +-- RHS size: {terms: 24, types: 21, coercions: 0, joins: 0/0} +T18174.$wfac1 :: forall {a}. GHC.Prim.Int# -> a -> (# a, GHC.Prim.Int# #) +T18174.$wfac1 + = \ (@a_s1dx) (ww_s1dC :: GHC.Prim.Int#) (w_s1dz :: a_s1dx) -> + case GHC.Prim.<# ww_s1dC 2# of { + __DEFAULT -> case T18174.$wfac1 @a_s1dx (GHC.Prim.-# ww_s1dC 1#) w_s1dz of { (# ww2_s1dI, ww3_s1dK #) -> (# ww2_s1dI, GHC.Prim.*# ww_s1dC ww3_s1dK #) }; + 1# -> (# w_s1dz, 1# #) + } +end Rec } + +-- RHS size: {terms: 15, types: 16, coercions: 0, joins: 0/0} +fac1 :: forall a. Int -> a -> (a, Int) +fac1 = \ (@a_s1dx) (w_s1dy :: Int) (w1_s1dz :: a_s1dx) -> case w_s1dy of { GHC.Types.I# ww1_s1dC -> case T18174.$wfac1 @a_s1dx ww1_s1dC w1_s1dz of { (# ww3_s1dI, ww4_s1dK #) -> (ww3_s1dI, GHC.Types.I# ww4_s1dK) } } + +-- RHS size: {terms: 30, types: 19, coercions: 0, joins: 0/0} +T18174.$wg2 :: GHC.Prim.Int# -> GHC.Prim.Int# -> (# GHC.Prim.Int#, GHC.Prim.Int# #) +T18174.$wg2 + = \ (ww_s1dR :: GHC.Prim.Int#) (ww1_s1dV :: GHC.Prim.Int#) -> + case ww1_s1dV of ds_X2 { + __DEFAULT -> case GHC.Classes.divInt# 2# ds_X2 of ww4_a153 { __DEFAULT -> (# GHC.Prim.*# 2# ww_s1dR, ww4_a153 #) }; + -1# -> (# GHC.Prim.*# 2# ww_s1dR, -2# #); + 0# -> case GHC.Real.divZeroError of wild_00 { }; + 1# -> (# GHC.Prim.+# 2# ww_s1dR, 0# #) + } + +-- RHS size: {terms: 26, types: 17, coercions: 0, joins: 0/0} +T18174.$wh2 :: GHC.Prim.Int# -> GHC.Prim.Int# +T18174.$wh2 + = \ (ww_s1ed :: GHC.Prim.Int#) -> + case ww_s1ed of ds_X2 { + __DEFAULT -> + case GHC.Prim.remInt# ds_X2 2# of { + __DEFAULT -> case T18174.$wg2 ds_X2 2# of { (# ww2_s1e4, ww3_s1e7 #) -> ww3_s1e7 }; + 0# -> case T18174.$wg2 2# ds_X2 of { (# ww2_s1e4, ww3_s1e7 #) -> GHC.Prim.+# ww2_s1e4 ww3_s1e7 } + }; + 1# -> 0# + } + +-- RHS size: {terms: 10, types: 4, coercions: 0, joins: 0/0} +h2 :: Int -> Int +h2 = \ (w_s1ea :: Int) -> case w_s1ea of { GHC.Types.I# ww1_s1ed -> case T18174.$wh2 ww1_s1ed of ww2_s1eh { __DEFAULT -> GHC.Types.I# ww2_s1eh } } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18174.h5 :: Int +T18174.h5 = GHC.Types.I# 0# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl1_r1ml :: Int +lvl1_r1ml = GHC.Types.I# -2# + +-- RHS size: {terms: 27, types: 15, coercions: 0, joins: 0/0} +T18174.$wg1 :: GHC.Prim.Int# -> (# GHC.Prim.Int#, Int #) +T18174.$wg1 + = \ (ww_s1en :: GHC.Prim.Int#) -> + case ww_s1en of ds_X2 { + __DEFAULT -> + (# GHC.Prim.*# 2# ds_X2, + case ds_X2 of { + __DEFAULT -> case GHC.Classes.divInt# 2# ds_X2 of ww4_a153 { __DEFAULT -> GHC.Types.I# ww4_a153 }; + -1# -> lvl1_r1ml; + 0# -> case GHC.Real.divZeroError of wild1_00 { } + } #); + 1# -> (# 15#, T18174.h5 #) + } + +-- RHS size: {terms: 8, types: 9, coercions: 0, joins: 0/0} +T18174.h4 :: (Int, Int) +T18174.h4 = case T18174.$wg1 2# of { (# ww1_s1eu, ww2_s1ew #) -> (GHC.Types.I# ww1_s1eu, ww2_s1ew) } + +-- RHS size: {terms: 22, types: 16, coercions: 0, joins: 0/0} +T18174.$wh1 :: GHC.Prim.Int# -> Int +T18174.$wh1 + = \ (ww_s1eC :: GHC.Prim.Int#) -> + case ww_s1eC of ds_X2 { + __DEFAULT -> case T18174.$wg1 ds_X2 of { (# ww2_s1eu, ww3_s1ew #) -> case ww3_s1ew of { GHC.Types.I# y_a15e -> GHC.Types.I# (GHC.Prim.+# ww2_s1eu y_a15e) } }; + 1# -> T18174.h5; + 2# -> case T18174.h4 of { (ds1_a137, y_a138) -> y_a138 } + } + +-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} +h1 :: Int -> Int +h1 = \ (w_s1ez :: Int) -> case w_s1ez of { GHC.Types.I# ww1_s1eC -> T18174.$wh1 ww1_s1eC } + +Rec { +-- RHS size: {terms: 23, types: 29, coercions: 0, joins: 0/0} +T18174.$wfacIO :: GHC.Prim.Int# -> GHC.Prim.State# GHC.Prim.RealWorld -> (# GHC.Prim.State# GHC.Prim.RealWorld, GHC.Prim.Int# #) +T18174.$wfacIO + = \ (ww_s1eJ :: GHC.Prim.Int#) (w_s1eG :: GHC.Prim.State# GHC.Prim.RealWorld) -> + case GHC.Prim.<# ww_s1eJ 2# of { + __DEFAULT -> case T18174.$wfacIO (GHC.Prim.-# ww_s1eJ 1#) w_s1eG of { (# ww2_s1eP, ww3_s1eR #) -> (# ww2_s1eP, GHC.Prim.*# ww_s1eJ ww3_s1eR #) }; + 1# -> (# w_s1eG, 1# #) + } +end Rec } + +-- RHS size: {terms: 14, types: 23, coercions: 0, joins: 0/0} +T18174.facIO1 :: Int -> GHC.Prim.State# GHC.Prim.RealWorld -> (# GHC.Prim.State# GHC.Prim.RealWorld, Int #) +T18174.facIO1 = \ (w_s1eF :: Int) (w1_s1eG :: GHC.Prim.State# GHC.Prim.RealWorld) -> case w_s1eF of { GHC.Types.I# ww1_s1eJ -> case T18174.$wfacIO ww1_s1eJ w1_s1eG of { (# ww3_s1eP, ww4_s1eR #) -> (# ww3_s1eP, GHC.Types.I# ww4_s1eR #) } } + +-- RHS size: {terms: 1, types: 0, coercions: 6, joins: 0/0} +facIO :: Int -> IO Int +facIO = T18174.facIO1 `cast` (_R %<'Many>_N ->_R Sym (GHC.Types.N:IO[0] _R) :: (Int -> GHC.Prim.State# GHC.Prim.RealWorld -> (# GHC.Prim.State# GHC.Prim.RealWorld, Int #)) ~R# (Int -> IO Int)) + + + ===================================== testsuite/tests/cpranal/should_compile/all.T ===================================== @@ -5,3 +5,5 @@ def f( name, opts ): setTestOpts(f) test('Cpr001', [], multimod_compile, ['Cpr001', '-v0']) +# The following test greps for type signatures of worker functions. +test('T18174', [ grep_errmsg(r'^T18174\.\$w\S+ ::') ], compile, ['-ddump-simpl -dsuppress-idinfo -dppr-cols=9999']) ===================================== testsuite/tests/cpranal/sigs/T1600.hs ===================================== @@ -1,23 +1,5 @@ -module Lib where - - --- pretty strict -fac1 :: Int -> a -> (a, Int) -fac1 n s | n < 2 = (s,1) - | otherwise = case fac1 (n-1) s of (s',n') -> let n'' = n*n' in n'' `seq` (s',n'') - --- lazier, but Int still has CPR -fac2 :: Int -> a -> (a, Int) -fac2 n s | n < 2 = (s,1) - | otherwise = case fac2 (n-1) s of (s',n') -> (s',n'*n') - --- even lazier, but evaluation of the Int doesn't terminate rapidly! --- Thus, we may not WW for the nested Int. --- Otherwise @fac3 99999 () `seq` ()@ (which should terminate rapidly) --- evaluates more than necessary. -fac3 :: Int -> a -> (a, Int) -fac3 n s | n < 2 = (s,1) - | otherwise = let (s',n') = fac3 (n-1) s in (s',n'*n') +-- | Basically tests Nested CPR on IO. +module T1600 where facIO :: Int -> IO Int facIO n | n < 2 = return 1 ===================================== testsuite/tests/cpranal/sigs/T1600.stderr ===================================== @@ -1,9 +1,6 @@ ==================== Cpr signatures ==================== -Lib.$trModule: * -Lib.fac1: *c1(*, #c1(#)) -Lib.fac2: *c1(*, #c1(#)) -Lib.fac3: *c1(*, *c1(#)) -Lib.facIO: *c1(*, #c1(#)) +T1600.$trModule: * +T1600.facIO: *c1(*, #c1(#)) ===================================== testsuite/tests/stranal/should_compile/T18894.stderr ===================================== @@ -205,7 +205,7 @@ h1 ==================== Demand analysis ==================== Result size of Demand analysis - = {terms: 171, types: 120, coercions: 0, joins: 0/0} + = {terms: 169, types: 121, coercions: 0, joins: 0/0} -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} $trModule :: GHC.Prim.Addr# @@ -242,42 +242,27 @@ T18894.$trModule :: GHC.Types.Module WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] T18894.$trModule = GHC.Types.Module $trModule $trModule --- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -lvl :: Int -[LclId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] -lvl = GHC.Types.I# 0# - --- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -lvl :: Int -[LclId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] -lvl = GHC.Types.I# -2# - --- RHS size: {terms: 32, types: 18, coercions: 0, joins: 0/0} -$wg2 [InlPrag=NOINLINE, Dmd=UCU(CS(P(1P(U),SP(U))))] - :: Int -> GHC.Prim.Int# -> (# Int, Int #) +-- RHS size: {terms: 36, types: 23, coercions: 0, joins: 0/0} +$wg2 [InlPrag=NOINLINE, Dmd=UCU(CS(P(1P(U),U)))] + :: Int -> GHC.Prim.Int# -> (# Int, GHC.Prim.Int# #) [LclId, Arity=2, Str=, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [20 30] 121 20}] + WorkFree=True, Expandable=True, Guidance=IF_ARGS [40 71] 122 30}] $wg2 = \ (w [Dmd=UP(U)] :: Int) (ww [Dmd=SU] :: GHC.Prim.Int#) -> case ww of ds { __DEFAULT -> + case GHC.Classes.divInt# 2# ds of ww4 { __DEFAULT -> (# case w of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.*# 2# y) }, - case ds of { - __DEFAULT -> - case GHC.Classes.divInt# 2# ds of ww4 { __DEFAULT -> - GHC.Types.I# ww4 - }; - -1# -> lvl; - 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } - } #); - 1# -> (# w, lvl #) + ww4 #) + }; + -1# -> + (# case w of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.*# 2# y) }, + -2# #); + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { }; + 1# -> (# w, 0# #) } -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} @@ -287,13 +272,13 @@ lvl :: Int WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] lvl = GHC.Types.I# 2# --- RHS size: {terms: 36, types: 23, coercions: 0, joins: 0/0} +-- RHS size: {terms: 30, types: 19, coercions: 0, joins: 0/0} $wh2 [InlPrag=[2]] :: GHC.Prim.Int# -> GHC.Prim.Int# [LclId, Arity=1, Str=, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 162 0}] + WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 142 0}] $wh2 = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> case ww of ds { @@ -301,14 +286,12 @@ $wh2 case GHC.Prim.remInt# ds 2# of { __DEFAULT -> case $wg2 (GHC.Types.I# ds) 2# of - { (# ww [Dmd=A], ww [Dmd=SP(SU)] #) -> - case ww of { GHC.Types.I# ww [Dmd=SU] -> ww } + { (# ww [Dmd=A], ww [Dmd=SU] #) -> + ww }; 0# -> - case $wg2 lvl ds of { (# ww [Dmd=SP(U)], ww [Dmd=SP(U)] #) -> - case ww of { GHC.Types.I# x -> - case ww of { GHC.Types.I# y -> GHC.Prim.+# x y } - } + case $wg2 lvl ds of { (# ww [Dmd=SP(U)], ww #) -> + case ww of { GHC.Types.I# x -> GHC.Prim.+# x ww } } }; 1# -> 0# @@ -333,6 +316,20 @@ h2 case $wh2 ww of ww { __DEFAULT -> GHC.Types.I# ww } } +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# -2# + -- RHS size: {terms: 27, types: 15, coercions: 0, joins: 0/0} $wg1 [InlPrag=NOINLINE, Dmd=UCU(P(U,UP(U)))] :: GHC.Prim.Int# -> (# GHC.Prim.Int#, Int #) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4c15c4838615ca8899a1e7afcdd42dd0e74f2a2c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4c15c4838615ca8899a1e7afcdd42dd0e74f2a2c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 17 16:31:31 2020 From: gitlab at gitlab.haskell.org (Andreas Klebinger) Date: Thu, 17 Dec 2020 11:31:31 -0500 Subject: [Git][ghc/ghc][wip/andreask/allocationArea] 352 commits: Fall back to types when looking up data constructors (#18740) Message-ID: <5fdb87e34944b_6b213272ce021221f9@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/allocationArea at Glasgow Haskell Compiler / GHC Commits: 990ea991 by Daniel Rogozin at 2020-10-11T22:20:04+03:00 Fall back to types when looking up data constructors (#18740) Before this patch, referring to a data constructor in a term-level context led to a scoping error: ghci> id Int <interactive>:1:4: error: Data constructor not in scope: Int After this patch, the renamer falls back to the type namespace and successfully finds the Int. It is then rejected in the type checker with a more useful error message: <interactive>:1:4: error: • Illegal term-level use of the type constructor ‘Int’ imported from ‘Prelude’ (and originally defined in ‘GHC.Types’) • In the first argument of ‘id’, namely ‘Int’ In the expression: id Int We also do this for type variables. - - - - - 9bbc84d2 by Sylvain Henry at 2020-10-12T18:21:51-04:00 DynFlags: refactor DmdAnal Make demand analysis usable without having to provide DynFlags. - - - - - 7fdcce6d by Wander Hillen at 2020-10-13T00:12:47-04:00 Initial ShortText code and conversion of package db code Metric Decrease: Naperian T10421 T10421a T10547 T12150 T12234 T12425 T13035 T18140 T18304 T5837 T6048 T13253-spj T18282 T18223 T3064 T9961 Metric Increase T13701 HFSKJH - - - - - 0a5f2918 by Sylvain Henry at 2020-10-13T00:13:28-04:00 Parser: don't require the HomeUnitId The HomeUnitId is only used by the Cmm parser and this one has access to the DynFlags, so it can grab the UnitId of the HomeUnit from them. Bump haddock submodule - - - - - 8f4f5794 by HaskellMouse at 2020-10-13T13:05:49+03:00 Unification of Nat and Naturals This commit removes the separate kind 'Nat' and enables promotion of type 'Natural' for using as type literal. It partially solves #10776 Now the following code will be successfully typechecked: data C = MkC Natural type CC = MkC 1 Before this change we had to create the separate type for promotion data C = MkC Natural data CP = MkCP Nat type CC = MkCP 1 But CP is uninhabited in terms. For backward compatibility type synonym `Nat` has been made: type Nat = Natural The user's documentation and tests have been updated. The haddock submodule also have been updated. - - - - - 0fc1cb54 by Ben Gamari at 2020-10-14T03:42:50-04:00 gitlab-ci: Verify that Hadrian builds with Stack As noted in #18726, this regularly breaks. Let's test it. Note that we don't actually perform a build of GHC itself; we merely test that the Hadrian executable builds and works (by invoking `hadrian --version`). - - - - - 89f4d8e9 by Ben Gamari at 2020-10-14T12:03:57-04:00 Bump LLVM version to 10.0 Fixes #18267. - - - - - 716385c9 by Ryan Scott at 2020-10-14T12:04:34-04:00 Make DataKinds the sole arbiter of kind-level literals (and friends) Previously, the use of kind-level literals, promoted tuples, and promoted lists required enabling both `DataKinds` and `PolyKinds`. This made sense back in a `TypeInType` world, but not so much now that `TypeInType`'s role has been superseded. Nowadays, `PolyKinds` only controls kind polymorphism, so let's make `DataKinds` the thing that controls the other aspects of `TypeInType`, which include literals, promoted tuples and promoted lists. There are some other things that overzealously required `PolyKinds`, which this patch fixes as well: * Previously, using constraints in kinds (e.g., `data T :: () -> Type`) required `PolyKinds`, despite the fact that this is orthogonal to kind polymorphism. This now requires `DataKinds` instead. * Previously, using kind annotations in kinds (e.g., `data T :: (Type :: Type) -> Type`) required both `KindSignatures` and `PolyKinds`. This doesn't make much sense, so it only requires `KindSignatures` now. Fixes #18831. - - - - - ac300a0d by Vladislav Zavialov at 2020-10-14T12:05:11-04:00 Remove "Operator sections" from docs/users_guide/bugs.rst The issue described in that section was fixed by 2b89ca5b850b4097447cc4908cbb0631011ce979 - - - - - bf2411a3 by Vladislav Zavialov at 2020-10-14T12:05:11-04:00 Fix PostfixOperators (#18151) This fixes a regression introduced in 2b89ca5b850b4097447cc4908cbb0631011ce979 See the new T18151x test case. - - - - - e60ae8a3 by Fumiaki Kinoshita at 2020-10-14T18:06:12-04:00 Add -Wnoncanonical-{monad,monoid}-instances to standardWarnings ------------------------- Metric Decrease: T12425 Metric Increase: T17516 ------------------------- - - - - - 15d2340c by Simon Peyton Jones at 2020-10-14T18:06:48-04:00 Fix some missed opportunities for preInlineUnconditionally There are two signficant changes here: * Ticket #18815 showed that we were missing some opportunities for preInlineUnconditionally. The one-line fix is in the code for GHC.Core.Opt.Simplify.Utils.preInlineUnconditionally, which now switches off only for INLINE pragmas. I expanded Note [Stable unfoldings and preInlineUnconditionally] to explain. * When doing this I discovered a way in which preInlineUnconditionally was occasionally /too/ eager. It's all explained in Note [Occurrences in stable unfoldings] in GHC.Core.Opt.OccurAnal, and the one-line change adding markAllMany to occAnalUnfolding. I also got confused about what NoUserInline meant, so I've renamed it to NoUserInlinePrag, and changed its pretty-printing slightly. That led to soem error messate wibbling, and touches quite a few files, but there is no change in functionality. I did a nofib run. As expected, no significant changes. Program Size Allocs ---------------------------------------- sphere -0.0% -0.4% ---------------------------------------- Min -0.0% -0.4% Max -0.0% +0.0% Geometric Mean -0.0% -0.0% I'm allowing a max-residency increase for T10370, which seems very irreproducible. (See comments on !4241.) There is always sampling error for max-residency measurements; and in any case the change shows up on some platforms but not others. Metric Increase: T10370 - - - - - 0c4bfed8 by Ben Gamari at 2020-10-14T18:07:25-04:00 users-guide: Add missing :ghc-flag: directive - - - - - 51c4b851 by Krzysztof Gogolewski at 2020-10-15T04:30:27-04:00 Remove Proxy# argument in Data.Typeable.Internal No longer neccessary - TypeRep is now indexed, there is no ambiguity. Also fix a comment in Evidence.hs, IsLabel no longer takes a Proxy#. - - - - - 809f09e8 by Sylvain Henry at 2020-10-15T04:31:07-04:00 Fix parsing of PIE flags -fPIE and -fno-PIE flags were (un)setting Opt_PIC instead of Opt_PIE. Original commit: 3625728a0e3a9b56c2b85ae7ea8bcabdd83ece6a - - - - - 3d7db148 by Ben Gamari at 2020-10-15T04:31:42-04:00 testsuite: Add missing #include on <stdlib.h> This otherwise fails on newer Clangs, which warn more aggressively on undeclared symbols. - - - - - 998803dc by Andrzej Rybczak at 2020-10-15T11:40:32+02:00 Add flags for annotating Generic{,1} methods INLINE[1] (#11068) Makes it possible for GHC to optimize away intermediate Generic representation for more types. Metric Increase: T12227 - - - - - 6b14c418 by GHC GitLab CI at 2020-10-15T21:57:50-04:00 Extend mAX_TUPLE_SIZE to 64 As well a ctuples and sums. - - - - - d495f36a by Ben Gamari at 2020-10-15T21:58:27-04:00 rts: Clean-up whitespace in Interpreter - - - - - cf10becd by Ben Gamari at 2020-10-15T21:58:27-04:00 compiler/ByteCode: Use strict Maps in bytecode assembler - - - - - ae146b53 by Ben Gamari at 2020-10-15T21:58:27-04:00 compiler/ByteCode: Make LocalLabel a newtype - - - - - cc536288 by Ben Gamari at 2020-10-15T21:58:27-04:00 compiler/ByteCode: Allow 2^32 local labels This widens LocalLabel to 2^16, avoiding the crash observed in #14334. Closes #14334. - - - - - 1bb0512f by Ben Gamari at 2020-10-16T00:15:31-04:00 mingw: Extract zst toolchain archives This should have been done when the toolchain was bumped. - - - - - bf7c5b6d by Ben Gamari at 2020-10-16T00:15:31-04:00 base: Reintroduce necessary LANGUAGE pragmas These were incorrectly removed in a recent cleanup commit. - - - - - c6b4be4b by Ben Gamari at 2020-10-16T00:15:31-04:00 testsuite: Sort metrics by metric type Closes #18838. - - - - - c7989c93 by Ben Gamari at 2020-10-16T00:15:31-04:00 testsuite: Account for -Wnoncanonical-monoid-instances changes on Windows - - - - - 330a5433 by Ben Gamari at 2020-10-16T00:15:31-04:00 rts: Add __mingw_vfprintf to RtsSymbols.c Following the model of the other printf symbols. See Note [Symbols for MinGW's printf]. - - - - - c4a69f37 by Ben Gamari at 2020-10-16T00:15:31-04:00 gitlab-ci: Remove allow_failure from Windows jobs - - - - - 9a9679db by Ben Gamari at 2020-10-16T00:15:31-04:00 gitlab-ci: Fix Hadrian bindist names - - - - - 07b0db86 by f-a at 2020-10-16T10:14:39-04:00 Clarify Eq documentation #18713 - - - - - aca0e63b by Ben Gamari at 2020-10-17T10:20:31-04:00 gitlab-ci: Allow doc-tarball job to fail Currently the Hadrian build appears not to package documentation correctly, causing doc-tarball to fail due to the Windows build. - - - - - b02a9ea7 by Ben Gamari at 2020-10-17T13:26:24-04:00 gitlab-ci: s/allow_newer/allow_failure Silly mistake on my part. - - - - - 59d7c9f4 by John Ericson at 2020-10-17T22:01:38-04:00 Skip type family defaults with hs-boot and hsig files Works around #17190, possible resolution for #17224. New design is is according to accepted [GHC Propoal 320]. Instances in signatures currently unconditionally opt into associated family defaults if no explicit instance is given. This is bad for two reasons: 1. It constrains possible instantiations to use the default, rather than possibly define the associated family differently. 2. It breaks compilation as type families are unsupported in signatures. This PR simply turns off the filling in of defaults in those cases. Additionally, it squelches a missing definition warning for hs-boot too that was only squelched for hsig before. The downsides are: 1. There is no way to opt into the default, other than copying its definition. 2. If we fixed type classes in signatures, and wanted instances to have to explicitly *out of* rather than into the default, that would now be a breaking change. The change that is most unambiguously goood is harmonizing the warning squelching between hs-boot or hsig. Maybe they should have the warning (opt out of default) maybe they shouldn't (opt in to default), but surely it should be the same for both. Add hs-boot version of a backpack test regarding class-specified defaults in instances that appear in an hs-boot file. The metrics increase is very slight and makes no sense --- at least no one has figured anything out after this languishing for a while, so I'm just going to accept it. Metric Increase: T10421a [GHC proposal 320]: https://github.com/ghc-proposals/ghc-proposals/pull/320 - - - - - 7eb46a09 by Sebastian Graf at 2020-10-17T22:02:13-04:00 Arity: Refactor fixed-point iteration in GHC.Core.Opt.Arity Arity analysis used to propagate optimistic arity types during fixed-point interation through the `ArityEnv`'s `ae_cheap_fun` field, which is like `GHC.Core.Utils.exprIsCheap`, but also considers the current iteration's optimistic arity, for the binder in question only. In #18793, we have seen that this is a problematic design, because it doesn't allow us to look through PAP bindings of that binder. Hence this patch refactors to a more traditional form with an explicit signature environment, in which we record the optimistic `ArityType` of the binder in question (and at the moment is the *only* binder that is recorded in the arity environment). - - - - - 6b3eb06a by Sebastian Graf at 2020-10-17T22:02:13-04:00 Arity: Record arity types for non-recursive lets In #18793, we saw a compelling example which requires us to look at non-recursive let-bindings during arity analysis and unleash their arity types at use sites. After the refactoring in the previous patch, the needed change is quite simple and very local to `arityType`'s defn for non-recurisve `Let`. Apart from that, we had to get rid of the second item of `Note [Dealing with bottoms]`, which was entirely a safety measure and hindered optimistic fixed-point iteration. Fixes #18793. The following metric increases are all caused by this commit and a result of the fact that we just do more work now: Metric Increase: T3294 T12545 T12707 - - - - - 451455fd by Sebastian Graf at 2020-10-17T22:02:13-04:00 Testsuite: Add dead arity analysis tests We didn't seem to test these old tests at all, judging from their expected output. - - - - - 50e9df49 by Dylan Yudaken at 2020-10-17T22:02:50-04:00 When using rts_setInCallCapability, lock incall threads This diff makes sure that incall threads, when using `rts_setInCallCapability`, will be created as locked. If the thread is not locked, the thread might end up being scheduled to a different capability. While this is mentioned in the docs for `rts_setInCallCapability,`, it makes the method significantly less useful as there is no guarantees on the capability being used. This commit also adds a test to make sure things stay on the correct capability. - - - - - 0b995759 by DylanZA at 2020-10-17T22:02:50-04:00 Apply suggestion to testsuite/tests/ffi/should_run/all.T - - - - - a91dcb66 by Sylvain Henry at 2020-10-17T22:04:02-04:00 Don't get host RTS ways via settings (#18651) To correctly perform a linking hack for Windows we need to link with the RTS GHC is currently using. We used to query the RTS ways via the "settings" file but it is fragile (#18651). The hack hasn't been fixed to take into account all the ways (Tracing) and it makes linking of GHC with another RTS more difficult (we need to link with another RTS and to regenerate the settings file). So this patch uses the ways reported by the RTS itself (GHC.Platform.Ways.hostWays) instead of the "settings" file. - - - - - d858a3ae by Hécate at 2020-10-17T22:04:38-04:00 Linting corrections * Bring back LANGUAGE pragmas in GHC.IO.Handle.Lock.Windows * Exclude some modules that are wrongfully reported - - - - - b5b3e34e by Vladislav Zavialov at 2020-10-19T18:16:20-04:00 Implement -Woperator-whitespace (#18834) This patch implements two related warnings: -Woperator-whitespace-ext-conflict warns on uses of infix operators that would be parsed differently were a particular GHC extension enabled -Woperator-whitespace warns on prefix, suffix, and tight infix uses of infix operators Updates submodules: haddock, containers. - - - - - 9648d680 by Sylvain Henry at 2020-10-19T18:16:58-04:00 Remove pdocPrec pdocPrec was only used in GHC.Cmm.DebugBlock.pprUnwindExpr, so remove it. OutputableP becomes a one-function class which might be better for performance. - - - - - ee5dcdf9 by Ben Gamari at 2020-10-20T00:47:54-04:00 testsuite: Add test for #18346 This was fixed by 4291bddaea3148908c55f235ee8978e1d9aa6f20. - - - - - 6c7a5c0c by Krzysztof Gogolewski at 2020-10-20T00:48:29-04:00 Minor comments, update linear types docs - Update comments: placeHolderTypeTc no longer exists "another level check problem" was a temporary comment from linear types - Use Mult type synonym (reported in #18676) - Mention multiplicity-polymorphic fields in linear types docs - - - - - 58a1ca38 by nineonine at 2020-10-20T00:49:07-04:00 Compile modules with `-fobject-code` enabled to byte-code when loaded with `*` prefix in ghci (#8042) The documentation states that when using :add and :load, the `*` prefix forces a module to be loaded as byte-code. However, this seems to be ignored when -fobject-code has been enabled. In that case, the compiled code is always used, regardless of whether the *-form is used. The idea is to consult the Targets in HscEnv and check the 'targetAllowObjCode' flag. If the flag for given module is set, then patch up DynFlags and select compilation backend accordingly. This would require a linear scan of course, but that shouldn't be too costly. - - - - - 59b08a5d by Ben Gamari at 2020-10-20T00:49:41-04:00 gitlab-ci: Rename FLAVOUR -> BUILD_FLAVOUR Previously the Hadrian jobs used the `FLAVOUR` environment variable to communicate which flavour `ci.sh` should build whereas `make` used `BUILD_FLAVOUR`. This caused unnecessary confusion. Consolidate these two. - - - - - ea736839 by Alan Zimmerman at 2020-10-20T08:35:34+01:00 API Annotations: Keep track of unicode for linear arrow notation The linear arrow can be parsed as `%1 ->` or a direct single token unicode equivalent. Make sure that this distinction is captured in the parsed AST by using IsUnicodeSyntax where it appears, and introduce a new API Annotation, AnnMult to represent its location when unicode is not used. Updated haddock submodule - - - - - cf3c3bcd by Ben Gamari at 2020-10-20T22:56:31-04:00 testsuite: Mark T12971 as fragile on Windows Due to #17945. - - - - - e2c4a947 by Vladislav Zavialov at 2020-10-21T16:00:30+03:00 Parser regression tests, close #12862 #12446 These issues were fixed by earlier parser changes, most likely related to whitespace-sensitive parsing. - - - - - 711929e6 by Simon Peyton Jones at 2020-10-23T02:42:59-04:00 Fix error message location in tcCheckPatSynDecl Ticket #18856 showed that we were failing to set the right location for an error message. Easy to fix, happily. Turns out that this also improves the error location in test T11010, which was bogus before but we had never noticed. - - - - - 730bb590 by Ben Gamari at 2020-10-23T02:43:33-04:00 cmm: Add Note reference to ForeignHint - - - - - b9d4dd9c by Ben Gamari at 2020-10-24T20:44:17-04:00 SMP.h: Add C11-style atomic operations - - - - - ccf2d4b0 by Ben Gamari at 2020-10-24T20:59:39-04:00 rts: Infrastructure for testing with ThreadSanitizer - - - - - a61f66d6 by Ben Gamari at 2020-10-24T20:59:39-04:00 rts/CNF: Initialize all bdescrs in group It seems wise and cheap to ensure that the whole bdescr of all blocks of a compact group is valid, even if most cases only look at the flags field. - - - - - 65136c13 by Ben Gamari at 2020-10-24T20:59:39-04:00 rts/Capability: Intialize interrupt field Previously this was left uninitialized. Also clarify some comments. - - - - - b3ce6aca by Ben Gamari at 2020-10-24T20:59:39-04:00 rts/Task: Make comments proper Notes - - - - - d3890ac7 by Ben Gamari at 2020-10-24T20:59:39-04:00 rts/SpinLock: Move to proper atomics This is fairly straightforward; we just needed to use relaxed operations for the PROF_SPIN counters and a release store instead of a write barrier. - - - - - ef88712f by Ben Gamari at 2020-10-24T20:59:39-04:00 rts/OSThreads: Fix data race Previously we would race on the cached processor count. Avoiding this is straightforward; just use relaxed operations. - - - - - 33a719c3 by Ben Gamari at 2020-10-24T20:59:39-04:00 rts/ClosureMaros: Use relaxed atomics - - - - - f08951fd by Ben Gamari at 2020-10-24T20:59:39-04:00 configure: Bump minimum-supported gcc version to 4.7 Since the __atomic_* builtins are not supported until gcc 4.7. Given that this version was released in 2012 I think this is acceptable. - - - - - d584923a by Ben Gamari at 2020-10-24T20:59:39-04:00 testsuite: Fix thread leak in hs_try_putmvar00[13] - - - - - bf1b0bc7 by Ben Gamari at 2020-10-24T20:59:39-04:00 rts: Introduce SET_HDR_RELEASE Also ensure that we also store the info table pointer last to ensure that the synchronization covers all stores. - - - - - 1a2e9f5e by Ben Gamari at 2020-10-24T21:00:19-04:00 gitlab-ci: Add nightly-x86_64-linux-deb9-tsan job - - - - - 58a5b0e5 by GHC GitLab CI at 2020-10-24T21:00:19-04:00 testsuite: Mark setnumcapabilities001 as broken with TSAN Due to #18808. - - - - - d9bc7dea by GHC GitLab CI at 2020-10-24T21:00:19-04:00 testsuite: Skip divbyzero and derefnull under TSAN ThreadSanitizer changes the output of these tests. - - - - - fcc42a10 by Ben Gamari at 2020-10-24T21:00:19-04:00 testsuite: Skip high memory usage tests with TSAN ThreadSanitizer significantly increases the memory footprint of tests, so much so that it can send machines into OOM. - - - - - cae4bb3e by Ben Gamari at 2020-10-24T21:00:19-04:00 testsuite: Mark hie002 as high_memory_usage This test has a peak residency of 1GByte; this is large enough to classify as "high" in my book. - - - - - dae1b86a by Ben Gamari at 2020-10-24T21:00:19-04:00 testsuite: Mark T9872[abc] as high_memory_usage These all have a maximum residency of over 2 GB. - - - - - c5a0bb22 by Ben Gamari at 2020-10-24T21:00:19-04:00 gitlab-ci: Disable documentation in TSAN build Haddock chews through enough memory to cause the CI builders to OOM and there's frankly no reason to build documentation in this job anyways. - - - - - 4cb1232e by Ben Gamari at 2020-10-24T21:00:19-04:00 TSANUtils: Ensure that C11 atomics are supported - - - - - 7ed15f7f by Ben Gamari at 2020-10-24T21:00:19-04:00 testsuite: Mark T3807 as broken with TSAN Due to #18883. - - - - - f7e6f012 by Ben Gamari at 2020-10-24T21:00:19-04:00 testsuite: Mark T13702 as broken with TSAN due to #18884 - - - - - 16b136b0 by Ben Gamari at 2020-10-24T21:00:36-04:00 rts: Factor out logic to identify a good capability for running a task Not only does this make the control flow a bit clearer but it also allows us to add a TSAN suppression on this logic, which requires (harmless) data races. - - - - - 2781d68c by Ben Gamari at 2020-10-24T21:00:36-04:00 rts: Annotate benign race in waitForCapability - - - - - f6b4b492 by Ben Gamari at 2020-10-24T21:00:36-04:00 rts: Clarify locking behavior of releaseCapability_ - - - - - 65219810 by Ben Gamari at 2020-10-24T21:00:36-04:00 rts: Add assertions for task ownership of capabilities - - - - - 31fa87ec by Ben Gamari at 2020-10-24T21:00:36-04:00 rts: Use relaxed atomics on n_returning_tasks This mitigates the warning of a benign race on n_returning_tasks in shouldYieldCapability. See #17261. - - - - - 6517a2ea by Ben Gamari at 2020-10-24T21:00:36-04:00 rts: Mitigate races in capability interruption logic - - - - - 2e9ba3f2 by Ben Gamari at 2020-10-24T21:00:36-04:00 rts/Capability: Use relaxed operations for last_free_capability - - - - - e10dde37 by Ben Gamari at 2020-10-24T21:00:37-04:00 rts: Use relaxed operations for cap->running_task (TODO) This shouldn't be necessary since only the owning thread of the capability should be touching this. - - - - - 855325cd by Ben Gamari at 2020-10-24T21:00:37-04:00 rts/Schedule: Use relaxed operations for sched_state - - - - - 811f915d by Ben Gamari at 2020-10-24T21:00:37-04:00 rts: Accept data race in work-stealing implementation This race is okay since the task is owned by the capability pushing it. By Note [Ownership of Task] this means that the capability is free to write to `task->cap` without taking `task->lock`. Fixes #17276. - - - - - 8d2b3c3d by Ben Gamari at 2020-10-24T21:00:37-04:00 rts: Eliminate data races on pending_sync - - - - - f8871018 by Ben Gamari at 2020-10-24T21:00:37-04:00 rts/Schedule: Eliminate data races on recent_activity We cannot safely use relaxed atomics here. - - - - - d079b943 by Ben Gamari at 2020-10-24T21:00:37-04:00 rts: Avoid data races in message handling - - - - - 06f80497 by Ben Gamari at 2020-10-24T21:00:37-04:00 rts/Messages: Drop incredibly fishy write barrier executeMessage previously had a write barrier at the beginning of its loop apparently in an attempt to synchronize with another thread's writes to the Message. I would guess that the author had intended to use a load barrier here given that there are no globally-visible writes done in executeMessage. I've removed the redundant barrier since the necessary load barrier is now provided by the ACQUIRE_LOAD. - - - - - d4a87779 by Ben Gamari at 2020-10-24T21:00:38-04:00 rts/ThreadPaused: Avoid data races - - - - - 56778ab3 by Ben Gamari at 2020-10-24T21:00:38-04:00 rts/Schedule: Eliminate data races in run queue management - - - - - 086521f7 by Ben Gamari at 2020-10-24T21:00:38-04:00 rts: Eliminate shutdown data race on task counters - - - - - abad9778 by Ben Gamari at 2020-10-24T21:00:38-04:00 rts/Threads: Avoid data races (TODO) Replace barriers with appropriate ordering. Drop redundant barrier in tryWakeupThread (the RELEASE barrier will be provided by sendMessage's mutex release). We use relaxed operations on why_blocked and the stack although it's not clear to me why this is necessary. - - - - - 2f56be8a by Ben Gamari at 2020-10-24T21:00:39-04:00 rts/Messages: Annotate benign race - - - - - 7c0cdab1 by Ben Gamari at 2020-10-24T21:00:39-04:00 rts/RaiseAsync: Synchronize what_next read - - - - - 6cc2a8a5 by Ben Gamari at 2020-10-24T21:00:39-04:00 rts/Task: Move debugTrace to avoid data race Specifically, we need to hold all_tasks_mutex to read taskCount. - - - - - bbaec97d by Ben Gamari at 2020-10-24T21:00:39-04:00 Disable flawed assertion - - - - - dd175a92 by Ben Gamari at 2020-10-24T21:00:39-04:00 Document schedulePushWork race - - - - - 3416244b by Ben Gamari at 2020-10-24T21:00:40-04:00 Capabiliity: Properly fix data race on n_returning_tasks There is a real data race but can be made safe by using proper atomic (but relaxed) accesses. - - - - - dffd9432 by Ben Gamari at 2020-10-24T21:00:40-04:00 rts: Make write of to_cap->inbox atomic This is necessary since emptyInbox may read from to_cap->inbox without taking cap->lock. - - - - - 1f4cbc29 by Ben Gamari at 2020-10-24T21:00:57-04:00 rts/BlockAlloc: Use relaxed operations - - - - - d0d07cff by Ben Gamari at 2020-10-24T21:00:57-04:00 rts: Rework handling of mutlist scavenging statistics - - - - - 9e5c7f6d by Ben Gamari at 2020-10-24T21:00:57-04:00 rts: Avoid data races in StablePtr implementation This fixes two potentially problematic data races in the StablePtr implementation: * We would fail to RELEASE the stable pointer table when enlarging it, causing other cores to potentially see uninitialized memory. * We would fail to ACQUIRE when dereferencing a stable pointer. - - - - - 316add67 by Ben Gamari at 2020-10-24T21:00:57-04:00 rts/Storage: Use atomics - - - - - 5c23bc4c by Ben Gamari at 2020-10-24T21:00:58-04:00 rts/Updates: Use proper atomic operations - - - - - 3d0f033c by Ben Gamari at 2020-10-24T21:00:58-04:00 rts/Weak: Eliminate data races By taking all_tasks_mutex in stat_exit. Also better-document the fact that the task statistics are protected by all_tasks_mutex. - - - - - edb4b92b by Ben Gamari at 2020-10-24T21:01:18-04:00 rts/WSDeque: Rewrite with proper atomics After a few attempts at shoring up the previous implementation, I ended up turning to the literature and now use the proven implementation, > N.M. Lê, A. Pop, A.Cohen, and F.Z. Nardelli. "Correct and Efficient > Work-Stealing for Weak Memory Models". PPoPP'13, February 2013, > ACM 978-1-4503-1922/13/02. Note only is this approach formally proven correct under C11 semantics but it is also proved to be a bit faster in practice. - - - - - d39bbd3d by Ben Gamari at 2020-10-24T21:01:33-04:00 rts: Use relaxed atomics for whitehole spin stats - - - - - 8f802f38 by Ben Gamari at 2020-10-24T21:01:33-04:00 rts: Avoid lock order inversion during fork Fixes #17275. - - - - - cef667b0 by GHC GitLab CI at 2020-10-24T21:01:34-04:00 rts: Use proper relaxe operations in getCurrentThreadCPUTime Here we are doing lazy initialization; it's okay if we do the check more than once, hence relaxed operation is fine. - - - - - 8cf50eb1 by Ben Gamari at 2020-10-24T21:01:54-04:00 rts/STM: Use atomics This fixes a potentially harmful race where we failed to synchronize before looking at a TVar's current_value. Also did a bit of refactoring to avoid abstract over management of max_commits. - - - - - 88a7ce38 by Ben Gamari at 2020-10-24T21:01:54-04:00 rts/stm: Strengthen orderings to SEQ_CST instead of volatile Previously the `current_value`, `first_watch_queue_entry`, and `num_updates` fields of `StgTVar` were marked as `volatile` in an attempt to provide strong ordering. Of course, this isn't sufficient. We now use proper atomic operations. In most of these cases I strengthen the ordering all the way to SEQ_CST although it's possible that some could be weakened with some thought. - - - - - f97c59ce by Ben Gamari at 2020-10-24T21:02:11-04:00 Mitigate data races in event manager startup/shutdown - - - - - c7c3f8aa by Ben Gamari at 2020-10-24T21:02:22-04:00 rts: Accept benign races in Proftimer - - - - - 5a98dfca by Ben Gamari at 2020-10-24T21:02:22-04:00 rts: Pause timer while changing capability count This avoids #17289. - - - - - 01d95525 by Ben Gamari at 2020-10-24T21:02:22-04:00 Fix #17289 - - - - - 9a528985 by Ben Gamari at 2020-10-24T21:02:23-04:00 suppress #17289 (ticker) race - - - - - 1726ec41 by Ben Gamari at 2020-10-24T21:02:23-04:00 rts: Fix timer initialization Previously `initScheduler` would attempt to pause the ticker and in so doing acquire the ticker mutex. However, initTicker, which is responsible for initializing said mutex, hadn't been called yet. - - - - - bfbe4366 by Ben Gamari at 2020-10-24T21:02:23-04:00 rts: Fix races in Pthread timer backend shudown We can generally be pretty relaxed in the barriers here since the timer thread is a loop. - - - - - 297acc71 by Ben Gamari at 2020-10-24T21:02:44-04:00 rts/Stats: Hide a few unused unnecessarily global functions - - - - - 9ad51bc9 by David Beacham at 2020-10-27T13:59:35-04:00 Fix `instance Bounded a => Bounded (Down a)` (#18716) * Flip `minBound` and `maxBound` to respect the change in ordering * Remove awkward `Enum` (and hence `Integral`) instances for `Data.Ord.Down` * Update changelog - - - - - eedec53d by Vladislav Zavialov at 2020-10-27T14:00:11-04:00 Version bump: base-4.16 (#18712) Also bumps upper bounds on base in boot libraries (incl. submodules). - - - - - 412018c1 by Tamar Christina at 2020-10-27T14:00:49-04:00 winio: simplify logic remove optimization step. - - - - - 4950dd07 by Ben Gamari at 2020-10-27T14:01:24-04:00 hadrian: Suppress xelatex output unless it fails As noted in #18835, xelatex produces an absurd amount of output, nearly all of which is meaningless. Silence this. Fixes #18835. - - - - - f3d8ab2e by Ben Gamari at 2020-10-27T14:02:00-04:00 build system: Clean mingw tarballs Tamar noticed in !4293 that the build systems fail to clean up the mingw tarballs directory (`ghc-tarballs`). Fix this in both the make build system and Hadrian. - - - - - 0b3d23af by Simon Peyton Jones at 2020-10-27T14:02:34-04:00 Fix two constraint solving problems This patch fixes two problems in the constraint solver. * An actual bug #18555: we were floating out a constraint to eagerly, and that was ultimately fatal. It's explained in Note [Do not float blocked constraints] in GHC.Core.Constraint. This is all very delicate, but it's all going to become irrelevant when we stop floating constraints (#17656). * A major performance infelicity in the flattener. When flattening (ty |> co) we *never* generated Refl, even when there was nothing at all to do. Result: we would gratuitously rewrite the constraint to exactly the same thing, wasting work. Described in #18413, and came up again in #18855. Solution: exploit the special case by calling the new function castCoercionKind1. See Note [castCoercionKind1] in GHC.Core.Coercion - - - - - f76c5a08 by Sergei Trofimovich at 2020-10-27T14:03:14-04:00 ghc.mk: amend 'make sdist' Noticed 'make sdist' failure seen as: ``` "rm" -rf sdistprep/ghc/ghc-9.1.0.20201020/hadrian/_build/ (SRC_DIST_GHC_DIR)/hadrian/dist-newstyle/ /bin/sh: -c: line 0: syntax error near unexpected token `(' ``` commit 9657f6f34 ("sdist: Include hadrian sources in source distribution") added a new cleanup path without a variable expantion. The change adds variable reference. While at it move directory cleanup to a separate statement. Amends #18794 Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - 78b52c88 by David Eichmann at 2020-10-27T14:03:51-04:00 Use config.run_ways for multi_compile_and_run tests - - - - - e3fdd419 by Alan Zimmerman at 2020-10-27T14:04:26-04:00 Api Annotations: Introduce AnnPercent for HsExplicitMult For the case foo :: a %p -> b The location of the '%' is captured, separate from the 'p' - - - - - d2a25f42 by Ben Gamari at 2020-10-27T14:05:02-04:00 gitlab-ci: Bump ci-images Bumps bootstrap compiler to 8.10.1. - - - - - 28f98b01 by Sebastian Graf at 2020-10-27T14:05:37-04:00 DmdAnal: Kill `is_thunk` case in `splitFV` The `splitFV` function implements the highly dubious hack described in `Note [Lazy und unleashable free variables]` in GHC.Core.Opt.DmdAnal. It arranges it so that demand signatures only carry strictness info on free variables. Usage info is released through other means, see the Note. It's purely for analysis performance reasons. It turns out that `splitFV` has a quite involved case for thunks that produces slightly different usage signatures and it's not clear why we need it: `splitFV` is only relevant in the LetDown case and the only time we call it on thunks is for top-level or local recursive thunks. Since usage signatures of top-level thunks can only reference other top-level bindings and we completely discard demand info we have on top-level things (see the lack of `setIdDemandInfo` in `dmdAnalTopBind`), the `is_thunk` case is completely irrelevant here. For local, recursive thunks, the added benefit of the `is_thunk` test is marginal: We get used-multiple-times in some cases where previously we had used-once if a recursive thunk has multiple call sites. It's very unlikely and not a case to optimise for. So we kill the `is_thunk` case and inline `splitFV` at its call site, exposing `isWeakDmd` from `GHC.Types.Demand` instead. The NoFib summary supports this decision: ``` Min 0.0% -0.0% Max 0.0% +0.0% Geometric Mean -0.0% -0.0% ``` - - - - - 60322f93 by Ben Gamari at 2020-10-28T21:11:39-04:00 hadrian: Don't quote metric baseline argument Previously this was quoted inappropriately. - - - - - c85eb372 by Alan Zimmerman at 2020-10-28T21:12:15-04:00 API Annotations: put constructors in alphabetical order - - - - - 795908dc by John Ericson at 2020-10-29T03:53:14-04:00 Widen acceptance threshold for T10421a Progress towards #18842. As @sgraf812 points out, widening the window is dangerous until the exponential described in #17658 is fixed. But this test has caused enough misery and is low stakes enough that we and @bgamari think it's worth it in this one case for the time being. - - - - - 0e9f6def by Sylvain Henry at 2020-10-29T03:53:52-04:00 Split GHC.Driver.Types I was working on making DynFlags stateless (#17957), especially by storing loaded plugins into HscEnv instead of DynFlags. It turned out to be complicated because HscEnv is in GHC.Driver.Types but LoadedPlugin isn't: it is in GHC.Driver.Plugins which depends on GHC.Driver.Types. I didn't feel like introducing yet another hs-boot file to break the loop. Additionally I remember that while we introduced the module hierarchy (#13009) we talked about splitting GHC.Driver.Types because it contained various unrelated types and functions, but we never executed. I didn't feel like making GHC.Driver.Types bigger with more unrelated Plugins related types, so finally I bit the bullet and split GHC.Driver.Types. As a consequence this patch moves a lot of things. I've tried to put them into appropriate modules but nothing is set in stone. Several other things moved to avoid loops. * Removed Binary instances from GHC.Utils.Binary for random compiler things * Moved Typeable Binary instances into GHC.Utils.Binary.Typeable: they import a lot of things that users of GHC.Utils.Binary don't want to depend on. * put everything related to Units/Modules under GHC.Unit: GHC.Unit.Finder, GHC.Unit.Module.{ModGuts,ModIface,Deps,etc.} * Created several modules under GHC.Types: GHC.Types.Fixity, SourceText, etc. * Split GHC.Utils.Error (into GHC.Types.Error) * Finally removed GHC.Driver.Types Note that this patch doesn't put loaded plugins into HscEnv. It's left for another patch. Bump haddock submodule - - - - - 22f5d9a9 by Sylvain Henry at 2020-10-29T03:53:52-04:00 GC: Avoid data race (#18717, #17964) - - - - - 2ef2fac4 by Ryan Scott at 2020-10-29T04:18:52-04:00 Check for large tuples more thoroughly This fixes #18723 by: * Moving the existing `GHC.Tc.Gen.HsType.bigConstraintTuple` validity check to `GHC.Rename.Utils.checkCTupSize` for consistency with `GHC.Rename.Utils.checkTupSize`, and * Using `check(C)TupSize` when checking tuple _types_, in addition to checking names, expressions, and patterns. Note that I put as many of these checks as possible in the typechecker so that GHC can properly distinguish between boxed and constraint tuples. The exception to this rule is checking names, which I perform in the renamer (in `GHC.Rename.Env`) so that we can rule out `(,, ... ,,)` and `''(,, ... ,,)` alike in one fell swoop. While I was in town, I also removed the `HsConstraintTuple` and `HsBoxedTuple` constructors of `HsTupleSort`, which are functionally unused. This requires a `haddock` submodule bump. - - - - - 7f8be3eb by Richard Eisenberg at 2020-10-29T22:08:13-04:00 Remove unnecessary gender from comments/docs While, say, alternating "he" and "she" in sequential writing may be nicer than always using "they", reading code/documentation is almost never sequential. If this small change makes individuals feel more welcome in GHC's codebase, that's a good thing. - - - - - aad1f803 by Ben Gamari at 2020-10-30T00:41:14-04:00 rts/GC: Use atomics - - - - - d0bc0517 by Ben Gamari at 2020-10-30T00:41:14-04:00 rts: Use RELEASE ordering in unlockClosure - - - - - d44f5232 by Ben Gamari at 2020-10-30T00:41:14-04:00 rts/Storage: Accept races on heap size counters - - - - - 4e4a7386 by Ben Gamari at 2020-10-30T00:41:14-04:00 rts: Join to concurrent mark thread during shutdown Previously we would take all capabilities but fail to join on the thread itself, potentially resulting in a leaked thread. - - - - - a80cc857 by GHC GitLab CI at 2020-10-30T00:41:14-04:00 rts: Fix race in GC CPU time accounting Ensure that the GC leader synchronizes with workers before calling stat_endGC. - - - - - 9902d9ec by Viktor Dukhovni at 2020-10-30T05:28:30-04:00 [skip ci] Fix typo in `callocBytes` haddock. - - - - - 105d43db by Ben Gamari at 2020-10-30T14:02:19-04:00 rts/SpinLock: Separate out slow path Not only is this in general a good idea, but it turns out that GCC unrolls the retry loop, resulting is massive code bloat in critical parts of the RTS (e.g. `evacuate`). - - - - - f7b45cde by Ben Gamari at 2020-10-30T14:02:19-04:00 rts: Use relaxed ordering on spinlock counters - - - - - 31fcb55f by Ryan Scott at 2020-10-30T18:52:50-04:00 Split HsConDecl{H98,GADT}Details Haskell98 and GADT constructors both use `HsConDeclDetails`, which includes `InfixCon`. But `InfixCon` is never used for GADT constructors, which results in an awkward unrepresentable state. This removes the unrepresentable state by: * Renaming the existing `HsConDeclDetails` synonym to `HsConDeclH98Details`, which emphasizes the fact that it is now only used for Haskell98-style data constructors, and * Creating a new `HsConDeclGADTDetails` data type with `PrefixConGADT` and `RecConGADT` constructors that closely resemble `PrefixCon` and `InfixCon` in `HsConDeclH98Details`. The key difference is that `HsConDeclGADTDetails` lacks any way to represent infix constructors. The rest of the patch is refactoring to accommodate the new structure of `HsConDecl{H98,GADT}Details`. Some highlights: * The `getConArgs` and `hsConDeclArgTys` functions have been removed, as there is no way to implement these functions uniformly for all `ConDecl`s. For the most part, their previous call sites now pattern match on the `ConDecl`s directly and do different things for `ConDeclH98`s and `ConDeclGADT`s. I did introduce one new function to make the transition easier: `getRecConArgs_maybe`, which extracts the arguments from a `RecCon(GADT)`. This is still possible since `RecCon(GADT)`s still use the same representation in both `HsConDeclH98Details` and `HsConDeclGADTDetails`, and since the pattern that `getRecConArgs_maybe` implements is used in several places, I thought it worthwhile to factor it out into its own function. * Previously, the `con_args` fields in `ConDeclH98` and `ConDeclGADT` were both of type `HsConDeclDetails`. Now, the former is of type `HsConDeclH98Details`, and the latter is of type `HsConDeclGADTDetails`, which are distinct types. As a result, I had to rename the `con_args` field in `ConDeclGADT` to `con_g_args` to make it typecheck. A consequence of all this is that the `con_args` field is now partial, so using `con_args` as a top-level field selector is dangerous. (Indeed, Haddock was using `con_args` at the top-level, which caused it to crash at runtime before I noticed what was wrong!) I decided to add a disclaimer in the 9.2.1 release notes to advertise this pitfall. Fixes #18844. Bumps the `haddock` submodule. - - - - - 57c3db96 by Ryan Scott at 2020-10-31T02:53:55-04:00 Make typechecker equality consider visibility in ForAllTys Previously, `can_eq_nc'` would equate `ForAllTy`s regardless of their `ArgFlag`, including `forall i -> i -> Type` and `forall i. i -> Type`! To fix this, `can_eq_nc'` now uses the `sameVis` function to first check if the `ArgFlag`s are equal modulo specificity. I have also updated `tcEqType`'s implementation to match this behavior. For more explanation on the "modulo specificity" part, see the new `Note [ForAllTy and typechecker equality]` in `GHC.Tc.Solver.Canonical`. While I was in town, I fixed some related documentation issues: * I added `Note [Typechecker equality]` to `GHC.Tc.Utils.TcType` to describe what exactly distinguishes `can_eq_nc'` and `tcEqType` (which implement typechecker equality) from `eqType` (which implements definitional equality, which does not care about the `ArgFlags` of `ForAllTy`s at all). * The User's Guide had some outdated prose on the specified/inferred distinction being different for types and kinds, a holdover from #15079. This is no longer the case on today's GHC, so I removed this prose, added some new prose to take its place, and added a regression test for the programs in #15079. * The User's Guide had some _more_ outdated prose on inferred type variables not being allowed in `default` type signatures for class methods, which is no longer true as of the resolution of #18432. * The related `Note [Deferred Unification]` was being referenced as `Note [Deferred unification]` elsewhere, which made it harder to `grep` for. I decided to change the name of the Note to `Deferred unification` for consistency with the capitalization style used for most other Notes. Fixes #18863. - - - - - a98593f0 by Sylvain Henry at 2020-10-31T02:54:34-04:00 Refactor numeric constant folding rules Avoid the use of global pattern synonyms. 1) I think it's going to be helpful to implement constant folding for other numeric types, especially Natural which doesn't have a wrapping behavior. We'll have to refactor these rules even more so we'd better make them less cryptic. 2) It should also be slightly faster because global pattern synonyms matched operations for every numeric types instead of the current one: e.g., ":**:" pattern was matching multiplication for both Int# and Word# types. As we will probably want to implement constant folding for other numeric types (Int8#, Int16#, etc.), it is more efficient to only match primops for a given type as we do now. - - - - - 730ef38f by Sylvain Henry at 2020-10-31T02:54:34-04:00 Simplify constant-folding (#18032) See #18032 for the details. * Use `Lit (LitNumber _ i)` instead of `isLitValue_maybe` which does more work but that is not needed for constant-folding * Don't export `GHC.Types.Literal.isLitValue_maybe` * Kill `GHC.Types.Literal.isLitValue` which isn't used - - - - - d5a53c1a by Ben Gamari at 2020-10-31T02:55:10-04:00 primops.txt.pp: Move ByteArray# primops to separate file This file will be generated. - - - - - b4278a41 by Ben Gamari at 2020-10-31T02:55:10-04:00 primops: Generate ByteArray# index/read/write primops Previously these were mostly undocumented and was ripe for potential inconsistencies. - - - - - 08e6993a by Sylvain Henry at 2020-10-31T02:55:50-04:00 Move loadDecl into IfaceToCore - - - - - cb1f755c by Tamar Christina at 2020-10-31T09:26:56-04:00 winio: Fix unused variables warnings - - - - - eb368078 by Andrzej Rybczak at 2020-10-31T09:27:34-04:00 Add testcase for #816 - - - - - bd4abdc9 by Ben Gamari at 2020-11-01T01:10:31-04:00 testsuite: Add performance test for #18698 - - - - - dfd27445 by Hécate at 2020-11-01T01:11:09-04:00 Add the proper HLint rules and remove redundant keywords from compiler - - - - - ce1bb995 by Hécate at 2020-11-01T08:52:08-05:00 Fix a leak in `transpose` This patch was authored by David Feuer <david.feuer at gmail.com> - - - - - e63db32c by Ben Gamari at 2020-11-01T08:52:44-05:00 Scav: Use bd->gen_no instead of bd->gen->no This potentially saves a cache miss per scavenge. - - - - - b1dda153 by Ben Gamari at 2020-11-01T12:58:36-05:00 rts/Stats: Protect with mutex While on face value this seems a bit heavy, I think it's far better than enforcing ordering on every access. - - - - - 5c2e6bce by Ben Gamari at 2020-11-01T12:58:36-05:00 rts: Tear down stats_mutex after exitHeapProfiling Since the latter wants to call getRTSStats. - - - - - ef25aaa1 by Ben Gamari at 2020-11-01T13:02:11-05:00 rts: Annotate hopefully "benign" races in freeGroup - - - - - 3a181553 by Ben Gamari at 2020-11-01T13:02:18-05:00 Strengthen ordering in releaseGCThreads - - - - - af474f62 by Ben Gamari at 2020-11-01T13:05:38-05:00 Suppress data race due to close This suppresses the other side of a race during shutdown. - - - - - b4686bff by Ben Gamari at 2020-11-01T13:09:59-05:00 Merge branch 'wip/tsan/ci' into wip/tsan/all - - - - - b8e66e0e by Ben Gamari at 2020-11-01T13:10:01-05:00 Merge branch 'wip/tsan/storage' into wip/tsan/all - - - - - 375512cf by Ben Gamari at 2020-11-01T13:10:02-05:00 Merge branch 'wip/tsan/wsdeque' into wip/tsan/all - - - - - 65ebf07e by Ben Gamari at 2020-11-01T13:10:03-05:00 Merge branch 'wip/tsan/misc' into wip/tsan/all - - - - - 55c375d0 by Ben Gamari at 2020-11-01T13:10:04-05:00 Merge branch 'wip/tsan/stm' into wip/tsan/all - - - - - a9f75fe2 by Ben Gamari at 2020-11-01T13:10:06-05:00 Merge branch 'wip/tsan/event-mgr' into wip/tsan/all - - - - - 8325d658 by Ben Gamari at 2020-11-01T13:10:24-05:00 Merge branch 'wip/tsan/timer' into wip/tsan/all - - - - - 07e82ba5 by Ben Gamari at 2020-11-01T13:10:35-05:00 Merge branch 'wip/tsan/stats' into wip/tsan/all - - - - - 4ce2f7d6 by GHC GitLab CI at 2020-11-02T23:45:06-05:00 testsuite: Add --top flag to driver This allows us to make `config.top` a proper Path. Previously it was a str, which caused the Ghostscript detection logic to break. - - - - - 0b772221 by Ben Gamari at 2020-11-02T23:45:42-05:00 Document that ccall convention doesn't support varargs We do not support foreign "C" imports of varargs functions. While this works on amd64, in general the platform's calling convention may need more type information that our Cmm representation can currently provide. For instance, this is the case with Darwin's AArch64 calling convention. Document this fact in the users guide and fix T5423 which makes use of a disallowed foreign import. Closes #18854. - - - - - 81006a06 by David Eichmann at 2020-11-02T23:46:19-05:00 RtsAPI: pause and resume the RTS The `rts_pause` and `rts_resume` functions have been added to `RtsAPI.h` and allow an external process to completely pause and resume the RTS. Co-authored-by: Sven Tennie <sven.tennie at gmail.com> Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> Co-authored-by: Ben Gamari <bgamari.foss at gmail.com> - - - - - bfb1e272 by Ryan Scott at 2020-11-02T23:46:55-05:00 Display results of GHC.Core.Lint.lint* functions consistently Previously, the functions in `GHC.Core.Lint` used a patchwork of different ways to display Core Lint errors: * `lintPassResult` (which is the source of most Core Lint errors) renders Core Lint errors with a distinctive banner (e.g., `*** Core Lint errors : in result of ... ***`) that sets them apart from ordinary GHC error messages. * `lintAxioms`, in contrast, uses a completely different code path that displays Core Lint errors in a rather confusing manner. For example, the program in #18770 would give these results: ``` Bug.hs:1:1: error: Bug.hs:12:1: warning: Non-*-like kind when *-like expected: RuntimeRep when checking the body of forall: 'TupleRep '[r] In the coercion axiom Bug.N:T :: []. Bug.T ~_R Any Substitution: [TCvSubst In scope: InScope {r} Type env: [axl :-> r] Co env: []] | 1 | {-# LANGUAGE DataKinds #-} | ^ ``` * Further digging reveals that `GHC.IfaceToCore` displays Core Lint errors for iface unfoldings as though they were a GHC panic. See, for example, this excerpt from #17723: ``` ghc: panic! (the 'impossible' happened) (GHC version 8.8.2 for x86_64-unknown-linux): Iface Lint failure In interface for Lib ... ``` This patch makes all of these code paths display Core Lint errors and warnings consistently. I decided to adopt the conventions that `lintPassResult` currently uses, as they appear to have been around the longest (and look the best, in my subjective opinion). We now use the `displayLintResult` function for all three scenarios mentioned above. For example, here is what the Core Lint error for the program in #18770 looks like after this patch: ``` [1 of 1] Compiling Bug ( Bug.hs, Bug.o ) *** Core Lint errors : in result of TcGblEnv axioms *** Bug.hs:12:1: warning: Non-*-like kind when *-like expected: RuntimeRep when checking the body of forall: 'TupleRep '[r_axn] In the coercion axiom N:T :: []. T ~_R Any Substitution: [TCvSubst In scope: InScope {r_axn} Type env: [axn :-> r_axn] Co env: []] *** Offending Program *** axiom N:T :: T = Any -- Defined at Bug.hs:12:1 *** End of Offense *** <no location info>: error: Compilation had errors ``` Fixes #18770. - - - - - a9e5f52c by Simon Peyton Jones at 2020-11-02T23:47:31-05:00 Expand type synonyms with :kind! The User's Guide claims that `:kind!` should expand type synonyms, but GHCi wasn't doing this in practice. Let's just update the implementation to match the specification in the User's Guide. Fixes #13795. Fixes #18828. Co-authored-by: Ryan Scott <ryan.gl.scott at gmail.com> - - - - - 1370eda7 by Ben Gamari at 2020-11-02T23:48:06-05:00 hadrian: Don't capture RunTest output There are a few reasons why capturing the output of the RunTest builder is undesirable: * there is a large amount of output which then gets unnecessarily duplicated by Hadrian if the builder fails * the output may contain codepoints which are unrepresentable in the current codepage on Windows, causing Hadrian to crash * capturing the output causes the testsuite driver to disable its colorisation logic, making the output less legible. - - - - - 78f2767d by Matthew Pickering at 2020-11-03T17:39:53-05:00 Update inlining flags documentation - - - - - 14ce454f by Sylvain Henry at 2020-11-03T17:40:34-05:00 Linker: reorganize linker related code Move linker related code into GHC.Linker. Previously it was scattered into GHC.Unit.State, GHC.Driver.Pipeline, GHC.Runtime.Linker, etc. Add documentation in GHC.Linker - - - - - 616bec0d by Alan Zimmerman at 2020-11-03T17:41:10-05:00 Restrict Linear arrow %1 to exactly literal 1 only This disallows `a %001 -> b`, and makes sure the type literal is printed from its SourceText so it is clear why. Closes #18888 - - - - - 3486ebe6 by Sylvain Henry at 2020-11-03T17:41:48-05:00 Hadrian: don't fail if ghc-tarballs dir doesn't exist - - - - - 37f0434d by Sylvain Henry at 2020-11-03T17:42:26-05:00 Constant-folding: don't pass through GHC's Int/Word (fix #11704) Constant-folding rules for integerToWord/integerToInt were performing the following coercions at compilation time: integerToWord: target's Integer -> ghc's Word -> target's Word integerToInt : target's Integer -> ghc's Int -> target's Int 1) It was wrong for cross-compilers when GHC's word size is smaller than the target one. This patch avoids passing through GHC's word-sized types: integerToWord: target's Integer -> ghc's Integer -> target's Word integerToInt : target's Integer -> ghc's Integer -> target's Int 2) Additionally we didn't wrap the target word/int literal to make it fit into the target's range! This broke the invariant of literals only containing values in range. The existing code is wrong only with a 64-bit cross-compiling GHC, targeting a 32-bit platform, and performing constant folding on a literal that doesn't fit in a 32-bit word. If GHC was built with DEBUG, the assertion in GHC.Types.Literal.mkLitWord would fail. Otherwise the bad transformation would go unnoticed. - - - - - bff74de7 by Sylvain Henry at 2020-11-03T17:43:03-05:00 Bignum: make GMP's bignat_add not recursive bignat_add was a loopbreaker with an INLINE pragma (spotted by @mpickering). This patch makes it non recursive to avoid the issue. - - - - - bb100805 by Andreas Klebinger at 2020-11-04T16:47:24-05:00 NCG: Fix 64bit int comparisons on 32bit x86 We no compare these by doing 64bit subtraction and checking the resulting flags. We used to do this differently but the old approach was broken when the high bits compared equal and the comparison was one of >= or <=. The new approach should be both correct and faster. - - - - - b790b7f9 by Andreas Klebinger at 2020-11-04T16:47:59-05:00 Testsuite: Support for user supplied package dbs We can now supply additional package dbs to the testsuite. For make the package db can be supplied by passing PACKAGE_DB=/path/to/db. In the testsuite driver it's passed via the --test-package-db argument. - - - - - 81560981 by Sylvain Henry at 2020-11-04T16:48:42-05:00 Don't use LEA with 8-bit registers (#18614) - - - - - 17d5c518 by Viktor Dukhovni at 2020-11-05T00:50:23-05:00 Naming, value types and tests for Addr# atomics The atomic Exchange and CAS operations on integral types are updated to take and return more natural `Word#` rather than `Int#` values. These are bit-block not arithmetic operations, and the sign bit plays no special role. Standardises the names to `atomic<OpType><ValType>Addr#`, where `OpType` is one of `Cas` or `Exchange` and `ValType` is presently either `Word` or `Addr`. Eventually, variants for `Word32` and `Word64` can and should be added, once #11953 and related issues (e.g. #13825) are resolved. Adds tests for `Addr#` CAS that mirror existing tests for `MutableByteArray#`. - - - - - 2125b1d6 by Ryan Scott at 2020-11-05T00:51:01-05:00 Add a regression test for #18920 Commit f594a68a5500696d94ae36425bbf4d4073aca3b2 (`Use level numbers for generalisation`) ended up fixing #18920. Let's add a regression test to ensure that it stays fixed. Fixes #18920. - - - - - e07e383a by Ryan Scott at 2020-11-06T03:45:28-05:00 Replace HsImplicitBndrs with HsOuterTyVarBndrs This refactors the GHC AST to remove `HsImplicitBndrs` and replace it with `HsOuterTyVarBndrs`, a type which records whether the outermost quantification in a type is explicit (i.e., with an outermost, invisible `forall`) or implicit. As a result of this refactoring, it is now evident in the AST where the `forall`-or-nothing rule applies: it's all the places that use `HsOuterTyVarBndrs`. See the revamped `Note [forall-or-nothing rule]` in `GHC.Hs.Type` (previously in `GHC.Rename.HsType`). Moreover, the places where `ScopedTypeVariables` brings lexically scoped type variables into scope are a subset of the places that adhere to the `forall`-or-nothing rule, so this also makes places that interact with `ScopedTypeVariables` easier to find. See the revamped `Note [Lexically scoped type variables]` in `GHC.Hs.Type` (previously in `GHC.Tc.Gen.Sig`). `HsOuterTyVarBndrs` are used in type signatures (see `HsOuterSigTyVarBndrs`) and type family equations (see `HsOuterFamEqnTyVarBndrs`). The main difference between the former and the latter is that the former cares about specificity but the latter does not. There are a number of knock-on consequences: * There is now a dedicated `HsSigType` type, which is the combination of `HsOuterSigTyVarBndrs` and `HsType`. `LHsSigType` is now an alias for an `XRec` of `HsSigType`. * Working out the details led us to a substantial refactoring of the handling of explicit (user-written) and implicit type-variable bindings in `GHC.Tc.Gen.HsType`. Instead of a confusing family of higher order functions, we now have a local data type, `SkolemInfo`, that controls how these binders are kind-checked. It remains very fiddly, not fully satisfying. But it's better than it was. Fixes #16762. Bumps the Haddock submodule. Co-authored-by: Simon Peyton Jones <simonpj at microsoft.com> Co-authored-by: Richard Eisenberg <rae at richarde.dev> Co-authored-by: Zubin Duggal <zubin at cmi.ac.in> - - - - - c85f4928 by Sylvain Henry at 2020-11-06T03:46:08-05:00 Refactor -dynamic-too handling 1) Don't modify DynFlags (too much) for -dynamic-too: now when we generate dynamic outputs for "-dynamic-too", we only set "dynamicNow" boolean field in DynFlags instead of modifying several other fields. These fields now have accessors that take dynamicNow into account. 2) Use DynamicTooState ADT to represent -dynamic-too state. It's much clearer than the undocumented "DynamicTooConditional" that was used before. As a result, we can finally remove the hscs_iface_dflags field in HscRecomp. There was a comment on this field saying: "FIXME (osa): I don't understand why this is necessary, but I spent almost two days trying to figure this out and I couldn't .. perhaps someone who understands this code better will remove this later." I don't fully understand the details, but it was needed because of the changes made to the DynFlags for -dynamic-too. There is still something very dubious in GHC.Iface.Recomp: we have to disable the "dynamicNow" flag at some point for some Backpack's "heinous hack" to continue to work. It may be because interfaces for indefinite units are always non-dynamic, or because we mix and match dynamic and non-dynamic interfaces (#9176), or something else, who knows? - - - - - 2cb87909 by Moritz Angermann at 2020-11-06T03:46:44-05:00 [AArch64] Aarch64 Always PIC - - - - - b1d2c1f3 by Ben Gamari at 2020-11-06T03:47:19-05:00 rts/Sanity: Avoid nasty race in weak pointer sanity-checking See Note [Racing weak pointer evacuation] for all of the gory details. - - - - - 638f38c5 by Ben Gamari at 2020-11-08T09:29:16-05:00 Merge remote-tracking branch 'origin/wip/tsan/all' - - - - - 22888798 by Ben Gamari at 2020-11-08T12:08:40-05:00 Fix haddock submodule The previous merge mistakenly reverted it. - - - - - d445cf05 by Ben Gamari at 2020-11-10T10:26:20-05:00 rts/linker: Fix relocation overflow in PE linker Previously the overflow check for the IMAGE_REL_AMD64_ADDR32NB relocation failed to account for the signed nature of the value. Specifically, the overflow check was: uint64_t v; v = S + A; if (v >> 32) { ... } However, `v` ultimately needs to fit into 32-bits as a signed value. Consequently, values `v > 2^31` in fact overflow yet this is not caught by the existing overflow check. Here we rewrite the overflow check to rather ensure that `INT32_MIN <= v <= INT32_MAX`. There is now quite a bit of repetition between the `IMAGE_REL_AMD64_REL32` and `IMAGE_REL_AMD64_ADDR32` cases but I am leaving fixing this for future work. This bug was first noticed by @awson. Fixes #15808. - - - - - 4c407f6e by Sylvain Henry at 2020-11-10T10:27:00-05:00 Export SPEC from GHC.Exts (#13681) - - - - - 7814cd5b by David Eichmann at 2020-11-10T10:27:35-05:00 ghc-heap: expose decoding from heap representation Co-authored-by: Sven Tennie <sven.tennie at gmail.com> Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> Co-authored-by: Ben Gamari <bgamari.foss at gmail.com> - - - - - fa344d33 by Richard Eisenberg at 2020-11-10T10:28:10-05:00 Add test case for #17186. This got fixed sometime recently; not worth it trying to figure out which commit. - - - - - 2e63a0fb by David Eichmann at 2020-11-10T10:28:46-05:00 Add code comments for StgInfoTable and StgStack structs - - - - - fcfda909 by Ben Gamari at 2020-11-11T03:19:59-05:00 nativeGen: Make makeImportsDoc take an NCGConfig rather than DynFlags It appears this was an oversight as there is no reason the full DynFlags is necessary. - - - - - 6e23695e by Ben Gamari at 2020-11-11T03:19:59-05:00 Move this_module into NCGConfig In various places in the NCG we need the Module currently being compiled. Let's move this into the environment instead of chewing threw another register. - - - - - c6264a2d by Ben Gamari at 2020-11-11T03:20:00-05:00 codeGen: Produce local symbols for module-internal functions It turns out that some important native debugging/profiling tools (e.g. perf) rely only on symbol tables for function name resolution (as opposed to using DWARF DIEs). However, previously GHC would emit temporary symbols (e.g. `.La42b`) to identify module-internal entities. Such symbols are dropped during linking and therefore not visible to runtime tools (in addition to having rather un-helpful unique names). For instance, `perf report` would often end up attributing all cost to the libc `frame_dummy` symbol since Haskell code was no covered by any proper symbol (see #17605). We now rather follow the model of C compilers and emit descriptively-named local symbols for module internal things. Since this will increase object file size this behavior can be disabled with the `-fno-expose-internal-symbols` flag. With this `perf record` can finally be used against Haskell executables. Even more, with `-g3` `perf annotate` provides inline source code. - - - - - 584058dd by Ben Gamari at 2020-11-11T03:20:00-05:00 Enable -fexpose-internal-symbols when debug level >=2 This seems like a reasonable default as the object file size increases by around 5%. - - - - - c34a4b98 by Ömer Sinan Ağacan at 2020-11-11T03:20:35-05:00 Fix and enable object unloading in GHCi Fixes #16525 by tracking dependencies between object file symbols and marking symbol liveness during garbage collection See Note [Object unloading] in CheckUnload.c for details. - - - - - 2782487f by Ray Shih at 2020-11-11T03:20:35-05:00 Add loadNativeObj and unloadNativeObj (This change is originally written by niteria) This adds two functions: * `loadNativeObj` * `unloadNativeObj` and implements them for Linux. They are useful if you want to load a shared object with Haskell code using the system linker and have GHC call dlclose() after the code is no longer referenced from the heap. Using the system linker allows you to load the shared object above outside the low-mem region. It also loads the DWARF sections in a way that `perf` understands. `dl_iterate_phdr` is what makes this implementation Linux specific. - - - - - 7a65f9e1 by GHC GitLab CI at 2020-11-11T03:20:35-05:00 rts: Introduce highMemDynamic - - - - - e9e1b2e7 by GHC GitLab CI at 2020-11-11T03:20:35-05:00 Introduce test for dynamic library unloading This uses the highMemDynamic flag introduced earlier to verify that dynamic objects are properly unloaded. - - - - - 5506f134 by Krzysztof Gogolewski at 2020-11-11T03:21:14-05:00 Force argument in setIdMult (#18925) - - - - - 787e93ae by Ben Gamari at 2020-11-11T23:14:11-05:00 testsuite: Add testcase for #18733 - - - - - 5353fd50 by Ben Gamari at 2020-11-12T10:05:30-05:00 compiler: Fix recompilation checking In ticket #18733 we noticed a rather serious deficiency in the current fingerprinting logic for recursive groups. I have described the old fingerprinting story and its problems in Note [Fingerprinting recursive groups] and have reworked the story accordingly to avoid these issues. Fixes #18733. - - - - - 63fa3997 by Sebastian Graf at 2020-11-13T14:29:39-05:00 Arity: Rework `ArityType` to fix monotonicity (#18870) As we found out in #18870, `andArityType` is not monotone, with potentially severe consequences for termination of fixed-point iteration. That showed in an abundance of "Exciting arity" DEBUG messages that are emitted whenever we do more than one step in fixed-point iteration. The solution necessitates also recording `OneShotInfo` info for `ABot` arity type. Thus we get the following definition for `ArityType`: ``` data ArityType = AT [OneShotInfo] Divergence ``` The majority of changes in this patch are the result of refactoring use sites of `ArityType` to match the new definition. The regression test `T18870` asserts that we indeed don't emit any DEBUG output anymore for a function where we previously would have. Similarly, there's a regression test `T18937` for #18937, which we expect to be broken for now. Fixes #18870. - - - - - 197d59fa by Sebastian Graf at 2020-11-13T14:29:39-05:00 Arity: Emit "Exciting arity" warning only after second iteration (#18937) See Note [Exciting arity] why we emit the warning at all and why we only do after the second iteration now. Fixes #18937. - - - - - de7ec9dd by David Eichmann at 2020-11-13T14:30:16-05:00 Add rts_listThreads and rts_listMiscRoots to RtsAPI.h These are used to find the current roots of the garbage collector. Co-authored-by: Sven Tennie's avatarSven Tennie <sven.tennie at gmail.com> Co-authored-by: Matthew Pickering's avatarMatthew Pickering <matthewtpickering at gmail.com> Co-authored-by: default avatarBen Gamari <bgamari.foss at gmail.com> - - - - - 24a86f09 by Ben Gamari at 2020-11-13T14:30:51-05:00 gitlab-ci: Cache cabal store in linting job - - - - - 0a7e592c by Ben Gamari at 2020-11-15T03:35:45-05:00 nativeGen/dwarf: Fix procedure end addresses Previously the `.debug_aranges` and `.debug_info` (DIE) DWARF information would claim that procedures (represented with a `DW_TAG_subprogram` DIE) would only span the range covered by their entry block. This omitted all of the continuation blocks (represented by `DW_TAG_lexical_block` DIEs), confusing `perf`. Fix this by introducing a end-of-procedure label and using this as the `DW_AT_high_pc` of procedure `DW_TAG_subprogram` DIEs Fixes #17605. - - - - - 1e19183d by Ben Gamari at 2020-11-15T03:35:45-05:00 nativeGen/dwarf: Only produce DW_AT_source_note DIEs in -g3 Standard debugging tools don't know how to understand these so let's not produce them unless asked. - - - - - ad73370f by Ben Gamari at 2020-11-15T03:35:45-05:00 nativeGen/dwarf: Use DW_AT_linkage instead of DW_AT_MIPS_linkage - - - - - a2539650 by Ben Gamari at 2020-11-15T03:35:45-05:00 gitlab-ci: Add DWARF release jobs for Debian 10, Fedora27 - - - - - d61adb3d by Ryan Scott at 2020-11-15T03:36:21-05:00 Name (tc)SplitForAll- functions more consistently There is a zoo of `splitForAll-` functions in `GHC.Core.Type` (as well as `tcSplitForAll-` functions in `GHC.Tc.Utils.TcType`) that all do very similar things, but vary in the particular form of type variable that they return. To make things worse, the names of these functions are often quite misleading. Some particularly egregious examples: * `splitForAllTys` returns `TyCoVar`s, but `splitSomeForAllTys` returns `VarBndr`s. * `splitSomeForAllTys` returns `VarBndr`s, but `tcSplitSomeForAllTys` returns `TyVar`s. * `splitForAllTys` returns `TyCoVar`s, but `splitForAllTysInvis` returns `InvisTVBinder`s. (This in particular arose in the context of #18939, and this finally motivated me to bite the bullet and improve the status quo vis-à-vis how we name these functions.) In an attempt to bring some sanity to how these functions are named, I have opted to rename most of these functions en masse to use consistent suffixes that describe the particular form of type variable that each function returns. In concrete terms, this amounts to: * Functions that return a `TyVar` now use the suffix `-TyVar`. This caused the following functions to be renamed: * `splitTyVarForAllTys` -> `splitForAllTyVars` * `splitForAllTy_ty_maybe` -> `splitForAllTyVar_maybe` * `tcSplitForAllTys` -> `tcSplitForAllTyVars` * `tcSplitSomeForAllTys` -> `tcSplitSomeForAllTyVars` * Functions that return a `CoVar` now use the suffix `-CoVar`. This caused the following functions to be renamed: * `splitForAllTy_co_maybe` -> `splitForAllCoVar_maybe` * Functions that return a `TyCoVar` now use the suffix `-TyCoVar`. This caused the following functions to be renamed: * `splitForAllTy` -> `splitForAllTyCoVar` * `splitForAllTys` -> `splitForAllTyCoVars` * `splitForAllTys'` -> `splitForAllTyCoVars'` * `splitForAllTy_maybe` -> `splitForAllTyCoVar_maybe` * Functions that return a `VarBndr` now use the suffix corresponding to the most relevant type synonym. This caused the following functions to be renamed: * `splitForAllVarBndrs` -> `splitForAllTyCoVarBinders` * `splitForAllTysInvis` -> `splitForAllInvisTVBinders` * `splitForAllTysReq` -> `splitForAllReqTVBinders` * `splitSomeForAllTys` -> `splitSomeForAllTyCoVarBndrs` * `tcSplitForAllVarBndrs` -> `tcSplitForAllTyVarBinders` * `tcSplitForAllTysInvis` -> `tcSplitForAllInvisTVBinders` * `tcSplitForAllTysReq` -> `tcSplitForAllReqTVBinders` * `tcSplitForAllTy_maybe` -> `tcSplitForAllTyVarBinder_maybe` Note that I left the following functions alone: * Functions that split apart things besides `ForAllTy`s, such as `splitFunTys` or `splitPiTys`. Thankfully, there are far fewer of these functions than there are functions that split apart `ForAllTy`s, so there isn't much of a pressing need to apply the new naming convention elsewhere. * Functions that split apart `ForAllCo`s in `Coercion`s, such as `GHC.Core.Coercion.splitForAllCo_maybe`. We could theoretically apply the new naming convention here, but then we'd have to figure out how to disambiguate `Type`-splitting functions from `Coercion`-splitting functions. Ultimately, the `Coercion`-splitting functions aren't used nearly as much as the `Type`-splitting functions, so I decided to leave the former alone. This is purely refactoring and should cause no change in behavior. - - - - - 645444af by Ryan Scott at 2020-11-15T03:36:21-05:00 Use tcSplitForAllInvisTyVars (not tcSplitForAllTyVars) in more places The use of `tcSplitForAllTyVars` in `tcDataFamInstHeader` was the immediate cause of #18939, and replacing it with a new `tcSplitForAllInvisTyVars` function (which behaves like `tcSplitForAllTyVars` but only splits invisible type variables) fixes the issue. However, this led me to realize that _most_ uses of `tcSplitForAllTyVars` in GHC really ought to be `tcSplitForAllInvisTyVars` instead. While I was in town, I opted to replace most uses of `tcSplitForAllTys` with `tcSplitForAllTysInvis` to reduce the likelihood of such bugs in the future. I say "most uses" above since there is one notable place where we _do_ want to use `tcSplitForAllTyVars`: in `GHC.Tc.Validity.forAllTyErr`, which produces the "`Illegal polymorphic type`" error message if you try to use a higher-rank `forall` without having `RankNTypes` enabled. Here, we really do want to split all `forall`s, not just invisible ones, or we run the risk of giving an inaccurate error message in the newly added `T18939_Fail` test case. I debated at some length whether I wanted to name the new function `tcSplitForAllInvisTyVars` or `tcSplitForAllTyVarsInvisible`, but in the end, I decided that I liked the former better. For consistency's sake, I opted to rename the existing `splitPiTysInvisible` and `splitPiTysInvisibleN` functions to `splitInvisPiTys` and `splitPiTysInvisN`, respectively, so that they use the same naming convention. As a consequence, this ended up requiring a `haddock` submodule bump. Fixes #18939. - - - - - 8887102f by Moritz Angermann at 2020-11-15T03:36:56-05:00 AArch64/arm64 adjustments This addes the necessary logic to support aarch64 on elf, as well as aarch64 on mach-o, which Apple calls arm64. We change architecture name to AArch64, which is the official arm naming scheme. - - - - - fc644b1a by Ben Gamari at 2020-11-15T03:37:31-05:00 ghc-bin: Build with eventlogging by default We now have all sorts of great facilities using the eventlog which were previously unavailable without building a custom GHC. Fix this by linking with `-eventlog` by default. - - - - - 52114fa0 by Sylvain Henry at 2020-11-16T11:48:47+01:00 Add Addr# atomic primops (#17751) This reuses the codegen used for ByteArray#'s atomic primops. - - - - - 8150f654 by Sebastian Graf at 2020-11-18T23:38:40-05:00 PmCheck: Print types of uncovered patterns (#18932) In order to avoid confusion as in #18932, we display the type of the match variables in the non-exhaustiveness warning, e.g. ``` T18932.hs:14:1: warning: [-Wincomplete-patterns] Pattern match(es) are non-exhaustive In an equation for ‘g’: Patterns of type ‘T a’, ‘T a’, ‘T a’ not matched: (MkT2 _) (MkT1 _) (MkT1 _) (MkT2 _) (MkT1 _) (MkT2 _) (MkT2 _) (MkT2 _) (MkT1 _) (MkT2 _) (MkT2 _) (MkT2 _) ... | 14 | g (MkT1 x) (MkT1 _) (MkT1 _) = x | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ``` It also allows us to omit the type signature on wildcard matches which we previously showed in only some situations, particularly `-XEmptyCase`. Fixes #18932. - - - - - 165352a2 by Krzysztof Gogolewski at 2020-11-20T02:08:36-05:00 Export indexError from GHC.Ix (#18579) - - - - - b57845c3 by Kamil Dworakowski at 2020-11-20T02:09:16-05:00 Clarify interruptible FFI wrt masking state - - - - - 321d1bd8 by Sebastian Graf at 2020-11-20T02:09:51-05:00 Fix strictness signatures of `prefetchValue*#` primops Their strictness signatures said the primops are strict in their first argument, which is wrong: Handing it a thunk will prefetch the pointer to the thunk, but not evaluate it. Hence not strict. The regression test `T8256` actually tests for laziness in the first argument, so GHC apparently never exploited the strictness signature. See also https://gitlab.haskell.org/ghc/ghc/-/issues/8256#note_310867, where this came up. - - - - - 0aec78b6 by Sebastian Graf at 2020-11-20T02:09:51-05:00 Demand: Interleave usage and strictness demands (#18903) As outlined in #18903, interleaving usage and strictness demands not only means a more compact demand representation, but also allows us to express demands that we weren't easily able to express before. Call demands are *relative* in the sense that a call demand `Cn(cd)` on `g` says "`g` is called `n` times. *Whenever `g` is called*, the result is used according to `cd`". Example from #18903: ```hs h :: Int -> Int h m = let g :: Int -> (Int,Int) g 1 = (m, 0) g n = (2 * n, 2 `div` n) {-# NOINLINE g #-} in case m of 1 -> 0 2 -> snd (g m) _ -> uncurry (+) (g m) ``` Without the interleaved representation, we would just get `L` for the strictness demand on `g`. Now we are able to express that whenever `g` is called, its second component is used strictly in denoting `g` by `1C1(P(1P(U),SP(U)))`. This would allow Nested CPR to unbox the division, for example. Fixes #18903. While fixing regressions, I also discovered and fixed #18957. Metric Decrease: T13253-spj - - - - - 3a55b3a2 by Sebastian Graf at 2020-11-20T02:09:51-05:00 Update user's guide entry on demand analysis and worker/wrapper The demand signature notation has been undocumented for a long time. The only source to understand it, apart from reading the `Outputable` instance, has been an outdated wiki page. Since the previous commits have reworked the demand lattice, I took it as an opportunity to also write some documentation about notation. - - - - - fc963932 by Greg Steuck at 2020-11-20T02:10:31-05:00 Find hadrian location more reliably in cabal-install output Fix #18944 - - - - - 9f40cf6c by Ben Gamari at 2020-11-20T02:11:07-05:00 rts/linker: Align bssSize to page size when mapping symbol extras We place symbol_extras right after bss. We also need to ensure that symbol_extras can be mprotect'd independently from the rest of the image. To ensure this we round up the size of bss to a page boundary, thus ensuring that symbol_extras is also page-aligned. - - - - - b739c319 by Ben Gamari at 2020-11-20T02:11:43-05:00 gitlab-ci: Add usage message to ci.sh - - - - - 802e9180 by Ben Gamari at 2020-11-20T02:11:43-05:00 gitlab-ci: Add VERBOSE environment variable And change the make build system's default behavior to V=0, greatly reducing build log sizes. - - - - - 2a8a979c by Ben Gamari at 2020-11-21T01:13:26-05:00 users-guide: A bit of clean-up in profiling flag documentation - - - - - 56804e33 by Ben Gamari at 2020-11-21T01:13:26-05:00 testsuite: Refactor CountParserDeps - - - - - 53ad67ea by Ben Gamari at 2020-11-21T01:13:26-05:00 Introduce -fprof-callers flag This introducing a new compiler flag to provide a convenient way to introduce profiler cost-centers on all occurrences of the named identifier. Closes #18566. - - - - - ecfd0278 by Sylvain Henry at 2020-11-21T01:14:09-05:00 Move Plugins into HscEnv (#17957) Loaded plugins have nothing to do in DynFlags so this patch moves them into HscEnv (session state). "DynFlags plugins" become "Driver plugins" to still be able to register static plugins. Bump haddock submodule - - - - - 72f2257c by Sylvain Henry at 2020-11-21T01:14:09-05:00 Don't initialize plugins in the Core2Core pipeline Some plugins can be added via TH (cf addCorePlugin). Initialize them in the driver instead of in the Core2Core pipeline. - - - - - ddbeeb3c by Ryan Scott at 2020-11-21T01:14:44-05:00 Add regression test for #10504 This issue was fixed at some point between GHC 8.0 and 8.2. Let's add a regression test to ensure that it stays fixed. Fixes #10504. - - - - - a4a6dc2a by Ben Gamari at 2020-11-21T01:15:21-05:00 dwarf: Apply info table offset consistently Previously we failed to apply the info table offset to the aranges and DIEs, meaning that we often failed to unwind in gdb. For some reason this only seemed to manifest in the RTS's Cmm closures. Nevertheless, now we can unwind completely up to `main` - - - - - 69bfbc21 by Ben Gamari at 2020-11-21T01:15:56-05:00 hadrian: Disable stripping when debug information is enabled - - - - - 7e93ae8b by Ben Gamari at 2020-11-21T13:13:29-05:00 rts: Post ticky entry counts to the eventlog We currently only post the entry counters, not the other global counters as in my experience the former are more useful. We use the heap profiler's census period to decide when to dump. Also spruces up the documentation surrounding ticky-ticky a bit. - - - - - bc9c3916 by Ben Gamari at 2020-11-22T06:28:10-05:00 Implement -ddump-c-backend argument To dump output of the C backend. - - - - - 901bc220 by Ben Gamari at 2020-11-22T12:39:02-05:00 Bump time submodule to 1.11.1 Also bumps directory, Cabal, hpc, time, and unix submodules. Closes #18847. - - - - - 92c0afbf by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Dump STG when ticky is enabled This changes the "ticky" modifier to enable dumping of final STG as this is generally needed to make sense of the ticky profiles. - - - - - d23fef68 by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Introduce notion of flavour transformers This extends Hadrian's notion of "flavour", as described in #18942. - - - - - 179d0bec by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Add a viaLlvmBackend modifier Note that this also slightly changes the semantics of these flavours as we only use LLVM for >= stage1 builds. - - - - - d4d95e51 by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Add profiled_ghc and no_dynamic_ghc modifiers - - - - - 6815603f by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Drop redundant flavour definitions Drop the profiled, LLVM, and ThreadSanitizer flavour definitions as these can now be realized with flavour transformers. - - - - - f88f4339 by Ben Gamari at 2020-11-24T02:43:20-05:00 rts: Flush eventlog buffers from flushEventLog As noted in #18043, flushTrace failed flush anything beyond the writer. This means that a significant amount of data sitting in capability-local event buffers may never get flushed, despite the users' pleads for us to flush. Fix this by making flushEventLog flush all of the event buffers before flushing the writer. Fixes #18043. - - - - - 7c03cc50 by Ben Gamari at 2020-11-24T02:43:55-05:00 gitlab-ci: Run LLVM job on appropriately-labelled MRs Namely, those marked with the ~"LLVM backend" label - - - - - 9b95d815 by Ben Gamari at 2020-11-24T02:43:55-05:00 gitlab-ci: Run LLVM builds on Debian 10 The current Debian 9 image doesn't provide LLVM 7. - - - - - 2ed3e6c0 by Ben Gamari at 2020-11-24T02:43:55-05:00 CmmToLlvm: Declare signature for memcmp Otherwise `opt` fails with: error: use of undefined value '@memcmp$def' - - - - - be5d74ca by Moritz Angermann at 2020-11-26T16:00:32-05:00 [Sized Cmm] properly retain sizes. This replaces all Word<N> = W<N># Word# and Int<N> = I<N># Int# with Word<N> = W<N># Word<N># and Int<N> = I<N># Int<N>#, thus providing us with properly sized primitives in the codegenerator instead of pretending they are all full machine words. This came up when implementing darwinpcs for arm64. The darwinpcs reqires us to pack function argugments in excess of registers on the stack. While most procedure call standards (pcs) assume arguments are just passed in 8 byte slots; and thus the caller does not know the exact signature to make the call, darwinpcs requires us to adhere to the prototype, and thus have the correct sizes. If we specify CInt in the FFI call, it should correspond to the C int, and not just be Word sized, when it's only half the size. This does change the expected output of T16402 but the new result is no less correct as it eliminates the narrowing (instead of the `and` as was previously done). Bumps the array, bytestring, text, and binary submodules. Co-Authored-By: Ben Gamari <ben at well-typed.com> Metric Increase: T13701 T14697 - - - - - a84e53f9 by Andreas Klebinger at 2020-11-26T16:00:32-05:00 RTS: Fix failed inlining of copy_tag. On windows using gcc-10 gcc failed to inline copy_tag into evacuate. To fix this we now set the always_inline attribute for the various copy* functions in Evac.c. The main motivation here is not the overhead of the function call, but rather that this allows the code to "specialize" for the size of the closure we copy which is often known at compile time. An earlier commit also tried to avoid evacuate_large inlining. But didn't quite succeed. So I also marked evacuate_large as noinline. Fixes #12416 - - - - - cdbd16f5 by Sylvain Henry at 2020-11-26T16:00:33-05:00 Fix toArgRep to support 64-bit reps on all systems [This is @Ericson2314 writing a commit message for @hsyl20's patch.] (Progress towards #11953, #17377, #17375) `Int64Rep` and `Word64Rep` are currently broken on 64-bit systems. This is because they should use "native arg rep" but instead use "large arg rep" as they do on 32-bit systems, which is either a non-concept or a 128-bit rep depending on one's vantage point. Now, these reps currently aren't used during 64-bit compilation, so the brokenness isn't observed, but I don't think that constitutes reasons not to fix it. Firstly, the linked issues there is a clearly expressed desire to use explicit-bitwidth constructs in more places. Secondly, per [1], there are other bugs that *do* manifest from not threading explicit-bitwidth information all the way through the compilation pipeline. One can therefore view this as one piece of the larger effort to do that, improve ergnomics, and squash remaining bugs. Also, this is needed for !3658. I could just merge this as part of that, but I'm keen on merging fixes "as they are ready" so the fixes that aren't ready are isolated and easier to debug. [1]: https://mail.haskell.org/pipermail/ghc-devs/2020-October/019332.html - - - - - a9378e69 by Tim Barnes at 2020-11-26T16:00:34-05:00 Set dynamic users-guide TOC spacing (fixes #18554) - - - - - 86a59d93 by Ben Gamari at 2020-11-26T16:00:34-05:00 rts: Use RTS_LIKELY in CHECK Most compilers probably already infer that `barf` diverges but it nevertheless doesn't hurt to be explicit. - - - - - 5757e82b by Matthew Pickering at 2020-11-26T16:00:35-05:00 Remove special case for GHC.ByteCode.Instr This was added in https://github.com/nomeata/ghc-heap-view/commit/34935206e51b9c86902481d84d2f368a6fd93423 GHC.ByteCode.Instr.BreakInfo no longer exists so the special case is dead code. Any check like this can be easily dealt with in client code. - - - - - d9c8b5b4 by Matthew Pickering at 2020-11-26T16:00:35-05:00 Split Up getClosureDataFromHeapRep Motivation 1. Don't enforce the repeated decoding of an info table, when the client can cache it (ghc-debug) 2. Allow the constructor information decoding to be overridden, this casues segfaults in ghc-debug - - - - - 3e3555cc by Andreas Klebinger at 2020-11-26T16:00:35-05:00 RegAlloc: Add missing raPlatformfield to RegAllocStatsSpill Fixes #18994 Co-Author: Benjamin Maurer <maurer.benjamin at gmail.com> - - - - - a1a75aa9 by Ben Gamari at 2020-11-27T06:20:41-05:00 rts: Allocate MBlocks with MAP_TOP_DOWN on Windows As noted in #18991, we would previously allocate heap in low memory. Due to this the linker, which typically *needs* low memory, would end up competing with the heap. In longer builds we end up running out of low memory entirely, leading to linking failures. - - - - - 75fc1ed5 by Sylvain Henry at 2020-11-28T15:40:23-05:00 Hadrian: fix detection of ghc-pkg for cross-compilers - - - - - 7cb5df96 by Sylvain Henry at 2020-11-28T15:40:23-05:00 hadrian: fix ghc-pkg uses (#17601) Make sure ghc-pkg doesn't read the compiler "settings" file by passing --no-user-package-db. - - - - - e3fd4226 by Ben Gamari at 2020-11-28T15:40:23-05:00 gitlab-ci: Introduce a nightly cross-compilation job This adds a job to test cross-compilation from x86-64 to AArch64 with Hadrian. Fixes #18234 - - - - - 698d3d96 by Ben Gamari at 2020-11-28T15:41:00-05:00 gitlab-ci: Only deploy GitLab Pages in ghc/ghc> The deployments are quite large and yet are currently only served for the ghc/ghc> project. - - - - - 625726f9 by David Eichmann at 2020-11-28T15:41:37-05:00 ghc-heap: partial TSO/STACK decoding Co-authored-by: Sven Tennie <sven.tennie at gmail.com> Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> Co-authored-by: Ben Gamari <bgamari.foss at gmail.com> - - - - - 22ea9c29 by Andreas Klebinger at 2020-11-28T15:42:13-05:00 Small optimization to CmmSink. Inside `regsUsedIn` we can avoid some thunks by specializing the recursion. In particular we avoid the thunk for `(f e z)` in the MachOp/Load branches, where we know this will evaluate to z. Reduces allocations for T3294 by ~1%. - - - - - bba42c62 by John Ericson at 2020-11-28T15:42:49-05:00 Make primop handler indentation more consistent - - - - - c82bc8e9 by John Ericson at 2020-11-28T15:42:49-05:00 Cleanup some primop constructor names Harmonize the internal (big sum type) names of the native vs fixed-sized number primops a bit. (Mainly by renaming the former.) No user-facing names are changed. - - - - - ae14f160 by Ben Gamari at 2020-11-28T15:43:25-05:00 testsuite: Mark T14702 as fragile on Windows Due to #18953. - - - - - 1bc104b0 by Ben Gamari at 2020-11-29T15:33:18-05:00 withTimings: Emit allocations counter This will allow us to back out the allocations per compiler pass from the eventlog. Note that we dump the allocation counter rather than the difference since this will allow us to determine how much work is done *between* `withTiming` blocks. - - - - - e992ea84 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 ThreadPaused: Don't zero slop until free vars are pushed When threadPaused blackholes a thunk it calls `OVERWRITING_CLOSURE` to zero the slop for the benefit of the sanity checker. Previously this was done *before* pushing the thunk's free variables to the update remembered set. Consequently we would pull zero'd pointers to the update remembered set. - - - - - e82cd140 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Fix regression from TSAN work The TSAN rework (specifically aad1f803) introduced a subtle regression in GC.c, swapping `g0` in place of `gen`. Whoops! Fixes #18997. - - - - - 35a5207e by GHC GitLab CI at 2020-11-29T15:33:54-05:00 rts/Messages: Add missing write barrier in THROWTO message update After a THROWTO message has been handle the message closure is overwritten by a NULL message. We must ensure that the original closure's pointers continue to be visible to the nonmoving GC. - - - - - 0120829f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Add missing write barrier in shrinkSmallByteArray - - - - - 8a4d8fb6 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 Updates: Don't zero slop until closure has been pushed Ensure that the the free variables have been pushed to the update remembered set before we zero the slop. - - - - - 2793cfdc by GHC GitLab CI at 2020-11-29T15:33:54-05:00 OSThreads: Fix error code checking pthread_join returns its error code and apparently doesn't set errno. - - - - - e391a16f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Don't join to mark_thread on shutdown The mark thread is not joinable as we detach from it on creation. - - - - - 60d088ab by Ben Gamari at 2020-11-29T15:33:54-05:00 nonmoving: Add reference to Ueno 2016 - - - - - 3aa60362 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Ensure that evacuated large objects are marked See Note [Non-moving GC: Marking evacuated objects]. - - - - - 8d304a99 by Ben Gamari at 2020-11-30T10:15:22-05:00 rts/m32: Refactor handling of allocator seeding Previously, in an attempt to reduce fragmentation, each new allocator would map a region of M32_MAX_PAGES fresh pages to seed itself. However, this ends up being extremely wasteful since it turns out that we often use fewer than this. Consequently, these pages end up getting freed which, ends up fragmenting our address space more than than we would have if we had naively allocated pages on-demand. Here we refactor m32 to avoid this waste while achieving the fragmentation mitigation previously desired. In particular, we move all page allocation into the global m32_alloc_page, which will pull a page from the free page pool. If the free page pool is empty we then refill it by allocating a region of M32_MAP_PAGES and adding them to the pool. Furthermore, we do away with the initial seeding entirely. That is, the allocator starts with no active pages: pages are rather allocated on an as-needed basis. On the whole this ends up being a pleasingly simple change, simultaneously making m32 more efficient, more robust, and simpler. Fixes #18980. - - - - - b6629289 by Ben Gamari at 2020-11-30T10:15:58-05:00 rts: Use CHECK instead of assert Use the GHC wrappers instead of <assert.h>. - - - - - 9f4efa6a by Ben Gamari at 2020-11-30T10:15:58-05:00 rts/linker: Replace some ASSERTs with CHECK In the past some people have confused ASSERT, which is for checking internal invariants, which CHECK, which should be used when checking things that might fail due to bad input (and therefore should be enabled even in the release compiler). Change some of these cases in the linker to use CHECK. - - - - - 0f8a4655 by Ryan Scott at 2020-11-30T10:16:34-05:00 Allow deploy:pages job to fail See #18973. - - - - - 49ebe369 by chessai at 2020-11-30T19:47:40-05:00 Optimisations in Data.Foldable (T17867) This PR concerns the following functions from `Data.Foldable`: * minimum * maximum * sum * product * minimumBy * maximumBy - Default implementations of these functions now use `foldl'` or `foldMap'`. - All have been marked with INLINEABLE to make room for further optimisations. - - - - - 4d79ef65 by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - 6af074ce by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - ab334262 by Viktor Dukhovni at 2020-11-30T19:48:17-05:00 dirty MVAR after mutating TSO queue head While the original head and tail of the TSO queue may be in the same generation as the MVAR, interior elements of the queue could be younger after a GC run and may then be exposed by putMVar operation that updates the queue head. Resolves #18919 - - - - - 5eb163f3 by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Don't allow shared libraries to be loaded multiple times - - - - - 490aa14d by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Initialise CCSs from native shared objects - - - - - 6ac3db5f by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Move shared library loading logic into Elf.c - - - - - b6698d73 by GHC GitLab CI at 2020-11-30T19:48:53-05:00 rts/linker: Don't declare dynamic objects with image_mapped This previously resulted in warnings due to spurious unmap failures. - - - - - b94a65af by jneira at 2020-11-30T19:49:31-05:00 Include tried paths in findToolDir error - - - - - 72a87fbc by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Move core flattening algorithm to Core.Unify This sets the stage for a later change, where this algorithm will be needed from GHC.Core.InstEnv. This commit also splits GHC.Core.Map into GHC.Core.Map.Type and GHC.Core.Map.Expr, in order to avoid module import cycles with GHC.Core. - - - - - 0dd45d0a by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Bump the # of commits searched for perf baseline The previous value of 75 meant that a feature branch with more than 75 commits would get spurious CI passes. This affects #18692, but does not fix that ticket, because if a baseline cannot be found, we should fail, not succeed. - - - - - 8bb52d91 by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Remove flattening variables This patch redesigns the flattener to simplify type family applications directly instead of using flattening meta-variables and skolems. The key new innovation is the CanEqLHS type and the new CEqCan constraint (Ct). A CanEqLHS is either a type variable or exactly-saturated type family application; either can now be rewritten using a CEqCan constraint in the inert set. Because the flattener no longer reduces all type family applications to variables, there was some performance degradation if a lengthy type family application is now flattened over and over (not making progress). To compensate, this patch contains some extra optimizations in the flattener, leading to a number of performance improvements. Close #18875. Close #18910. There are many extra parts of the compiler that had to be affected in writing this patch: * The family-application cache (formerly the flat-cache) sometimes stores coercions built from Given inerts. When these inerts get kicked out, we must kick out from the cache as well. (This was, I believe, true previously, but somehow never caused trouble.) Kicking out from the cache requires adding a filterTM function to TrieMap. * This patch obviates the need to distinguish "blocking" coercion holes from non-blocking ones (which, previously, arose from CFunEqCans). There is thus some simplification around coercion holes. * Extra commentary throughout parts of the code I read through, to preserve the knowledge I gained while working. * A change in the pure unifier around unifying skolems with other types. Unifying a skolem now leads to SurelyApart, not MaybeApart, as documented in Note [Binding when looking up instances] in GHC.Core.InstEnv. * Some more use of MCoercion where appropriate. * Previously, class-instance lookup automatically noticed that e.g. C Int was a "unifier" to a target [W] C (F Bool), because the F Bool was flattened to a variable. Now, a little more care must be taken around checking for unifying instances. * Previously, tcSplitTyConApp_maybe would split (Eq a => a). This is silly, because (=>) is not a tycon in Haskell. Fixed now, but there are some knock-on changes in e.g. TrieMap code and in the canonicaliser. * New function anyFreeVarsOf{Type,Co} to check whether a free variable satisfies a certain predicate. * Type synonyms now remember whether or not they are "forgetful"; a forgetful synonym drops at least one argument. This is useful when flattening; see flattenView. * The pattern-match completeness checker invokes the solver. This invocation might need to look through newtypes when checking representational equality. Thus, the desugarer needs to keep track of the in-scope variables to know what newtype constructors are in scope. I bet this bug was around before but never noticed. * Extra-constraints wildcards are no longer simplified before printing. See Note [Do not simplify ConstraintHoles] in GHC.Tc.Solver. * Whether or not there are Given equalities has become slightly subtler. See the new HasGivenEqs datatype. * Note [Type variable cycles in Givens] in GHC.Tc.Solver.Canonical explains a significant new wrinkle in the new approach. * See Note [What might match later?] in GHC.Tc.Solver.Interact, which explains the fix to #18910. * The inert_count field of InertCans wasn't actually used, so I removed it. Though I (Richard) did the implementation, Simon PJ was very involved in design and review. This updates the Haddock submodule to avoid #18932 by adding a type signature. ------------------------- Metric Decrease: T12227 T5030 T9872a T9872b T9872c Metric Increase: T9872d ------------------------- - - - - - d66660ba by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Rename the flattener to become the rewriter. Now that flattening doesn't produce flattening variables, it's not really flattening anything: it's rewriting. This change also means that the rewriter can no longer be confused the core flattener (in GHC.Core.Unify), which is sometimes used during type-checking. - - - - - add0aeae by Ben Gamari at 2020-12-01T19:58:17-05:00 rts: Introduce mmapAnonForLinker Previously most of the uses of mmapForLinker were mapping anonymous memory, resulting in a great deal of unnecessary repetition. Factor this out into a new helper. Also fixes a few places where error checking was missing or suboptimal. - - - - - 97d71646 by Ben Gamari at 2020-12-01T19:58:17-05:00 rts/linker: Introduce munmapForLinker Consolidates munmap calls to ensure consistent error handling. - - - - - d8872af0 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/Linker: Introduce Windows implementations for mmapForLinker, et al. - - - - - c35d0e03 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/m32: Introduce NEEDS_M32 macro Instead of relying on RTS_LINKER_USE_MMAP - - - - - 41c64eb5 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/linker: Use m32 to allocate symbol extras in PEi386 - - - - - e0b08c5f by Ben Gamari at 2020-12-03T13:01:47-05:00 gitlab-ci: Fix copy-paste error Also be more consistent in quoting. - - - - - 33ec3a06 by Ben Gamari at 2020-12-03T23:11:31-05:00 gitlab-ci: Run linters through ci.sh Ensuring that the right toolchain is used. - - - - - 4a437bc1 by Shayne Fletcher at 2020-12-05T09:06:38-05:00 Fix bad span calculations of post qualified imports - - - - - 8fac4b93 by Ben Gamari at 2020-12-05T09:07:13-05:00 testsuite: Add a test for #18923 - - - - - 62ed6957 by Simon Peyton Jones at 2020-12-08T15:31:41-05:00 Fix kind inference for data types. Again. This patch fixes several aspects of kind inference for data type declarations, especially data /instance/ declarations Specifically 1. In kcConDecls/kcConDecl make it clear that the tc_res_kind argument is only used in the H98 case; and in that case there is no result kind signature; and hence no need for the disgusting splitPiTys in kcConDecls (now thankfully gone). The GADT case is a bit different to before, and much nicer. This is what fixes #18891. See Note [kcConDecls: kind-checking data type decls] 2. Do not look at the constructor decls of a data/newtype instance in tcDataFamInstanceHeader. See GHC.Tc.TyCl.Instance Note [Kind inference for data family instances]. This was a new realisation that arose when doing (1) This causes a few knock-on effects in the tests suite, because we require more information than before in the instance /header/. New user-manual material about this in "Kind inference in data type declarations" and "Kind inference for data/newtype instance declarations". 3. Minor improvement in kcTyClDecl, combining GADT and H98 cases 4. Fix #14111 and #8707 by allowing the header of a data instance to affect kind inferece for the the data constructor signatures; as described at length in Note [GADT return types] in GHC.Tc.TyCl This led to a modest refactoring of the arguments (and argument order) of tcConDecl/tcConDecls. 5. Fix #19000 by inverting the sense of the test in new_locs in GHC.Tc.Solver.Canonical.canDecomposableTyConAppOK. - - - - - 0abe3ddf by Adam Sandberg Ericsson at 2020-12-08T15:32:19-05:00 hadrian: build the _l and _thr_l rts flavours in the develN flavours The ghc binary requires the eventlog rts since fc644b1a643128041cfec25db84e417851e28bab - - - - - 51e3bb6d by Andreas Klebinger at 2020-12-08T22:43:21-05:00 CodeGen: Make folds User/DefinerOfRegs INLINEABLE. Reduces allocation for the test case I was looking at by about 1.2%. Mostly from avoiding allocation of some folding functions which turn into let-no-escape bindings which just reuse their environment instead. We also force inlining in a few key places in CmmSink which helps a bit more. - - - - - 69ae10c3 by Andreas Klebinger at 2020-12-08T22:43:21-05:00 CmmSink: Force inlining of foldRegsDefd Helps avoid allocating the folding function. Improves perf for T3294 by about 1%. - - - - - 6e3da800 by Andreas Klebinger at 2020-12-08T22:43:21-05:00 Cmm: Make a few types and utility function slightly stricter. About 0.6% reduction in allocations for the code I was looking at. Not a huge difference but no need to throw away performance. - - - - - aef44d7f by Andreas Klebinger at 2020-12-08T22:43:21-05:00 Cmm.Sink: Optimize retaining of assignments, live sets. Sinking requires us to track live local regs after each cmm statement. We used to do this via "Set LocalReg". However we can replace this with a solution based on IntSet which is overall more efficient without losing much. The thing we lose is width of the variables, which isn't used by the sinking pass anyway. I also reworked how we keep assignments to regs mentioned in skipped assignments. I put the details into Note [Keeping assignemnts mentioned in skipped RHSs]. The gist of it is instead of keeping track of it via the use count which is a `IntMap Int` we now use the live regs set (IntSet) which is quite a bit faster. I think it also matches the semantics a lot better. The skipped (not discarded) assignment does in fact keep the regs on it's rhs alive so keeping track of this in the live set seems like the clearer solution as well. Improves allocations for T3294 by yet another 1%. - - - - - 59f2249b by Andreas Klebinger at 2020-12-08T22:43:21-05:00 GHC.Cmm.Opt: Be stricter in results. Optimization either returns Nothing if nothing is to be done or `Just <cmmExpr>` otherwise. There is no point in being lazy in `cmmExpr`. We usually inspect this element so the thunk gets forced not long after. We might eliminate it as dead code once in a blue moon but that's not a case worth optimizing for. Overall the impact of this is rather low. As Cmm.Opt doesn't allocate much (compared to the rest of GHC) to begin with. - - - - - 54b88eac by Andreas Klebinger at 2020-12-08T22:43:57-05:00 Bump time submodule. This should fix #19002. - - - - - 35e7b0c6 by Kirill Elagin at 2020-12-10T01:45:54-05:00 doc: Clarify the default for -fomit-yields “Yield points enabled” is confusing (and probably wrong? I am not 100% sure what it means). Change it to a simple “on”. Undo this change from 2c23fff2e03e77187dc4d01f325f5f43a0e7cad2. - - - - - 3551c554 by Kirill Elagin at 2020-12-10T01:45:54-05:00 doc: Extra-clarify -fomit-yields Be more clear on what this optimisation being on by default means in terms of yields. - - - - - 6484f0d7 by Sergei Trofimovich at 2020-12-10T01:46:33-05:00 rts/linker/Elf.c: add missing <dlfcn.h> include (musl support) The change fixes build failure on musl: ``` rts/linker/Elf.c:2031:3: error: warning: implicit declaration of function 'dlclose'; did you mean 'close'? [-Wimplicit-function-declaration] 2031 | dlclose(nc->dlopen_handle); | ^~~~~~~ | close ``` Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - ab24ed9b by Ben Gamari at 2020-12-11T03:55:51-05:00 users guide: Fix syntax errors Fixes errors introduced by 3a55b3a2574f913d046f3a6f82db48d7f6df32e3. - - - - - d3a24d31 by Ben Gamari at 2020-12-11T03:55:51-05:00 users guide: Describe GC lifecycle events Every time I am asked about how to interpret these events I need to figure it out from scratch. It's well past time that the users guide properly documents these. - - - - - 741309b9 by Ben Gamari at 2020-12-11T03:56:27-05:00 gitlab-ci: Fix incorrect Docker image for nightly cross job Also refactor the job definition to eliminate the bug by construction. - - - - - 19703bc8 by Ben Gamari at 2020-12-11T03:56:27-05:00 gitlab-ci: Fix name of flavour in ThreadSanitizer job It looks like I neglected to update this after introduce flavour transformers. - - - - - 381eb660 by Sylvain Henry at 2020-12-11T12:57:35-05:00 Display FFI labels (fix #18539) - - - - - 4548d1f8 by Aaron Allen at 2020-12-11T12:58:14-05:00 Elide extraneous messages for :doc command (#15784) Do not print `<has no documentation>` alongside a valid doc. Additionally, if two matching symbols lack documentation then the message will only be printed once. Hence, `<has no documentation>` will be printed at most once and only if all matching symbols are lacking docs. - - - - - 5eba91b6 by Aaron Allen at 2020-12-11T12:58:14-05:00 Add :doc test case for duplicate record fields Tests that the output of the `:doc` command is correct for duplicate record fields defined using -XDuplicateRecordFields. - - - - - 5feb9b2d by Ryan Scott at 2020-12-11T22:39:29-05:00 Delete outdated Note [Kind-checking tyvar binders for associated types] This Note has severely bitrotted, as it has no references anywhere in the codebase, and none of the functions that it mentions exist anymore. Let's just delete this. While I was in town, I deleted some outdated comments from `checkFamPatBinders` of a similar caliber. Fixes #19008. [ci skip] - - - - - f9f9f030 by Sylvain Henry at 2020-12-11T22:40:08-05:00 Arrows: correctly query arrow methods (#17423) Consider the following code: proc (C x y) -> ... Before this patch, the evidence binding for the Arrow dictionary was attached to the C pattern: proc (C x y) { $dArrow = ... } -> ... But then when we desugar this, we use arrow operations ("arr", ">>>"...) specialised for this arrow: let arr_xy = arr $dArrow -- <-- Not in scope! ... in arr_xy (\(C x y) { $dArrow = ... } -> ...) This patch allows arrow operations to be type-checked before the proc itself, avoiding this issue. Fix #17423 - - - - - aaa8f00f by Sylvain Henry at 2020-12-11T22:40:48-05:00 Validate script: fix configure command when using stack - - - - - b4a929a1 by Sylvain Henry at 2020-12-11T22:41:30-05:00 Hadrian: fix libffi tarball parsing Fix parsing of "libffi-3.3.tar.gz". NB: switch to a newer libffi isn't done in this patch - - - - - 690c8946 by Sylvain Henry at 2020-12-11T22:42:09-05:00 Parser: move parser utils into their own module Move code unrelated to runtime evaluation out of GHC.Runtime.Eval - - - - - 76be0e32 by Sylvain Henry at 2020-12-11T22:42:48-05:00 Move SizedSeq into ghc-boot - - - - - 3a16d764 by Sylvain Henry at 2020-12-11T22:42:48-05:00 ghci: don't compile unneeded modules - - - - - 2895fa60 by Sylvain Henry at 2020-12-11T22:42:48-05:00 ghci: reuse Arch from ghc-boot - - - - - 480a38d4 by Sylvain Henry at 2020-12-11T22:43:30-05:00 rts: don't use siginterrupt (#19019) - - - - - 4af6126d by Sylvain Henry at 2020-12-11T22:44:11-05:00 Use static array in zeroCount - - - - - 5bd71bfd by Sebastian Graf at 2020-12-12T04:45:09-05:00 DmdAnal: Annotate top-level function bindings with demands (#18894) It's useful to annotate a non-exported top-level function like `g` in ```hs module Lib (h) where g :: Int -> Int -> (Int,Int) g m 1 = (m, 0) g m n = (2 * m, 2 `div` n) {-# NOINLINE g #-} h :: Int -> Int h 1 = 0 h m | odd m = snd (g m 2) | otherwise = uncurry (+) (g 2 m) ``` with its demand `UCU(CS(P(1P(U),SP(U))`, which tells us that whenever `g` was called, the second component of the returned pair was evaluated strictly. Since #18903 we do so for local functions, where we can see all calls. For top-level functions, we can assume that all *exported* functions are demanded according to `topDmd` and thus get sound demands for non-exported top-level functions. The demand on `g` is crucial information for Nested CPR, which may the go on and unbox `g` for the second pair component. That is true even if that pair component may diverge, as is the case for the call site `g 13 0`, which throws a div-by-zero exception. In `T18894b`, you can even see the new demand annotation enabling us to eta-expand a function that we wouldn't be able to eta-expand without Call Arity. We only track bindings of function type in order not to risk huge compile-time regressions, see `isInterestingTopLevelFn`. There was a CoreLint check that rejected strict demand annotations on recursive or top-level bindings, which seems completely unjustified. All the cases I investigated were fine, so I removed it. Fixes #18894. - - - - - 3aae036e by Sebastian Graf at 2020-12-12T04:45:09-05:00 Demand: Simplify `CU(U)` to `U` (#19005) Both sub-demands encode the same information. This is a trivial change and already affects a few regression tests (e.g. `T5075`), so no separate regression test is necessary. - - - - - c6477639 by Adam Sandberg Ericsson at 2020-12-12T04:45:48-05:00 hadrian: correctly copy the docs dir into the bindist #18669 - - - - - e033dd05 by Adam Sandberg Ericsson at 2020-12-12T10:52:19+00:00 mkDocs: support hadrian bindists #18973 - - - - - 78580ba3 by John Ericson at 2020-12-13T07:14:50-05:00 Remove old .travis.yml - - - - - c696bb2f by Cale Gibbard at 2020-12-14T13:37:09-05:00 Implement type applications in patterns The haddock submodule is also updated so that it understands the changes to patterns. - - - - - 7e9debd4 by Ben Gamari at 2020-12-14T13:37:09-05:00 Optimise nullary type constructor usage During the compilation of programs GHC very frequently deals with the `Type` type, which is a synonym of `TYPE 'LiftedRep`. This patch teaches GHC to avoid expanding the `Type` synonym (and other nullary type synonyms) during type comparisons, saving a good amount of work. This optimisation is described in `Note [Comparing nullary type synonyms]`. To maximize the impact of this optimisation, we introduce a few special-cases to reduce `TYPE 'LiftedRep` to `Type`. See `Note [Prefer Type over TYPE 'LiftedPtrRep]`. Closes #17958. Metric Decrease: T18698b T1969 T12227 T12545 T12707 T14683 T3064 T5631 T5642 T9020 T9630 T9872a T13035 haddock.Cabal haddock.base - - - - - 92377c27 by Ben Gamari at 2020-12-14T13:41:58-05:00 Revert "Optimise nullary type constructor usage" This was inadvertently merged. This reverts commit 7e9debd4ceb068effe8ac81892d2cabcb8f55850. - - - - - d0e8c10d by Sylvain Henry at 2020-12-14T19:45:13+01:00 Move Unit related fields from DynFlags to HscEnv The unit database cache, the home unit and the unit state were stored in DynFlags while they ought to be stored in the compiler session state (HscEnv). This patch fixes this. It introduces a new UnitEnv type that should be used in the future to handle separate unit environments (especially host vs target units). Related to #17957 Bump haddock submodule - - - - - af855ac1 by Andreas Klebinger at 2020-12-14T15:22:13-05:00 Optimize dumping of consecutive whitespace. The naive way of putting out n characters of indent would be something like `hPutStr hdl (replicate n ' ')`. However this is quite inefficient as we allocate an absurd number of strings consisting of simply spaces as we don't cache them. To improve on this we now track if we can simply write ascii spaces via hPutBuf instead. This is the case when running with -ddump-to-file where we force the encoding to be UTF8. This avoids both the cost of going through encoding as well as avoiding allocation churn from all the white space. Instead we simply use hPutBuf on a preallocated unlifted string. When dumping stg like this: > nofib/spectral/simple/Main.hs -fforce-recomp -ddump-stg-final -ddump-to-file -c +RTS -s Allocations went from 1,778 MB to 1,702MB. About a 4% reduction of allocation! I did not measure the difference in runtime but expect it to be similar. Bumps the haddock submodule since the interface of GHC's Pretty slightly changed. ------------------------- Metric Decrease: T12227 ------------------------- - - - - - dad87210 by Ben Gamari at 2020-12-14T15:22:29-05:00 Optimise nullary type constructor usage During the compilation of programs GHC very frequently deals with the `Type` type, which is a synonym of `TYPE 'LiftedRep`. This patch teaches GHC to avoid expanding the `Type` synonym (and other nullary type synonyms) during type comparisons, saving a good amount of work. This optimisation is described in `Note [Comparing nullary type synonyms]`. To maximize the impact of this optimisation, we introduce a few special-cases to reduce `TYPE 'LiftedRep` to `Type`. See `Note [Prefer Type over TYPE 'LiftedPtrRep]`. Closes #17958. Metric Decrease: T18698b T1969 T12227 T12545 T12707 T14683 T3064 T5631 T5642 T9020 T9630 T9872a T13035 haddock.Cabal haddock.base - - - - - 6c2eb223 by Andrew Martin at 2020-12-14T18:48:51-05:00 Implement BoxedRep proposal This implements the BoxedRep proposal, refacoring the `RuntimeRep` hierarchy from: ```haskell data RuntimeRep = LiftedPtrRep | UnliftedPtrRep | ... ``` to ```haskell data RuntimeRep = BoxedRep Levity | ... data Levity = Lifted | Unlifted ``` Closes #17526. - - - - - 3ee696cc by Sebastian Graf at 2020-12-15T10:53:31-05:00 Add regression test for #19053 - - - - - 535dae66 by Ben Gamari at 2020-12-15T10:53:58-05:00 testsuite: Mark divbyzero, derefnull as fragile Due to #18548. - - - - - 331f5568 by Ben Gamari at 2020-12-15T11:21:06-05:00 Revert "Implement BoxedRep proposal" This was inadvertently merged. This reverts commit 6c2eb2232b39ff4720fda0a4a009fb6afbc9dcea. - - - - - 50fae07d by Ben Gamari at 2020-12-15T15:15:16-05:00 Roll-back broken haddock commit Updates haddock submodule to revert a commit that does not build. - - - - - e9b18a75 by Ben Gamari at 2020-12-15T15:55:38-05:00 Revert haddock submodule yet again - - - - - b58cb63a by GHC GitLab CI at 2020-12-16T03:46:31+00:00 Bump haddock submodule To adapt haddock for the nullary tyconapp optimisation patch. - - - - - 3ed758e2 by Andreas Klebinger at 2020-12-17T17:31:07+01:00 Increase -A default to 4MB. This gives a small increase in performance under most circumstances. For single threaded GC the improvement is on the order of 1-2%. For multi threaded GC the results are quite noisy but seem to fall into the same ballpark. Fixes #16499 - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - − .travis.yml - aclocal.m4 - compiler/.hlint.yaml - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Types/Literals.hs - compiler/GHC/Builtin/Types/Prim.hs - + compiler/GHC/Builtin/Types/Prim.hs-boot - compiler/GHC/Builtin/Utils.hs - + compiler/GHC/Builtin/bytearray-ops.txt.pp - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/InfoTable.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/CallConv.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Graph.hs - compiler/GHC/Cmm/Info/Build.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b3c1e42eb9c4f1ed7771e6e87be46cf5069769f1...3ed758e2a39dcf3a11fe6f3ccd72817892d6b95f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b3c1e42eb9c4f1ed7771e6e87be46cf5069769f1...3ed758e2a39dcf3a11fe6f3ccd72817892d6b95f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 17 16:57:51 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Thu, 17 Dec 2020 11:57:51 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/T18929 Message-ID: <5fdb8e0f15b1b_6b2174471c2128389@gitlab.mail> Simon Peyton Jones pushed new branch wip/T18929 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T18929 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 17 17:37:20 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 17 Dec 2020 12:37:20 -0500 Subject: [Git][ghc/ghc][ghc-8.10] 10 commits: Limit upper version of Happy for ghc-9.0 and earlier (#18620) Message-ID: <5fdb97501680e_6b218662044214587b@gitlab.mail> Ben Gamari pushed to branch ghc-8.10 at Glasgow Haskell Compiler / GHC Commits: e89a5563 by Takenobu Tani at 2020-12-13T17:11:57-05:00 Limit upper version of Happy for ghc-9.0 and earlier (#18620) This patch adds the upper bound of a happy version for ghc-9.0 and earlier. Currently, we can't use happy-1.20.0 for ghc-9.0. See #18620. (cherry picked from commit 74a7fbff5a8f244cd44345bf987e26413bb1989e) - - - - - d9064a7c by Ben Gamari at 2020-12-13T17:11:57-05:00 Bump bytestring submodule to 0.10.12.0 Fixes #18233. - - - - - 0b9d2fe7 by Shayne Fletcher at 2020-12-15T20:10:03-05:00 Fix bad span calculations of post qualified imports (cherry picked from commit 57f3fdb1fbeb82b5b19bc5e2970d8857c2514fcc) - - - - - 572f9c8f by Ben Gamari at 2020-12-15T20:10:05-05:00 gitlab-ci: Rename RELEASE variable to RELEASE_JOB This interfered with the autoconf variable of the same name, breaking pre-release builds. (cherry picked from commit 15dca84793d5ec4ff922726477923e40caa075eb) (cherry picked from commit 3e55edd97c8eba271f5cb64b9362796791e0e887) - - - - - bc364f3e by Ben Gamari at 2020-12-16T17:00:31-05:00 Disable deprecation warnings in Cabal build - - - - - b3cc6847 by Ben Gamari at 2020-12-16T17:00:31-05:00 hadrian: Reindent Settings.Warnings The previous state was quite illegible. - - - - - afc39ff5 by Ben Gamari at 2020-12-16T17:00:31-05:00 hadrian: Pass -Werror before other arguments Previously we would append -Werror to the argument list. However, this ended up overriding the -Wno-error=... flags in Settings.Warnings. - - - - - 496a0d6d by Ben Gamari at 2020-12-16T17:00:31-05:00 users guide: Add release notes for 8.10.3 - - - - - 98d9f832 by Ben Gamari at 2020-12-16T17:00:31-05:00 Update autoconf scripts Scripts taken from autoconf 90b8cb42ba3b244250a6986b8b78c80f30ed197a - - - - - 6db6db46 by Ben Gamari at 2020-12-16T17:00:31-05:00 configure: Release 8.10.3 - - - - - 14 changed files: - .gitlab-ci.yml - aclocal.m4 - compiler/parser/Parser.y - config.guess - config.sub - configure.ac - + docs/users_guide/8.10.3-notes.rst - docs/users_guide/index.rst - hadrian/hadrian.cabal - hadrian/src/Flavour.hs - hadrian/src/Settings/Warnings.hs - libraries/base/config.guess - libraries/base/config.sub - libraries/bytestring The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b0ad86fb84fbd2ac78208e6545c48c7a09e7f4aa...6db6db46af6f8e3e24d7d16b0b43a984a9a14677 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b0ad86fb84fbd2ac78208e6545c48c7a09e7f4aa...6db6db46af6f8e3e24d7d16b0b43a984a9a14677 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 17 17:37:19 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 17 Dec 2020 12:37:19 -0500 Subject: [Git][ghc/ghc] Deleted branch wip/backports-8.10 Message-ID: <5fdb974f83260_6b217c5d45421456cb@gitlab.mail> Ben Gamari deleted branch wip/backports-8.10 at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 17 18:10:31 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 17 Dec 2020 13:10:31 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/gc/root-evac-stats Message-ID: <5fdb9f17c854e_6b21674185421536ce@gitlab.mail> Ben Gamari pushed new branch wip/gc/root-evac-stats at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/gc/root-evac-stats You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 17 18:12:14 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 17 Dec 2020 13:12:14 -0500 Subject: [Git][ghc/ghc][wip/gc/root-evac-stats] rts: Track root evacuation statistics Message-ID: <5fdb9f7e83287_6b2174471c2157933@gitlab.mail> Ben Gamari pushed to branch wip/gc/root-evac-stats at Glasgow Haskell Compiler / GHC Commits: b0ae3043 by Ben Gamari at 2020-12-17T13:12:06-05:00 rts: Track root evacuation statistics - - - - - 3 changed files: - rts/sm/GC.c - rts/sm/GCThread.h - rts/sm/MarkWeak.c Changes: ===================================== rts/sm/GC.c ===================================== @@ -217,6 +217,35 @@ addMutListScavStats(const MutListScavStats *src, } #endif /* DEBUG */ +/* ----------------------------------------------------------------------------- + Statistics from root evacuation + -------------------------------------------------------------------------- */ + +/* + * Note [Root evacuation statistics] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * When diagnosing concurrent GC pauses it can often be useful + * to know how many GC roots we get from various sources. + * Consequently, track this information in each GC thread and + * emit eventlog events if ROOT_EVAC_STATS is #define'd. + * + * To keep track of root evacuations mark_root() bumps a + * counter in gc_thread, which gets zero'd after we finish + * evacuating each class of roots. We also bump the counter in + * markWeakPtrList(), since this codepath doesn't use mark_root(). + */ + +#if defined(DEBUG) +#define ROOT_EVAC_STATS +#endif + +#if defined(ROOT_EVAC_STATS) +#define TRACE_EVACD_ROOTS(label) \ + debugTrace(DEBUG_gc, "root:" label ":%d", gct->n_roots_evacd); \ + gct->n_roots_evacd = 0; +#else +#define TRACE_EVACD_ROOTS(label) +#endif /* ----------------------------------------------------------------------------- GarbageCollect: the main entry point to the garbage collector. @@ -441,10 +470,12 @@ GarbageCollect (uint32_t collect_gen, } } } + TRACE_EVACD_ROOTS("MutList"); // follow roots from the CAF list (used by GHCi) gct->evac_gen_no = 0; markCAFs(mark_root, gct); + TRACE_EVACD_ROOTS("CAF"); // follow all the roots that the application knows about. gct->evac_gen_no = 0; @@ -456,15 +487,20 @@ GarbageCollect (uint32_t collect_gen, } else { markCapability(mark_root, gct, cap, true/*don't mark sparks*/); } + TRACE_EVACD_ROOTS("Cap"); + // Mark runnable threads markScheduler(mark_root, gct); + TRACE_EVACD_ROOTS("Sched"); // Mark the weak pointer list, and prepare to detect dead weak pointers. markWeakPtrList(); initWeakForGC(); + TRACE_EVACD_ROOTS("WeakPtr"); // Mark the stable pointer table. markStablePtrTable(mark_root, gct); + TRACE_EVACD_ROOTS("StablePtr"); // Remember old stable name addresses. rememberOldStableNameAddresses (); @@ -1296,7 +1332,11 @@ gcWorkerThread (Capability *cap) // Every thread evacuates some roots. gct->evac_gen_no = 0; markCapability(mark_root, gct, cap, true/*prune sparks*/); + TRACE_EVACD_ROOTS("Cap"); + + // Scavenge mutable lists scavenge_capability_mut_lists(cap); + TRACE_EVACD_ROOTS("MutList"); scavenge_until_all_done(); @@ -1753,6 +1793,7 @@ init_gc_thread (gc_thread *t) t->any_work = 0; t->no_work = 0; t->scav_find_work = 0; + t->n_roots_evacd = 0; } /* ----------------------------------------------------------------------------- @@ -1774,6 +1815,9 @@ mark_root(void *user USED_IF_THREADS, StgClosure **root) SET_GCT(user); evacuate(root); +#if defined(ROOT_EVAC_STATS) + gct->n_evacd_roots++; +#endif SET_GCT(saved_gct); } ===================================== rts/sm/GCThread.h ===================================== @@ -184,6 +184,7 @@ typedef struct gc_thread_ { W_ any_work; W_ no_work; W_ scav_find_work; + W_ n_roots_evacd; // See Note [Root evacuation statistics] in GC.c. Time gc_start_cpu; // thread CPU time Time gc_end_cpu; // thread CPU time ===================================== rts/sm/MarkWeak.c ===================================== @@ -427,6 +427,7 @@ markWeakPtrList ( void ) } #endif + gct->n_roots_evacd++; // See Note [Root evacuation statistics] evacuate((StgClosure **)last_w); w = *last_w; last_w = &(w->link); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b0ae3043d3fd93a097826b1dc4d5206aedf4750e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b0ae3043d3fd93a097826b1dc4d5206aedf4750e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 17 18:19:05 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 17 Dec 2020 13:19:05 -0500 Subject: [Git][ghc/ghc][wip/gc/root-evac-stats] rts: Track root evacuation statistics Message-ID: <5fdba119678c5_6b2192bada0216006a@gitlab.mail> Ben Gamari pushed to branch wip/gc/root-evac-stats at Glasgow Haskell Compiler / GHC Commits: b3917b31 by Ben Gamari at 2020-12-17T13:18:49-05:00 rts: Track root evacuation statistics - - - - - 3 changed files: - rts/sm/GC.c - rts/sm/GCThread.h - rts/sm/MarkWeak.c Changes: ===================================== rts/sm/GC.c ===================================== @@ -217,6 +217,35 @@ addMutListScavStats(const MutListScavStats *src, } #endif /* DEBUG */ +/* ----------------------------------------------------------------------------- + Statistics from root evacuation + -------------------------------------------------------------------------- */ + +/* + * Note [Root evacuation statistics] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * When diagnosing concurrent GC pauses it can often be useful + * to know how many GC roots we get from various sources. + * Consequently, track this information in each GC thread and + * emit eventlog events if ROOT_EVAC_STATS is #define'd. + * + * To keep track of root evacuations mark_root() bumps a + * counter in gc_thread, which gets zero'd after we finish + * evacuating each class of roots. We also bump the counter in + * markWeakPtrList(), since this codepath doesn't use mark_root(). + */ + +#if defined(DEBUG) || defined(THREADED_RTS) +#define ROOT_EVAC_STATS +#endif + +#if defined(ROOT_EVAC_STATS) +#define TRACE_EVACD_ROOTS(label) \ + trace(nonmoving_gc, "root:" label ":%d", gct->n_roots_evacd); \ + gct->n_roots_evacd = 0; +#else +#define TRACE_EVACD_ROOTS(label) +#endif /* ----------------------------------------------------------------------------- GarbageCollect: the main entry point to the garbage collector. @@ -441,10 +470,12 @@ GarbageCollect (uint32_t collect_gen, } } } + TRACE_EVACD_ROOTS("MutList"); // follow roots from the CAF list (used by GHCi) gct->evac_gen_no = 0; markCAFs(mark_root, gct); + TRACE_EVACD_ROOTS("CAF"); // follow all the roots that the application knows about. gct->evac_gen_no = 0; @@ -456,15 +487,20 @@ GarbageCollect (uint32_t collect_gen, } else { markCapability(mark_root, gct, cap, true/*don't mark sparks*/); } + TRACE_EVACD_ROOTS("Cap"); + // Mark runnable threads markScheduler(mark_root, gct); + TRACE_EVACD_ROOTS("Sched"); // Mark the weak pointer list, and prepare to detect dead weak pointers. markWeakPtrList(); initWeakForGC(); + TRACE_EVACD_ROOTS("WeakPtr"); // Mark the stable pointer table. markStablePtrTable(mark_root, gct); + TRACE_EVACD_ROOTS("StablePtr"); // Remember old stable name addresses. rememberOldStableNameAddresses (); @@ -1296,7 +1332,11 @@ gcWorkerThread (Capability *cap) // Every thread evacuates some roots. gct->evac_gen_no = 0; markCapability(mark_root, gct, cap, true/*prune sparks*/); + TRACE_EVACD_ROOTS("Cap"); + + // Scavenge mutable lists scavenge_capability_mut_lists(cap); + TRACE_EVACD_ROOTS("MutList"); scavenge_until_all_done(); @@ -1753,6 +1793,7 @@ init_gc_thread (gc_thread *t) t->any_work = 0; t->no_work = 0; t->scav_find_work = 0; + t->n_roots_evacd = 0; } /* ----------------------------------------------------------------------------- @@ -1774,6 +1815,9 @@ mark_root(void *user USED_IF_THREADS, StgClosure **root) SET_GCT(user); evacuate(root); +#if defined(ROOT_EVAC_STATS) + gct->n_evacd_roots++; +#endif SET_GCT(saved_gct); } ===================================== rts/sm/GCThread.h ===================================== @@ -184,6 +184,7 @@ typedef struct gc_thread_ { W_ any_work; W_ no_work; W_ scav_find_work; + W_ n_roots_evacd; // See Note [Root evacuation statistics] in GC.c. Time gc_start_cpu; // thread CPU time Time gc_end_cpu; // thread CPU time ===================================== rts/sm/MarkWeak.c ===================================== @@ -427,6 +427,7 @@ markWeakPtrList ( void ) } #endif + gct->n_roots_evacd++; // See Note [Root evacuation statistics] evacuate((StgClosure **)last_w); w = *last_w; last_w = &(w->link); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b3917b313325d3cb9b4cc6788ce41356c9659868 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b3917b313325d3cb9b4cc6788ce41356c9659868 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 17 18:19:30 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Thu, 17 Dec 2020 13:19:30 -0500 Subject: [Git][ghc/ghc][wip/nested-cpr-2019] WorkWrap CPR: Consider how a function body is used Message-ID: <5fdba132b7bcf_6b2186620442160776@gitlab.mail> Sebastian Graf pushed to branch wip/nested-cpr-2019 at Glasgow Haskell Compiler / GHC Commits: 3a0802dc by Sebastian Graf at 2020-12-17T19:19:21+01:00 WorkWrap CPR: Consider how a function body is used Consider `T18894`: ```hs module T18894 (h) where g :: Int -> Int -> (Int,Int) g !m 1 = (2 + m, 0) g m n = (2 * m, 2 `div` n) {-# NOINLINE g #-} h :: Int -> Int h 1 = 0 h m | odd m = snd (g m 2) | otherwise = uncurry (+) (g 2 m) ``` We give `g` the CPR type `#c1(#c1(*), *c1(#))`. Previously, that wouldn't let us unbox the second component, because the division might diverge (throw a div-by-zero exception). But since #18894/!4493, we annotate `g` with its demand `UCU(CS(P(1P(U),SP(U))))`. Note that demand tells us that, *when* `g` is called, we always evaluate the second component of the returned pair. So it's OK for W/W to unbox it, because all call sites will force the division anyway! This is what this commit is implementing. The changes are entirely local to W/W. I also added a test case, `T18174`, that tracks everything Nested CPR is supposed to do (which is tracked in #18174). - - - - - 11 changed files: - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Types/Cpr.hs - + testsuite/tests/cpranal/should_compile/T18174.hs - + testsuite/tests/cpranal/should_compile/T18174.stderr - testsuite/tests/cpranal/should_compile/all.T - testsuite/tests/cpranal/sigs/T1600.hs - testsuite/tests/cpranal/sigs/T1600.stderr - testsuite/tests/simplCore/should_compile/T3772.stdout - testsuite/tests/stranal/should_compile/T18894.stderr - testsuite/tests/stranal/should_compile/T18903.stderr Changes: ===================================== compiler/GHC/Core/Opt/WorkWrap.hs ===================================== @@ -482,7 +482,7 @@ tryWW dflags fam_envs is_rec fn_id rhs -- See Note [Don't w/w inline small non-loop-breaker things] | is_fun && is_eta_exp - = splitFun dflags fam_envs new_fn_id fn_info wrap_dmds div cpr rhs + = splitFun dflags fam_envs new_fn_id fn_info wrap_arg_dmds div forced_cpr rhs | isNonRec is_rec, is_thunk -- See Note [Thunk splitting] = splitThunk dflags fam_envs is_rec new_fn_id rhs @@ -491,9 +491,9 @@ tryWW dflags fam_envs is_rec fn_id rhs = return [ (new_fn_id, rhs) ] where - uf_opts = unfoldingOpts dflags - fn_info = idInfo fn_id - (wrap_dmds, div) = splitStrictSig (strictnessInfo fn_info) + uf_opts = unfoldingOpts dflags + fn_info = idInfo fn_id + (wrap_arg_dmds, div) = splitStrictSig (strictnessInfo fn_info) cpr_ty = getCprSig (cprInfo fn_info) -- Arity of the CPR sig should match idArity when it's not a join point. @@ -501,14 +501,21 @@ tryWW dflags fam_envs is_rec fn_id rhs cpr = ASSERT2( isJoinId fn_id || cpr_ty == topCprType || ct_arty cpr_ty == arityInfo fn_info , ppr fn_id <> colon <+> text "ct_arty:" <+> ppr (ct_arty cpr_ty) <+> text "arityInfo:" <+> ppr (arityInfo fn_info)) ct_cpr cpr_ty + -- Figure out the *least sub-demand* put on the function body by all call sites... + -- Sub-demand, because we can assume at least seq demand. + (_card1 :* fn_sd) = demandInfo fn_info -- describes how the function was called + (_card2, wrap_body_sd) = peelManyCalls (length wrap_arg_dmds) fn_sd + -- Force the recorded CPR (and Termination information!) according to how + -- the function is used. + (_tm, forced_cpr) = forceCpr wrap_body_sd cpr new_fn_id = zapIdUsedOnceInfo (zapIdUsageEnvInfo fn_id) -- See Note [Zapping DmdEnv after Demand Analyzer] and -- See Note [Zapping Used Once info WorkWrap] - is_fun = notNull wrap_dmds || isJoinId fn_id + is_fun = notNull wrap_arg_dmds || isJoinId fn_id -- See Note [Don't eta expand in w/w] - is_eta_exp = length wrap_dmds == manifestArity rhs + is_eta_exp = length wrap_arg_dmds == manifestArity rhs is_thunk = not is_fun && not (exprIsHNF rhs) && not (isJoinId fn_id) && not (isUnliftedType (idType fn_id)) @@ -586,10 +593,10 @@ See https://gitlab.haskell.org/ghc/ghc/merge_requests/312#note_192064. --------------------- splitFun :: DynFlags -> FamInstEnvs -> Id -> IdInfo -> [Demand] -> Divergence -> Cpr -> CoreExpr -> UniqSM [(Id, CoreExpr)] -splitFun dflags fam_envs fn_id fn_info wrap_dmds div cpr rhs - = WARN( not (wrap_dmds `lengthIs` arity), ppr fn_id <+> (ppr arity $$ ppr wrap_dmds $$ ppr cpr) ) do +splitFun dflags fam_envs fn_id fn_info wrap_arg_dmds div cpr rhs + = WARN( not (wrap_arg_dmds `lengthIs` arity), ppr fn_id <+> (ppr arity $$ ppr wrap_arg_dmds $$ ppr cpr) ) do -- The arity should match the signature - stuff <- mkWwBodies dflags fam_envs rhs_fvs fn_id wrap_dmds use_cpr + stuff <- mkWwBodies dflags fam_envs rhs_fvs fn_id wrap_arg_dmds use_cpr case stuff of Just (work_demands, join_arity, wrap_fn, work_fn) -> do work_uniq <- getUniqueM ===================================== compiler/GHC/Core/Opt/WorkWrap/Utils.hs ===================================== @@ -132,11 +132,12 @@ type WwResult mkWwBodies :: DynFlags -> FamInstEnvs - -> VarSet -- Free vars of RHS + -> VarSet -- ^ Free vars of RHS -- See Note [Freshen WW arguments] - -> Id -- The original function - -> [Demand] -- Strictness of original function - -> Cpr -- Info about function result + -> Id -- ^ The original function + -> [Demand] -- ^ Strictness of original function + -- (derived from 'idStrictness') + -> Cpr -- ^ Info about function result -> UniqSM (Maybe WwResult) -- wrap_fn_args E = \x y -> E @@ -150,12 +151,12 @@ mkWwBodies :: DynFlags -- let x = (a,b) in -- E -mkWwBodies dflags fam_envs rhs_fvs fun_id demands cpr_info +mkWwBodies dflags fam_envs rhs_fvs fun_id arg_dmds cpr_info = do { let empty_subst = mkEmptyTCvSubst (mkInScopeSet rhs_fvs) -- See Note [Freshen WW arguments] ; (wrap_args, wrap_fn_args, work_fn_args, res_ty) - <- mkWWargs empty_subst fun_ty demands + <- mkWWargs empty_subst fun_ty arg_dmds ; (useful1, work_args, wrap_fn_str, work_fn_str) <- mkWWstr dflags fam_envs has_inlineable_prag wrap_args @@ -168,7 +169,7 @@ mkWwBodies dflags fam_envs rhs_fvs fun_id demands cpr_info wrapper_body = wrap_fn_args . wrap_fn_cpr . wrap_fn_str . applyToVars work_call_args . Var worker_body = mkLams work_lam_args. work_fn_str . work_fn_cpr . work_fn_args - ; if isWorkerSmallEnough dflags (length demands) work_args + ; if isWorkerSmallEnough dflags (length arg_dmds) work_args && not (too_many_args_for_join_point wrap_args) && ((useful1 && not only_one_void_argument) || useful2) then return (Just (worker_args_dmds, length work_call_args, @@ -190,7 +191,7 @@ mkWwBodies dflags fam_envs rhs_fvs fun_id demands cpr_info -- Note [Do not split void functions] only_one_void_argument - | [d] <- demands + | [d] <- arg_dmds , Just (_, arg_ty1, _) <- splitFunTy_maybe fun_ty , isAbsDmd d && isVoidTy arg_ty1 = True @@ -221,9 +222,9 @@ isWorkerSmallEnough dflags old_n_args vars Note [Always do CPR w/w] ~~~~~~~~~~~~~~~~~~~~~~~~ At one time we refrained from doing CPR w/w for thunks, on the grounds that -we might duplicate work. But that is already handled by the demand analyser, +we might duplicate work. But that is already handled by CPR analysis, which doesn't give the CPR property if w/w might waste work: see -Note [CPR for thunks] in GHC.Core.Opt.DmdAnal. +Note [CPR for thunks] in GHC.Core.Opt.CprAnal. And if something *has* been given the CPR property and we don't w/w, it's a disaster, because then the enclosing function might say it has the CPR @@ -1085,9 +1086,7 @@ mkWWcpr opt_CprAnal fam_envs body_ty cpr | not opt_CprAnal = return (False, id, id, body_ty) -- CPR is turned on by default for -O and O2 | otherwise = do - -- We assume WHNF, so the outer layer always terminates. - let (_tm, cpr') = forceCpr seqDmd cpr - mb_stuff <- mkWWcpr_one_layer fam_envs body_ty cpr' + mb_stuff <- mkWWcpr_one_layer fam_envs body_ty cpr case mb_stuff of Nothing -> return (False, id, id, body_ty) Just stuff -> do ===================================== compiler/GHC/Types/Cpr.hs ===================================== @@ -475,8 +475,8 @@ forceTermM sd (Term tf l_sh) = do _ -> return l_sh -- just don't force anything return (Term Terminates l_sh') -forceCpr :: Demand -> Cpr -> (TerminationFlag, Cpr) -forceCpr dmd cpr = runTerminationM (idIfLazy forceCprM dmd cpr) +forceCpr :: SubDemand -> Cpr -> (TerminationFlag, Cpr) +forceCpr sd cpr = runTerminationM (forceCprM sd cpr) -- | 'lubTerm's the given outer @TerminationFlag@ on the @CprType at s 'ct_term'. bothCprType :: CprType -> TerminationFlag -> CprType ===================================== testsuite/tests/cpranal/should_compile/T18174.hs ===================================== @@ -0,0 +1,66 @@ +{-# OPTIONS_GHC -O2 -fforce-recomp #-} +{-# LANGUAGE BangPatterns #-} + +module T18174 (fac1, fac2, fac3, facIO, h1, h2) where + +---------------------------------------------------------------------- +-- First some basic examples that we want to CPR nestedly. + +-- pretty strict +fac1 :: Int -> a -> (a, Int) +fac1 n s | n < 2 = (s,1) + | otherwise = case fac1 (n-1) s of (s',n') -> let n'' = n*n' in n'' `seq` (s',n'') + +-- lazier, but Int still has CPR +fac2 :: Int -> a -> (a, Int) +fac2 n s | n < 2 = (s,1) + | otherwise = case fac2 (n-1) s of (s',n') -> (s',n'*n') + +-- even lazier, but evaluation of the Int doesn't terminate rapidly! +-- Thus, we may not WW for the nested Int. +-- Otherwise @fac3 99999 () `seq` ()@ (which should terminate rapidly) +-- evaluates more than necessary. +fac3 :: Int -> a -> (a, Int) +fac3 n s | n < 2 = (s,1) + | otherwise = let (s',n') = fac3 (n-1) s in (s',n'*n') + +facIO :: Int -> IO Int +facIO n | n < 2 = return 1 + | otherwise = do n' <- facIO (n-1); return (n*n') + +---------------------------------------------------------------------- +-- The following functions are copied from T18894. This test is about +-- *exploiting* the demand signatures that we assertedly (by T18894) +-- annotate. + +g1 :: Int -> (Int,Int) +g1 1 = (15, 0) +g1 n = (2 * n, 2 `div` n) +{-# NOINLINE g1 #-} + +-- | Sadly, the @g1 2@ subexpression will be floated to top-level, where we +-- don't see the specific demand placed on it by @snd at . Tracked in #19001. +h1 :: Int -> Int +h1 1 = 0 +h1 2 = snd (g1 2) +h1 m = uncurry (+) (g1 m) + +-- | So @g2@ here takes an additional argument m that prohibits floating to +-- top-level. We want that argument to have the CPR property, so we have +-- to add a bang so that it's used strictly and ultimately unboxed. +-- We expect the following CPR type: +-- +-- > #c1(#c1(#), *c1(#)) +-- +-- In combination with the the fact that all calls to @g2@ evaluate the second +-- component of the pair, we may unbox @g2@ to @(# Int#, Int# #)@. +g2 :: Int -> Int -> (Int,Int) +g2 !m 1 = (2 + m, 0) +g2 m n = (2 * m, 2 `div` n) +{-# NOINLINE g2 #-} + +h2 :: Int -> Int +h2 1 = 0 +h2 m + | odd m = snd (g2 m 2) + | otherwise = uncurry (+) (g2 2 m) ===================================== testsuite/tests/cpranal/should_compile/T18174.stderr ===================================== @@ -0,0 +1,167 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core = {terms: 336, types: 368, coercions: 6, joins: 0/1} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18174.$trModule4 :: GHC.Prim.Addr# +T18174.$trModule4 = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18174.$trModule3 :: GHC.Types.TrName +T18174.$trModule3 = GHC.Types.TrNameS T18174.$trModule4 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18174.$trModule2 :: GHC.Prim.Addr# +T18174.$trModule2 = "T18174"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18174.$trModule1 :: GHC.Types.TrName +T18174.$trModule1 = GHC.Types.TrNameS T18174.$trModule2 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18174.$trModule :: GHC.Types.Module +T18174.$trModule = GHC.Types.Module T18174.$trModule3 T18174.$trModule1 + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl_r1mk :: Int +lvl_r1mk = GHC.Types.I# 1# + +Rec { +-- RHS size: {terms: 38, types: 38, coercions: 0, joins: 0/1} +T18174.$wfac3 :: forall {a}. GHC.Prim.Int# -> a -> (# a, Int #) +T18174.$wfac3 + = \ (@a_s1d4) (ww_s1d9 :: GHC.Prim.Int#) (w_s1d6 :: a_s1d4) -> + case GHC.Prim.<# ww_s1d9 2# of { + __DEFAULT -> + let { + ds_s186 :: (a_s1d4, Int) + ds_s186 = case T18174.$wfac3 @a_s1d4 (GHC.Prim.-# ww_s1d9 1#) w_s1d6 of { (# ww2_s1dd, ww3_s1de #) -> (ww2_s1dd, ww3_s1de) } } in + (# case ds_s186 of { (s'_aXb, n'_aXc) -> s'_aXb }, case ds_s186 of { (s'_aXb, n'_aXc) -> case n'_aXc of { GHC.Types.I# ww2_s1d2 -> GHC.Types.I# (GHC.Prim.*# ww2_s1d2 ww2_s1d2) } } #); + 1# -> (# w_s1d6, lvl_r1mk #) + } +end Rec } + +-- RHS size: {terms: 14, types: 16, coercions: 0, joins: 0/0} +fac3 :: forall a. Int -> a -> (a, Int) +fac3 = \ (@a_s1d4) (w_s1d5 :: Int) (w1_s1d6 :: a_s1d4) -> case w_s1d5 of { GHC.Types.I# ww1_s1d9 -> case T18174.$wfac3 @a_s1d4 ww1_s1d9 w1_s1d6 of { (# ww3_s1dd, ww4_s1de #) -> (ww3_s1dd, ww4_s1de) } } + +Rec { +-- RHS size: {terms: 24, types: 21, coercions: 0, joins: 0/0} +T18174.$wfac2 :: forall {a}. GHC.Prim.Int# -> a -> (# a, GHC.Prim.Int# #) +T18174.$wfac2 + = \ (@a_s1dh) (ww_s1dm :: GHC.Prim.Int#) (w_s1dj :: a_s1dh) -> + case GHC.Prim.<# ww_s1dm 2# of { + __DEFAULT -> case T18174.$wfac2 @a_s1dh (GHC.Prim.-# ww_s1dm 1#) w_s1dj of { (# ww2_s1ds, ww3_s1du #) -> (# ww2_s1ds, GHC.Prim.*# ww3_s1du ww3_s1du #) }; + 1# -> (# w_s1dj, 1# #) + } +end Rec } + +-- RHS size: {terms: 15, types: 16, coercions: 0, joins: 0/0} +fac2 :: forall a. Int -> a -> (a, Int) +fac2 = \ (@a_s1dh) (w_s1di :: Int) (w1_s1dj :: a_s1dh) -> case w_s1di of { GHC.Types.I# ww1_s1dm -> case T18174.$wfac2 @a_s1dh ww1_s1dm w1_s1dj of { (# ww3_s1ds, ww4_s1du #) -> (ww3_s1ds, GHC.Types.I# ww4_s1du) } } + +Rec { +-- RHS size: {terms: 24, types: 21, coercions: 0, joins: 0/0} +T18174.$wfac1 :: forall {a}. GHC.Prim.Int# -> a -> (# a, GHC.Prim.Int# #) +T18174.$wfac1 + = \ (@a_s1dx) (ww_s1dC :: GHC.Prim.Int#) (w_s1dz :: a_s1dx) -> + case GHC.Prim.<# ww_s1dC 2# of { + __DEFAULT -> case T18174.$wfac1 @a_s1dx (GHC.Prim.-# ww_s1dC 1#) w_s1dz of { (# ww2_s1dI, ww3_s1dK #) -> (# ww2_s1dI, GHC.Prim.*# ww_s1dC ww3_s1dK #) }; + 1# -> (# w_s1dz, 1# #) + } +end Rec } + +-- RHS size: {terms: 15, types: 16, coercions: 0, joins: 0/0} +fac1 :: forall a. Int -> a -> (a, Int) +fac1 = \ (@a_s1dx) (w_s1dy :: Int) (w1_s1dz :: a_s1dx) -> case w_s1dy of { GHC.Types.I# ww1_s1dC -> case T18174.$wfac1 @a_s1dx ww1_s1dC w1_s1dz of { (# ww3_s1dI, ww4_s1dK #) -> (ww3_s1dI, GHC.Types.I# ww4_s1dK) } } + +-- RHS size: {terms: 30, types: 19, coercions: 0, joins: 0/0} +T18174.$wg2 :: GHC.Prim.Int# -> GHC.Prim.Int# -> (# GHC.Prim.Int#, GHC.Prim.Int# #) +T18174.$wg2 + = \ (ww_s1dR :: GHC.Prim.Int#) (ww1_s1dV :: GHC.Prim.Int#) -> + case ww1_s1dV of ds_X2 { + __DEFAULT -> case GHC.Classes.divInt# 2# ds_X2 of ww4_a153 { __DEFAULT -> (# GHC.Prim.*# 2# ww_s1dR, ww4_a153 #) }; + -1# -> (# GHC.Prim.*# 2# ww_s1dR, -2# #); + 0# -> case GHC.Real.divZeroError of wild_00 { }; + 1# -> (# GHC.Prim.+# 2# ww_s1dR, 0# #) + } + +-- RHS size: {terms: 26, types: 17, coercions: 0, joins: 0/0} +T18174.$wh2 :: GHC.Prim.Int# -> GHC.Prim.Int# +T18174.$wh2 + = \ (ww_s1ed :: GHC.Prim.Int#) -> + case ww_s1ed of ds_X2 { + __DEFAULT -> + case GHC.Prim.remInt# ds_X2 2# of { + __DEFAULT -> case T18174.$wg2 ds_X2 2# of { (# ww2_s1e4, ww3_s1e7 #) -> ww3_s1e7 }; + 0# -> case T18174.$wg2 2# ds_X2 of { (# ww2_s1e4, ww3_s1e7 #) -> GHC.Prim.+# ww2_s1e4 ww3_s1e7 } + }; + 1# -> 0# + } + +-- RHS size: {terms: 10, types: 4, coercions: 0, joins: 0/0} +h2 :: Int -> Int +h2 = \ (w_s1ea :: Int) -> case w_s1ea of { GHC.Types.I# ww1_s1ed -> case T18174.$wh2 ww1_s1ed of ww2_s1eh { __DEFAULT -> GHC.Types.I# ww2_s1eh } } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18174.h5 :: Int +T18174.h5 = GHC.Types.I# 0# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl1_r1ml :: Int +lvl1_r1ml = GHC.Types.I# -2# + +-- RHS size: {terms: 27, types: 15, coercions: 0, joins: 0/0} +T18174.$wg1 :: GHC.Prim.Int# -> (# GHC.Prim.Int#, Int #) +T18174.$wg1 + = \ (ww_s1en :: GHC.Prim.Int#) -> + case ww_s1en of ds_X2 { + __DEFAULT -> + (# GHC.Prim.*# 2# ds_X2, + case ds_X2 of { + __DEFAULT -> case GHC.Classes.divInt# 2# ds_X2 of ww4_a153 { __DEFAULT -> GHC.Types.I# ww4_a153 }; + -1# -> lvl1_r1ml; + 0# -> case GHC.Real.divZeroError of wild1_00 { } + } #); + 1# -> (# 15#, T18174.h5 #) + } + +-- RHS size: {terms: 8, types: 9, coercions: 0, joins: 0/0} +T18174.h4 :: (Int, Int) +T18174.h4 = case T18174.$wg1 2# of { (# ww1_s1eu, ww2_s1ew #) -> (GHC.Types.I# ww1_s1eu, ww2_s1ew) } + +-- RHS size: {terms: 22, types: 16, coercions: 0, joins: 0/0} +T18174.$wh1 :: GHC.Prim.Int# -> Int +T18174.$wh1 + = \ (ww_s1eC :: GHC.Prim.Int#) -> + case ww_s1eC of ds_X2 { + __DEFAULT -> case T18174.$wg1 ds_X2 of { (# ww2_s1eu, ww3_s1ew #) -> case ww3_s1ew of { GHC.Types.I# y_a15e -> GHC.Types.I# (GHC.Prim.+# ww2_s1eu y_a15e) } }; + 1# -> T18174.h5; + 2# -> case T18174.h4 of { (ds1_a137, y_a138) -> y_a138 } + } + +-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} +h1 :: Int -> Int +h1 = \ (w_s1ez :: Int) -> case w_s1ez of { GHC.Types.I# ww1_s1eC -> T18174.$wh1 ww1_s1eC } + +Rec { +-- RHS size: {terms: 23, types: 29, coercions: 0, joins: 0/0} +T18174.$wfacIO :: GHC.Prim.Int# -> GHC.Prim.State# GHC.Prim.RealWorld -> (# GHC.Prim.State# GHC.Prim.RealWorld, GHC.Prim.Int# #) +T18174.$wfacIO + = \ (ww_s1eJ :: GHC.Prim.Int#) (w_s1eG :: GHC.Prim.State# GHC.Prim.RealWorld) -> + case GHC.Prim.<# ww_s1eJ 2# of { + __DEFAULT -> case T18174.$wfacIO (GHC.Prim.-# ww_s1eJ 1#) w_s1eG of { (# ww2_s1eP, ww3_s1eR #) -> (# ww2_s1eP, GHC.Prim.*# ww_s1eJ ww3_s1eR #) }; + 1# -> (# w_s1eG, 1# #) + } +end Rec } + +-- RHS size: {terms: 14, types: 23, coercions: 0, joins: 0/0} +T18174.facIO1 :: Int -> GHC.Prim.State# GHC.Prim.RealWorld -> (# GHC.Prim.State# GHC.Prim.RealWorld, Int #) +T18174.facIO1 = \ (w_s1eF :: Int) (w1_s1eG :: GHC.Prim.State# GHC.Prim.RealWorld) -> case w_s1eF of { GHC.Types.I# ww1_s1eJ -> case T18174.$wfacIO ww1_s1eJ w1_s1eG of { (# ww3_s1eP, ww4_s1eR #) -> (# ww3_s1eP, GHC.Types.I# ww4_s1eR #) } } + +-- RHS size: {terms: 1, types: 0, coercions: 6, joins: 0/0} +facIO :: Int -> IO Int +facIO = T18174.facIO1 `cast` (_R %<'Many>_N ->_R Sym (GHC.Types.N:IO[0] _R) :: (Int -> GHC.Prim.State# GHC.Prim.RealWorld -> (# GHC.Prim.State# GHC.Prim.RealWorld, Int #)) ~R# (Int -> IO Int)) + + + ===================================== testsuite/tests/cpranal/should_compile/all.T ===================================== @@ -5,3 +5,5 @@ def f( name, opts ): setTestOpts(f) test('Cpr001', [], multimod_compile, ['Cpr001', '-v0']) +# The following test greps for type signatures of worker functions. +test('T18174', [ grep_errmsg(r'^T18174\.\$w\S+ ::') ], compile, ['-ddump-simpl -dsuppress-idinfo -dppr-cols=9999']) ===================================== testsuite/tests/cpranal/sigs/T1600.hs ===================================== @@ -1,23 +1,5 @@ -module Lib where - - --- pretty strict -fac1 :: Int -> a -> (a, Int) -fac1 n s | n < 2 = (s,1) - | otherwise = case fac1 (n-1) s of (s',n') -> let n'' = n*n' in n'' `seq` (s',n'') - --- lazier, but Int still has CPR -fac2 :: Int -> a -> (a, Int) -fac2 n s | n < 2 = (s,1) - | otherwise = case fac2 (n-1) s of (s',n') -> (s',n'*n') - --- even lazier, but evaluation of the Int doesn't terminate rapidly! --- Thus, we may not WW for the nested Int. --- Otherwise @fac3 99999 () `seq` ()@ (which should terminate rapidly) --- evaluates more than necessary. -fac3 :: Int -> a -> (a, Int) -fac3 n s | n < 2 = (s,1) - | otherwise = let (s',n') = fac3 (n-1) s in (s',n'*n') +-- | Basically tests Nested CPR on IO. +module T1600 where facIO :: Int -> IO Int facIO n | n < 2 = return 1 ===================================== testsuite/tests/cpranal/sigs/T1600.stderr ===================================== @@ -1,9 +1,6 @@ ==================== Cpr signatures ==================== -Lib.$trModule: * -Lib.fac1: *c1(*, #c1(#)) -Lib.fac2: *c1(*, #c1(#)) -Lib.fac3: *c1(*, *c1(#)) -Lib.facIO: *c1(*, #c1(#)) +T1600.$trModule: * +T1600.facIO: *c1(*, #c1(#)) ===================================== testsuite/tests/simplCore/should_compile/T3772.stdout ===================================== @@ -42,7 +42,7 @@ T3772.$trModule Rec { -- RHS size: {terms: 10, types: 2, coercions: 0, joins: 0/0} $wxs :: GHC.Prim.Int# -> () -[GblId, Arity=1, Str=, Unf=OtherCon []] +[GblId, Arity=1, Str=, Cpr=#, Unf=OtherCon []] $wxs = \ (ww :: GHC.Prim.Int#) -> case ww of ds1 { ===================================== testsuite/tests/stranal/should_compile/T18894.stderr ===================================== @@ -205,7 +205,7 @@ h1 ==================== Demand analysis ==================== Result size of Demand analysis - = {terms: 171, types: 120, coercions: 0, joins: 0/0} + = {terms: 169, types: 121, coercions: 0, joins: 0/0} -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} $trModule :: GHC.Prim.Addr# @@ -242,42 +242,27 @@ T18894.$trModule :: GHC.Types.Module WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] T18894.$trModule = GHC.Types.Module $trModule $trModule --- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -lvl :: Int -[LclId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] -lvl = GHC.Types.I# 0# - --- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -lvl :: Int -[LclId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] -lvl = GHC.Types.I# -2# - --- RHS size: {terms: 32, types: 18, coercions: 0, joins: 0/0} -$wg2 [InlPrag=NOINLINE, Dmd=UCU(CS(P(1P(U),SP(U))))] - :: Int -> GHC.Prim.Int# -> (# Int, Int #) +-- RHS size: {terms: 36, types: 23, coercions: 0, joins: 0/0} +$wg2 [InlPrag=NOINLINE, Dmd=UCU(CS(P(1P(U),U)))] + :: Int -> GHC.Prim.Int# -> (# Int, GHC.Prim.Int# #) [LclId, Arity=2, Str=, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [20 30] 121 20}] + WorkFree=True, Expandable=True, Guidance=IF_ARGS [40 71] 122 30}] $wg2 = \ (w [Dmd=UP(U)] :: Int) (ww [Dmd=SU] :: GHC.Prim.Int#) -> case ww of ds { __DEFAULT -> + case GHC.Classes.divInt# 2# ds of ww4 { __DEFAULT -> (# case w of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.*# 2# y) }, - case ds of { - __DEFAULT -> - case GHC.Classes.divInt# 2# ds of ww4 { __DEFAULT -> - GHC.Types.I# ww4 - }; - -1# -> lvl; - 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { } - } #); - 1# -> (# w, lvl #) + ww4 #) + }; + -1# -> + (# case w of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.*# 2# y) }, + -2# #); + 0# -> case GHC.Real.divZeroError of wild [Dmd=B] { }; + 1# -> (# w, 0# #) } -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} @@ -287,13 +272,13 @@ lvl :: Int WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] lvl = GHC.Types.I# 2# --- RHS size: {terms: 36, types: 23, coercions: 0, joins: 0/0} +-- RHS size: {terms: 30, types: 19, coercions: 0, joins: 0/0} $wh2 [InlPrag=[2]] :: GHC.Prim.Int# -> GHC.Prim.Int# [LclId, Arity=1, Str=, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 162 0}] + WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 142 0}] $wh2 = \ (ww [Dmd=SU] :: GHC.Prim.Int#) -> case ww of ds { @@ -301,14 +286,12 @@ $wh2 case GHC.Prim.remInt# ds 2# of { __DEFAULT -> case $wg2 (GHC.Types.I# ds) 2# of - { (# ww [Dmd=A], ww [Dmd=SP(SU)] #) -> - case ww of { GHC.Types.I# ww [Dmd=SU] -> ww } + { (# ww [Dmd=A], ww [Dmd=SU] #) -> + ww }; 0# -> - case $wg2 lvl ds of { (# ww [Dmd=SP(U)], ww [Dmd=SP(U)] #) -> - case ww of { GHC.Types.I# x -> - case ww of { GHC.Types.I# y -> GHC.Prim.+# x y } - } + case $wg2 lvl ds of { (# ww [Dmd=SP(U)], ww #) -> + case ww of { GHC.Types.I# x -> GHC.Prim.+# x ww } } }; 1# -> 0# @@ -333,6 +316,20 @@ h2 case $wh2 ww of ww { __DEFAULT -> GHC.Types.I# ww } } +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# 0# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl :: Int +[LclId, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +lvl = GHC.Types.I# -2# + -- RHS size: {terms: 27, types: 15, coercions: 0, joins: 0/0} $wg1 [InlPrag=NOINLINE, Dmd=UCU(P(U,UP(U)))] :: GHC.Prim.Int# -> (# GHC.Prim.Int#, Int #) ===================================== testsuite/tests/stranal/should_compile/T18903.stderr ===================================== @@ -1,7 +1,7 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 84, types: 55, coercions: 0, joins: 0/1} + = {terms: 79, types: 55, coercions: 0, joins: 0/1} -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T18903.$trModule4 :: GHC.Prim.Addr# @@ -44,66 +44,60 @@ T18903.h1 :: Int [GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] -T18903.h1 = GHC.Types.I# 0# +T18903.h1 = GHC.Types.I# -2# --- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T18903.h2 :: Int -[GblId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] -T18903.h2 = GHC.Types.I# -2# - --- RHS size: {terms: 56, types: 41, coercions: 0, joins: 0/1} -T18903.$wh [InlPrag=[2]] :: GHC.Prim.Int# -> Int +-- RHS size: {terms: 50, types: 41, coercions: 0, joins: 0/1} +T18903.$wh [InlPrag=[2]] :: GHC.Prim.Int# -> GHC.Prim.Int# [GblId, Arity=1, Str=, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [70] 262 10}] + WorkFree=True, Expandable=True, Guidance=IF_ARGS [70] 222 0}] T18903.$wh = \ (ww :: GHC.Prim.Int#) -> let { - $wg [InlPrag=NOINLINE, Dmd=1C1(P(1P(U),SP(U)))] - :: GHC.Prim.Int# -> (# Int, Int #) + $wg [InlPrag=NOINLINE, Dmd=1C1(P(1P(U),U))] + :: GHC.Prim.Int# -> (# Int, GHC.Prim.Int# #) [LclId, Arity=1, Str=, Unf=OtherCon []] $wg = \ (ww1 [OS=OneShot] :: GHC.Prim.Int#) -> case ww1 of ds { __DEFAULT -> - (# GHC.Types.I# (GHC.Prim.*# 2# ds), - case ds of { - __DEFAULT -> - case GHC.Classes.divInt# 2# ds of ww4 { __DEFAULT -> - GHC.Types.I# ww4 - }; - -1# -> T18903.h2; - 0# -> case GHC.Real.divZeroError of wild1 { } - } #); - 1# -> (# GHC.Types.I# ww, T18903.h1 #) + case GHC.Classes.divInt# 2# ds of ww4 { __DEFAULT -> + (# GHC.Types.I# (GHC.Prim.*# 2# ds), ww4 #) + }; + -1# -> (# T18903.h1, -2# #); + 0# -> case GHC.Real.divZeroError of wild { }; + 1# -> (# GHC.Types.I# ww, 0# #) } } in case ww of ds { __DEFAULT -> case $wg ds of { (# ww2, ww3 #) -> - case ww2 of { GHC.Types.I# x -> - case ww3 of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) } - } + case ww2 of { GHC.Types.I# x -> GHC.Prim.+# x ww3 } }; - 1# -> T18903.h1; + 1# -> 0#; 2# -> case $wg 2# of { (# ww2, ww3 #) -> ww3 } } --- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} +-- RHS size: {terms: 10, types: 4, coercions: 0, joins: 0/0} h [InlPrag=[2]] :: Int -> Int [GblId, Arity=1, Str=, + Cpr=*c1(#), Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) Tmpl= \ (w [Occ=Once1!] :: Int) -> - case w of { GHC.Types.I# ww1 [Occ=Once1] -> T18903.$wh ww1 }}] + case w of { GHC.Types.I# ww1 [Occ=Once1] -> + case T18903.$wh ww1 of ww2 [Occ=Once1] { __DEFAULT -> + GHC.Types.I# ww2 + } + }}] h = \ (w :: Int) -> - case w of { GHC.Types.I# ww1 -> T18903.$wh ww1 } + case w of { GHC.Types.I# ww1 -> + case T18903.$wh ww1 of ww2 { __DEFAULT -> GHC.Types.I# ww2 } + } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3a0802dce5c7e7249a0f8149d3eeec9a68defaf2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3a0802dce5c7e7249a0f8149d3eeec9a68defaf2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 17 18:21:14 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 17 Dec 2020 13:21:14 -0500 Subject: [Git][ghc/ghc][wip/gc/root-evac-stats] rts: Track root evacuation statistics Message-ID: <5fdba19a6e40a_6b2174471c21617d2@gitlab.mail> Ben Gamari pushed to branch wip/gc/root-evac-stats at Glasgow Haskell Compiler / GHC Commits: 118a287f by Ben Gamari at 2020-12-17T13:21:07-05:00 rts: Track root evacuation statistics - - - - - 3 changed files: - rts/sm/GC.c - rts/sm/GCThread.h - rts/sm/MarkWeak.c Changes: ===================================== rts/sm/GC.c ===================================== @@ -217,6 +217,35 @@ addMutListScavStats(const MutListScavStats *src, } #endif /* DEBUG */ +/* ----------------------------------------------------------------------------- + Statistics from root evacuation + -------------------------------------------------------------------------- */ + +/* + * Note [Root evacuation statistics] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * When diagnosing concurrent GC pauses it can often be useful + * to know how many GC roots we get from various sources. + * Consequently, track this information in each GC thread and + * emit eventlog events if ROOT_EVAC_STATS is #define'd. + * + * To keep track of root evacuations mark_root() bumps a + * counter in gc_thread, which gets zero'd after we finish + * evacuating each class of roots. We also bump the counter in + * markWeakPtrList(), since this codepath doesn't use mark_root(). + */ + +#if defined(DEBUG) || defined(THREADED_RTS) +#define ROOT_EVAC_STATS +#endif + +#if defined(ROOT_EVAC_STATS) +#define TRACE_EVACD_ROOTS(label) \ + trace(TRACE_nonmoving_gc, "root:" label ":%d", gct->n_roots_evacd); \ + gct->n_roots_evacd = 0; +#else +#define TRACE_EVACD_ROOTS(label) +#endif /* ----------------------------------------------------------------------------- GarbageCollect: the main entry point to the garbage collector. @@ -441,10 +470,12 @@ GarbageCollect (uint32_t collect_gen, } } } + TRACE_EVACD_ROOTS("MutList"); // follow roots from the CAF list (used by GHCi) gct->evac_gen_no = 0; markCAFs(mark_root, gct); + TRACE_EVACD_ROOTS("CAF"); // follow all the roots that the application knows about. gct->evac_gen_no = 0; @@ -456,15 +487,20 @@ GarbageCollect (uint32_t collect_gen, } else { markCapability(mark_root, gct, cap, true/*don't mark sparks*/); } + TRACE_EVACD_ROOTS("Cap"); + // Mark runnable threads markScheduler(mark_root, gct); + TRACE_EVACD_ROOTS("Sched"); // Mark the weak pointer list, and prepare to detect dead weak pointers. markWeakPtrList(); initWeakForGC(); + TRACE_EVACD_ROOTS("WeakPtr"); // Mark the stable pointer table. markStablePtrTable(mark_root, gct); + TRACE_EVACD_ROOTS("StablePtr"); // Remember old stable name addresses. rememberOldStableNameAddresses (); @@ -1296,7 +1332,11 @@ gcWorkerThread (Capability *cap) // Every thread evacuates some roots. gct->evac_gen_no = 0; markCapability(mark_root, gct, cap, true/*prune sparks*/); + TRACE_EVACD_ROOTS("Cap"); + + // Scavenge mutable lists scavenge_capability_mut_lists(cap); + TRACE_EVACD_ROOTS("MutList"); scavenge_until_all_done(); @@ -1753,6 +1793,7 @@ init_gc_thread (gc_thread *t) t->any_work = 0; t->no_work = 0; t->scav_find_work = 0; + t->n_roots_evacd = 0; } /* ----------------------------------------------------------------------------- @@ -1774,6 +1815,9 @@ mark_root(void *user USED_IF_THREADS, StgClosure **root) SET_GCT(user); evacuate(root); +#if defined(ROOT_EVAC_STATS) + gct->n_evacd_roots++; +#endif SET_GCT(saved_gct); } ===================================== rts/sm/GCThread.h ===================================== @@ -184,6 +184,7 @@ typedef struct gc_thread_ { W_ any_work; W_ no_work; W_ scav_find_work; + W_ n_evacd_roots; // See Note [Root evacuation statistics] in GC.c. Time gc_start_cpu; // thread CPU time Time gc_end_cpu; // thread CPU time ===================================== rts/sm/MarkWeak.c ===================================== @@ -427,6 +427,7 @@ markWeakPtrList ( void ) } #endif + gct->n_roots_evacd++; // See Note [Root evacuation statistics] evacuate((StgClosure **)last_w); w = *last_w; last_w = &(w->link); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/118a287f6cfa97b478fe1758038e822ac024a210 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/118a287f6cfa97b478fe1758038e822ac024a210 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 17 18:21:43 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 17 Dec 2020 13:21:43 -0500 Subject: [Git][ghc/ghc][wip/gc/root-evac-stats] rts: Track root evacuation statistics Message-ID: <5fdba1b7b2936_6b21866204421624f7@gitlab.mail> Ben Gamari pushed to branch wip/gc/root-evac-stats at Glasgow Haskell Compiler / GHC Commits: 28d076c8 by Ben Gamari at 2020-12-17T13:21:37-05:00 rts: Track root evacuation statistics - - - - - 3 changed files: - rts/sm/GC.c - rts/sm/GCThread.h - rts/sm/MarkWeak.c Changes: ===================================== rts/sm/GC.c ===================================== @@ -217,6 +217,35 @@ addMutListScavStats(const MutListScavStats *src, } #endif /* DEBUG */ +/* ----------------------------------------------------------------------------- + Statistics from root evacuation + -------------------------------------------------------------------------- */ + +/* + * Note [Root evacuation statistics] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * When diagnosing concurrent GC pauses it can often be useful + * to know how many GC roots we get from various sources. + * Consequently, track this information in each GC thread and + * emit eventlog events if ROOT_EVAC_STATS is #define'd. + * + * To keep track of root evacuations mark_root() bumps a + * counter in gc_thread, which gets zero'd after we finish + * evacuating each class of roots. We also bump the counter in + * markWeakPtrList(), since this codepath doesn't use mark_root(). + */ + +#if defined(DEBUG) || defined(THREADED_RTS) +#define ROOT_EVAC_STATS +#endif + +#if defined(ROOT_EVAC_STATS) +#define TRACE_EVACD_ROOTS(label) \ + trace(TRACE_nonmoving_gc, "root:" label ":%d", gct->n_roots_evacd); \ + gct->n_roots_evacd = 0; +#else +#define TRACE_EVACD_ROOTS(label) +#endif /* ----------------------------------------------------------------------------- GarbageCollect: the main entry point to the garbage collector. @@ -441,10 +470,12 @@ GarbageCollect (uint32_t collect_gen, } } } + TRACE_EVACD_ROOTS("MutList"); // follow roots from the CAF list (used by GHCi) gct->evac_gen_no = 0; markCAFs(mark_root, gct); + TRACE_EVACD_ROOTS("CAF"); // follow all the roots that the application knows about. gct->evac_gen_no = 0; @@ -456,15 +487,20 @@ GarbageCollect (uint32_t collect_gen, } else { markCapability(mark_root, gct, cap, true/*don't mark sparks*/); } + TRACE_EVACD_ROOTS("Cap"); + // Mark runnable threads markScheduler(mark_root, gct); + TRACE_EVACD_ROOTS("Sched"); // Mark the weak pointer list, and prepare to detect dead weak pointers. markWeakPtrList(); initWeakForGC(); + TRACE_EVACD_ROOTS("WeakPtr"); // Mark the stable pointer table. markStablePtrTable(mark_root, gct); + TRACE_EVACD_ROOTS("StablePtr"); // Remember old stable name addresses. rememberOldStableNameAddresses (); @@ -1296,7 +1332,11 @@ gcWorkerThread (Capability *cap) // Every thread evacuates some roots. gct->evac_gen_no = 0; markCapability(mark_root, gct, cap, true/*prune sparks*/); + TRACE_EVACD_ROOTS("Cap"); + + // Scavenge mutable lists scavenge_capability_mut_lists(cap); + TRACE_EVACD_ROOTS("MutList"); scavenge_until_all_done(); @@ -1753,6 +1793,7 @@ init_gc_thread (gc_thread *t) t->any_work = 0; t->no_work = 0; t->scav_find_work = 0; + t->n_roots_evacd = 0; } /* ----------------------------------------------------------------------------- @@ -1774,6 +1815,9 @@ mark_root(void *user USED_IF_THREADS, StgClosure **root) SET_GCT(user); evacuate(root); +#if defined(ROOT_EVAC_STATS) + gct->n_evacd_roots++; +#endif SET_GCT(saved_gct); } ===================================== rts/sm/GCThread.h ===================================== @@ -184,6 +184,7 @@ typedef struct gc_thread_ { W_ any_work; W_ no_work; W_ scav_find_work; + W_ n_evacd_roots; // See Note [Root evacuation statistics] in GC.c. Time gc_start_cpu; // thread CPU time Time gc_end_cpu; // thread CPU time ===================================== rts/sm/MarkWeak.c ===================================== @@ -427,6 +427,7 @@ markWeakPtrList ( void ) } #endif + gct->n_evacd_roots++; // See Note [Root evacuation statistics] evacuate((StgClosure **)last_w); w = *last_w; last_w = &(w->link); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/28d076c830c61a485d2e0de1c0d4812304d800cc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/28d076c830c61a485d2e0de1c0d4812304d800cc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 17 18:22:21 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 17 Dec 2020 13:22:21 -0500 Subject: [Git][ghc/ghc][wip/gc/root-evac-stats] rts: Track root evacuation statistics Message-ID: <5fdba1dd77828_6b21962d8e821631f0@gitlab.mail> Ben Gamari pushed to branch wip/gc/root-evac-stats at Glasgow Haskell Compiler / GHC Commits: eecb519b by Ben Gamari at 2020-12-17T13:22:00-05:00 rts: Track root evacuation statistics - - - - - 3 changed files: - rts/sm/GC.c - rts/sm/GCThread.h - rts/sm/MarkWeak.c Changes: ===================================== rts/sm/GC.c ===================================== @@ -217,6 +217,35 @@ addMutListScavStats(const MutListScavStats *src, } #endif /* DEBUG */ +/* ----------------------------------------------------------------------------- + Statistics from root evacuation + -------------------------------------------------------------------------- */ + +/* + * Note [Root evacuation statistics] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * When diagnosing concurrent GC pauses it can often be useful + * to know how many GC roots we get from various sources. + * Consequently, track this information in each GC thread and + * emit eventlog events if ROOT_EVAC_STATS is #define'd. + * + * To keep track of root evacuations mark_root() bumps a + * counter in gc_thread, which gets zero'd after we finish + * evacuating each class of roots. We also bump the counter in + * markWeakPtrList(), since this codepath doesn't use mark_root(). + */ + +#if defined(DEBUG) || defined(THREADED_RTS) +#define ROOT_EVAC_STATS +#endif + +#if defined(ROOT_EVAC_STATS) +#define TRACE_EVACD_ROOTS(label) \ + trace(TRACE_nonmoving_gc, "root:" label ":%d", gct->n_roots_evacd); \ + gct->n_evacd_roots = 0; +#else +#define TRACE_EVACD_ROOTS(label) +#endif /* ----------------------------------------------------------------------------- GarbageCollect: the main entry point to the garbage collector. @@ -441,10 +470,12 @@ GarbageCollect (uint32_t collect_gen, } } } + TRACE_EVACD_ROOTS("MutList"); // follow roots from the CAF list (used by GHCi) gct->evac_gen_no = 0; markCAFs(mark_root, gct); + TRACE_EVACD_ROOTS("CAF"); // follow all the roots that the application knows about. gct->evac_gen_no = 0; @@ -456,15 +487,20 @@ GarbageCollect (uint32_t collect_gen, } else { markCapability(mark_root, gct, cap, true/*don't mark sparks*/); } + TRACE_EVACD_ROOTS("Cap"); + // Mark runnable threads markScheduler(mark_root, gct); + TRACE_EVACD_ROOTS("Sched"); // Mark the weak pointer list, and prepare to detect dead weak pointers. markWeakPtrList(); initWeakForGC(); + TRACE_EVACD_ROOTS("WeakPtr"); // Mark the stable pointer table. markStablePtrTable(mark_root, gct); + TRACE_EVACD_ROOTS("StablePtr"); // Remember old stable name addresses. rememberOldStableNameAddresses (); @@ -1296,7 +1332,11 @@ gcWorkerThread (Capability *cap) // Every thread evacuates some roots. gct->evac_gen_no = 0; markCapability(mark_root, gct, cap, true/*prune sparks*/); + TRACE_EVACD_ROOTS("Cap"); + + // Scavenge mutable lists scavenge_capability_mut_lists(cap); + TRACE_EVACD_ROOTS("MutList"); scavenge_until_all_done(); @@ -1753,6 +1793,7 @@ init_gc_thread (gc_thread *t) t->any_work = 0; t->no_work = 0; t->scav_find_work = 0; + t->n_roots_evacd = 0; } /* ----------------------------------------------------------------------------- @@ -1774,6 +1815,9 @@ mark_root(void *user USED_IF_THREADS, StgClosure **root) SET_GCT(user); evacuate(root); +#if defined(ROOT_EVAC_STATS) + gct->n_evacd_roots++; +#endif SET_GCT(saved_gct); } ===================================== rts/sm/GCThread.h ===================================== @@ -184,6 +184,7 @@ typedef struct gc_thread_ { W_ any_work; W_ no_work; W_ scav_find_work; + W_ n_evacd_roots; // See Note [Root evacuation statistics] in GC.c. Time gc_start_cpu; // thread CPU time Time gc_end_cpu; // thread CPU time ===================================== rts/sm/MarkWeak.c ===================================== @@ -427,6 +427,7 @@ markWeakPtrList ( void ) } #endif + gct->n_evacd_roots++; // See Note [Root evacuation statistics] evacuate((StgClosure **)last_w); w = *last_w; last_w = &(w->link); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eecb519b8cef1c03ef25c591368622e4bdf9f04d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eecb519b8cef1c03ef25c591368622e4bdf9f04d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 17 18:22:53 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 17 Dec 2020 13:22:53 -0500 Subject: [Git][ghc/ghc][wip/gc/root-evac-stats] rts: Track root evacuation statistics Message-ID: <5fdba1fd12d5b_6b21725c11c21638e7@gitlab.mail> Ben Gamari pushed to branch wip/gc/root-evac-stats at Glasgow Haskell Compiler / GHC Commits: e887daf1 by Ben Gamari at 2020-12-17T13:22:46-05:00 rts: Track root evacuation statistics - - - - - 3 changed files: - rts/sm/GC.c - rts/sm/GCThread.h - rts/sm/MarkWeak.c Changes: ===================================== rts/sm/GC.c ===================================== @@ -217,6 +217,35 @@ addMutListScavStats(const MutListScavStats *src, } #endif /* DEBUG */ +/* ----------------------------------------------------------------------------- + Statistics from root evacuation + -------------------------------------------------------------------------- */ + +/* + * Note [Root evacuation statistics] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * When diagnosing concurrent GC pauses it can often be useful + * to know how many GC roots we get from various sources. + * Consequently, track this information in each GC thread and + * emit eventlog events if ROOT_EVAC_STATS is #define'd. + * + * To keep track of root evacuations mark_root() bumps a + * counter in gc_thread, which gets zero'd after we finish + * evacuating each class of roots. We also bump the counter in + * markWeakPtrList(), since this codepath doesn't use mark_root(). + */ + +#if defined(DEBUG) || defined(THREADED_RTS) +#define ROOT_EVAC_STATS +#endif + +#if defined(ROOT_EVAC_STATS) +#define TRACE_EVACD_ROOTS(label) \ + trace(TRACE_nonmoving_gc, "root:" label ":%d", gct->n_evacd_roots); \ + gct->n_evacd_roots = 0; +#else +#define TRACE_EVACD_ROOTS(label) +#endif /* ----------------------------------------------------------------------------- GarbageCollect: the main entry point to the garbage collector. @@ -441,10 +470,12 @@ GarbageCollect (uint32_t collect_gen, } } } + TRACE_EVACD_ROOTS("MutList"); // follow roots from the CAF list (used by GHCi) gct->evac_gen_no = 0; markCAFs(mark_root, gct); + TRACE_EVACD_ROOTS("CAF"); // follow all the roots that the application knows about. gct->evac_gen_no = 0; @@ -456,15 +487,20 @@ GarbageCollect (uint32_t collect_gen, } else { markCapability(mark_root, gct, cap, true/*don't mark sparks*/); } + TRACE_EVACD_ROOTS("Cap"); + // Mark runnable threads markScheduler(mark_root, gct); + TRACE_EVACD_ROOTS("Sched"); // Mark the weak pointer list, and prepare to detect dead weak pointers. markWeakPtrList(); initWeakForGC(); + TRACE_EVACD_ROOTS("WeakPtr"); // Mark the stable pointer table. markStablePtrTable(mark_root, gct); + TRACE_EVACD_ROOTS("StablePtr"); // Remember old stable name addresses. rememberOldStableNameAddresses (); @@ -1296,7 +1332,11 @@ gcWorkerThread (Capability *cap) // Every thread evacuates some roots. gct->evac_gen_no = 0; markCapability(mark_root, gct, cap, true/*prune sparks*/); + TRACE_EVACD_ROOTS("Cap"); + + // Scavenge mutable lists scavenge_capability_mut_lists(cap); + TRACE_EVACD_ROOTS("MutList"); scavenge_until_all_done(); @@ -1753,6 +1793,7 @@ init_gc_thread (gc_thread *t) t->any_work = 0; t->no_work = 0; t->scav_find_work = 0; + t->n_evacd_roots = 0; } /* ----------------------------------------------------------------------------- @@ -1774,6 +1815,9 @@ mark_root(void *user USED_IF_THREADS, StgClosure **root) SET_GCT(user); evacuate(root); +#if defined(ROOT_EVAC_STATS) + gct->n_evacd_roots++; +#endif SET_GCT(saved_gct); } ===================================== rts/sm/GCThread.h ===================================== @@ -184,6 +184,7 @@ typedef struct gc_thread_ { W_ any_work; W_ no_work; W_ scav_find_work; + W_ n_evacd_roots; // See Note [Root evacuation statistics] in GC.c. Time gc_start_cpu; // thread CPU time Time gc_end_cpu; // thread CPU time ===================================== rts/sm/MarkWeak.c ===================================== @@ -427,6 +427,7 @@ markWeakPtrList ( void ) } #endif + gct->n_evacd_roots++; // See Note [Root evacuation statistics] evacuate((StgClosure **)last_w); w = *last_w; last_w = &(w->link); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e887daf1797dda29981ba7bcc6521e196de925d3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e887daf1797dda29981ba7bcc6521e196de925d3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 17 18:55:25 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 17 Dec 2020 13:55:25 -0500 Subject: [Git][ghc/ghc][master] User guide minor typo Message-ID: <5fdba99d3e9db_6b2174471c21680f9@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 80df2edd by David Eichmann at 2020-12-17T13:55:21-05:00 User guide minor typo [ci skip] - - - - - 1 changed file: - docs/users_guide/runtime_control.rst Changes: ===================================== docs/users_guide/runtime_control.rst ===================================== @@ -229,7 +229,7 @@ To use an :c:type:`EventLogWriter` the RTS API provides the following functions: .. c:function:: bool startEventLogging(const EventLogWriter *writer) Start logging events to the given :c:type:`EventLogWriter`. Returns true on - success or false is another writer has already been configured. + success or false if another writer has already been configured. .. c:function:: void endEventLogging() View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/80df2edd1b28dc211a894ab7c4faf1c8a0c92fcb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/80df2edd1b28dc211a894ab7c4faf1c8a0c92fcb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 17 18:56:06 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 17 Dec 2020 13:56:06 -0500 Subject: [Git][ghc/ghc][master] Force module recompilation if '*' prefix was used to load modules in ghci (#8042) Message-ID: <5fdba9c6eec88_6b21725c11c21738e3@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 09f28390 by nineonine at 2020-12-17T13:55:59-05:00 Force module recompilation if '*' prefix was used to load modules in ghci (#8042) Usually pre-compiled code is preferred to be loaded in ghci if available, which means that if we try to load module with '*' prefix and compilation artifacts are available on disc (.o and .hi files) or the source code was untouched, the driver would think no recompilation is required. Therefore, we need to force recompilation so that desired byte-code is generated and loaded. Forcing in this case should be ok, since this is what happens for interpreted code anyways when reloading modules. - - - - - 4 changed files: - compiler/GHC/Driver/Pipeline.hs - + testsuite/tests/ghci/scripts/T8042recomp.script - + testsuite/tests/ghci/scripts/T8042recomp.stdout - testsuite/tests/ghci/scripts/all.T Changes: ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -339,14 +339,18 @@ compileOne' m_tc_result mHscMessage current_dir = takeDirectory basename old_paths = includePaths dflags2 !prevailing_dflags = hsc_dflags hsc_env0 + loadAsByteCode + | Just (Target _ obj _) <- findTarget summary (hsc_targets hsc_env0) + , not obj + = True + | otherwise = False -- Figure out which backend we're using (bcknd, dflags3) -- #8042: When module was loaded with `*` prefix in ghci, but DynFlags -- suggest to generate object code (which may happen in case -fobject-code -- was set), force it to generate byte-code. This is NOT transitive and -- only applies to direct targets. - | Just (Target _ obj _) <- findTarget summary (hsc_targets hsc_env0) - , not obj + | loadAsByteCode = (Interpreter, dflags2 { backend = Interpreter }) | otherwise = (backend dflags, dflags2) @@ -362,7 +366,10 @@ compileOne' m_tc_result mHscMessage -- -fforce-recomp should also work with --make force_recomp = gopt Opt_ForceRecomp dflags source_modified - | force_recomp = SourceModified + -- #8042: Usually pre-compiled code is preferred to be loaded in ghci + -- if available. So, if the "*" prefix was used, force recompilation + -- to make sure byte-code is loaded. + | force_recomp || loadAsByteCode = SourceModified | otherwise = source_modified0 always_do_basic_recompilation_check = case bcknd of ===================================== testsuite/tests/ghci/scripts/T8042recomp.script ===================================== @@ -0,0 +1,7 @@ +:set -v1 +System.IO.writeFile "T8042B.hs" "module T8042B where { fooB = \"T8042B\"; }" +System.IO.writeFile "T8042A.hs" "module T8042A where { import T8042B; run = putStrLn fooB }" +:set -fobject-code +:load T8042A +:load *T8042A +:break run ===================================== testsuite/tests/ghci/scripts/T8042recomp.stdout ===================================== @@ -0,0 +1,6 @@ +[1 of 2] Compiling T8042B ( T8042B.hs, T8042B.o ) +[2 of 2] Compiling T8042A ( T8042A.hs, T8042A.o ) +Ok, two modules loaded. +[2 of 2] Compiling T8042A ( T8042A.hs, interpreted ) +Ok, two modules loaded. +Breakpoint 0 activated at T8042A.hs:1:44-56 ===================================== testsuite/tests/ghci/scripts/all.T ===================================== @@ -175,6 +175,7 @@ test('T7873', normal, ghci_script, ['T7873.script']) test('T7939', normal, ghci_script, ['T7939.script']) test('T7894', normal, ghci_script, ['T7894.script']) test('T8042', normal, ghci_script, ['T8042.script']) +test('T8042recomp', normal, ghci_script, ['T8042recomp.script']) test('T8116', normal, ghci_script, ['T8116.script']) test('T8113', normal, ghci_script, ['T8113.script']) test('T8172', when(opsys('mingw32'), normalise_drive_letter), View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/09f2839086d43483066e45fe15bb7a0b39f8d1dc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/09f2839086d43483066e45fe15bb7a0b39f8d1dc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 17 18:56:13 2020 From: gitlab at gitlab.haskell.org (Alan Zimmerman) Date: Thu, 17 Dec 2020 13:56:13 -0500 Subject: [Git][ghc/ghc][wip/az/exactprint] Proof of Concept implementation of in-tree API Annotations Message-ID: <5fdba9cdf1ba3_6b218662044217406d@gitlab.mail> Alan Zimmerman pushed to branch wip/az/exactprint at Glasgow Haskell Compiler / GHC Commits: 1e6bcea9 by Alan Zimmerman at 2020-12-17T18:55:51+00:00 Proof of Concept implementation of in-tree API Annotations This MR introduces a possible machinery to introduce API Annotations into the TTG extension points. It is intended to be a concrete example for discussion. It still needs to process comments. Remove LHsLocalBinds Fix up after rebasing to bring in XRec Main thing is to make type instance XRec (GhcPass p) a = GenLocated (Anno a) a type family Anno a = b But this has massive implications. - - - - - 19 changed files: - compiler/GHC.hs - compiler/GHC/Data/BooleanFormula.hs - compiler/GHC/Data/OrdList.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Ppr.hs - compiler/GHC/Hs.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Dump.hs - + compiler/GHC/Hs/Exact.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Expr.hs-boot - compiler/GHC/Hs/Extension.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Pat.hs-boot - compiler/GHC/Hs/Stats.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1e6bcea98b3f342098f35fc6ff28e433272565d7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1e6bcea98b3f342098f35fc6ff28e433272565d7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 17 18:56:44 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 17 Dec 2020 13:56:44 -0500 Subject: [Git][ghc/ghc][master] Reject dodgy scoping in associated family instance RHSes Message-ID: <5fdba9ec1b6b4_6b216741854217899d@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: b1178cbc by Ryan Scott at 2020-12-17T13:56:35-05:00 Reject dodgy scoping in associated family instance RHSes Commit e63518f5d6a93be111f9108c0990a1162f88d615 tried to push all of the logic of detecting out-of-scope type variables on the RHSes of associated type family instances to `GHC.Tc.Validity` by deleting a similar check in the renamer. Unfortunately, this commit went a little too far, as there are some corner cases that `GHC.Tc.Validity` doesn't detect. Consider this example: ```hs class C a where data D a instance forall a. C Int where data instance D Int = MkD a ``` If this program isn't rejected by the time it reaches the typechecker, then GHC will believe the `a` in `MkD a` is existentially quantified and accept it. This is almost surely not what the user wants! The simplest way to reject programs like this is to restore the old validity check in the renamer (search for `improperly_scoped` in `rnFamEqn`). Note that this is technically a breaking change, since the program in the `polykinds/T9574` test case (which previously compiled) will now be rejected: ```hs instance Funct ('KProxy :: KProxy o) where type Codomain 'KProxy = NatTr (Proxy :: o -> *) ``` This is because the `o` on the RHS will now be rejected for being out of scope. Luckily, this is simple to repair: ```hs instance Funct ('KProxy :: KProxy o) where type Codomain ('KProxy @o) = NatTr (Proxy :: o -> *) ``` All of the discussion is now a part of the revamped `Note [Renaming associated types]` in `GHC.Rename.Module`. A different design would be to make associated type family instances have completely separate scoping from the parent instance declaration, much like how associated type family default declarations work today. See the discussion beginning at https://gitlab.haskell.org/ghc/ghc/-/issues/18021#note_265729 for more on this point. This, however, would break even more programs that are accepted today and likely warrants a GHC proposal before going forward. In the meantime, this patch fixes the issue described in #18021 in the least invasive way possible. There are programs that are accepted today that will no longer be accepted after this patch, but they are arguably pathological programs, and they are simple to repair. Fixes #18021. - - - - - 8 changed files: - compiler/GHC/Rename/Module.hs - docs/users_guide/9.2.1-notes.rst - testsuite/tests/indexed-types/should_fail/T5515.stderr - + testsuite/tests/polykinds/T9574.stderr - testsuite/tests/polykinds/all.T - + testsuite/tests/rename/should_fail/T18021.hs - + testsuite/tests/rename/should_fail/T18021.stderr - testsuite/tests/rename/should_fail/all.T Changes: ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -661,12 +661,13 @@ rnClsInstDecl (ClsInstDecl { cid_poly_ty = inst_ty, cid_binds = mbinds rnFamEqn :: HsDocContext -> AssocTyFamInfo -> FreeKiTyVars - -- ^ Kind variables from the equation's RHS to be implicitly bound - -- if no explicit forall. + -- ^ Additional kind variables to implicitly bind if there is no + -- explicit forall. (See the comments on @all_imp_vars@ below for a + -- more detailed explanation.) -> FamEqn GhcPs rhs -> (HsDocContext -> rhs -> RnM (rhs', FreeVars)) -> RnM (FamEqn GhcRn rhs', FreeVars) -rnFamEqn doc atfi rhs_kvars +rnFamEqn doc atfi extra_kvars (FamEqn { feqn_tycon = tycon , feqn_bndrs = outer_bndrs , feqn_pats = pats @@ -679,15 +680,19 @@ rnFamEqn doc atfi rhs_kvars -- Note [forall-or-nothing rule] in GHC.Hs.Type), which means -- ignoring: -- - -- - pat_kity_vars_with_dups, the variables mentioned in the LHS of - -- the equation, and - -- - rhs_kvars, the kind variables mentioned in an outermost kind - -- signature on the RHS of the equation. (See - -- Note [Implicit quantification in type synonyms] in - -- GHC.Rename.HsType for why these are implicitly quantified in the - -- absence of an explicit forall). + -- - pat_kity_vars, the free variables mentioned in the type patterns + -- on the LHS of the equation, and + -- - extra_kvars, which is one of the following: + -- * For type family instances, extra_kvars are the free kind + -- variables mentioned in an outermost kind signature on the RHS + -- of the equation. + -- (See Note [Implicit quantification in type synonyms] in + -- GHC.Rename.HsType.) + -- * For data family instances, extra_kvars are the free kind + -- variables mentioned in the explicit return kind, if one is + -- provided. (e.g., the `k` in `data instance T :: k -> Type`). -- - -- For example: + -- Some examples: -- -- @ -- type family F a b @@ -695,8 +700,20 @@ rnFamEqn doc atfi rhs_kvars -- -- all_imp_vars = [] -- type instance F [(a, b)] c = a -> b -> c -- -- all_imp_vars = [a, b, c] + -- + -- type family G :: Maybe a + -- type instance forall a. G = (Nothing :: Maybe a) + -- -- all_imp_vars = [] + -- type instance G = (Nothing :: Maybe a) + -- -- all_imp_vars = [a] + -- + -- data family H :: k -> Type + -- data instance forall k. H :: k -> Type where ... + -- -- all_imp_vars = [] + -- data instance H :: k -> Type where ... + -- -- all_imp_vars = [k] -- @ - ; let all_imp_vars = pat_kity_vars_with_dups ++ rhs_kvars + ; let all_imp_vars = pat_kity_vars ++ extra_kvars ; bindHsOuterTyVarBndrs doc mb_cls all_imp_vars outer_bndrs $ \rn_outer_bndrs -> do { (pats', pat_fvs) <- rnLHsTypeArgs (FamPatCtx tycon) pats @@ -714,8 +731,7 @@ rnFamEqn doc atfi rhs_kvars rn_outer_bndrs groups :: [NonEmpty (Located RdrName)] - groups = equivClasses cmpLocated $ - pat_kity_vars_with_dups + groups = equivClasses cmpLocated pat_kity_vars ; nms_dups <- mapM (lookupOccRn . unLoc) $ [ tv | (tv :| (_:_)) <- groups ] -- Add to the used variables @@ -725,10 +741,24 @@ rnFamEqn doc atfi rhs_kvars -- of the instance decl. See -- Note [Unused type variables in family instances] ; let nms_used = extendNameSetList rhs_fvs $ - inst_tvs ++ nms_dups + nms_dups {- (a) -} ++ inst_head_tvs {- (b) -} all_nms = hsOuterTyVarNames rn_outer_bndrs' ; warnUnusedTypePatterns all_nms nms_used + -- For associated family instances, if a type variable from the + -- parent instance declaration is mentioned on the RHS of the + -- associated family instance but not bound on the LHS, then reject + -- that type variable as being out of scope. + -- See Note [Renaming associated types] + ; let lhs_bound_vars = extendNameSetList pat_fvs all_nms + improperly_scoped cls_tkv = + cls_tkv `elemNameSet` rhs_fvs + -- Mentioned on the RHS... + && not (cls_tkv `elemNameSet` lhs_bound_vars) + -- ...but not bound on the LHS. + bad_tvs = filter improperly_scoped inst_head_tvs + ; unless (null bad_tvs) (badAssocRhs bad_tvs) + ; let eqn_fvs = rhs_fvs `plusFV` pat_fvs -- See Note [Type family equations and occurrences] all_fvs = case atfi of @@ -754,12 +784,12 @@ rnFamEqn doc atfi rhs_kvars -- The type variables from the instance head, if we are dealing with an -- associated type family instance. - inst_tvs = case atfi of - NonAssocTyFamEqn _ -> [] - AssocTyFamDeflt _ -> [] - AssocTyFamInst _ inst_tvs -> inst_tvs + inst_head_tvs = case atfi of + NonAssocTyFamEqn _ -> [] + AssocTyFamDeflt _ -> [] + AssocTyFamInst _ inst_head_tvs -> inst_head_tvs - pat_kity_vars_with_dups = extractHsTyArgRdrKiTyVars pats + pat_kity_vars = extractHsTyArgRdrKiTyVars pats -- It is crucial that extractHsTyArgRdrKiTyVars return -- duplicate occurrences, since they're needed to help -- determine unused binders on the LHS. @@ -769,11 +799,18 @@ rnFamEqn doc atfi rhs_kvars -- -- type instance F a b c = Either a b -- ^^^^^ - lhs_loc = case map lhsTypeArgSrcSpan pats ++ map getLoc rhs_kvars of + lhs_loc = case map lhsTypeArgSrcSpan pats ++ map getLoc extra_kvars of [] -> panic "rnFamEqn.lhs_loc" [loc] -> loc (loc:locs) -> loc `combineSrcSpans` last locs + badAssocRhs :: [Name] -> RnM () + badAssocRhs ns + = addErr (hang (text "The RHS of an associated type declaration mentions" + <+> text "out-of-scope variable" <> plural ns + <+> pprWithCommas (quotes . ppr) ns) + 2 (text "All such variables must be bound on the LHS")) + rnTyFamInstDecl :: AssocTyFamInfo -> TyFamInstDecl GhcPs -> RnM (TyFamInstDecl GhcRn, FreeVars) @@ -829,9 +866,9 @@ rnTyFamInstEqn :: AssocTyFamInfo -> TyFamInstEqn GhcPs -> RnM (TyFamInstEqn GhcRn, FreeVars) rnTyFamInstEqn atfi eqn@(FamEqn { feqn_tycon = tycon, feqn_rhs = rhs }) - = rnFamEqn (TySynCtx tycon) atfi rhs_kvs eqn rnTySyn + = rnFamEqn (TySynCtx tycon) atfi extra_kvs eqn rnTySyn where - rhs_kvs = extractHsTyRdrTyVarsKindVars rhs + extra_kvs = extractHsTyRdrTyVarsKindVars rhs rnTyFamDefltDecl :: Name -> TyFamDefltDecl GhcPs @@ -844,9 +881,9 @@ rnDataFamInstDecl :: AssocTyFamInfo rnDataFamInstDecl atfi (DataFamInstDecl { dfid_eqn = eqn@(FamEqn { feqn_tycon = tycon , feqn_rhs = rhs })}) - = do { let rhs_kvs = extractDataDefnKindVars rhs + = do { let extra_kvs = extractDataDefnKindVars rhs ; (eqn', fvs) <- - rnFamEqn (TyDataCtx tycon) atfi rhs_kvs eqn rnDataDefn + rnFamEqn (TyDataCtx tycon) atfi extra_kvs eqn rnDataDefn ; return (DataFamInstDecl { dfid_eqn = eqn' }, fvs) } -- Renaming of the associated types in instances. @@ -927,58 +964,131 @@ Relevant tickets: #3699, #10586, #10982 and #11451. Note [Renaming associated types] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Check that the RHS of the decl mentions only type variables that are explicitly -bound on the LHS. For example, this is not ok - class C a b where - type F a x :: * - instance C (p,q) r where - type F (p,q) x = (x, r) -- BAD: mentions 'r' -c.f. #5515 - -Kind variables, on the other hand, are allowed to be implicitly or explicitly -bound. As examples, this (#9574) is acceptable: - class Funct f where - type Codomain f :: * - instance Funct ('KProxy :: KProxy o) where - -- o is implicitly bound by the kind signature - -- of the LHS type pattern ('KProxy) - type Codomain 'KProxy = NatTr (Proxy :: o -> *) -And this (#14131) is also acceptable: - data family Nat :: k -> k -> * - -- k is implicitly bound by an invisible kind pattern - newtype instance Nat :: (k -> *) -> (k -> *) -> * where - Nat :: (forall xx. f xx -> g xx) -> Nat f g -We could choose to disallow this, but then associated type families would not -be able to be as expressive as top-level type synonyms. For example, this type -synonym definition is allowed: - type T = (Nothing :: Maybe a) -So for parity with type synonyms, we also allow: - type family T :: Maybe a - type instance T = (Nothing :: Maybe a) - -All this applies only for *instance* declarations. In *class* -declarations there is no RHS to worry about, and the class variables -can all be in scope (#5862): +When renaming a type/data family instance, be it top-level or associated with +a class, we must check that all of the type variables mentioned on the RHS are +properly scoped. Specifically, the rule is this: + + Every variable mentioned on the RHS of a type instance declaration + (whether associated or not) must be either + * Mentioned on the LHS, or + * Mentioned in an outermost kind signature on the RHS + (see Note [Implicit quantification in type synonyms]) + +Here is a simple example of something we should reject: + + class C a b where + type F a x + instance C Int Bool where + type F Int x = z + +Here, `z` is mentioned on the RHS of the associated instance without being +mentioned on the LHS, nor is `z` mentioned in an outermost kind signature. The +renamer will reject `z` as being out of scope without much fuss. + +Things get slightly trickier when the instance header itself binds type +variables. Consider this example (adapted from #5515): + + instance C (p,q) z where + type F (p,q) x = (x, z) + +According to the rule above, this instance is improperly scoped. However, due +to the way GHC's renamer works, `z` is /technically/ in scope, as GHC will +always bring type variables from an instance header into scope over the +associated type family instances. As a result, the renamer won't simply reject +the `z` as being out of scope (like it would for the `type F Int x = z` +example) unless further action is taken. It is important to reject this sort of +thing in the renamer, because if it is allowed to make it through to the +typechecker, unexpected shenanigans can occur (see #18021 for examples). + +To prevent these sorts of shenanigans, we reject programs like the one above +with an extra validity check in rnFamEqn. For each type variable bound in the +parent instance head, we check if it is mentioned on the RHS of the associated +family instance but not bound on the LHS. If any of the instance-head-bound +variables meet these criteria, we throw an error. +(See rnFamEqn.improperly_scoped for how this is implemented.) + +Some additional wrinkles: + +* This Note only applies to *instance* declarations. In *class* declarations + there is no RHS to worry about, and the class variables can all be in scope + (#5862): + class Category (x :: k -> k -> *) where type Ob x :: k -> Constraint id :: Ob x a => x a a (.) :: (Ob x a, Ob x b, Ob x c) => x b c -> x a b -> x a c -Here 'k' is in scope in the kind signature, just like 'x'. -Although type family equations can bind type variables with explicit foralls, -it need not be the case that all variables that appear on the RHS must be bound -by a forall. For instance, the following is acceptable: + Here 'k' is in scope in the kind signature, just like 'x'. + +* Although type family equations can bind type variables with explicit foralls, + it need not be the case that all variables that appear on the RHS must be + bound by a forall. For instance, the following is acceptable: + + class C4 a where + type T4 a b + instance C4 (Maybe a) where + type forall b. T4 (Maybe a) b = Either a b + + Even though `a` is not bound by the forall, this is still accepted because `a` + was previously bound by the `instance C4 (Maybe a)` part. (see #16116). + +* In addition to the validity check in rnFamEqn.improperly_scoped, there is an + additional check in GHC.Tc.Validity.checkFamPatBinders that checks each family + instance equation for type variables used on the RHS but not bound on the + LHS. This is not made redundant by rmFamEqn.improperly_scoped, as there are + programs that each check will reject that the other check will not catch: + + - checkValidFamPats is used on all forms of family instances, whereas + rmFamEqn.improperly_scoped only checks associated family instances. Since + checkFamPatBinders occurs after typechecking, it can catch programs that + introduce dodgy scoping by way of type synonyms (see #7536), which is + impractical to accomplish in the renamer. + - rnFamEqn.improperly_scoped catches some programs that, if allowed to escape + the renamer, would accidentally be accepted by the typechecker. Here is one + such program (#18021): + + class C5 a where + data family D a + + instance forall a. C5 Int where + data instance D Int = MkD a + + If this is not rejected in the renamer, the typechecker would treat this + program as though the `a` were existentially quantified, like so: + + data instance D Int = forall a. MkD a + + This is likely not what the user intended! + + Here is another such program (#9574): + + class Funct f where + type Codomain f + instance Funct ('KProxy :: KProxy o) where + type Codomain 'KProxy = NatTr (Proxy :: o -> Type) + + Where: + + data Proxy (a :: k) = Proxy + data KProxy (t :: Type) = KProxy + data NatTr (c :: o -> Type) - class C a where - type T a b - instance C (Maybe a) where - type forall b. T (Maybe a) b = Either a b + Note that the `o` in the `Codomain 'KProxy` instance should be considered + improperly scoped. It does not meet the criteria for being explicitly + quantified, as it is not mentioned by name on the LHS, nor does it meet the + criteria for being implicitly quantified, as it is used in a RHS kind + signature that is not outermost (see Note [Implicit quantification in type + synonyms]). However, `o` /is/ bound by the instance header, so if this + program is not rejected by the renamer, the typechecker would treat it as + though you had written this: -Even though `a` is not bound by the forall, this is still accepted because `a` -was previously bound by the `instance C (Maybe a)` part. (see #16116). + instance Funct ('KProxy :: KProxy o) where + type Codomain ('KProxy @o) = NatTr (Proxy :: o -> Type) -In each case, the function which detects improperly bound variables on the RHS -is GHC.Tc.Validity.checkValidFamPats. + Although this is a valid program, it's probably a stretch too far to turn + `type Codomain 'KProxy = ...` into `type Codomain ('KProxy @o) = ...` here. + If the user really wants the latter, it is simple enough to communicate + their intent by mentioning `o` on the LHS by name. Note [Type family equations and occurrences] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== docs/users_guide/9.2.1-notes.rst ===================================== @@ -18,6 +18,34 @@ Language more restrictive than before. See the user manual :ref:`kind-inference-data-family-instances`. This is a breaking change, albeit a fairly obscure one that corrects a specification bug. +* GHC is stricter about checking for out-of-scope type variables on the + right-hand sides of associated type family instances that are not bound on + the left-hand side. As a result, some programs that were accidentally + accepted in previous versions of GHC will now be rejected, such as this + example: :: + + class Funct f where + type Codomain f + instance Funct ('KProxy :: KProxy o) where + type Codomain 'KProxy = NatTr (Proxy :: o -> Type) + + Where: :: + + data Proxy (a :: k) = Proxy + data KProxy (t :: Type) = KProxy + data NatTr (c :: o -> Type) + + GHC will now reject the ``o`` on the right-hand side of the ``Codomain`` + instance as being out of scope, as it does not meet the requirements for + being explicitly bound (as it is not mentioned on the left-hand side) nor + implicitly bound (as it is not mentioned in an *outermost* kind signature, + as required by :ref:`scoping-class-params`). This program can be repaired in + a backwards-compatible way by mentioning ``o`` on the left-hand side: :: + + instance Funct ('KProxy :: KProxy o) where + type Codomain ('KProxy @o) = NatTr (Proxy :: o -> Type) + -- Alternatively, + -- type Codomain ('KProxy :: KProxy o) = NatTr (Proxy :: o -> Type) Compiler ~~~~~~~~ @@ -52,7 +80,7 @@ Compiler - There is a significant refactoring in the solver; any type-checker plugins will have to be updated, as GHC no longer uses flattening skolems or flattening metavariables. - + ``ghc-prim`` library ~~~~~~~~~~~~~~~~~~~~ ===================================== testsuite/tests/indexed-types/should_fail/T5515.stderr ===================================== @@ -1,24 +1,8 @@ -T5515.hs:6:16: error: - • Expecting one more argument to ‘ctx’ - Expected a type, but ‘ctx’ has kind ‘* -> Constraint’ - • In the first argument of ‘Arg’, namely ‘ctx’ - In the first argument of ‘ctx’, namely ‘(Arg ctx)’ - In the class declaration for ‘Bome’ +T5515.hs:9:3: error: + The RHS of an associated type declaration mentions out-of-scope variable ‘a’ + All such variables must be bound on the LHS -T5515.hs:14:1: error: - • Type variable ‘a’ is mentioned in the RHS, - but not bound on the LHS of the family instance - • In the type instance declaration for ‘Arg’ - In the instance declaration for ‘Some f’ - -T5515.hs:14:10: error: - • Could not deduce (C f a0) - from the context: C f a - bound by an instance declaration: - forall f a. C f a => Some f - at T5515.hs:14:10-24 - The type variable ‘a0’ is ambiguous - • In the ambiguity check for an instance declaration - To defer the ambiguity check to use sites, enable AllowAmbiguousTypes - In the instance declaration for ‘Some f’ +T5515.hs:15:3: error: + The RHS of an associated type declaration mentions out-of-scope variable ‘a’ + All such variables must be bound on the LHS ===================================== testsuite/tests/polykinds/T9574.stderr ===================================== @@ -0,0 +1,4 @@ + +T9574.hs:13:5: error: + The RHS of an associated type declaration mentions out-of-scope variable ‘o’ + All such variables must be bound on the LHS ===================================== testsuite/tests/polykinds/all.T ===================================== @@ -107,7 +107,7 @@ test('T9725', normal, compile, ['']) test('T9750', normal, compile, ['']) test('T9569', normal, compile, ['']) test('T9838', normal, multimod_compile, ['T9838.hs','-v0']) -test('T9574', normal, compile, ['']) +test('T9574', normal, compile_fail, ['']) test('T9833', normal, compile, ['']) test('T7908', normal, compile, ['']) test('PolyInstances', normal, compile, ['']) ===================================== testsuite/tests/rename/should_fail/T18021.hs ===================================== @@ -0,0 +1,18 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +module T18021 where + +class C a where + data D a + +instance forall a. C Int where + data instance D Int = MkD1 a + +class X a b + +instance forall a. C Bool where + data instance D Bool = MkD2 + deriving (X a) ===================================== testsuite/tests/rename/should_fail/T18021.stderr ===================================== @@ -0,0 +1,8 @@ + +T18021.hs:12:3: error: + The RHS of an associated type declaration mentions out-of-scope variable ‘a’ + All such variables must be bound on the LHS + +T18021.hs:17:3: error: + The RHS of an associated type declaration mentions out-of-scope variable ‘a’ + All such variables must be bound on the LHS ===================================== testsuite/tests/rename/should_fail/all.T ===================================== @@ -156,6 +156,7 @@ test('T16504', normal, compile_fail, ['']) test('T14548', normal, compile_fail, ['']) test('T16610', normal, compile_fail, ['']) test('T17593', normal, compile_fail, ['']) +test('T18021', normal, compile_fail, ['']) test('T18145', normal, compile_fail, ['']) test('T18240a', normal, compile_fail, ['']) test('T18240b', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b1178cbc87feb1ec9c2bf98e0ad347f99dd3f20e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b1178cbc87feb1ec9c2bf98e0ad347f99dd3f20e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 17 18:57:20 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 17 Dec 2020 13:57:20 -0500 Subject: [Git][ghc/ghc][master] submodule update: containers and stm Message-ID: <5fdbaa10e1cd1_6b21962d8e8218263c@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: cf8ab4a6 by Tom Ellis at 2020-12-17T13:57:12-05:00 submodule update: containers and stm Needed for https://gitlab.haskell.org/ghc/ghc/-/issues/15656 as it stops the packages triggering incomplete-uni-patterns and incomplete-record-updates - - - - - 2 changed files: - libraries/containers - libraries/stm Changes: ===================================== libraries/containers ===================================== @@ -1 +1 @@ -Subproject commit 648fdb95cb4cf406ed7364533de6314069e3ffa5 +Subproject commit 3d05a4ec97fea535593c63a12c188259e6418545 ===================================== libraries/stm ===================================== @@ -1 +1 @@ -Subproject commit a439b76a645a903757d2410dd70fe44538f45759 +Subproject commit e966ebbdf5f6e9dd772c719b168a1e859f40de88 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cf8ab4a6a5271c072fefb946186600baaf8b1671 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cf8ab4a6a5271c072fefb946186600baaf8b1671 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 17 18:57:09 2020 From: gitlab at gitlab.haskell.org (David Eichmann) Date: Thu, 17 Dec 2020 13:57:09 -0500 Subject: [Git][ghc/ghc][wip/T19078] Test start/endEventlogging: first header must be EVENT_HEADER_BEGIN Message-ID: <5fdbaa053d225_6b216741854217918f@gitlab.mail> David Eichmann pushed to branch wip/T19078 at Glasgow Haskell Compiler / GHC Commits: 38b14b7e by David Eichmann at 2020-12-17T18:51:59+00:00 Test start/endEventlogging: first header must be EVENT_HEADER_BEGIN - - - - - 4 changed files: - + testsuite/tests/rts/RestartEventLogging.hs - + testsuite/tests/rts/RestartEventLogging.stdout - + testsuite/tests/rts/RestartEventLogging_c.c - testsuite/tests/rts/all.T Changes: ===================================== testsuite/tests/rts/RestartEventLogging.hs ===================================== @@ -0,0 +1,35 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +import System.IO + +import Control.Concurrent +import Control.Monad (forever, void) +import GHC.Conc + + +-- Test that the start/end/restartEventLog interface works as expected. +main :: IO () +main = do + + -- + -- Start other threads to generate some event log events. + -- + + let loop f = void $ forkIO $ forever (f >> yield) + + -- start lots of short lived threads + loop (forkIO $ yield) + + -- sparks + loop (let x = 1 + (1 :: Int) in return (par x (sum [0,1,2,3,x]))) + + -- + -- Try restarting event logging a few times. + -- + + putStrLn "Restarting eventlog..." + hFlush stdout + c_restart_eventlog + +foreign import ccall safe "c_restart_eventlog" + c_restart_eventlog :: IO () ===================================== testsuite/tests/rts/RestartEventLogging.stdout ===================================== @@ -0,0 +1,65 @@ +Restarting eventlog... +failed to start eventlog +init +Event log started with EVENT_HEADER_BEGIN +write +write +write +write +stop +init +Event log started with EVENT_HEADER_BEGIN +write +write +write +write +stop +init +Event log started with EVENT_HEADER_BEGIN +write +write +write +write +stop +init +Event log started with EVENT_HEADER_BEGIN +write +write +write +write +stop +init +Event log started with EVENT_HEADER_BEGIN +write +write +write +write +stop +init +Event log started with EVENT_HEADER_BEGIN +write +write +write +write +stop +init +Event log started with EVENT_HEADER_BEGIN +write +write +write +write +stop +init +Event log started with EVENT_HEADER_BEGIN +write +write +write +write +stop +init +Event log started with EVENT_HEADER_BEGIN +write +write +write +write +stop ===================================== testsuite/tests/rts/RestartEventLogging_c.c ===================================== @@ -0,0 +1,78 @@ +#include +#include +#include + +#define STOPPED 0 +#define STARTED 1 +#define WRITTEN 2 + +static int32_t state = STOPPED; + +void test_init(void) { + if (state != STOPPED) { + printf("test_init was not called first or directly after test_stop\n"); + } + + state = STARTED; + printf("init\n"); + fflush(stdout); +} + +bool test_write(void *eventlog, size_t eventlog_size) { + if (state == STOPPED) { + printf("test_init was not called\n"); + } + if (state == STARTED) { + // Note that the encoding of the header is coppied from EventLog.c (see `postInt32()`) + StgWord8 * words = (StgWord8 *)eventlog; + StgInt32 h32 = EVENT_HEADER_BEGIN; + StgWord32 h = (StgWord32)h32; // Yes, the cast is correct. See `postInt32()` + if ((words[0] != (StgWord8)(h >> 24)) + || (words[1] != (StgWord8)(h >> 16)) + || (words[2] != (StgWord8)(h >> 8)) + || (words[3] != (StgWord8)h)) { + printf("ERROR: event does not start with EVENT_HEADER_BEGIN\n"); + printf("0x%x != 0x%x\n", words[0], (StgWord8)(h >> 24)); + printf("0x%x != 0x%x\n", words[1], (StgWord8)(h >> 16)); + printf("0x%x != 0x%x\n", words[2], (StgWord8)(h >> 8)); + printf("0x%x != 0x%x\n", words[3], (StgWord8)h); + } + else { + printf("Event log started with EVENT_HEADER_BEGIN\n"); + } + } + + state = WRITTEN; + + printf("write\n"); + fflush(stdout); + return true; +} + +void test_flush(void) { + printf("flush\n"); + fflush(stdout); +} + +void test_stop(void) { + state = STOPPED; + printf("stop\n"); + fflush(stdout); +} + +const EventLogWriter writer = { + .initEventLogWriter = test_init, + .writeEventLog = test_write, + .flushEventLog = test_flush, + .stopEventLogWriter = test_stop +}; + +void c_restart_eventlog(void) { + for (int i = 0; i < 10; i++) { + if (!startEventLogging(&writer)) { + printf("failed to start eventlog\n"); + } + endEventLogging(); + } +} + ===================================== testsuite/tests/rts/all.T ===================================== @@ -419,6 +419,9 @@ test('T13676', test('InitEventLogging', [only_ways(['normal']), extra_run_opts('+RTS -RTS')], compile_and_run, ['-eventlog InitEventLogging_c.c']) +test('RestartEventLogging', + [only_ways(['threaded1','threaded2']), extra_run_opts('+RTS -la -RTS')], + compile_and_run, ['-eventlog RestartEventLogging_c.c']) test('T17088', [only_ways(['normal']), extra_run_opts('+RTS -c -A256k -RTS')], View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/38b14b7e53173cf9e22870674793fd23c6fe1904 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/38b14b7e53173cf9e22870674793fd23c6fe1904 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 17 18:57:57 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 17 Dec 2020 13:57:57 -0500 Subject: [Git][ghc/ghc][master] Unfortunate dirty hack to overcome #18998. Message-ID: <5fdbaa3564f18_6b21725c11c2187081@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: df7c7faa by Richard Eisenberg at 2020-12-17T13:57:48-05:00 Unfortunate dirty hack to overcome #18998. See commentary in tcCheckUsage. Close #18998. Test case: typecheck/should_compile/T18998 - - - - - 4 changed files: - compiler/GHC/Tc/Utils/Env.hs - + testsuite/tests/typecheck/should_compile/T18998.hs - + testsuite/tests/typecheck/should_compile/T18998b.hs - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== compiler/GHC/Tc/Utils/Env.hs ===================================== @@ -102,6 +102,7 @@ import GHC.Core.ConLike import GHC.Core.TyCon import GHC.Core.Type import GHC.Core.Coercion.Axiom +import GHC.Core.Coercion import GHC.Core.Class import GHC.Unit.Module @@ -663,10 +664,41 @@ tcCheckUsage name id_mult thing_inside ; wrapper <- case actual_u of Bottom -> return idHsWrapper Zero -> tcSubMult (UsageEnvironmentOf name) Many id_mult - MUsage m -> tcSubMult (UsageEnvironmentOf name) m id_mult + MUsage m -> do { m <- zonkTcType m + ; m <- promote_mult m + ; tcSubMult (UsageEnvironmentOf name) m id_mult } ; tcEmitBindingUsage (deleteUE uenv name) ; return wrapper } + -- This is gross. The problem is in test case typecheck/should_compile/T18998: + -- f :: a %1-> Id n a -> Id n a + -- f x (MkId _) = MkId x + -- where MkId is a GADT constructor. Multiplicity polymorphism of constructors + -- invents a new multiplicity variable p[2] for the application MkId x. This + -- variable is at level 2, bumped because of the GADT pattern-match (MkId _). + -- We eventually unify the variable with One, due to the call to tcSubMult in + -- tcCheckUsage. But by then, we're at TcLevel 1, and so the level-check + -- fails. + -- + -- What to do? If we did inference "for real", the sub-multiplicity constraint + -- would end up in the implication of the GADT pattern-match, and all would + -- be well. But we don't have a real sub-multiplicity constraint to put in + -- the implication. (Multiplicity inference works outside the usual generate- + -- constraints-and-solve scheme.) Here, where the multiplicity arrives, we + -- must promote all multiplicity variables to reflect this outer TcLevel. + -- It's reminiscent of floating a constraint, really, so promotion is + -- appropriate. The promoteTcType function works only on types of kind TYPE rr, + -- so we can't use it here. Thus, this dirtiness. + -- + -- It works nicely in practice. + (promote_mult, _, _, _) = mapTyCo mapper + mapper = TyCoMapper { tcm_tyvar = \ () tv -> do { _ <- promoteTyVar tv + ; zonkTcTyVar tv } + , tcm_covar = \ () cv -> return (mkCoVarCo cv) + , tcm_hole = \ () h -> return (mkHoleCo h) + , tcm_tycobinder = \ () tcv _flag -> return ((), tcv) + , tcm_tycon = return } + {- ********************************************************************* * * The TcBinderStack ===================================== testsuite/tests/typecheck/should_compile/T18998.hs ===================================== @@ -0,0 +1,14 @@ +{-# LANGUAGE LinearTypes, GADTs, DataKinds, KindSignatures #-} + +-- this caused a TcLevel assertion failure + +module T18998 where + +import GHC.Types +import GHC.TypeLits + +data Id :: Nat -> Type -> Type where + MkId :: a %1-> Id 0 a + +f :: a %1-> Id n a -> Id n a +f a (MkId _) = MkId a ===================================== testsuite/tests/typecheck/should_compile/T18998b.hs ===================================== @@ -0,0 +1,27 @@ +{-# LANGUAGE ScopedTypeVariables, LinearTypes, DataKinds, TypeOperators, GADTs, + PolyKinds, ConstraintKinds, TypeApplications #-} + +module T18998b where + +import GHC.TypeLits +import Data.Kind +import Unsafe.Coerce + +data Dict :: Constraint -> Type where + Dict :: c => Dict c +knowPred :: Dict (KnownNat (n+1)) -> Dict (KnownNat n) +knowPred Dict = unsafeCoerce (Dict :: Dict ()) +data NList :: Nat -> Type -> Type where + Nil :: NList 0 a + Cons :: a %1-> NList n a %1-> NList (n+1) a +-- Alright, this breaks linearity for some unknown reason + +snoc :: forall n a. KnownNat n => a %1-> NList n a %1-> NList (n+1) a +snoc a Nil = Cons a Nil +snoc a (Cons x (xs :: NList n' a)) = case knowPred (Dict :: Dict (KnownNat n)) of + Dict -> Cons x (snoc a xs) +-- This works fine + +snoc' :: forall n a. a %1-> NList n a %1-> NList (n+1) a +snoc' a Nil = Cons a Nil +snoc' a (Cons x xs) = Cons x (snoc' a xs) ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -749,3 +749,6 @@ test('TyAppPat_UniversalMulti2', normal, compile, ['']) test('TyAppPat_UniversalMulti3', normal, compile, ['']) test('TyAppPat_UniversalNested', normal, compile, ['']) test('TyAppPat_Wildcard', normal, compile, ['']) + +test('T18998', normal, compile, ['']) +test('T18998b', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/df7c7faa9998f2b618eab586bb4420d6743aad18 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/df7c7faa9998f2b618eab586bb4420d6743aad18 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 17 18:58:38 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 17 Dec 2020 13:58:38 -0500 Subject: [Git][ghc/ghc][master] Fix project version for ProjectVersionMunged (fix #19058) Message-ID: <5fdbaa5e9d15c_6b2194b989021912a0@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 659fcb14 by Sylvain Henry at 2020-12-17T13:58:30-05:00 Fix project version for ProjectVersionMunged (fix #19058) - - - - - 2 changed files: - .gitlab/linters/check-version-number.sh - configure.ac Changes: ===================================== .gitlab/linters/check-version-number.sh ===================================== @@ -2,5 +2,6 @@ set -e -grep -E -q '\[[0-9]+\.[0-9]+\.[0-9]+\]' configure.ac || - ( echo "error: configure.ac: GHC version number must have three components."; exit 1 ) +grep -E -q 'RELEASE=NO' configure.ac || + grep -E -q '\[[0-9]+\.[0-9]+\.[0-9]+\]' configure.ac || + ( echo "error: configure.ac: GHC version number must have three components when RELEASE=YES."; exit 1 ) ===================================== configure.ac ===================================== @@ -13,7 +13,10 @@ dnl # see what flags are available. (Better yet, read the documentation!) # -AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.1.0], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) +AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.1], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) + # Version on HEAD must be X.Y (not X.Y.Z) for ProjectVersionMunged variable + # to be useful (cf #19058) + # Set this to YES for a released version, otherwise NO : ${RELEASE=NO} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/659fcb14937e60510e3eea4c1211ea117419905b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/659fcb14937e60510e3eea4c1211ea117419905b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 17 19:29:56 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 17 Dec 2020 14:29:56 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 13 commits: User guide minor typo Message-ID: <5fdbb1b4d11b2_6b217be38c022066f5@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 80df2edd by David Eichmann at 2020-12-17T13:55:21-05:00 User guide minor typo [ci skip] - - - - - 09f28390 by nineonine at 2020-12-17T13:55:59-05:00 Force module recompilation if '*' prefix was used to load modules in ghci (#8042) Usually pre-compiled code is preferred to be loaded in ghci if available, which means that if we try to load module with '*' prefix and compilation artifacts are available on disc (.o and .hi files) or the source code was untouched, the driver would think no recompilation is required. Therefore, we need to force recompilation so that desired byte-code is generated and loaded. Forcing in this case should be ok, since this is what happens for interpreted code anyways when reloading modules. - - - - - b1178cbc by Ryan Scott at 2020-12-17T13:56:35-05:00 Reject dodgy scoping in associated family instance RHSes Commit e63518f5d6a93be111f9108c0990a1162f88d615 tried to push all of the logic of detecting out-of-scope type variables on the RHSes of associated type family instances to `GHC.Tc.Validity` by deleting a similar check in the renamer. Unfortunately, this commit went a little too far, as there are some corner cases that `GHC.Tc.Validity` doesn't detect. Consider this example: ```hs class C a where data D a instance forall a. C Int where data instance D Int = MkD a ``` If this program isn't rejected by the time it reaches the typechecker, then GHC will believe the `a` in `MkD a` is existentially quantified and accept it. This is almost surely not what the user wants! The simplest way to reject programs like this is to restore the old validity check in the renamer (search for `improperly_scoped` in `rnFamEqn`). Note that this is technically a breaking change, since the program in the `polykinds/T9574` test case (which previously compiled) will now be rejected: ```hs instance Funct ('KProxy :: KProxy o) where type Codomain 'KProxy = NatTr (Proxy :: o -> *) ``` This is because the `o` on the RHS will now be rejected for being out of scope. Luckily, this is simple to repair: ```hs instance Funct ('KProxy :: KProxy o) where type Codomain ('KProxy @o) = NatTr (Proxy :: o -> *) ``` All of the discussion is now a part of the revamped `Note [Renaming associated types]` in `GHC.Rename.Module`. A different design would be to make associated type family instances have completely separate scoping from the parent instance declaration, much like how associated type family default declarations work today. See the discussion beginning at https://gitlab.haskell.org/ghc/ghc/-/issues/18021#note_265729 for more on this point. This, however, would break even more programs that are accepted today and likely warrants a GHC proposal before going forward. In the meantime, this patch fixes the issue described in #18021 in the least invasive way possible. There are programs that are accepted today that will no longer be accepted after this patch, but they are arguably pathological programs, and they are simple to repair. Fixes #18021. - - - - - cf8ab4a6 by Tom Ellis at 2020-12-17T13:57:12-05:00 submodule update: containers and stm Needed for https://gitlab.haskell.org/ghc/ghc/-/issues/15656 as it stops the packages triggering incomplete-uni-patterns and incomplete-record-updates - - - - - df7c7faa by Richard Eisenberg at 2020-12-17T13:57:48-05:00 Unfortunate dirty hack to overcome #18998. See commentary in tcCheckUsage. Close #18998. Test case: typecheck/should_compile/T18998 - - - - - 659fcb14 by Sylvain Henry at 2020-12-17T13:58:30-05:00 Fix project version for ProjectVersionMunged (fix #19058) - - - - - fcad4a40 by Simon Peyton Jones at 2020-12-17T14:29:35-05:00 Kill floatEqualities completely This patch delivers on #17656, by entirel killing off the complex floatEqualities mechanism. Previously, floatEqualities would float an equality out of an implication, so that it could be solved at an outer level. But now we simply do unification in-place, without floating the constraint, relying on level numbers to determine untouchability. There are a number of important new Notes: * GHC.Tc.Utils.Unify Note [Unification preconditions] describes the preconditions for unification, including both skolem-escape and touchability. * GHC.Tc.Solver.Interact Note [Solve by unification] describes what we do when we do unify * GHC.Tc.Solver.Monad Note [The Unification Level Flag] describes how we control solver iteration under this new scheme * GHC.Tc.Solver.Monad Note [Tracking Given equalities] describes how we track when we have Given equalities * GHC.Tc.Types.Constraint Note [HasGivenEqs] is a new explanation of the ic_given_eqs field of an implication A big raft of subtle Notes in Solver, concerning floatEqualities, disappears. Main code changes: * GHC.Tc.Solver.floatEqualities disappears entirely * GHC.Tc.Solver.Monad: new fields in InertCans, inert_given_eq_lvl and inert_given_eq, updated by updateGivenEqs See Note [Tracking Given equalities]. * In exchange for updateGivenEqa, GHC.Tc.Solver.Monad.getHasGivenEqs is much simpler and more efficient * I found I could kill of metaTyVarUpdateOK entirely One test case T14683 showed a 5.1% decrease in compile-time allocation; and T5631 was down 2.2%. Other changes were small. Metric Decrease: T14683 T5631 - - - - - c2f74fb1 by Alfredo Di Napoli at 2020-12-17T14:29:40-05:00 Rename parser Error and Warning types This commit renames parser's Error and Warning types (and their constructors) to have a 'Ps' prefix, so that this would play nicely when more errors and warnings for other phases of the pipeline will be added. This will make more explicit which is the particular type of error and warning we are dealing with, and will be more informative for users to see in the generated Haddock. - - - - - 5d5a025e by Richard Eisenberg at 2020-12-17T14:29:41-05:00 Fix #19044 by tweaking unification in inst lookup See Note [Infinitary substitution in lookup] in GHC.Core.InstEnv and Note [Unification result] in GHC.Core.Unify. Test case: typecheck/should_compile/T190{44,52} Close #19044 Close #19052 - - - - - f84acb4c by Ben Gamari at 2020-12-17T14:29:41-05:00 rts: Fix typo in macro name THREADED_RTS was previously misspelled as THREADEDED_RTS. Fixes #19057. - - - - - 26c1da9a by Krzysztof Gogolewski at 2020-12-17T14:29:47-05:00 Bump haddock submodule (displaying linear types) - - - - - 14c3493c by Ben Gamari at 2020-12-17T14:29:47-05:00 testsuite: Fix two shell quoting issues Fixes two ancient bugs in the testsuite driver makefiles due to insufficient quoting. I have no idea how these went unnoticed for so long. Thanks to @tomjaguarpaw for testing. - - - - - 6de3e496 by Richard Eisenberg at 2020-12-17T14:29:48-05:00 Cite "Kind Inference for Datatypes" - - - - - 22 changed files: - .gitlab/linters/check-version-number.sh - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Parser/Monad.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Errors.hs - compiler/GHC/Parser/Errors/Ppr.hs - compiler/GHC/Parser/Header.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Parser/PostProcess/Haddock.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Runtime/Heap/Inspect.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/04ad0cc9fa6e33cfd6dccb5056355423009061d0...6de3e4963d9cde9243b5b2018867a031b443a33f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/04ad0cc9fa6e33cfd6dccb5056355423009061d0...6de3e4963d9cde9243b5b2018867a031b443a33f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Dec 17 19:56:42 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Thu, 17 Dec 2020 14:56:42 -0500 Subject: [Git][ghc/ghc][wip/sgraf-dmdanal-stuff] 2 commits: DmdAnal: Keep alive RULE vars in LetUp (#18971) Message-ID: <5fdbb7faad244_6b2194b989022158a0@gitlab.mail> Sebastian Graf pushed to branch wip/sgraf-dmdanal-stuff at Glasgow Haskell Compiler / GHC Commits: 912184c7 by Sebastian Graf at 2020-12-17T17:42:08+01:00 DmdAnal: Keep alive RULE vars in LetUp (#18971) I also took the liberty to refactor the logic around `ruleFVs`. - - - - - a7ff359a by Sebastian Graf at 2020-12-17T20:45:13+01:00 WorkWrap: Unbox constructors with existentials (#18982) Consider ```hs data Ex where Ex :: e -> Int -> Ex f :: Ex -> Int f (Ex e n) = e `seq` n + 1 ``` Worker/wrapper should build the following worker for `f`: ```hs $wf :: forall e. e -> Int# -> Int# $wf e n = e `seq` n +# 1# ``` But previously it didn't, because `Ex` binds an existential. This patch lifts that condition. That entailed having to instantiate existential binders in `GHC.Core.Opt.WorkWrap.Utils.mkWWstr` via `GHC.Core.Utils.dataConRepFSInstPat`, requiring a bit of a refactoring around what is now `DataConPatContext`. CPR W/W still won't unbox DataCons with existentials. See `Note [Which types are unboxed?]` for details. I also refactored the various `tyCon*DataCon(s)_maybe` functions in `GHC.Core.TyCon`, deleting some of them which are no longer needed (`isDataProductType_maybe` and `isDataSumType_maybe`). I cleaned up a couple of call sites, some of which weren't very explicit about whether they cared for existentials or not. The test output of `T18013` changed, because we now unbox the `Rule` data type. Its constructor carries existential state and will be w/w'd now. In the particular example, the worker functions inlines right back into the wrapper, which then unnecessarily has a (quite big) stable unfolding. I think this kind of fallout is inevitable; see also Note [Don't w/w inline small non-loop-breaker things]. There's a new regression test case `T18982`. Fixes #18982. - - - - - 16 changed files: - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Opt/CprAnal.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/HsToCore/Foreign/Call.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Tc/Deriv/Utils.hs - compiler/GHC/Types/Demand.hs - testsuite/tests/simplCore/should_compile/T18013.stderr - + testsuite/tests/stranal/should_compile/T18982.hs - + testsuite/tests/stranal/should_compile/T18982.stderr - testsuite/tests/stranal/should_compile/all.T Changes: ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -1564,15 +1564,13 @@ promoteDataCon (MkData { dcPromoted = tc }) = tc -- | Extract the type constructor, type argument, data constructor and it's -- /representation/ argument types from a type if it is a product type. -- --- Precisely, we return @Just@ for any type that is all of: +-- Precisely, we return @Just@ for any data type that is all of: -- -- * Concrete (i.e. constructors visible) --- -- * Single-constructor +-- * ... which has no existentials -- --- * Not existentially quantified --- --- Whether the type is a @data@ type or a @newtype@ +-- Whether the type is a @data@ type or a @newtype at . splitDataProductType_maybe :: Type -- ^ A product type, perhaps -> Maybe (TyCon, -- The type constructor @@ -1580,13 +1578,14 @@ splitDataProductType_maybe DataCon, -- The data constructor [Scaled Type]) -- Its /representation/ arg types - -- Rejecting existentials is conservative. Maybe some things - -- could be made to work with them, but I'm not going to sweat - -- it through till someone finds it's important. + -- Rejecting existentials means we don't have to worry about + -- freshening and substituting type variables + -- (See "GHC.Type.Id.Make.dataConArgUnpack") splitDataProductType_maybe ty | Just (tycon, ty_args) <- splitTyConApp_maybe ty - , Just con <- isDataProductTyCon_maybe tycon + , Just con <- tyConSingleDataCon_maybe tycon + , null (dataConExTyCoVars con) -- no existentials! See above = Just (tycon, ty_args, con, dataConInstArgTys con ty_args) | otherwise = Nothing ===================================== compiler/GHC/Core/FVs.hs ===================================== @@ -28,12 +28,13 @@ module GHC.Core.FVs ( varTypeTyCoFVs, idUnfoldingVars, idFreeVars, dIdFreeVars, bndrRuleAndUnfoldingVarsDSet, + bndrRuleAndUnfoldingIds, idFVs, - idRuleVars, idRuleRhsVars, stableUnfoldingVars, + idRuleVars, stableUnfoldingVars, ruleFreeVars, rulesFreeVars, rulesFreeVarsDSet, mkRuleInfo, ruleLhsFreeIds, ruleLhsFreeIdsList, - ruleRhsFreeVars, ruleRhsFreeIds, + ruleRhsFreeVars, rulesRhsFreeIds, expr_fvs, @@ -450,87 +451,71 @@ orph_names_of_fun_ty_con _ = emptyNameSet ************************************************************************ -} +data RuleFVsFrom + = LhsOnly + | RhsOnly + | BothSides + +-- | Those locally-defined variables free in the left and/or right hand sides +-- of the rule, depending on the first argument. Returns an 'FV' computation. +ruleFVs :: RuleFVsFrom -> CoreRule -> FV +ruleFVs !_ (BuiltinRule {}) = emptyFV +ruleFVs from (Rule { ru_fn = _do_not_include + -- See Note [Rule free var hack] + , ru_bndrs = bndrs + , ru_rhs = rhs, ru_args = args }) + = filterFV isLocalVar $ addBndrs bndrs (exprs_fvs exprs) + where + exprs = case from of + LhsOnly -> args + RhsOnly -> [rhs] + BothSides -> rhs:args + +-- | Those locally-defined variables free in the left and/or right hand sides +-- from several rules, depending on the first argument. +-- Returns an 'FV' computation. +rulesFVs :: RuleFVsFrom -> [CoreRule] -> FV +rulesFVs from = mapUnionFV (ruleFVs from) + -- | Those variables free in the right hand side of a rule returned as a -- non-deterministic set ruleRhsFreeVars :: CoreRule -> VarSet -ruleRhsFreeVars (BuiltinRule {}) = noFVs -ruleRhsFreeVars (Rule { ru_fn = _, ru_bndrs = bndrs, ru_rhs = rhs }) - = fvVarSet $ filterFV isLocalVar $ addBndrs bndrs (expr_fvs rhs) - -- See Note [Rule free var hack] +ruleRhsFreeVars = fvVarSet . ruleFVs RhsOnly --- | Those variables free in the both the left right hand sides of a rule +-- | Those locally-defined free 'Id's in the right hand side of several rules -- returned as a non-deterministic set -ruleFreeVars :: CoreRule -> VarSet -ruleFreeVars = fvVarSet . ruleFVs +rulesRhsFreeIds :: [CoreRule] -> VarSet +rulesRhsFreeIds = fvVarSet . filterFV isLocalId . rulesFVs RhsOnly --- | Those variables free in the both the left right hand sides of a rule --- returned as FV computation -ruleFVs :: CoreRule -> FV -ruleFVs (BuiltinRule {}) = emptyFV -ruleFVs (Rule { ru_fn = _do_not_include - -- See Note [Rule free var hack] - , ru_bndrs = bndrs - , ru_rhs = rhs, ru_args = args }) - = filterFV isLocalVar $ addBndrs bndrs (exprs_fvs (rhs:args)) +ruleLhsFreeIds :: CoreRule -> VarSet +-- ^ This finds all locally-defined free Ids on the left hand side of a rule +-- and returns them as a non-deterministic set +ruleLhsFreeIds = fvVarSet . filterFV isLocalId . ruleFVs LhsOnly --- | Those variables free in the both the left right hand sides of rules --- returned as FV computation -rulesFVs :: [CoreRule] -> FV -rulesFVs = mapUnionFV ruleFVs +ruleLhsFreeIdsList :: CoreRule -> [Var] +-- ^ This finds all locally-defined free Ids on the left hand side of a rule +-- and returns them as a deterministically ordered list +ruleLhsFreeIdsList = fvVarList . filterFV isLocalId . ruleFVs LhsOnly + +-- | Those variables free in the both the left right hand sides of a rule +-- returned as a non-deterministic set +ruleFreeVars :: CoreRule -> VarSet +ruleFreeVars = fvVarSet . ruleFVs BothSides -- | Those variables free in the both the left right hand sides of rules -- returned as a deterministic set rulesFreeVarsDSet :: [CoreRule] -> DVarSet -rulesFreeVarsDSet rules = fvDVarSet $ rulesFVs rules +rulesFreeVarsDSet rules = fvDVarSet $ rulesFVs BothSides rules + +-- | Those variables free in both the left right hand sides of several rules +rulesFreeVars :: [CoreRule] -> VarSet +rulesFreeVars rules = fvVarSet $ rulesFVs BothSides rules -- | Make a 'RuleInfo' containing a number of 'CoreRule's, suitable -- for putting into an 'IdInfo' mkRuleInfo :: [CoreRule] -> RuleInfo mkRuleInfo rules = RuleInfo rules (rulesFreeVarsDSet rules) -idRuleRhsVars :: (Activation -> Bool) -> Id -> VarSet --- Just the variables free on the *rhs* of a rule -idRuleRhsVars is_active id - = mapUnionVarSet get_fvs (idCoreRules id) - where - get_fvs (Rule { ru_fn = fn, ru_bndrs = bndrs - , ru_rhs = rhs, ru_act = act }) - | is_active act - -- See Note [Finding rule RHS free vars] in "GHC.Core.Opt.OccurAnal" - = delOneFromUniqSet_Directly fvs (getUnique fn) - -- Note [Rule free var hack] - where - fvs = fvVarSet $ filterFV isLocalVar $ addBndrs bndrs (expr_fvs rhs) - get_fvs _ = noFVs - --- | Those variables free in the right hand side of several rules -rulesFreeVars :: [CoreRule] -> VarSet -rulesFreeVars rules = mapUnionVarSet ruleFreeVars rules - -ruleLhsFreeIds :: CoreRule -> VarSet --- ^ This finds all locally-defined free Ids on the left hand side of a rule --- and returns them as a non-deterministic set -ruleLhsFreeIds = fvVarSet . ruleLhsFVIds - -ruleLhsFreeIdsList :: CoreRule -> [Var] --- ^ This finds all locally-defined free Ids on the left hand side of a rule --- and returns them as a deterministically ordered list -ruleLhsFreeIdsList = fvVarList . ruleLhsFVIds - -ruleLhsFVIds :: CoreRule -> FV --- ^ This finds all locally-defined free Ids on the left hand side of a rule --- and returns an FV computation -ruleLhsFVIds (BuiltinRule {}) = emptyFV -ruleLhsFVIds (Rule { ru_bndrs = bndrs, ru_args = args }) - = filterFV isLocalId $ addBndrs bndrs (exprs_fvs args) - -ruleRhsFreeIds :: CoreRule -> VarSet --- ^ This finds all locally-defined free Ids on the right hand side of a rule --- and returns them as a non-deterministic set -ruleRhsFreeIds (BuiltinRule {}) = emptyVarSet -ruleRhsFreeIds (Rule { ru_bndrs = bndrs, ru_rhs = rhs }) - = fvVarSet $ filterFV isLocalId $ addBndrs bndrs $ expr_fvs rhs - {- Note [Rule free var hack] (Not a hack any more) ~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -660,6 +645,9 @@ idFVs id = ASSERT( isId id) bndrRuleAndUnfoldingVarsDSet :: Id -> DVarSet bndrRuleAndUnfoldingVarsDSet id = fvDVarSet $ bndrRuleAndUnfoldingFVs id +bndrRuleAndUnfoldingIds :: Id -> IdSet +bndrRuleAndUnfoldingIds id = fvVarSet $ filterFV isId $ bndrRuleAndUnfoldingFVs id + bndrRuleAndUnfoldingFVs :: Id -> FV bndrRuleAndUnfoldingFVs id | isId id = idRuleFVs id `unionFV` idUnfoldingFVs id ===================================== compiler/GHC/Core/Opt/CprAnal.hs ===================================== @@ -425,7 +425,7 @@ nonVirgin env = env { ae_virgin = False } extendSigEnvForDemand :: AnalEnv -> Id -> Demand -> AnalEnv extendSigEnvForDemand env id dmd | isId id - , Just (_, DataConAppContext { dcac_dc = dc }) + , Just (_, DataConPatContext { dcpc_dc = dc }) <- wantToUnbox (ae_fam_envs env) has_inlineable_prag (idType id) dmd = extendSigEnv env id (CprSig (conCprType (dataConTag dc))) | otherwise @@ -446,14 +446,12 @@ extendEnvForDataAlt env scrut case_bndr dc bndrs ids_w_strs = filter isId bndrs `zip` dataConRepStrictness dc - tycon = dataConTyCon dc - is_product = isJust (isDataProductTyCon_maybe tycon) - is_sum = isJust (isDataSumTyCon_maybe tycon) + is_algebraic = isJust (tyConAlgDataCons_maybe (dataConTyCon dc)) + no_exs = null (dataConExTyCoVars dc) case_bndr_ty - | is_product || is_sum = conCprType (dataConTag dc) - -- Any of the constructors had existentials. This is a little too - -- conservative (after all, we only care about the particular data con), - -- but there is no easy way to write is_sum and this won't happen much. + | is_algebraic, no_exs = conCprType (dataConTag dc) + -- The tycon wasn't algebraic or the datacon had existentials. + -- See Note [Which types are unboxed?] for why no existentials. | otherwise = topCprType -- We could have much deeper CPR info here with Nested CPR, which could ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -34,7 +34,7 @@ import GHC.Types.Id import GHC.Core.Utils import GHC.Core.TyCon import GHC.Core.Type -import GHC.Core.FVs ( exprFreeIds, ruleRhsFreeIds ) +import GHC.Core.FVs ( rulesRhsFreeIds, bndrRuleAndUnfoldingIds ) import GHC.Core.Coercion ( Coercion, coVarsOfCo ) import GHC.Core.FamInstEnv import GHC.Core.Opt.Arity ( typeArity ) @@ -96,7 +96,7 @@ dmdAnalProgram opts fam_envs rules binds = dmd_ty rule_fvs :: IdSet - rule_fvs = foldr (unionVarSet . ruleRhsFreeIds) emptyVarSet rules + rule_fvs = rulesRhsFreeIds rules -- | We attach useful (e.g. not 'topDmd') 'idDemandInfo' to top-level bindings -- that satisfy this function. @@ -265,7 +265,10 @@ dmdAnalBindLetUp top_lvl env id rhs anal_body = (final_ty, NonRec id' rhs', body (body_ty', id_dmd) = findBndrDmd env notArgOfDfun body_ty id id' = setBindIdDemandInfo top_lvl id id_dmd (rhs_ty, rhs') = dmdAnalStar env (dmdTransformThunkDmd rhs id_dmd) rhs - final_ty = body_ty' `plusDmdType` rhs_ty + + -- See Note [Absence analysis for stable unfoldings and RULES] + rule_fvs = bndrRuleAndUnfoldingIds id + final_ty = body_ty' `plusDmdType` rhs_ty `keepAliveDmdType` rule_fvs -- | Let bindings can be processed in two ways: -- Down (RHS before body) or Up (body before RHS). @@ -423,8 +426,8 @@ dmdAnal' env dmd (Lam var body) dmdAnal' env dmd (Case scrut case_bndr ty [(alt, bndrs, rhs)]) -- Only one alternative. - -- If it's a DataAlt, it should be a product constructor. - | is_non_sum_alt alt + -- If it's a DataAlt, it should be the only constructor of the type. + | is_single_data_alt alt = let (rhs_ty, rhs') = dmdAnal env dmd rhs (alt_ty1, dmds) = findBndrsDmds env rhs_ty bndrs @@ -463,8 +466,8 @@ dmdAnal' env dmd (Case scrut case_bndr ty [(alt, bndrs, rhs)]) -- , text "res_ty" <+> ppr res_ty ]) $ (res_ty, Case scrut' case_bndr' ty [(alt, bndrs', rhs')]) where - is_non_sum_alt (DataAlt dc) = isJust $ isDataProductTyCon_maybe $ dataConTyCon dc - is_non_sum_alt _ = True + is_single_data_alt (DataAlt dc) = isJust $ tyConSingleAlgDataCon_maybe $ dataConTyCon dc + is_single_data_alt _ = True dmdAnal' env dmd (Case scrut case_bndr ty alts) = let -- Case expression with multiple alternatives @@ -524,10 +527,11 @@ forcesRealWorld :: FamInstEnvs -> Type -> Bool forcesRealWorld fam_envs ty | ty `eqType` realWorldStatePrimTy = True - | Just DataConAppContext{ dcac_dc = dc, dcac_arg_tys = field_tys } + | Just DataConPatContext{ dcpc_dc = dc, dcpc_tc_args = tc_args } <- deepSplitProductType_maybe fam_envs ty , isUnboxedTupleDataCon dc - = any (\(ty,_) -> scaledThing ty `eqType` realWorldStatePrimTy) field_tys + , let field_tys = dataConInstArgTys dc tc_args + = any (eqType realWorldStatePrimTy . scaledThing) field_tys | otherwise = False @@ -809,21 +813,12 @@ dmdAnalRhsSig top_lvl rec_flag env let_dmd id rhs Recursive -> reuseEnv rhs_fv NonRecursive -> rhs_fv - rhs_fv2 = rhs_fv1 `keepAliveDmdEnv` extra_fvs - -- Find the RHS free vars of the unfoldings and RULES -- See Note [Absence analysis for stable unfoldings and RULES] - extra_fvs = foldr (unionVarSet . ruleRhsFreeIds) unf_fvs $ - idCoreRules id + rhs_fv2 = rhs_fv1 `keepAliveDmdEnv` bndrRuleAndUnfoldingIds id -- See Note [Lazy and unleashable free variables] (lazy_fv, sig_fv) = partitionVarEnv isWeakDmd rhs_fv2 - unf = realIdUnfolding id - unf_fvs | isStableUnfolding unf - , Just unf_body <- maybeUnfoldingTemplate unf - = exprFreeIds unf_body - | otherwise = emptyVarSet - -- | If given the (local, non-recursive) let-bound 'Id', 'useLetUp' determines -- whether we should process the binding up (body before rhs) or down (rhs -- before body). ===================================== compiler/GHC/Core/Opt/WorkWrap/Utils.hs ===================================== @@ -8,7 +8,7 @@ A library for the ``worker\/wrapper'' back-end to the strictness analyser module GHC.Core.Opt.WorkWrap.Utils ( mkWwBodies, mkWWstr, mkWorkerArgs - , DataConAppContext(..), deepSplitProductType_maybe, wantToUnbox + , DataConPatContext(..), deepSplitProductType_maybe, wantToUnbox , findTypeShape , isWorkerSmallEnough ) @@ -19,7 +19,8 @@ where import GHC.Prelude import GHC.Core -import GHC.Core.Utils ( exprType, mkCast, mkDefaultCase, mkSingleAltCase ) +import GHC.Core.Utils ( exprType, mkCast, mkDefaultCase, mkSingleAltCase + , dataConRepFSInstPat ) import GHC.Types.Id import GHC.Types.Id.Info ( JoinArity ) import GHC.Core.DataCon @@ -43,9 +44,11 @@ import GHC.Core.TyCon import GHC.Core.TyCon.RecWalk import GHC.Types.Unique.Supply import GHC.Types.Unique +import GHC.Types.Name ( getOccFS ) import GHC.Data.Maybe import GHC.Utils.Misc import GHC.Utils.Outputable +import GHC.Utils.Panic import GHC.Driver.Session import GHC.Driver.Ppr import GHC.Data.FastString @@ -606,53 +609,53 @@ mkWWstr_one dflags fam_envs has_inlineable_prag arg arg_ty = idType arg dmd = idDemandInfo arg -wantToUnbox :: FamInstEnvs -> Bool -> Type -> Demand -> Maybe ([Demand], DataConAppContext) +wantToUnbox :: FamInstEnvs -> Bool -> Type -> Demand -> Maybe ([Demand], DataConPatContext) +-- See Note [Which types are unboxed?] wantToUnbox fam_envs has_inlineable_prag ty dmd = case deepSplitProductType_maybe fam_envs ty of - Just dcac at DataConAppContext{ dcac_arg_tys = con_arg_tys } + Just dcpc at DataConPatContext{ dcpc_dc = dc } | isStrUsedDmd dmd + , let arity = dataConRepArity dc -- See Note [Unpacking arguments with product and polymorphic demands] - , Just cs <- split_prod_dmd_arity dmd (length con_arg_tys) + , Just cs <- split_prod_dmd_arity dmd arity -- See Note [Do not unpack class dictionaries] , not (has_inlineable_prag && isClassPred ty) -- See Note [mkWWstr and unsafeCoerce] - , cs `equalLength` con_arg_tys - -> Just (cs, dcac) + , cs `lengthIs` arity + -> Just (cs, dcpc) _ -> Nothing where - split_prod_dmd_arity dmd arty + split_prod_dmd_arity dmd arity -- For seqDmd, it should behave like , for some -- suitable arity - | isSeqDmd dmd = Just (replicate arty absDmd) + | isSeqDmd dmd = Just (replicate arity absDmd) | _ :* Prod ds <- dmd = Just ds | otherwise = Nothing unbox_one :: DynFlags -> FamInstEnvs -> Var -> [Demand] - -> DataConAppContext + -> DataConPatContext -> UniqSM (Bool, [Var], CoreExpr -> CoreExpr, CoreExpr -> CoreExpr) unbox_one dflags fam_envs arg cs - DataConAppContext { dcac_dc = data_con, dcac_tys = inst_tys - , dcac_arg_tys = inst_con_arg_tys - , dcac_co = co } - = do { (uniq1:uniqs) <- getUniquesM - ; let scale = scaleScaled (idMult arg) - scaled_inst_con_arg_tys = map (\(t,s) -> (scale t, s)) inst_con_arg_tys - -- See Note [Add demands for strict constructors] - cs' = addDataConStrictness data_con cs - unpk_args = zipWith3 mk_ww_arg uniqs scaled_inst_con_arg_tys cs' - unbox_fn = mkUnpackCase (Var arg) co (idMult arg) uniq1 - data_con unpk_args - arg_no_unf = zapStableUnfolding arg - -- See Note [Zap unfolding when beta-reducing] - -- in GHC.Core.Opt.Simplify; and see #13890 - rebox_fn = Let (NonRec arg_no_unf con_app) - con_app = mkConApp2 data_con inst_tys unpk_args `mkCast` mkSymCo co - ; (_, worker_args, wrap_fn, work_fn) <- mkWWstr dflags fam_envs False unpk_args - ; return (True, worker_args, unbox_fn . wrap_fn, work_fn . rebox_fn) } - -- Don't pass the arg, rebox instead - where - mk_ww_arg uniq ty sub_dmd = setIdDemandInfo (mk_ww_local uniq ty) sub_dmd + DataConPatContext { dcpc_dc = dc, dcpc_tc_args = tc_args + , dcpc_co = co } + = do { (case_bndr_uniq:pat_bndrs_uniqs) <- getUniquesM + ; let ex_name_fss = map getOccFS $ dataConExTyCoVars dc + (ex_tvs', arg_ids) = + dataConRepFSInstPat (ex_name_fss ++ repeat ww_prefix) pat_bndrs_uniqs (idMult arg) dc tc_args + -- See Note [Add demands for strict constructors] + cs' = addDataConStrictness dc cs + arg_ids' = zipWithEqual "unbox_one" setIdDemandInfo arg_ids cs' + unbox_fn = mkUnpackCase (Var arg) co (idMult arg) case_bndr_uniq + dc (ex_tvs' ++ arg_ids') + arg_no_unf = zapStableUnfolding arg + -- See Note [Zap unfolding when beta-reducing] + -- in GHC.Core.Opt.Simplify; and see #13890 + rebox_fn = Let (NonRec arg_no_unf con_app) + con_app = mkConApp2 dc tc_args (ex_tvs' ++ arg_ids') `mkCast` mkSymCo co + ; (_, worker_args, wrap_fn, work_fn) <- mkWWstr dflags fam_envs False (ex_tvs' ++ arg_ids') + ; return (True, worker_args, unbox_fn . wrap_fn, work_fn . rebox_fn) } + -- Don't pass the arg, rebox instead ---------------------- nop_fn :: CoreExpr -> CoreExpr @@ -932,73 +935,72 @@ off the unpacking in mkWWstr_one (see the isClassPred test). Historical note: #14955 describes how I got this fix wrong the first time. -} --- | Context for a 'DataCon' application with a hole for every field, including --- surrounding coercions. +-- | Context for a 'DataCon' pattern wrapped in a cast, where we know the type +-- arguments of the 'TyCon' but not any of the arguments to the 'DataCon' (type +-- or term). +-- -- The result of 'deepSplitProductType_maybe' and 'deepSplitCprType_maybe'. -- -- Example: -- --- > DataConAppContext Just [Int] [(Lazy, Int)] (co :: Maybe Int ~ First Int) +-- > DataConPatContext Right [Int, Bool] (co :: Right Int Bool ~ NT Char) -- -- represents -- --- > Just @Int (_1 :: Int) |> co :: First Int +-- > (Right ... :: Either Int Bool) |> co :: NT Char -- --- where _1 is a hole for the first argument. The number of arguments is --- determined by the length of @arg_tys at . -data DataConAppContext - = DataConAppContext - { dcac_dc :: !DataCon - , dcac_tys :: ![Type] - , dcac_arg_tys :: ![(Scaled Type, StrictnessMark)] - , dcac_co :: !Coercion +data DataConPatContext + = DataConPatContext + { dcpc_dc :: !DataCon + , dcpc_tc_args :: ![Type] + , dcpc_co :: !Coercion } -deepSplitProductType_maybe :: FamInstEnvs -> Type -> Maybe DataConAppContext --- If deepSplitProductType_maybe ty = Just (dc, tys, arg_tys, co) --- then dc @ tys (args::arg_tys) :: rep_ty --- co :: ty ~ rep_ty --- Why do we return the strictness of the data-con arguments? --- Answer: see Note [Record evaluated-ness in worker/wrapper] +-- | If @deepSplitProductType_maybe ty = Just (dc, tys, co)@ +-- then @dc \@tys \@_ex_tys (_args::_arg_tys) :: tc tys@ +-- and @co :: ty ~ tc tys@ +-- where underscore prefixes are holes, e.g. yet unspecified. +-- +-- See Note [Which types are unboxed?]. +deepSplitProductType_maybe :: FamInstEnvs -> Type -> Maybe DataConPatContext deepSplitProductType_maybe fam_envs ty | let (co, ty1) = topNormaliseType_maybe fam_envs ty `orElse` (mkRepReflCo ty, ty) , Just (tc, tc_args) <- splitTyConApp_maybe ty1 - , Just con <- isDataProductTyCon_maybe tc - , let arg_tys = dataConInstArgTys con tc_args - strict_marks = dataConRepStrictness con - = Just DataConAppContext { dcac_dc = con - , dcac_tys = tc_args - , dcac_arg_tys = zipEqual "dspt" arg_tys strict_marks - , dcac_co = co } + , Just con <- tyConSingleAlgDataCon_maybe tc + = Just DataConPatContext { dcpc_dc = con + , dcpc_tc_args = tc_args + , dcpc_co = co } deepSplitProductType_maybe _ _ = Nothing -deepSplitCprType_maybe - :: FamInstEnvs -> ConTag -> Type -> Maybe DataConAppContext --- If deepSplitCprType_maybe n ty = Just (dc, tys, arg_tys, co) --- then dc @ tys (args::arg_tys) :: rep_ty --- co :: ty ~ rep_ty --- Why do we return the strictness of the data-con arguments? --- Answer: see Note [Record evaluated-ness in worker/wrapper] +-- | If @deepSplitCprType_maybe n ty = Just (dc, tys, co)@ +-- then @dc \@tys \@_ex_tys (_args::_arg_tys) :: tc tys@ +-- and @co :: ty ~ tc tys@ +-- where underscore prefixes are holes, e.g. yet unspecified. +-- @dc@ is the @n at th data constructor of @tc at . +-- +-- See Note [Which types are unboxed?]. +deepSplitCprType_maybe :: FamInstEnvs -> ConTag -> Type -> Maybe DataConPatContext deepSplitCprType_maybe fam_envs con_tag ty | let (co, ty1) = topNormaliseType_maybe fam_envs ty `orElse` (mkRepReflCo ty, ty) , Just (tc, tc_args) <- splitTyConApp_maybe ty1 - , isDataTyCon tc + , isDataTyCon tc -- NB: rules out unboxed sums and pairs! , let cons = tyConDataCons tc , cons `lengthAtLeast` con_tag -- This might not be true if we import the - -- type constructor via a .hs-bool file (#8743) + -- type constructor via a .hs-boot file (#8743) , let con = cons `getNth` (con_tag - fIRST_TAG) - arg_tys = dataConInstArgTys con tc_args - strict_marks = dataConRepStrictness con - , all isLinear arg_tys + , null (dataConExTyCoVars con) -- no existentials; + -- See Note [Which types are unboxed?] + -- and GHC.Core.Opt.CprAnal.extendEnvForDataAlt + -- where we also check this. + , all isLinear (dataConInstArgTys con tc_args) -- Deactivates CPR worker/wrapper splits on constructors with non-linear -- arguments, for the moment, because they require unboxed tuple with variable -- multiplicity fields. - = Just DataConAppContext { dcac_dc = con - , dcac_tys = tc_args - , dcac_arg_tys = zipEqual "dspt" arg_tys strict_marks - , dcac_co = co } + = Just DataConPatContext { dcpc_dc = con + , dcpc_tc_args = tc_args + , dcpc_co = co } deepSplitCprType_maybe _ _ _ = Nothing isLinear :: Scaled a -> Bool @@ -1035,13 +1037,16 @@ findTypeShape fam_envs ty | Just (_, rhs, _) <- topReduceTyFamApp_maybe fam_envs tc tc_args = go rec_tc rhs - | Just con <- isDataProductTyCon_maybe tc + | Just con <- tyConSingleAlgDataCon_maybe tc , Just rec_tc <- if isTupleTyCon tc then Just rec_tc else checkRecTc rec_tc tc -- We treat tuples specially because they can't cause loops. -- Maybe we should do so in checkRecTc. - = TsProd (map (go rec_tc . scaledThing) (dataConInstArgTys con tc_args)) + -- The use of 'dubiousDataConInstArgTys' is OK, since this + -- function performs no substitution at all, hence the uniques + -- don't matter. + = TsProd (map (go rec_tc) (dubiousDataConInstArgTys con tc_args)) | Just (ty', _) <- instNewTyCon_maybe tc tc_args , Just rec_tc <- checkRecTc rec_tc tc @@ -1050,7 +1055,54 @@ findTypeShape fam_envs ty | otherwise = TsUnk -{- +-- | Exactly 'dataConInstArgTys', but lacks the (ASSERT'ed) precondition that +-- the 'DataCon' may not have existentials. The lack of cloning the existentials +-- compared to 'dataConInstExAndArgVars' makes this function \"dubious\"; +-- only use it where type variables aren't substituted for! +dubiousDataConInstArgTys :: DataCon -> [Type] -> [Type] +dubiousDataConInstArgTys dc tc_args = arg_tys + where + univ_tvs = dataConUnivTyVars dc + ex_tvs = dataConExTyCoVars dc + subst = extendTCvInScopeList (zipTvSubst univ_tvs tc_args) ex_tvs + arg_tys = substTy subst . scaledThing <$> dataConRepArgTys dc + +{- Note [Which types are unboxed?] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Worker/wrapper will unbox + + 1. A strict data type argument, that + * is an algebraic data type (not a newtype) + * has a single constructor (thus is a "product") + * that may bind existentials + We can transform + > f (D @ex a b) = e + to + > $wf @ex a b = e + via 'mkWWstr'. + + 2. The constructed result of a function, if + * its type is an algebraic data type (not a newtype) + * the applied data constructor *does not* bind existentials + We can transform + > f x y = let ... in D a b + to + > $wf x y = let ... in (# a, b #) + via 'mkWWcpr'. + + NB: We don't allow existentials for CPR W/W, because we don't have unboxed + dependent tuples (yet?). Otherwise, we could transform + > f x y = let ... in D @ex (a :: ..ex..) (b :: ..ex..) + to + > $wf x y = let ... in (# @ex, (a :: ..ex..), (b :: ..ex..) #) + +The respective tests are in 'deepSplitProductType_maybe' and +'deepSplitCprType_maybe', respectively. + +Note that the data constructor /can/ have evidence arguments: equality +constraints, type classes etc. So it can be GADT. These evidence +arguments are simply value arguments, and should not get in the way. + ************************************************************************ * * \subsection{CPR stuff} @@ -1083,35 +1135,36 @@ mkWWcpr opt_CprAnal fam_envs body_ty cpr | otherwise = case asConCpr cpr of Nothing -> return (False, id, id, body_ty) -- No CPR info - Just con_tag | Just dcac <- deepSplitCprType_maybe fam_envs con_tag body_ty - -> mkWWcpr_help dcac + Just con_tag | Just dcpc <- deepSplitCprType_maybe fam_envs con_tag body_ty + -> mkWWcpr_help dcpc | otherwise -- See Note [non-algebraic or open body type warning] -> WARN( True, text "mkWWcpr: non-algebraic or open body type" <+> ppr body_ty ) return (False, id, id, body_ty) -mkWWcpr_help :: DataConAppContext +mkWWcpr_help :: DataConPatContext -> UniqSM (Bool, CoreExpr -> CoreExpr, CoreExpr -> CoreExpr, Type) -mkWWcpr_help (DataConAppContext { dcac_dc = data_con, dcac_tys = inst_tys - , dcac_arg_tys = arg_tys, dcac_co = co }) - | [arg1@(arg_ty1, _)] <- arg_tys - , isUnliftedType (scaledThing arg_ty1) - , isLinear arg_ty1 +mkWWcpr_help (DataConPatContext { dcpc_dc = dc, dcpc_tc_args = tc_args + , dcpc_co = co }) + | [arg_ty] <- arg_tys + , [str_mark] <- str_marks + , isUnliftedType (scaledThing arg_ty) + , isLinear arg_ty -- Special case when there is a single result of unlifted, linear, type -- -- Wrapper: case (..call worker..) of x -> C x -- Worker: case ( ..body.. ) of C x -> x = do { (work_uniq : arg_uniq : _) <- getUniquesM - ; let arg = mk_ww_local arg_uniq arg1 - con_app = mkConApp2 data_con inst_tys [arg] `mkCast` mkSymCo co + ; let arg_id = mk_ww_local arg_uniq str_mark arg_ty + con_app = mkConApp2 dc tc_args [arg_id] `mkCast` mkSymCo co ; return ( True - , \ wkr_call -> mkDefaultCase wkr_call arg con_app - , \ body -> mkUnpackCase body co One work_uniq data_con [arg] (varToCoreExpr arg) + , \ wkr_call -> mkDefaultCase wkr_call arg_id con_app + , \ body -> mkUnpackCase body co One work_uniq dc [arg_id] (varToCoreExpr arg_id) -- varToCoreExpr important here: arg can be a coercion -- Lacking this caused #10658 - , scaledThing arg_ty1 ) } + , scaledThing arg_ty ) } | otherwise -- The general case -- Wrapper: case (..call worker..) of (# a, b #) -> C a b @@ -1123,19 +1176,26 @@ mkWWcpr_help (DataConAppContext { dcac_dc = data_con, dcac_tys = inst_tys -- parametrised by the multiplicity of its fields. Specifically, in this -- instance, the multiplicity of the fields of (#,#) is chosen to be the -- same as those of C. - = do { (work_uniq : wild_uniq : uniqs) <- getUniquesM - ; let wrap_wild = mk_ww_local wild_uniq (linear ubx_tup_ty,MarkedStrict) - args = zipWith mk_ww_local uniqs arg_tys - ubx_tup_ty = exprType ubx_tup_app - ubx_tup_app = mkCoreUbxTup (map (scaledThing . fst) arg_tys) (map varToCoreExpr args) - con_app = mkConApp2 data_con inst_tys args `mkCast` mkSymCo co - tup_con = tupleDataCon Unboxed (length arg_tys) + = do { (work_uniq : wild_uniq : pat_bndrs_uniqs) <- getUniquesM + ; let case_mult = One -- see above + (_exs, arg_ids) = + dataConRepFSInstPat (repeat ww_prefix) pat_bndrs_uniqs case_mult dc tc_args + wrap_wild = mk_ww_local wild_uniq MarkedStrict (Scaled case_mult ubx_tup_ty) + ubx_tup_ty = exprType ubx_tup_app + ubx_tup_app = mkCoreUbxTup (map scaledThing arg_tys) (map varToCoreExpr arg_ids) + con_app = mkConApp2 dc tc_args arg_ids `mkCast` mkSymCo co + tup_con = tupleDataCon Unboxed (length arg_tys) + + ; MASSERT( null _exs ) -- Should have been caught by deepSplitCprType_maybe ; return (True , \ wkr_call -> mkSingleAltCase wkr_call wrap_wild - (DataAlt tup_con) args con_app - , \ body -> mkUnpackCase body co One work_uniq data_con args ubx_tup_app + (DataAlt tup_con) arg_ids con_app + , \ body -> mkUnpackCase body co case_mult work_uniq dc arg_ids ubx_tup_app , ubx_tup_ty ) } + where + arg_tys = dataConInstArgTys dc tc_args -- NB: No existentials! + str_marks = dataConRepStrictness dc mkUnpackCase :: CoreExpr -> Coercion -> Mult -> Unique -> DataCon -> [Id] -> CoreExpr -> CoreExpr -- (mkUnpackCase e co uniq Con args body) @@ -1149,7 +1209,7 @@ mkUnpackCase scrut co mult uniq boxing_con unpk_args body (DataAlt boxing_con) unpk_args body where casted_scrut = scrut `mkCast` co - bndr = mk_ww_local uniq (Scaled mult (exprType casted_scrut), MarkedStrict) + bndr = mk_ww_local uniq MarkedStrict (Scaled mult (exprType casted_scrut)) -- An unpacking case can always be chosen linear, because the variables -- are always passed to a constructor. This limits the {- @@ -1291,10 +1351,13 @@ mk_absent_let dflags fam_envs arg -- See also Note [Unique Determinism] in GHC.Types.Unique unlifted_rhs = mkTyApps (Lit rubbishLit) [arg_ty] -mk_ww_local :: Unique -> (Scaled Type, StrictnessMark) -> Id +ww_prefix :: FastString +ww_prefix = fsLit "ww" + +mk_ww_local :: Unique -> StrictnessMark -> Scaled Type -> Id -- The StrictnessMark comes form the data constructor and says -- whether this field is strict -- See Note [Record evaluated-ness in worker/wrapper] -mk_ww_local uniq (Scaled w ty,str) +mk_ww_local uniq str (Scaled w ty) = setCaseBndrEvald str $ - mkSysLocalOrCoVar (fsLit "ww") uniq w ty + mkSysLocalOrCoVar ww_prefix uniq w ty ===================================== compiler/GHC/Core/TyCon.hs ===================================== @@ -58,8 +58,7 @@ module GHC.Core.TyCon( isKindTyCon, isLiftedTypeKindTyConName, isTauTyCon, isFamFreeTyCon, isForgetfulSynTyCon, - isDataTyCon, isProductTyCon, isDataProductTyCon_maybe, - isDataSumTyCon_maybe, + isDataTyCon, isEnumerationTyCon, isNewTyCon, isAbstractTyCon, isFamilyTyCon, isOpenFamilyTyCon, @@ -84,6 +83,7 @@ module GHC.Core.TyCon( tyConCType, tyConCType_maybe, tyConDataCons, tyConDataCons_maybe, tyConSingleDataCon_maybe, tyConSingleDataCon, + tyConAlgDataCons_maybe, tyConSingleAlgDataCon_maybe, tyConFamilySize, tyConStupidTheta, @@ -143,7 +143,7 @@ import {-# SOURCE #-} GHC.Builtin.Types , multiplicityTyCon , vecCountTyCon, vecElemTyCon, liftedTypeKind ) import {-# SOURCE #-} GHC.Core.DataCon - ( DataCon, dataConExTyCoVars, dataConFieldLabels + ( DataCon, dataConFieldLabels , dataConTyCon, dataConFullSig , isUnboxedSumDataCon ) import GHC.Builtin.Uniques @@ -1976,72 +1976,6 @@ unwrapNewTyConEtad_maybe (AlgTyCon { algTcRhs = NewTyCon { nt_co = co, = Just (tvs, rhs, co) unwrapNewTyConEtad_maybe _ = Nothing -isProductTyCon :: TyCon -> Bool --- True of datatypes or newtypes that have --- one, non-existential, data constructor --- See Note [Product types] -isProductTyCon tc@(AlgTyCon {}) - = case algTcRhs tc of - TupleTyCon {} -> True - DataTyCon{ data_cons = [data_con] } - -> null (dataConExTyCoVars data_con) - NewTyCon {} -> True - _ -> False -isProductTyCon _ = False - -isDataProductTyCon_maybe :: TyCon -> Maybe DataCon --- True of datatypes (not newtypes) with --- one, vanilla, data constructor --- See Note [Product types] -isDataProductTyCon_maybe (AlgTyCon { algTcRhs = rhs }) - = case rhs of - DataTyCon { data_cons = [con] } - | null (dataConExTyCoVars con) -- non-existential - -> Just con - TupleTyCon { data_con = con } - -> Just con - _ -> Nothing -isDataProductTyCon_maybe _ = Nothing - -isDataSumTyCon_maybe :: TyCon -> Maybe [DataCon] -isDataSumTyCon_maybe (AlgTyCon { algTcRhs = rhs }) - = case rhs of - DataTyCon { data_cons = cons } - | cons `lengthExceeds` 1 - , all (null . dataConExTyCoVars) cons -- FIXME(osa): Why do we need this? - -> Just cons - SumTyCon { data_cons = cons } - | all (null . dataConExTyCoVars) cons -- FIXME(osa): Why do we need this? - -> Just cons - _ -> Nothing -isDataSumTyCon_maybe _ = Nothing - -{- Note [Product types] -~~~~~~~~~~~~~~~~~~~~~~~ -A product type is - * A data type (not a newtype) - * With one, boxed data constructor - * That binds no existential type variables - -The main point is that product types are amenable to unboxing for - * Strict function calls; we can transform - f (D a b) = e - to - fw a b = e - via the worker/wrapper transformation. (Question: couldn't this - work for existentials too?) - - * CPR for function results; we can transform - f x y = let ... in D a b - to - fw x y = let ... in (# a, b #) - -Note that the data constructor /can/ have evidence arguments: equality -constraints, type classes etc. So it can be GADT. These evidence -arguments are simply value arguments, and should not get in the way. --} - - -- | Is this a 'TyCon' representing a regular H98 type synonym (@type@)? {-# INLINE isTypeSynonymTyCon #-} -- See Note [Inlining coreView] in GHC.Core.Type isTypeSynonymTyCon :: TyCon -> Bool @@ -2380,8 +2314,7 @@ tyConDataCons_maybe _ = Nothing -- | If the given 'TyCon' has a /single/ data constructor, i.e. it is a @data@ -- type with one alternative, a tuple type or a @newtype@ then that constructor -- is returned. If the 'TyCon' has more than one constructor, or represents a --- primitive or function type constructor then @Nothing@ is returned. In any --- other case, the function panics +-- primitive or function type constructor then @Nothing@ is returned. tyConSingleDataCon_maybe :: TyCon -> Maybe DataCon tyConSingleDataCon_maybe (AlgTyCon { algTcRhs = rhs }) = case rhs of @@ -2391,21 +2324,29 @@ tyConSingleDataCon_maybe (AlgTyCon { algTcRhs = rhs }) _ -> Nothing tyConSingleDataCon_maybe _ = Nothing +-- | Like 'tyConSingleDataCon_maybe', but panics if 'Nothing'. tyConSingleDataCon :: TyCon -> DataCon tyConSingleDataCon tc = case tyConSingleDataCon_maybe tc of Just c -> c Nothing -> pprPanic "tyConDataCon" (ppr tc) +-- | Like 'tyConSingleDataCon_maybe', but returns 'Nothing' for newtypes. tyConSingleAlgDataCon_maybe :: TyCon -> Maybe DataCon --- Returns (Just con) for single-constructor --- *algebraic* data types *not* newtypes -tyConSingleAlgDataCon_maybe (AlgTyCon { algTcRhs = rhs }) - = case rhs of - DataTyCon { data_cons = [c] } -> Just c - TupleTyCon { data_con = c } -> Just c - _ -> Nothing -tyConSingleAlgDataCon_maybe _ = Nothing +tyConSingleAlgDataCon_maybe tycon + | isNewTyCon tycon = Nothing + | otherwise = tyConSingleDataCon_maybe tycon + +-- | Returns @Just dcs@ if the given 'TyCon' is a @data@ type, a tuple type +-- or a sum type with data constructors dcs. If the 'TyCon' has more than one +-- constructor, or represents a primitive or function type constructor then +-- @Nothing@ is returned. +-- +-- Like 'tyConDataCons_maybe', but returns 'Nothing' for newtypes. +tyConAlgDataCons_maybe :: TyCon -> Maybe [DataCon] +tyConAlgDataCons_maybe tycon + | isNewTyCon tycon = Nothing + | otherwise = tyConDataCons_maybe tycon -- | Determine the number of value constructors a 'TyCon' has. Panics if the -- 'TyCon' is not algebraic or a tuple ===================================== compiler/GHC/CoreToIface.hs ===================================== @@ -245,7 +245,7 @@ toIfaceTyCon tc , Just tsort <- tupleSort tc' = tsort | isUnboxedSumTyCon tc - , Just cons <- isDataSumTyCon_maybe tc = IfaceSumTyCon (length cons) + , Just cons <- tyConDataCons_maybe tc = IfaceSumTyCon (length cons) | otherwise = IfaceNormalTyCon ===================================== compiler/GHC/Hs/Pat.hs ===================================== @@ -771,8 +771,6 @@ isIrrefutableHsPat L _ (PatSynCon _pat) -> False -- Conservative L _ (RealDataCon con) -> isJust (tyConSingleDataCon_maybe (dataConTyCon con)) - -- NB: tyConSingleDataCon_maybe, *not* isProductTyCon, because - -- the latter is false of existentials. See #4439 && all goL (hsConPatArgs details) go (LitPat {}) = False go (NPat {}) = False ===================================== compiler/GHC/HsToCore/Foreign/Call.hs ===================================== @@ -350,7 +350,8 @@ resultWrapper result_ty -- Data types with a single constructor, which has a single arg -- This includes types like Ptr and ForeignPtr | Just (tycon, tycon_arg_tys) <- maybe_tc_app - , Just data_con <- isDataProductTyCon_maybe tycon -- One constructor, no existentials + , Just data_con <- tyConSingleAlgDataCon_maybe tycon -- One constructor + , null (dataConExTyCoVars data_con) -- no existentials , [Scaled _ unwrapped_res_ty] <- dataConInstOrigArgTys data_con tycon_arg_tys -- One argument = do { (maybe_ty, wrapper) <- resultWrapper unwrapped_res_ty ; let marshal_con e = Var (dataConWrapId data_con) ===================================== compiler/GHC/HsToCore/Utils.hs ===================================== @@ -737,7 +737,7 @@ is_flat_prod_pat (TuplePat _ ps Boxed) = all is_triv_lpat ps is_flat_prod_pat (ConPat { pat_con = L _ pcon , pat_args = ps}) | RealDataCon con <- pcon - , isProductTyCon (dataConTyCon con) + , Just _ <- tyConSingleDataCon_maybe (dataConTyCon con) = all is_triv_lpat (hsConPatArgs ps) is_flat_prod_pat _ = False ===================================== compiler/GHC/Tc/Deriv/Utils.hs ===================================== @@ -928,8 +928,8 @@ cond_isEnumeration _ _ rep_tc cond_isProduct :: Condition cond_isProduct _ _ rep_tc - | isProductTyCon rep_tc = IsValid - | otherwise = NotValid why + | Just _ <- tyConSingleDataCon_maybe rep_tc = IsValid + | otherwise = NotValid why where why = quotes (pprSourceTyCon rep_tc) <+> text "must have precisely one constructor" ===================================== compiler/GHC/Types/Demand.hs ===================================== @@ -55,6 +55,7 @@ module GHC.Types.Demand ( PlusDmdArg, mkPlusDmdArg, toPlusDmdArg, -- ** Other operations peelFV, findIdDemand, addDemand, splitDmdTy, deferAfterPreciseException, + keepAliveDmdType, -- * Demand signatures StrictSig(..), mkStrictSigForArity, mkClosedStrictSig, @@ -1196,6 +1197,11 @@ findIdDemand (DmdType fv _ res) id deferAfterPreciseException :: DmdType -> DmdType deferAfterPreciseException = lubDmdType exnDmdType +-- | See 'keepAliveDmdEnv'. +keepAliveDmdType :: DmdType -> VarSet -> DmdType +keepAliveDmdType (DmdType fvs ds res) vars = + DmdType (fvs `keepAliveDmdEnv` vars) ds res + {- Note [Demand type Divergence] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== testsuite/tests/simplCore/should_compile/T18013.stderr ===================================== @@ -132,33 +132,58 @@ Result size of Tidy Core = {terms: 52, types: 106, coercions: 17, joins: 0/1} -- RHS size: {terms: 37, types: 87, coercions: 17, joins: 0/1} -mapMaybeRule +mapMaybeRule [InlPrag=[2]] :: forall a b. Rule IO a b -> Rule IO (Maybe a) (Maybe b) [GblId, Arity=1, - Str=, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 150 10}] + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (@a) (@b) (w [Occ=Once1!] :: Rule IO a b) -> + case w of { Rule @s ww1 ww2 [Occ=OnceL1!] -> + T18013a.Rule + @IO + @(Maybe a) + @(Maybe b) + @s + ww1 + ((\ (s2 [Occ=Once1] :: s) + (a1 [Occ=Once1!] :: Maybe a) + (s1 [Occ=Once2] :: GHC.Prim.State# GHC.Prim.RealWorld) -> + case a1 of { + Nothing -> + (# s1, T18013a.Result @s @(Maybe b) ww1 (GHC.Maybe.Nothing @b) #); + Just x [Occ=Once1] -> + case ((ww2 s2 x) `cast` ) s1 of + { (# ipv [Occ=Once1], ipv1 [Occ=Once1!] #) -> + case ipv1 of { Result t2 [Occ=Once1] c1 [Occ=Once1] -> + (# ipv, T18013a.Result @s @(Maybe b) t2 (GHC.Maybe.Just @b c1) #) + } + } + }) + `cast` ) + }}] mapMaybeRule - = \ (@a) (@b) (f :: Rule IO a b) -> - case f of { Rule @s t0 g -> + = \ (@a) (@b) (w :: Rule IO a b) -> + case w of { Rule @s ww1 ww2 -> let { lvl :: Result s (Maybe b) [LclId, Unf=OtherCon []] - lvl = T18013a.Result @s @(Maybe b) t0 (GHC.Maybe.Nothing @b) } in + lvl = T18013a.Result @s @(Maybe b) ww1 (GHC.Maybe.Nothing @b) } in T18013a.Rule @IO @(Maybe a) @(Maybe b) @s - t0 + ww1 ((\ (s2 :: s) (a1 :: Maybe a) (s1 :: GHC.Prim.State# GHC.Prim.RealWorld) -> case a1 of { Nothing -> (# s1, lvl #); Just x -> - case ((g s2 x) `cast` ) s1 of { (# ipv, ipv1 #) -> + case ((ww2 s2 x) `cast` ) s1 of { (# ipv, ipv1 #) -> case ipv1 of { Result t2 c1 -> (# ipv, T18013a.Result @s @(Maybe b) t2 (GHC.Maybe.Just @b c1) #) } ===================================== testsuite/tests/stranal/should_compile/T18982.hs ===================================== @@ -0,0 +1,41 @@ +{-# OPTIONS_GHC -O -fforce-recomp #-} +{-# LANGUAGE GADTs #-} + +module T18982 where + +data Box a where + Box :: a -> Box a + +data Ex a where + Ex :: e -> a -> Ex a + +data GADT a where + GADT :: Int -> GADT Int + +data ExGADT a where + ExGADT :: (e ~ Int) => e -> Int -> ExGADT Int + +-- | Expected worker type: +-- $wf :: Int# -> Int# +f :: Box Int -> Int +f (Box n) = n + 1 +{-# NOINLINE f #-} + +-- | Expected worker type: +-- $wg :: forall {e}. e -> Int# -> Int# +g :: Ex Int -> Int +g (Ex e n) = e `seq` n + 1 +{-# NOINLINE g #-} + +-- | Expected worker type: +-- $wh :: Int# -> Int# +h :: GADT a -> Int +h (GADT n) = n + 1 +{-# NOINLINE h #-} + +-- | Expected worker type: +-- $wi :: forall {e}. e -> Int# -> Int# +i :: ExGADT a -> Int +i (ExGADT e n) = e `seq` n + 1 +{-# NOINLINE i #-} + ===================================== testsuite/tests/stranal/should_compile/T18982.stderr ===================================== @@ -0,0 +1,246 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core = {terms: 311, types: 249, coercions: 4, joins: 0/0} + +-- RHS size: {terms: 8, types: 11, coercions: 1, joins: 0/0} +T18982.$WExGADT :: forall e. (e ~ Int) => e %1 -> Int %1 -> ExGADT Int +T18982.$WExGADT = \ (@e) (dt :: e ~ Int) (dt :: e) (dt :: Int) -> T18982.ExGADT @Int @e @~(_N :: Int GHC.Prim.~# Int) dt dt dt + +-- RHS size: {terms: 3, types: 2, coercions: 1, joins: 0/0} +T18982.$WGADT :: Int %1 -> GADT Int +T18982.$WGADT = \ (dt :: Int) -> T18982.GADT @Int @~(_N :: Int GHC.Prim.~# Int) dt + +-- RHS size: {terms: 7, types: 8, coercions: 0, joins: 0/0} +T18982.$WEx :: forall e a. e %1 -> a %1 -> Ex a +T18982.$WEx = \ (@e) (@a) (dt :: e) (dt :: a) -> T18982.Ex @a @e dt dt + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$trModule4 :: GHC.Prim.Addr# +T18982.$trModule4 = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$trModule3 :: GHC.Types.TrName +T18982.$trModule3 = GHC.Types.TrNameS T18982.$trModule4 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$trModule2 :: GHC.Prim.Addr# +T18982.$trModule2 = "T18982"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$trModule1 :: GHC.Types.TrName +T18982.$trModule1 = GHC.Types.TrNameS T18982.$trModule2 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18982.$trModule :: GHC.Types.Module +T18982.$trModule = GHC.Types.Module T18982.$trModule3 T18982.$trModule1 + +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} +$krep :: GHC.Types.KindRep +$krep = GHC.Types.KindRepTyConApp GHC.Types.$tcInt (GHC.Types.[] @GHC.Types.KindRep) + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$krep1 :: GHC.Types.KindRep +$krep1 = GHC.Types.KindRepVar 1# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$krep2 :: GHC.Types.KindRep +$krep2 = GHC.Types.KindRepVar 0# + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +$krep3 :: [GHC.Types.KindRep] +$krep3 = GHC.Types.: @GHC.Types.KindRep $krep (GHC.Types.[] @GHC.Types.KindRep) + +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} +$krep4 :: [GHC.Types.KindRep] +$krep4 = GHC.Types.: @GHC.Types.KindRep $krep2 $krep3 + +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} +$krep5 :: [GHC.Types.KindRep] +$krep5 = GHC.Types.: @GHC.Types.KindRep GHC.Types.krep$* $krep4 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep6 :: GHC.Types.KindRep +$krep6 = GHC.Types.KindRepTyConApp GHC.Types.$tc~ $krep5 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tcBox2 :: GHC.Prim.Addr# +T18982.$tcBox2 = "Box"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tcBox1 :: GHC.Types.TrName +T18982.$tcBox1 = GHC.Types.TrNameS T18982.$tcBox2 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tcBox :: GHC.Types.TyCon +T18982.$tcBox = GHC.Types.TyCon 16948648223906549518## 2491460178135962649## T18982.$trModule T18982.$tcBox1 0# GHC.Types.krep$*Arr* + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +$krep7 :: [GHC.Types.KindRep] +$krep7 = GHC.Types.: @GHC.Types.KindRep $krep2 (GHC.Types.[] @GHC.Types.KindRep) + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep8 :: GHC.Types.KindRep +$krep8 = GHC.Types.KindRepTyConApp T18982.$tcBox $krep7 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Box1 :: GHC.Types.KindRep +T18982.$tc'Box1 = GHC.Types.KindRepFun $krep2 $krep8 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Box3 :: GHC.Prim.Addr# +T18982.$tc'Box3 = "'Box"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Box2 :: GHC.Types.TrName +T18982.$tc'Box2 = GHC.Types.TrNameS T18982.$tc'Box3 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Box :: GHC.Types.TyCon +T18982.$tc'Box = GHC.Types.TyCon 1412068769125067428## 8727214667407894081## T18982.$trModule T18982.$tc'Box2 1# T18982.$tc'Box1 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tcEx2 :: GHC.Prim.Addr# +T18982.$tcEx2 = "Ex"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tcEx1 :: GHC.Types.TrName +T18982.$tcEx1 = GHC.Types.TrNameS T18982.$tcEx2 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tcEx :: GHC.Types.TyCon +T18982.$tcEx = GHC.Types.TyCon 4376661818164435927## 18005417598910668817## T18982.$trModule T18982.$tcEx1 0# GHC.Types.krep$*Arr* + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +$krep9 :: [GHC.Types.KindRep] +$krep9 = GHC.Types.: @GHC.Types.KindRep $krep1 (GHC.Types.[] @GHC.Types.KindRep) + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep10 :: GHC.Types.KindRep +$krep10 = GHC.Types.KindRepTyConApp T18982.$tcEx $krep9 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep11 :: GHC.Types.KindRep +$krep11 = GHC.Types.KindRepFun $krep1 $krep10 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Ex1 :: GHC.Types.KindRep +T18982.$tc'Ex1 = GHC.Types.KindRepFun $krep2 $krep11 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Ex3 :: GHC.Prim.Addr# +T18982.$tc'Ex3 = "'Ex"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Ex2 :: GHC.Types.TrName +T18982.$tc'Ex2 = GHC.Types.TrNameS T18982.$tc'Ex3 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Ex :: GHC.Types.TyCon +T18982.$tc'Ex = GHC.Types.TyCon 14609381081172201359## 3077219645053200509## T18982.$trModule T18982.$tc'Ex2 2# T18982.$tc'Ex1 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tcGADT2 :: GHC.Prim.Addr# +T18982.$tcGADT2 = "GADT"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tcGADT1 :: GHC.Types.TrName +T18982.$tcGADT1 = GHC.Types.TrNameS T18982.$tcGADT2 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tcGADT :: GHC.Types.TyCon +T18982.$tcGADT = GHC.Types.TyCon 9243924476135839950## 5096619276488416461## T18982.$trModule T18982.$tcGADT1 0# GHC.Types.krep$*Arr* + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep12 :: GHC.Types.KindRep +$krep12 = GHC.Types.KindRepTyConApp T18982.$tcGADT $krep3 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'GADT1 :: GHC.Types.KindRep +T18982.$tc'GADT1 = GHC.Types.KindRepFun $krep $krep12 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'GADT3 :: GHC.Prim.Addr# +T18982.$tc'GADT3 = "'GADT"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'GADT2 :: GHC.Types.TrName +T18982.$tc'GADT2 = GHC.Types.TrNameS T18982.$tc'GADT3 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'GADT :: GHC.Types.TyCon +T18982.$tc'GADT = GHC.Types.TyCon 2077850259354179864## 16731205864486799217## T18982.$trModule T18982.$tc'GADT2 0# T18982.$tc'GADT1 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tcExGADT2 :: GHC.Prim.Addr# +T18982.$tcExGADT2 = "ExGADT"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tcExGADT1 :: GHC.Types.TrName +T18982.$tcExGADT1 = GHC.Types.TrNameS T18982.$tcExGADT2 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tcExGADT :: GHC.Types.TyCon +T18982.$tcExGADT = GHC.Types.TyCon 6470898418160489500## 10361108917441214060## T18982.$trModule T18982.$tcExGADT1 0# GHC.Types.krep$*Arr* + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep13 :: GHC.Types.KindRep +$krep13 = GHC.Types.KindRepTyConApp T18982.$tcExGADT $krep3 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep14 :: GHC.Types.KindRep +$krep14 = GHC.Types.KindRepFun $krep $krep13 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep15 :: GHC.Types.KindRep +$krep15 = GHC.Types.KindRepFun $krep2 $krep14 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'ExGADT1 :: GHC.Types.KindRep +T18982.$tc'ExGADT1 = GHC.Types.KindRepFun $krep6 $krep15 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'ExGADT3 :: GHC.Prim.Addr# +T18982.$tc'ExGADT3 = "'ExGADT"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'ExGADT2 :: GHC.Types.TrName +T18982.$tc'ExGADT2 = GHC.Types.TrNameS T18982.$tc'ExGADT3 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'ExGADT :: GHC.Types.TyCon +T18982.$tc'ExGADT = GHC.Types.TyCon 8468257409157161049## 5503123603717080600## T18982.$trModule T18982.$tc'ExGADT2 1# T18982.$tc'ExGADT1 + +-- RHS size: {terms: 11, types: 14, coercions: 0, joins: 0/0} +T18982.$wi :: forall {a} {e}. (a GHC.Prim.~# Int) -> e -> GHC.Prim.Int# -> GHC.Prim.Int# +T18982.$wi = \ (@a) (@e) (ww :: a GHC.Prim.~# Int) (ww1 :: e) (ww2 :: GHC.Prim.Int#) -> case ww1 of { __DEFAULT -> GHC.Prim.+# ww2 1# } + +-- RHS size: {terms: 15, types: 27, coercions: 1, joins: 0/0} +i :: forall a. ExGADT a -> Int +i = \ (@a) (w :: ExGADT a) -> case w of { ExGADT @e ww1 ww2 ww3 ww4 -> case ww4 of { GHC.Types.I# ww6 -> case T18982.$wi @a @e @~(ww1 :: a GHC.Prim.~# Int) ww3 ww6 of ww7 { __DEFAULT -> GHC.Types.I# ww7 } } } + +-- RHS size: {terms: 6, types: 10, coercions: 0, joins: 0/0} +T18982.$wh :: forall {a}. (a GHC.Prim.~# Int) -> GHC.Prim.Int# -> GHC.Prim.Int# +T18982.$wh = \ (@a) (ww :: a GHC.Prim.~# Int) (ww1 :: GHC.Prim.Int#) -> GHC.Prim.+# ww1 1# + +-- RHS size: {terms: 14, types: 18, coercions: 1, joins: 0/0} +h :: forall a. GADT a -> Int +h = \ (@a) (w :: GADT a) -> case w of { GADT ww1 ww2 -> case ww2 of { GHC.Types.I# ww4 -> case T18982.$wh @a @~(ww1 :: a GHC.Prim.~# Int) ww4 of ww5 { __DEFAULT -> GHC.Types.I# ww5 } } } + +-- RHS size: {terms: 9, types: 5, coercions: 0, joins: 0/0} +T18982.$wg :: forall {e}. e -> GHC.Prim.Int# -> GHC.Prim.Int# +T18982.$wg = \ (@e) (ww :: e) (ww1 :: GHC.Prim.Int#) -> case ww of { __DEFAULT -> GHC.Prim.+# ww1 1# } + +-- RHS size: {terms: 14, types: 12, coercions: 0, joins: 0/0} +g :: Ex Int -> Int +g = \ (w :: Ex Int) -> case w of { Ex @e ww1 ww2 -> case ww2 of { GHC.Types.I# ww4 -> case T18982.$wg @e ww1 ww4 of ww5 { __DEFAULT -> GHC.Types.I# ww5 } } } + +-- RHS size: {terms: 4, types: 1, coercions: 0, joins: 0/0} +T18982.$wf :: GHC.Prim.Int# -> GHC.Prim.Int# +T18982.$wf = \ (ww :: GHC.Prim.Int#) -> GHC.Prim.+# ww 1# + +-- RHS size: {terms: 13, types: 8, coercions: 0, joins: 0/0} +f :: Box Int -> Int +f = \ (w :: Box Int) -> case w of { Box ww1 -> case ww1 of { GHC.Types.I# ww3 -> case T18982.$wf ww3 of ww4 { __DEFAULT -> GHC.Types.I# ww4 } } } + + + ===================================== testsuite/tests/stranal/should_compile/all.T ===================================== @@ -62,3 +62,5 @@ test('T18903', [ grep_errmsg(r'Dmd=\S+C\S+') ], compile, ['-ddump-simpl -dsuppr test('T18894', [ grep_errmsg(r'Dmd=\S+C\S+') ], compile, ['-ddump-stranal -dsuppress-uniques']) # We care about the Arity 2 on eta, as a result of the annotated Dmd test('T18894b', [ grep_errmsg(r'Arity=2') ], compile, ['-ddump-stranal -dsuppress-uniques -fno-call-arity -dppr-cols=200']) +# We care about the workers of f,g,h,i: +test('T18982', [ grep_errmsg(r'\$w. .*Int#$') ], compile, ['-dppr-cols=1000 -ddump-simpl -dsuppress-idinfo -dsuppress-uniques']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/401618b9859a819f55112031515e01742d81b942...a7ff359a55016727f6495f529a4c2964dda24db9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/401618b9859a819f55112031515e01742d81b942...a7ff359a55016727f6495f529a4c2964dda24db9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 18 01:00:31 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 17 Dec 2020 20:00:31 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 11 commits: Use HsOuterExplicit in instance sigs in deriving-generated code Message-ID: <5fdbff2f97d27_6b217be38c0224308b@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 13d70b5d by Ryan Scott at 2020-12-17T20:00:08-05:00 Use HsOuterExplicit in instance sigs in deriving-generated code Issue #18914 revealed that `GeneralizedNewtypeDeriving` would generate code that mentions unbound type variables, which is dangerously fragile. The problem (and fix) is described in the new `Wrinkle: Use HsOuterExplicit` in `Note [GND and QuantifiedConstraints]`. The gist of it: make sure to put the top-level `forall`s in `deriving`-generated instance signatures in an `HsOuterExplicit` to ensure that they scope over the bodies of methods correctly. A side effect of this process is that it will expand any type synonyms in the instance signature, which will surface any `forall`s that are hidden underneath type synonyms (such as in the test case for #18914). While I was in town, I also performed some maintenance on `NewHsTypeX`, which powers `GeneralizedNewtypeDeriving`: * I renamed `NewHsTypeX` to `HsCoreTy`, which more accurately describes its intended purpose (#15706). I also made `HsCoreTy` a type synonym instead of a newtype, as making it a distinct data type wasn't buying us much. * To make sure that mistakes similar to #18914 do not occur later, I added an additional validity check when renaming `HsCoreTy`s that complains if an `HsCoreTy`s contains an out-of-scope type variable. See the new `Note [Renaming HsCoreTys]` in `GHC.Rename.HsType` for the details. Fixes #15706. Fixes #18914. Bumps the `haddock` submodule. - - - - - 8e2e658a by Andreas Klebinger at 2020-12-17T20:00:09-05:00 OSMem.c: Use proper type for mbinds mask argument. StgWord has different widths on 32/64bit. So use the proper type instead. - - - - - ac4fa90c by Andreas Klebinger at 2020-12-17T20:00:09-05:00 rts: EventLog.c: Properly cast (potential) 32bit pointers to uint64_t - - - - - b5ccee92 by Andreas Klebinger at 2020-12-17T20:00:09-05:00 Rts/elf-linker: Upcast to 64bit to satisfy format string. The elf size is 32bit on 32bit builds and 64 otherwise. We just upcast to 64bits before printing now. - - - - - 048b427f by Alfredo Di Napoli at 2020-12-17T20:00:10-05:00 Split Driver.Env module This commit splits the GHC.Driver.Env module creating a separate GHC.Driver.Env.Types module where HscEnv and Hsc would live. This will pave the way to the structured error values by avoiding one boot module later down the line. - - - - - 1f9589f4 by Alfredo Di Napoli at 2020-12-17T20:00:12-05:00 Rename parser Error and Warning types This commit renames parser's Error and Warning types (and their constructors) to have a 'Ps' prefix, so that this would play nicely when more errors and warnings for other phases of the pipeline will be added. This will make more explicit which is the particular type of error and warning we are dealing with, and will be more informative for users to see in the generated Haddock. - - - - - 4adaee93 by Richard Eisenberg at 2020-12-17T20:00:13-05:00 Fix #19044 by tweaking unification in inst lookup See Note [Infinitary substitution in lookup] in GHC.Core.InstEnv and Note [Unification result] in GHC.Core.Unify. Test case: typecheck/should_compile/T190{44,52} Close #19044 Close #19052 - - - - - f333672e by Ben Gamari at 2020-12-17T20:00:13-05:00 rts: Fix typo in macro name THREADED_RTS was previously misspelled as THREADEDED_RTS. Fixes #19057. - - - - - 25ea7006 by Ben Gamari at 2020-12-17T20:00:14-05:00 primops: Document semantics of Float/Int conversions Fixes #18840. - - - - - 578b029a by Ben Gamari at 2020-12-17T20:00:22-05:00 testsuite: Fix two shell quoting issues Fixes two ancient bugs in the testsuite driver makefiles due to insufficient quoting. I have no idea how these went unnoticed for so long. Thanks to @tomjaguarpaw for testing. - - - - - b7819b92 by Richard Eisenberg at 2020-12-17T20:00:22-05:00 Cite "Kind Inference for Datatypes" - - - - - 30 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Parser/Monad.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Driver/Env.hs - + compiler/GHC/Driver/Env/Types.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Errors.hs - compiler/GHC/Parser/Errors/Ppr.hs - compiler/GHC/Parser/Header.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Parser/PostProcess/Haddock.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Sig.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/ghc.cabal.in - rts/RaiseAsync.c - rts/eventlog/EventLog.c - rts/linker/Elf.c - rts/posix/OSMem.c - testsuite/mk/boilerplate.mk - testsuite/mk/test.mk The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6de3e4963d9cde9243b5b2018867a031b443a33f...b7819b923c4669da244973351fb8bcf50174b193 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6de3e4963d9cde9243b5b2018867a031b443a33f...b7819b923c4669da244973351fb8bcf50174b193 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 18 02:01:09 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 17 Dec 2020 21:01:09 -0500 Subject: [Git][ghc/ghc][wip/T17656] 7 commits: User guide minor typo Message-ID: <5fdc0d6526689_6b2192bada022574cb@gitlab.mail> Ben Gamari pushed to branch wip/T17656 at Glasgow Haskell Compiler / GHC Commits: 80df2edd by David Eichmann at 2020-12-17T13:55:21-05:00 User guide minor typo [ci skip] - - - - - 09f28390 by nineonine at 2020-12-17T13:55:59-05:00 Force module recompilation if '*' prefix was used to load modules in ghci (#8042) Usually pre-compiled code is preferred to be loaded in ghci if available, which means that if we try to load module with '*' prefix and compilation artifacts are available on disc (.o and .hi files) or the source code was untouched, the driver would think no recompilation is required. Therefore, we need to force recompilation so that desired byte-code is generated and loaded. Forcing in this case should be ok, since this is what happens for interpreted code anyways when reloading modules. - - - - - b1178cbc by Ryan Scott at 2020-12-17T13:56:35-05:00 Reject dodgy scoping in associated family instance RHSes Commit e63518f5d6a93be111f9108c0990a1162f88d615 tried to push all of the logic of detecting out-of-scope type variables on the RHSes of associated type family instances to `GHC.Tc.Validity` by deleting a similar check in the renamer. Unfortunately, this commit went a little too far, as there are some corner cases that `GHC.Tc.Validity` doesn't detect. Consider this example: ```hs class C a where data D a instance forall a. C Int where data instance D Int = MkD a ``` If this program isn't rejected by the time it reaches the typechecker, then GHC will believe the `a` in `MkD a` is existentially quantified and accept it. This is almost surely not what the user wants! The simplest way to reject programs like this is to restore the old validity check in the renamer (search for `improperly_scoped` in `rnFamEqn`). Note that this is technically a breaking change, since the program in the `polykinds/T9574` test case (which previously compiled) will now be rejected: ```hs instance Funct ('KProxy :: KProxy o) where type Codomain 'KProxy = NatTr (Proxy :: o -> *) ``` This is because the `o` on the RHS will now be rejected for being out of scope. Luckily, this is simple to repair: ```hs instance Funct ('KProxy :: KProxy o) where type Codomain ('KProxy @o) = NatTr (Proxy :: o -> *) ``` All of the discussion is now a part of the revamped `Note [Renaming associated types]` in `GHC.Rename.Module`. A different design would be to make associated type family instances have completely separate scoping from the parent instance declaration, much like how associated type family default declarations work today. See the discussion beginning at https://gitlab.haskell.org/ghc/ghc/-/issues/18021#note_265729 for more on this point. This, however, would break even more programs that are accepted today and likely warrants a GHC proposal before going forward. In the meantime, this patch fixes the issue described in #18021 in the least invasive way possible. There are programs that are accepted today that will no longer be accepted after this patch, but they are arguably pathological programs, and they are simple to repair. Fixes #18021. - - - - - cf8ab4a6 by Tom Ellis at 2020-12-17T13:57:12-05:00 submodule update: containers and stm Needed for https://gitlab.haskell.org/ghc/ghc/-/issues/15656 as it stops the packages triggering incomplete-uni-patterns and incomplete-record-updates - - - - - df7c7faa by Richard Eisenberg at 2020-12-17T13:57:48-05:00 Unfortunate dirty hack to overcome #18998. See commentary in tcCheckUsage. Close #18998. Test case: typecheck/should_compile/T18998 - - - - - 659fcb14 by Sylvain Henry at 2020-12-17T13:58:30-05:00 Fix project version for ProjectVersionMunged (fix #19058) - - - - - ac5b1742 by Simon Peyton Jones at 2020-12-17T21:01:07-05:00 Kill floatEqualities completely This patch delivers on #17656, by entirel killing off the complex floatEqualities mechanism. Previously, floatEqualities would float an equality out of an implication, so that it could be solved at an outer level. But now we simply do unification in-place, without floating the constraint, relying on level numbers to determine untouchability. There are a number of important new Notes: * GHC.Tc.Utils.Unify Note [Unification preconditions] describes the preconditions for unification, including both skolem-escape and touchability. * GHC.Tc.Solver.Interact Note [Solve by unification] describes what we do when we do unify * GHC.Tc.Solver.Monad Note [The Unification Level Flag] describes how we control solver iteration under this new scheme * GHC.Tc.Solver.Monad Note [Tracking Given equalities] describes how we track when we have Given equalities * GHC.Tc.Types.Constraint Note [HasGivenEqs] is a new explanation of the ic_given_eqs field of an implication A big raft of subtle Notes in Solver, concerning floatEqualities, disappears. Main code changes: * GHC.Tc.Solver.floatEqualities disappears entirely * GHC.Tc.Solver.Monad: new fields in InertCans, inert_given_eq_lvl and inert_given_eq, updated by updateGivenEqs See Note [Tracking Given equalities]. * In exchange for updateGivenEqa, GHC.Tc.Solver.Monad.getHasGivenEqs is much simpler and more efficient * I found I could kill of metaTyVarUpdateOK entirely One test case T14683 showed a 5.1% decrease in compile-time allocation; and T5631 was down 2.2%. Other changes were small. Metric Decrease: T14683 T5631 - - - - - 30 changed files: - .gitlab/linters/check-version-number.sh - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Runtime/Heap/Inspect.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Interact.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/Env.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Utils/Unify.hs - configure.ac - docs/users_guide/9.2.1-notes.rst - docs/users_guide/runtime_control.rst - libraries/containers - libraries/stm - testsuite/tests/ghci.debugger/scripts/break012.stdout - + testsuite/tests/ghci/scripts/T8042recomp.script - + testsuite/tests/ghci/scripts/T8042recomp.stdout - testsuite/tests/ghci/scripts/all.T - testsuite/tests/indexed-types/should_fail/T5515.stderr - testsuite/tests/partial-sigs/should_compile/T10403.stderr - testsuite/tests/partial-sigs/should_compile/T14715.stderr - testsuite/tests/partial-sigs/should_fail/ScopedNamedWildcardsBad.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/79c6c01a7540a78ec6e492f86f84c8fec5f57bd1...ac5b1742f3390c95ade4ada822b000ab3e182c3f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/79c6c01a7540a78ec6e492f86f84c8fec5f57bd1...ac5b1742f3390c95ade4ada822b000ab3e182c3f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 18 02:09:34 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 17 Dec 2020 21:09:34 -0500 Subject: [Git][ghc/ghc][wip/boxed-rep] Implement BoxedRep proposal Message-ID: <5fdc0f5e73b8c_6b2192bada022582f4@gitlab.mail> Ben Gamari pushed to branch wip/boxed-rep at Glasgow Haskell Compiler / GHC Commits: b2700f40 by Andrew Martin at 2020-12-17T21:09:04-05:00 Implement BoxedRep proposal This implements the BoxedRep proposal, refacoring the `RuntimeRep` hierarchy from: ```haskell data RuntimeRep = LiftedPtrRep | UnliftedPtrRep | ... ``` to ```haskell data RuntimeRep = BoxedRep Levity | ... data Levity = Lifted | Unlifted ``` Updates binary, haddock submodules. Closes #17526. - - - - - 30 changed files: - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Instance/Typeable.hs - compiler/GHC/Types/RepType.hs - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/Binary/Typeable.hs - docs/users_guide/9.2.1-notes.rst - docs/users_guide/exts/levity_polymorphism.rst - docs/users_guide/exts/typed_holes.rst - libraries/base/Data/Typeable.hs - libraries/base/Data/Typeable/Internal.hs - libraries/base/GHC/Enum.hs - libraries/base/GHC/Exts.hs - libraries/base/GHC/Show.hs - libraries/base/Unsafe/Coerce.hs - libraries/base/tests/T11334a.hs - libraries/base/tests/T11334a.stdout - libraries/binary - libraries/ghc-heap/GHC/Exts/Heap.hs - libraries/ghc-heap/tests/ClosureSizeUtils.hs - libraries/ghc-prim/GHC/Types.hs - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - testsuite/tests/backpack/should_run/T13955.bkp The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b2700f40cc4cf3faef61ad6d6cf677517cc9b2f4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b2700f40cc4cf3faef61ad6d6cf677517cc9b2f4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 18 02:28:57 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 17 Dec 2020 21:28:57 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/backports-9.0 Message-ID: <5fdc13e9beefc_6b2194b989022592e8@gitlab.mail> Ben Gamari pushed new branch wip/backports-9.0 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/backports-9.0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 18 02:34:03 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 17 Dec 2020 21:34:03 -0500 Subject: [Git][ghc/ghc][wip/backports-9.0] 6 commits: Backport: Fix for #18955 to GHC 9.0 Message-ID: <5fdc151b897b0_6b2174471c22619c4@gitlab.mail> Ben Gamari pushed to branch wip/backports-9.0 at Glasgow Haskell Compiler / GHC Commits: 00f07ca5 by Roland Senn at 2020-12-08T20:16:09+01:00 Backport: Fix for #18955 to GHC 9.0 Since MR !554 (#15454) GHCi automatically enabled the flag `-fobject-code` on any module using the UnboxedTuples or UnboxedSum extensions. MR !1553 (#16876) allowed to inhibit the automatic compiling to object-code of these modules by setting the `fbyte-code` flag. However, it assigned 2 different semantics to this flag and introduced the regression described in issue #18955. This MR fixes this regression by unsetting the internal flag `Opt_ByteCodeIfUnboxed` before it's copied to DynFlags local to the module. - - - - - 3a1af9bf by Ben Gamari at 2020-12-14T10:31:58-05:00 Bump Cabal submodule to 3.4.0.0-rc5 - - - - - f081501e by Andreas Klebinger at 2020-12-14T10:31:58-05:00 RegAlloc: Add missing raPlatformfield to RegAllocStatsSpill Fixes #18994 Co-Author: Benjamin Maurer <maurer.benjamin at gmail.com> (cherry picked from commit 3e3555cc9c2a9f5246895f151259fd2a81621f38) - - - - - ca506ea7 by Shayne Fletcher at 2020-12-14T10:31:58-05:00 Fix bad span calculations of post qualified imports (cherry picked from commit 4a437bc19d2026845948356a932b2cac2417eb12) - - - - - 48896a5a by Adam Sandberg Ericsson at 2020-12-17T21:33:25-05:00 hadrian: correctly copy the docs dir into the bindist #18669 (cherry picked from commit c647763954717d9853d08ff04eece7f1ddeae15c) - - - - - 0b1a82db by Adam Sandberg Ericsson at 2020-12-17T21:33:25-05:00 mkDocs: support hadrian bindists #18973 (cherry picked from commit e033dd0512443140dcca5b3c90b84022d8caf942) - - - - - 17 changed files: - compiler/GHC/CmmToAsm/Reg/Graph.hs - compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Parser.y - distrib/mkDocs/mkDocs - ghc/GHCi/UI.hs - hadrian/src/Rules/BinaryDist.hs - libraries/Cabal - + testsuite/tests/ghci/scripts/T18955.hs - + testsuite/tests/ghci/scripts/T18955.script - + testsuite/tests/ghci/scripts/T18955.stdout - testsuite/tests/ghci/scripts/all.T - testsuite/tests/module/all.T - + testsuite/tests/module/mod185.hs - + testsuite/tests/module/mod185.stderr Changes: ===================================== compiler/GHC/CmmToAsm/Reg/Graph.hs ===================================== @@ -278,7 +278,8 @@ regAlloc_spin config spinCount triv regsFree slotsFree slotsCount debug_codeGrap , raCoalesced = rmCoalesce , raSpillStats = spillStats , raSpillCosts = spillCosts - , raSpilled = code_spilled } + , raSpilled = code_spilled + , raPlatform = platform } -- Bundle up all the register allocator statistics. -- .. but make sure to drop them on the floor if they're not ===================================== compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs ===================================== @@ -73,7 +73,11 @@ data RegAllocStats statics instr , raSpillCosts :: SpillCostInfo -- | Code with spill instructions added. - , raSpilled :: [LiveCmmDecl statics instr] } + , raSpilled :: [LiveCmmDecl statics instr] + + -- | Target platform + , raPlatform :: !Platform + } -- a successful coloring ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -273,7 +273,7 @@ data GeneralFlag | Opt_SingleLibFolder | Opt_KeepCAFs | Opt_KeepGoing - | Opt_ByteCode + | Opt_ByteCodeIfUnboxed | Opt_LinkRts -- output style opts ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -2230,7 +2230,7 @@ enableCodeGenForUnboxedTuplesOrSums = where condition ms = unboxed_tuples_or_sums (ms_hspp_opts ms) && - not (gopt Opt_ByteCode (ms_hspp_opts ms)) && + not (gopt Opt_ByteCodeIfUnboxed (ms_hspp_opts ms)) && (isBootSummary ms == NotBoot) unboxed_tuples_or_sums d = xopt LangExt.UnboxedTuples d || xopt LangExt.UnboxedSums d ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -3091,10 +3091,10 @@ dynamic_flags_deps = [ , make_ord_flag defFlag "fno-code" (NoArg ((upd $ \d -> d { ghcLink=NoLink }) >> setTarget HscNothing)) - , make_ord_flag defFlag "fbyte-code" - (noArgM $ \dflags -> do - setTarget HscInterpreted - pure $ gopt_set dflags Opt_ByteCode) + , make_ord_flag defFlag "fbyte-code" (NoArg ((upd $ \d -> + -- Enabling Opt_ByteCodeIfUnboxed is a workaround for #18955. + -- See the comments for resetOptByteCodeIfUnboxed for more details. + gopt_set d Opt_ByteCodeIfUnboxed) >> setTarget HscInterpreted)) , make_ord_flag defFlag "fobject-code" $ NoArg $ do dflags <- liftEwM getCmdLineState setTarget $ defaultObjectTarget dflags ===================================== compiler/GHC/Parser.y ===================================== @@ -967,18 +967,20 @@ importdecls_semi importdecl :: { LImportDecl GhcPs } : 'import' maybe_src maybe_safe optqualified maybe_pkg modid optqualified maybeas maybeimpspec {% do { - ; checkImportDecl $4 $7 - ; ams (L (comb4 $1 $6 (snd $8) $9) $ + ; let { ; mPreQual = unLoc $4 + ; mPostQual = unLoc $7 } + ; checkImportDecl mPreQual mPostQual + ; ams (L (comb5 $1 $6 $7 (snd $8) $9) $ ImportDecl { ideclExt = noExtField , ideclSourceSrc = snd $ fst $2 , ideclName = $6, ideclPkgQual = snd $5 , ideclSource = snd $2, ideclSafe = snd $3 - , ideclQualified = importDeclQualifiedStyle $4 $7 + , ideclQualified = importDeclQualifiedStyle mPreQual mPostQual , ideclImplicit = False , ideclAs = unLoc (snd $8) , ideclHiding = unLoc $9 }) - (mj AnnImport $1 : fst (fst $2) ++ fst $3 ++ fmap (mj AnnQualified) (maybeToList $4) - ++ fst $5 ++ fmap (mj AnnQualified) (maybeToList $7) ++ fst $8) + (mj AnnImport $1 : fst (fst $2) ++ fst $3 ++ fmap (mj AnnQualified) (maybeToList mPreQual) + ++ fst $5 ++ fmap (mj AnnQualified) (maybeToList mPostQual) ++ fst $8) } } @@ -1002,9 +1004,9 @@ maybe_pkg :: { ([AddAnn],Maybe StringLiteral) } ; return ([mj AnnPackageName $1], Just (StringLiteral (getSTRINGs $1) pkgFS)) } } | {- empty -} { ([],Nothing) } -optqualified :: { Maybe (Located Token) } - : 'qualified' { Just $1 } - | {- empty -} { Nothing } +optqualified :: { Located (Maybe (Located Token)) } + : 'qualified' { sL1 $1 (Just $1) } + | {- empty -} { noLoc Nothing } maybeas :: { ([AddAnn],Located (Maybe (Located ModuleName))) } : 'as' modid { ([mj AnnAs $1] @@ -3754,6 +3756,11 @@ comb4 a b c d = a `seq` b `seq` c `seq` d `seq` (combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $ combineSrcSpans (getLoc c) (getLoc d)) +comb5 :: Located a -> Located b -> Located c -> Located d -> Located e -> SrcSpan +comb5 a b c d e = a `seq` b `seq` c `seq` d `seq` e `seq` + (combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $ + combineSrcSpans (getLoc c) $ combineSrcSpans (getLoc d) (getLoc e)) + -- strict constructor version: {-# INLINE sL #-} sL :: SrcSpan -> a -> Located a ===================================== distrib/mkDocs/mkDocs ===================================== @@ -31,7 +31,9 @@ cd .. tar -Jxf "$WINDOWS_BINDIST" mv ghc* windows cd inst/share/doc/ghc*/html/libraries -mv ../../../../../../windows/doc/html/libraries/Win32-* . +mv ../../../../../../windows/doc/html/libraries/Win32-* . || \ # make binary distribution + mv ../../../../../../windows/docs/html/libraries/Win32 . || \ # hadrian binary distribution + die "failed to find the Win32 package documentation" sh gen_contents_index cd .. for i in haddock libraries users_guide ===================================== ghc/GHCi/UI.hs ===================================== @@ -1941,6 +1941,7 @@ reloadModuleDefer = wrapDeferTypeErrors . reloadModule -- sessions. doLoadAndCollectInfo :: GhciMonad m => Bool -> LoadHowMuch -> m SuccessFlag doLoadAndCollectInfo retain_context howmuch = do + resetOptByteCodeIfUnboxed -- #18955 doCollectInfo <- isOptionSet CollectInfo doLoad retain_context howmuch >>= \case @@ -1953,6 +1954,24 @@ doLoadAndCollectInfo retain_context howmuch = do return Succeeded flag -> return flag +-- An `OPTIONS_GHC -fbyte-code` pragma at the beginning of a module sets the +-- flag `Opt_ByteCodeIfUnboxed` locally for this module. This stops automatic +-- compilation of this module to object code, if the module uses (or depends +-- on a module using) the UnboxedSums/Tuples extensions. +-- However a GHCi `:set -fbyte-code` command sets the flag Opt_ByteCodeIfUnboxed +-- globally to all modules. This triggered #18955. This function unsets the +-- flag from the global DynFlags before they are copied to the module-specific +-- DynFlags. +-- This is a temporary workaround until GHCi will support unboxed tuples and +-- unboxed sums. +resetOptByteCodeIfUnboxed :: GhciMonad m => m () +resetOptByteCodeIfUnboxed = do + dflags <- getDynFlags + when (gopt Opt_ByteCodeIfUnboxed dflags) $ do + _ <- GHC.setProgramDynFlags $ gopt_unset dflags Opt_ByteCodeIfUnboxed + pure () + pure () + doLoad :: GhciMonad m => Bool -> LoadHowMuch -> m SuccessFlag doLoad retain_context howmuch = do -- turn off breakpoints before we load: we can't turn them off later, because ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -12,6 +12,7 @@ import Settings import Settings.Program (programContext) import Target import Utilities +import qualified System.Directory.Extra as IO {- Note [Binary distributions] @@ -136,13 +137,20 @@ bindistRules = do copyDirectory (ghcBuildDir -/- "bin") bindistFilesDir copyDirectory (ghcBuildDir -/- "lib") bindistFilesDir copyDirectory (rtsIncludeDir) bindistFilesDir + unless cross $ need ["docs"] + -- TODO: we should only embed the docs that have been generated -- depending on the current settings (flavours' "ghcDocs" field and -- "--docs=.." command-line flag) -- Currently we embed the "docs" directory if it exists but it may -- contain outdated or even invalid data. - whenM (doesDirectoryExist (root -/- "docs")) $ do + + -- Use the IO version of doesDirectoryExist because the Shake Action + -- version should not be used for directories the build system can + -- create. Using the Action version caused documentation to not be + -- included in the bindist in the past (part of the problem in #18669). + whenM (liftIO (IO.doesDirectoryExist (root -/- "docs"))) $ do copyDirectory (root -/- "docs") bindistFilesDir when windowsHost $ do copyDirectory (root -/- "mingw") bindistFilesDir ===================================== libraries/Cabal ===================================== @@ -1 +1 @@ -Subproject commit 5aea8a4b8463e1ae95272e190a1022764164294f +Subproject commit 7907a676ada3a5944cfa3b45e23deda7496767cf ===================================== testsuite/tests/ghci/scripts/T18955.hs ===================================== @@ -0,0 +1,2 @@ +main :: IO () +main = putStrLn "Hello World" ===================================== testsuite/tests/ghci/scripts/T18955.script ===================================== @@ -0,0 +1,3 @@ +:set -v1 +:set -fbyte-code +:l T18955 ===================================== testsuite/tests/ghci/scripts/T18955.stdout ===================================== @@ -0,0 +1,2 @@ +[1 of 1] Compiling Main ( T18955.hs, interpreted ) +Ok, one module loaded. ===================================== testsuite/tests/ghci/scripts/all.T ===================================== @@ -318,3 +318,4 @@ test('T17403', normal, ghci_script, ['T17403.script']) test('T17431', normal, ghci_script, ['T17431.script']) test('T17549', normal, ghci_script, ['T17549.script']) test('T17669', [extra_run_opts('-fexternal-interpreter -fobject-code'), expect_broken(17669)], ghci_script, ['T17669.script']) +test('T18955', [extra_hc_opts("-fobject-code")], ghci_script, ['T18955.script']) ===================================== testsuite/tests/module/all.T ===================================== @@ -268,6 +268,7 @@ test('mod181', normal, compile, ['']) test('mod182', normal, compile_fail, ['']) test('mod183', normal, compile_fail, ['']) test('mod184', normal, compile, ['-Wprepositive-qualified-module']) +test('mod185', normal, compile, ['-ddump-parsed-ast']) test('T1148', normal, compile, ['']) test('T1074', normal, compile, ['']) ===================================== testsuite/tests/module/mod185.hs ===================================== @@ -0,0 +1,5 @@ +{-# LANGUAGE ImportQualifiedPost #-} +-- The span of the import decl should include the 'qualified' keyword. +import Prelude qualified + +main = Prelude.undefined ===================================== testsuite/tests/module/mod185.stderr ===================================== @@ -0,0 +1,62 @@ +==================== Parser AST ==================== + +({ mod185.hs:1:1 } + (HsModule + (VirtualBraces + (1)) + (Nothing) + (Nothing) + [({ mod185.hs:3:1-24 } + (ImportDecl + (NoExtField) + (NoSourceText) + ({ mod185.hs:3:8-14 } + {ModuleName: Prelude}) + (Nothing) + (NotBoot) + (False) + (QualifiedPost) + (False) + (Nothing) + (Nothing)))] + [({ mod185.hs:5:1-24 } + (ValD + (NoExtField) + (FunBind + (NoExtField) + ({ mod185.hs:5:1-4 } + (Unqual + {OccName: main})) + (MG + (NoExtField) + ({ mod185.hs:5:1-24 } + [({ mod185.hs:5:1-24 } + (Match + (NoExtField) + (FunRhs + ({ mod185.hs:5:1-4 } + (Unqual + {OccName: main})) + (Prefix) + (NoSrcStrict)) + [] + (GRHSs + (NoExtField) + [({ mod185.hs:5:6-24 } + (GRHS + (NoExtField) + [] + ({ mod185.hs:5:8-24 } + (HsVar + (NoExtField) + ({ mod185.hs:5:8-24 } + (Qual + {ModuleName: Prelude} + {OccName: undefined}))))))] + ({ } + (EmptyLocalBinds + (NoExtField))))))]) + (FromSource)) + [])))] + (Nothing) + (Nothing))) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5dd6769a1a85481e5e3578a658351061bdc56436...0b1a82db05356ac446c54c5a8c94e6e8cdb0cbe1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5dd6769a1a85481e5e3578a658351061bdc56436...0b1a82db05356ac446c54c5a8c94e6e8cdb0cbe1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 18 08:21:32 2020 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Fri, 18 Dec 2020 03:21:32 -0500 Subject: [Git][ghc/ghc][wip/con-info-ci] 69 commits: gitlab-ci: Fix copy-paste error Message-ID: <5fdc668c5c875_6b2186620442291378@gitlab.mail> Matthew Pickering pushed to branch wip/con-info-ci at Glasgow Haskell Compiler / GHC Commits: e0b08c5f by Ben Gamari at 2020-12-03T13:01:47-05:00 gitlab-ci: Fix copy-paste error Also be more consistent in quoting. - - - - - 33ec3a06 by Ben Gamari at 2020-12-03T23:11:31-05:00 gitlab-ci: Run linters through ci.sh Ensuring that the right toolchain is used. - - - - - 4a437bc1 by Shayne Fletcher at 2020-12-05T09:06:38-05:00 Fix bad span calculations of post qualified imports - - - - - 8fac4b93 by Ben Gamari at 2020-12-05T09:07:13-05:00 testsuite: Add a test for #18923 - - - - - 62ed6957 by Simon Peyton Jones at 2020-12-08T15:31:41-05:00 Fix kind inference for data types. Again. This patch fixes several aspects of kind inference for data type declarations, especially data /instance/ declarations Specifically 1. In kcConDecls/kcConDecl make it clear that the tc_res_kind argument is only used in the H98 case; and in that case there is no result kind signature; and hence no need for the disgusting splitPiTys in kcConDecls (now thankfully gone). The GADT case is a bit different to before, and much nicer. This is what fixes #18891. See Note [kcConDecls: kind-checking data type decls] 2. Do not look at the constructor decls of a data/newtype instance in tcDataFamInstanceHeader. See GHC.Tc.TyCl.Instance Note [Kind inference for data family instances]. This was a new realisation that arose when doing (1) This causes a few knock-on effects in the tests suite, because we require more information than before in the instance /header/. New user-manual material about this in "Kind inference in data type declarations" and "Kind inference for data/newtype instance declarations". 3. Minor improvement in kcTyClDecl, combining GADT and H98 cases 4. Fix #14111 and #8707 by allowing the header of a data instance to affect kind inferece for the the data constructor signatures; as described at length in Note [GADT return types] in GHC.Tc.TyCl This led to a modest refactoring of the arguments (and argument order) of tcConDecl/tcConDecls. 5. Fix #19000 by inverting the sense of the test in new_locs in GHC.Tc.Solver.Canonical.canDecomposableTyConAppOK. - - - - - 0abe3ddf by Adam Sandberg Ericsson at 2020-12-08T15:32:19-05:00 hadrian: build the _l and _thr_l rts flavours in the develN flavours The ghc binary requires the eventlog rts since fc644b1a643128041cfec25db84e417851e28bab - - - - - 51e3bb6d by Andreas Klebinger at 2020-12-08T22:43:21-05:00 CodeGen: Make folds User/DefinerOfRegs INLINEABLE. Reduces allocation for the test case I was looking at by about 1.2%. Mostly from avoiding allocation of some folding functions which turn into let-no-escape bindings which just reuse their environment instead. We also force inlining in a few key places in CmmSink which helps a bit more. - - - - - 69ae10c3 by Andreas Klebinger at 2020-12-08T22:43:21-05:00 CmmSink: Force inlining of foldRegsDefd Helps avoid allocating the folding function. Improves perf for T3294 by about 1%. - - - - - 6e3da800 by Andreas Klebinger at 2020-12-08T22:43:21-05:00 Cmm: Make a few types and utility function slightly stricter. About 0.6% reduction in allocations for the code I was looking at. Not a huge difference but no need to throw away performance. - - - - - aef44d7f by Andreas Klebinger at 2020-12-08T22:43:21-05:00 Cmm.Sink: Optimize retaining of assignments, live sets. Sinking requires us to track live local regs after each cmm statement. We used to do this via "Set LocalReg". However we can replace this with a solution based on IntSet which is overall more efficient without losing much. The thing we lose is width of the variables, which isn't used by the sinking pass anyway. I also reworked how we keep assignments to regs mentioned in skipped assignments. I put the details into Note [Keeping assignemnts mentioned in skipped RHSs]. The gist of it is instead of keeping track of it via the use count which is a `IntMap Int` we now use the live regs set (IntSet) which is quite a bit faster. I think it also matches the semantics a lot better. The skipped (not discarded) assignment does in fact keep the regs on it's rhs alive so keeping track of this in the live set seems like the clearer solution as well. Improves allocations for T3294 by yet another 1%. - - - - - 59f2249b by Andreas Klebinger at 2020-12-08T22:43:21-05:00 GHC.Cmm.Opt: Be stricter in results. Optimization either returns Nothing if nothing is to be done or `Just <cmmExpr>` otherwise. There is no point in being lazy in `cmmExpr`. We usually inspect this element so the thunk gets forced not long after. We might eliminate it as dead code once in a blue moon but that's not a case worth optimizing for. Overall the impact of this is rather low. As Cmm.Opt doesn't allocate much (compared to the rest of GHC) to begin with. - - - - - 54b88eac by Andreas Klebinger at 2020-12-08T22:43:57-05:00 Bump time submodule. This should fix #19002. - - - - - 35e7b0c6 by Kirill Elagin at 2020-12-10T01:45:54-05:00 doc: Clarify the default for -fomit-yields “Yield points enabled” is confusing (and probably wrong? I am not 100% sure what it means). Change it to a simple “on”. Undo this change from 2c23fff2e03e77187dc4d01f325f5f43a0e7cad2. - - - - - 3551c554 by Kirill Elagin at 2020-12-10T01:45:54-05:00 doc: Extra-clarify -fomit-yields Be more clear on what this optimisation being on by default means in terms of yields. - - - - - 6484f0d7 by Sergei Trofimovich at 2020-12-10T01:46:33-05:00 rts/linker/Elf.c: add missing <dlfcn.h> include (musl support) The change fixes build failure on musl: ``` rts/linker/Elf.c:2031:3: error: warning: implicit declaration of function 'dlclose'; did you mean 'close'? [-Wimplicit-function-declaration] 2031 | dlclose(nc->dlopen_handle); | ^~~~~~~ | close ``` Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - ab24ed9b by Ben Gamari at 2020-12-11T03:55:51-05:00 users guide: Fix syntax errors Fixes errors introduced by 3a55b3a2574f913d046f3a6f82db48d7f6df32e3. - - - - - d3a24d31 by Ben Gamari at 2020-12-11T03:55:51-05:00 users guide: Describe GC lifecycle events Every time I am asked about how to interpret these events I need to figure it out from scratch. It's well past time that the users guide properly documents these. - - - - - 741309b9 by Ben Gamari at 2020-12-11T03:56:27-05:00 gitlab-ci: Fix incorrect Docker image for nightly cross job Also refactor the job definition to eliminate the bug by construction. - - - - - 19703bc8 by Ben Gamari at 2020-12-11T03:56:27-05:00 gitlab-ci: Fix name of flavour in ThreadSanitizer job It looks like I neglected to update this after introduce flavour transformers. - - - - - 381eb660 by Sylvain Henry at 2020-12-11T12:57:35-05:00 Display FFI labels (fix #18539) - - - - - 4548d1f8 by Aaron Allen at 2020-12-11T12:58:14-05:00 Elide extraneous messages for :doc command (#15784) Do not print `<has no documentation>` alongside a valid doc. Additionally, if two matching symbols lack documentation then the message will only be printed once. Hence, `<has no documentation>` will be printed at most once and only if all matching symbols are lacking docs. - - - - - 5eba91b6 by Aaron Allen at 2020-12-11T12:58:14-05:00 Add :doc test case for duplicate record fields Tests that the output of the `:doc` command is correct for duplicate record fields defined using -XDuplicateRecordFields. - - - - - 5feb9b2d by Ryan Scott at 2020-12-11T22:39:29-05:00 Delete outdated Note [Kind-checking tyvar binders for associated types] This Note has severely bitrotted, as it has no references anywhere in the codebase, and none of the functions that it mentions exist anymore. Let's just delete this. While I was in town, I deleted some outdated comments from `checkFamPatBinders` of a similar caliber. Fixes #19008. [ci skip] - - - - - f9f9f030 by Sylvain Henry at 2020-12-11T22:40:08-05:00 Arrows: correctly query arrow methods (#17423) Consider the following code: proc (C x y) -> ... Before this patch, the evidence binding for the Arrow dictionary was attached to the C pattern: proc (C x y) { $dArrow = ... } -> ... But then when we desugar this, we use arrow operations ("arr", ">>>"...) specialised for this arrow: let arr_xy = arr $dArrow -- <-- Not in scope! ... in arr_xy (\(C x y) { $dArrow = ... } -> ...) This patch allows arrow operations to be type-checked before the proc itself, avoiding this issue. Fix #17423 - - - - - aaa8f00f by Sylvain Henry at 2020-12-11T22:40:48-05:00 Validate script: fix configure command when using stack - - - - - b4a929a1 by Sylvain Henry at 2020-12-11T22:41:30-05:00 Hadrian: fix libffi tarball parsing Fix parsing of "libffi-3.3.tar.gz". NB: switch to a newer libffi isn't done in this patch - - - - - 690c8946 by Sylvain Henry at 2020-12-11T22:42:09-05:00 Parser: move parser utils into their own module Move code unrelated to runtime evaluation out of GHC.Runtime.Eval - - - - - 76be0e32 by Sylvain Henry at 2020-12-11T22:42:48-05:00 Move SizedSeq into ghc-boot - - - - - 3a16d764 by Sylvain Henry at 2020-12-11T22:42:48-05:00 ghci: don't compile unneeded modules - - - - - 2895fa60 by Sylvain Henry at 2020-12-11T22:42:48-05:00 ghci: reuse Arch from ghc-boot - - - - - 480a38d4 by Sylvain Henry at 2020-12-11T22:43:30-05:00 rts: don't use siginterrupt (#19019) - - - - - 4af6126d by Sylvain Henry at 2020-12-11T22:44:11-05:00 Use static array in zeroCount - - - - - 5bd71bfd by Sebastian Graf at 2020-12-12T04:45:09-05:00 DmdAnal: Annotate top-level function bindings with demands (#18894) It's useful to annotate a non-exported top-level function like `g` in ```hs module Lib (h) where g :: Int -> Int -> (Int,Int) g m 1 = (m, 0) g m n = (2 * m, 2 `div` n) {-# NOINLINE g #-} h :: Int -> Int h 1 = 0 h m | odd m = snd (g m 2) | otherwise = uncurry (+) (g 2 m) ``` with its demand `UCU(CS(P(1P(U),SP(U))`, which tells us that whenever `g` was called, the second component of the returned pair was evaluated strictly. Since #18903 we do so for local functions, where we can see all calls. For top-level functions, we can assume that all *exported* functions are demanded according to `topDmd` and thus get sound demands for non-exported top-level functions. The demand on `g` is crucial information for Nested CPR, which may the go on and unbox `g` for the second pair component. That is true even if that pair component may diverge, as is the case for the call site `g 13 0`, which throws a div-by-zero exception. In `T18894b`, you can even see the new demand annotation enabling us to eta-expand a function that we wouldn't be able to eta-expand without Call Arity. We only track bindings of function type in order not to risk huge compile-time regressions, see `isInterestingTopLevelFn`. There was a CoreLint check that rejected strict demand annotations on recursive or top-level bindings, which seems completely unjustified. All the cases I investigated were fine, so I removed it. Fixes #18894. - - - - - 3aae036e by Sebastian Graf at 2020-12-12T04:45:09-05:00 Demand: Simplify `CU(U)` to `U` (#19005) Both sub-demands encode the same information. This is a trivial change and already affects a few regression tests (e.g. `T5075`), so no separate regression test is necessary. - - - - - c6477639 by Adam Sandberg Ericsson at 2020-12-12T04:45:48-05:00 hadrian: correctly copy the docs dir into the bindist #18669 - - - - - e033dd05 by Adam Sandberg Ericsson at 2020-12-12T10:52:19+00:00 mkDocs: support hadrian bindists #18973 - - - - - 78580ba3 by John Ericson at 2020-12-13T07:14:50-05:00 Remove old .travis.yml - - - - - c696bb2f by Cale Gibbard at 2020-12-14T13:37:09-05:00 Implement type applications in patterns The haddock submodule is also updated so that it understands the changes to patterns. - - - - - 7e9debd4 by Ben Gamari at 2020-12-14T13:37:09-05:00 Optimise nullary type constructor usage During the compilation of programs GHC very frequently deals with the `Type` type, which is a synonym of `TYPE 'LiftedRep`. This patch teaches GHC to avoid expanding the `Type` synonym (and other nullary type synonyms) during type comparisons, saving a good amount of work. This optimisation is described in `Note [Comparing nullary type synonyms]`. To maximize the impact of this optimisation, we introduce a few special-cases to reduce `TYPE 'LiftedRep` to `Type`. See `Note [Prefer Type over TYPE 'LiftedPtrRep]`. Closes #17958. Metric Decrease: T18698b T1969 T12227 T12545 T12707 T14683 T3064 T5631 T5642 T9020 T9630 T9872a T13035 haddock.Cabal haddock.base - - - - - 92377c27 by Ben Gamari at 2020-12-14T13:41:58-05:00 Revert "Optimise nullary type constructor usage" This was inadvertently merged. This reverts commit 7e9debd4ceb068effe8ac81892d2cabcb8f55850. - - - - - d0e8c10d by Sylvain Henry at 2020-12-14T19:45:13+01:00 Move Unit related fields from DynFlags to HscEnv The unit database cache, the home unit and the unit state were stored in DynFlags while they ought to be stored in the compiler session state (HscEnv). This patch fixes this. It introduces a new UnitEnv type that should be used in the future to handle separate unit environments (especially host vs target units). Related to #17957 Bump haddock submodule - - - - - af855ac1 by Andreas Klebinger at 2020-12-14T15:22:13-05:00 Optimize dumping of consecutive whitespace. The naive way of putting out n characters of indent would be something like `hPutStr hdl (replicate n ' ')`. However this is quite inefficient as we allocate an absurd number of strings consisting of simply spaces as we don't cache them. To improve on this we now track if we can simply write ascii spaces via hPutBuf instead. This is the case when running with -ddump-to-file where we force the encoding to be UTF8. This avoids both the cost of going through encoding as well as avoiding allocation churn from all the white space. Instead we simply use hPutBuf on a preallocated unlifted string. When dumping stg like this: > nofib/spectral/simple/Main.hs -fforce-recomp -ddump-stg-final -ddump-to-file -c +RTS -s Allocations went from 1,778 MB to 1,702MB. About a 4% reduction of allocation! I did not measure the difference in runtime but expect it to be similar. Bumps the haddock submodule since the interface of GHC's Pretty slightly changed. ------------------------- Metric Decrease: T12227 ------------------------- - - - - - dad87210 by Ben Gamari at 2020-12-14T15:22:29-05:00 Optimise nullary type constructor usage During the compilation of programs GHC very frequently deals with the `Type` type, which is a synonym of `TYPE 'LiftedRep`. This patch teaches GHC to avoid expanding the `Type` synonym (and other nullary type synonyms) during type comparisons, saving a good amount of work. This optimisation is described in `Note [Comparing nullary type synonyms]`. To maximize the impact of this optimisation, we introduce a few special-cases to reduce `TYPE 'LiftedRep` to `Type`. See `Note [Prefer Type over TYPE 'LiftedPtrRep]`. Closes #17958. Metric Decrease: T18698b T1969 T12227 T12545 T12707 T14683 T3064 T5631 T5642 T9020 T9630 T9872a T13035 haddock.Cabal haddock.base - - - - - 6c2eb223 by Andrew Martin at 2020-12-14T18:48:51-05:00 Implement BoxedRep proposal This implements the BoxedRep proposal, refacoring the `RuntimeRep` hierarchy from: ```haskell data RuntimeRep = LiftedPtrRep | UnliftedPtrRep | ... ``` to ```haskell data RuntimeRep = BoxedRep Levity | ... data Levity = Lifted | Unlifted ``` Closes #17526. - - - - - 3ee696cc by Sebastian Graf at 2020-12-15T10:53:31-05:00 Add regression test for #19053 - - - - - 535dae66 by Ben Gamari at 2020-12-15T10:53:58-05:00 testsuite: Mark divbyzero, derefnull as fragile Due to #18548. - - - - - 331f5568 by Ben Gamari at 2020-12-15T11:21:06-05:00 Revert "Implement BoxedRep proposal" This was inadvertently merged. This reverts commit 6c2eb2232b39ff4720fda0a4a009fb6afbc9dcea. - - - - - 50fae07d by Ben Gamari at 2020-12-15T15:15:16-05:00 Roll-back broken haddock commit Updates haddock submodule to revert a commit that does not build. - - - - - e9b18a75 by Ben Gamari at 2020-12-15T15:55:38-05:00 Revert haddock submodule yet again - - - - - b58cb63a by GHC GitLab CI at 2020-12-16T03:46:31+00:00 Bump haddock submodule To adapt haddock for the nullary tyconapp optimisation patch. - - - - - 80df2edd by David Eichmann at 2020-12-17T13:55:21-05:00 User guide minor typo [ci skip] - - - - - 09f28390 by nineonine at 2020-12-17T13:55:59-05:00 Force module recompilation if '*' prefix was used to load modules in ghci (#8042) Usually pre-compiled code is preferred to be loaded in ghci if available, which means that if we try to load module with '*' prefix and compilation artifacts are available on disc (.o and .hi files) or the source code was untouched, the driver would think no recompilation is required. Therefore, we need to force recompilation so that desired byte-code is generated and loaded. Forcing in this case should be ok, since this is what happens for interpreted code anyways when reloading modules. - - - - - b1178cbc by Ryan Scott at 2020-12-17T13:56:35-05:00 Reject dodgy scoping in associated family instance RHSes Commit e63518f5d6a93be111f9108c0990a1162f88d615 tried to push all of the logic of detecting out-of-scope type variables on the RHSes of associated type family instances to `GHC.Tc.Validity` by deleting a similar check in the renamer. Unfortunately, this commit went a little too far, as there are some corner cases that `GHC.Tc.Validity` doesn't detect. Consider this example: ```hs class C a where data D a instance forall a. C Int where data instance D Int = MkD a ``` If this program isn't rejected by the time it reaches the typechecker, then GHC will believe the `a` in `MkD a` is existentially quantified and accept it. This is almost surely not what the user wants! The simplest way to reject programs like this is to restore the old validity check in the renamer (search for `improperly_scoped` in `rnFamEqn`). Note that this is technically a breaking change, since the program in the `polykinds/T9574` test case (which previously compiled) will now be rejected: ```hs instance Funct ('KProxy :: KProxy o) where type Codomain 'KProxy = NatTr (Proxy :: o -> *) ``` This is because the `o` on the RHS will now be rejected for being out of scope. Luckily, this is simple to repair: ```hs instance Funct ('KProxy :: KProxy o) where type Codomain ('KProxy @o) = NatTr (Proxy :: o -> *) ``` All of the discussion is now a part of the revamped `Note [Renaming associated types]` in `GHC.Rename.Module`. A different design would be to make associated type family instances have completely separate scoping from the parent instance declaration, much like how associated type family default declarations work today. See the discussion beginning at https://gitlab.haskell.org/ghc/ghc/-/issues/18021#note_265729 for more on this point. This, however, would break even more programs that are accepted today and likely warrants a GHC proposal before going forward. In the meantime, this patch fixes the issue described in #18021 in the least invasive way possible. There are programs that are accepted today that will no longer be accepted after this patch, but they are arguably pathological programs, and they are simple to repair. Fixes #18021. - - - - - cf8ab4a6 by Tom Ellis at 2020-12-17T13:57:12-05:00 submodule update: containers and stm Needed for https://gitlab.haskell.org/ghc/ghc/-/issues/15656 as it stops the packages triggering incomplete-uni-patterns and incomplete-record-updates - - - - - df7c7faa by Richard Eisenberg at 2020-12-17T13:57:48-05:00 Unfortunate dirty hack to overcome #18998. See commentary in tcCheckUsage. Close #18998. Test case: typecheck/should_compile/T18998 - - - - - 659fcb14 by Sylvain Henry at 2020-12-17T13:58:30-05:00 Fix project version for ProjectVersionMunged (fix #19058) - - - - - 2257718d by Matthew Pickering at 2020-12-18T08:12:05+00:00 Fix haddock parse error - - - - - 8fcdfcfb by Matthew Pickering at 2020-12-18T08:12:05+00:00 Revert "Remove GHC.Types.Unique.Map module" This reverts commit 1c7c6f1afc8e7f7ba5d256780bc9d5bb5f3e7601. - - - - - 469a0aa0 by Matthew Pickering at 2020-12-18T08:12:05+00:00 Profiling by info table mode (-hi) This profiling mode creates bands by the address of the info table for each closure. This provides a much more fine-grained profiling output than any of the other profiling modes. The `-hi` profiling mode does not require a profiling build. - - - - - 4c0d14ff by Matthew Pickering at 2020-12-18T08:14:19+00:00 Add -finfo-table-map which maps info tables to source positions This new flag embeds a lookup table from the address of an info table to information about that info table. The main interface for consulting the map is the `lookupIPE` C function > InfoProvEnt * lookupIPE(StgInfoTable *info) The `InfoProvEnt` has the following structure: > typedef struct InfoProv_{ > char * table_name; > char * closure_desc; > char * ty_desc; > char * label; > char * module; > char * srcloc; > } InfoProv; > > typedef struct InfoProvEnt_ { > StgInfoTable * info; > InfoProv prov; > struct InfoProvEnt_ *link; > } InfoProvEnt; The source positions are approximated in a similar way to the source positions for DWARF debugging information. They are only approximate but in our experience provide a good enough hint about where the problem might be. It is therefore recommended to use this flag in conjunction with `-g<n>` for more accurate locations. The lookup table is also emitted into the eventlog when it is available as it is intended to be used with the `-hi` profiling mode. Using this flag will significantly increase the size of the resulting object file but only by a factor of 2-3x in our experience. - - - - - 2ba18294 by Matthew Pickering at 2020-12-18T08:14:20+00:00 Add option to give each usage of a data constructor its own info table The `-fdistinct-constructor-tables` flag will generate a fresh info table for the usage of any data constructor. This is useful for debugging as now by inspecting the info table, you can determine which usage of a constructor caused that allocation rather than the old situation where the info table always mapped to the definition site of the data constructor which is useless. In conjunction with `-hi` and `-finfo-table-map` this gives a more fine grained understanding of where constructor allocations arise from in a program. - - - - - c6cea417 by Matthew Pickering at 2020-12-18T08:14:20+00:00 Add whereFrom and whereFrom# primop The `whereFrom` function provides a Haskell interface for using the information created by `-finfo-table-map`. Given a Haskell value, the info table address will be passed to the `lookupIPE` function in order to attempt to find the source location information for that particular closure. At the moment it's not possible to distinguish the absense of the map and a failed lookup. - - - - - d2afc7a4 by Matthew Pickering at 2020-12-18T08:14:20+00:00 Add test for whereFrom# - - - - - ec10cdd7 by Matthew Pickering at 2020-12-18T08:14:49+00:00 Add release notes for -hi, -finfo-table-map and -fdistinct-constructor-tables - - - - - 5bd97cb0 by Matthew Pickering at 2020-12-18T08:14:51+00:00 Turn on SourceNotes without -g - - - - - 2b509e61 by Matthew Pickering at 2020-12-18T08:14:51+00:00 release notes - - - - - dc22d60e by Matthew Pickering at 2020-12-18T08:14:51+00:00 debug info docs - - - - - fbc46648 by Matthew Pickering at 2020-12-18T08:14:51+00:00 Some more comments - - - - - ab1e0e9e by Matthew Pickering at 2020-12-18T08:14:51+00:00 Disable tests - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/linters/check-version-number.sh - − .travis.yml - compiler/GHC.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - + compiler/GHC/Builtin/Types/Prim.hs-boot - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Expr.hs - + compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Liveness.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Parser/Monad.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a6cea7ff30f4c38e1b16d7502b23cadc88740b63...ab1e0e9e01a4c9ea7c5ab0aaec47e8c8027f5cdd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a6cea7ff30f4c38e1b16d7502b23cadc88740b63...ab1e0e9e01a4c9ea7c5ab0aaec47e8c8027f5cdd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 18 08:23:40 2020 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Fri, 18 Dec 2020 03:23:40 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/ghc-debug-ghc Message-ID: <5fdc670ccb50b_6b213272ce022929b3@gitlab.mail> Matthew Pickering pushed new branch wip/ghc-debug-ghc at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/ghc-debug-ghc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 18 08:48:03 2020 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Fri, 18 Dec 2020 03:48:03 -0500 Subject: [Git][ghc/ghc][wip/ghc-dynamic-census] Apply 1 suggestion(s) to 1 file(s) Message-ID: <5fdc6cc346cfc_6b2194b989022946b@gitlab.mail> Matthew Pickering pushed to branch wip/ghc-dynamic-census at Glasgow Haskell Compiler / GHC Commits: dc7fbe08 by Matthew Pickering at 2020-12-18T03:48:01-05:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 1 changed file: - rts/RtsFlags.c Changes: ===================================== rts/RtsFlags.c ===================================== @@ -392,8 +392,9 @@ usage_text[] = { #endif /* PROFILING */ " -i Time between heap profile samples (seconds, default: 0.1)", -" --no-automatic-heap-samples Do not start the heap profile interval timer,", -" rely on the user to trigger samples from their application", +" --no-automatic-heap-samples Do not start the heap profile interval timer on start-up,", +" Rather, the application will be responsible for triggering", +" heap profiler samples." #if defined(TRACING) "", View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dc7fbe086c582a6e29a80d32fe41222764bbd58f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dc7fbe086c582a6e29a80d32fe41222764bbd58f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 18 09:45:44 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Fri, 18 Dec 2020 04:45:44 -0500 Subject: [Git][ghc/ghc][wip/T17656] Kill floatEqualities completely Message-ID: <5fdc7a48a6c72_6b2167418542298490@gitlab.mail> Simon Peyton Jones pushed to branch wip/T17656 at Glasgow Haskell Compiler / GHC Commits: 4f85f141 by Simon Peyton Jones at 2020-12-18T09:44:46+00:00 Kill floatEqualities completely This patch delivers on #17656, by entirel killing off the complex floatEqualities mechanism. Previously, floatEqualities would float an equality out of an implication, so that it could be solved at an outer level. But now we simply do unification in-place, without floating the constraint, relying on level numbers to determine untouchability. There are a number of important new Notes: * GHC.Tc.Utils.Unify Note [Unification preconditions] describes the preconditions for unification, including both skolem-escape and touchability. * GHC.Tc.Solver.Interact Note [Solve by unification] describes what we do when we do unify * GHC.Tc.Solver.Monad Note [The Unification Level Flag] describes how we control solver iteration under this new scheme * GHC.Tc.Solver.Monad Note [Tracking Given equalities] describes how we track when we have Given equalities * GHC.Tc.Types.Constraint Note [HasGivenEqs] is a new explanation of the ic_given_eqs field of an implication A big raft of subtle Notes in Solver, concerning floatEqualities, disappears. Main code changes: * GHC.Tc.Solver.floatEqualities disappears entirely * GHC.Tc.Solver.Monad: new fields in InertCans, inert_given_eq_lvl and inert_given_eq, updated by updateGivenEqs See Note [Tracking Given equalities]. * In exchange for updateGivenEqa, GHC.Tc.Solver.Monad.getHasGivenEqs is much simpler and more efficient * I found I could kill of metaTyVarUpdateOK entirely One test case T14683 showed a 5.1% decrease in compile-time allocation; and T5631 was down 2.2%. Other changes were small. Metric Decrease: T14683 T5631 - - - - - 20 changed files: - compiler/GHC/Runtime/Heap/Inspect.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Interact.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/Env.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Utils/Unify.hs - testsuite/tests/ghci.debugger/scripts/break012.stdout - testsuite/tests/partial-sigs/should_compile/T10403.stderr - testsuite/tests/partial-sigs/should_compile/T14715.stderr - testsuite/tests/partial-sigs/should_fail/ScopedNamedWildcardsBad.stderr - testsuite/tests/typecheck/should_fail/ExpandSynsFail2.stderr - testsuite/tests/typecheck/should_fail/T7453.stderr Changes: ===================================== compiler/GHC/Runtime/Heap/Inspect.hs ===================================== @@ -577,7 +577,7 @@ newOpenVar = liftTcM (do { kind <- newOpenTypeKind ~~~~~~~~~~~~~~~~~~~~~~ In the GHCi debugger we use unification variables whose MetaInfo is RuntimeUnkTv. The special property of a RuntimeUnkTv is that it can -unify with a polytype (see GHC.Tc.Utils.Unify.metaTyVarUpdateOK). +unify with a polytype (see GHC.Tc.Utils.Unify.checkTypeEq). If we don't do this `:print ` will fail if the type of has nested `forall`s or `=>`s. ===================================== compiler/GHC/Tc/Errors.hs ===================================== @@ -21,7 +21,7 @@ import GHC.Tc.Utils.Monad import GHC.Tc.Types.Constraint import GHC.Core.Predicate import GHC.Tc.Utils.TcMType -import GHC.Tc.Utils.Unify( occCheckForErrors, MetaTyVarUpdateResult(..) ) +import GHC.Tc.Utils.Unify( occCheckForErrors, CheckTyEqResult(..) ) import GHC.Tc.Utils.Env( tcInitTidyEnv ) import GHC.Tc.Utils.TcType import GHC.Tc.Types.Origin @@ -1482,7 +1482,7 @@ mkTyVarEqErr' dflags ctxt report ct tv1 ty2 , report ] - | MTVU_Occurs <- occ_check_expand + | CTE_Occurs <- occ_check_expand -- We report an "occurs check" even for a ~ F t a, where F is a type -- function; it's not insoluble (because in principle F could reduce) -- but we have certainly been unable to solve it @@ -1503,7 +1503,7 @@ mkTyVarEqErr' dflags ctxt report ct tv1 ty2 ; mkErrorMsgFromCt ctxt ct $ mconcat [headline_msg, extra2, extra3, report] } - | MTVU_Bad <- occ_check_expand + | CTE_Bad <- occ_check_expand = do { let msg = vcat [ text "Cannot instantiate unification variable" <+> quotes (ppr tv1) , hang (text "with a" <+> what <+> text "involving polytypes:") 2 (ppr ty2) ] ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -907,7 +907,7 @@ That is the entire point of qlUnify! Wrinkles: * We must not make an occurs-check; we use occCheckExpand for that. -* metaTyVarUpdateOK also checks for various other things, including +* checkTypeEq also checks for various other things, including - foralls, and predicate types (which we want to allow here) - type families (relates to a very specific and exotic performance question, that is unlikely to bite here) ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -312,7 +312,7 @@ Note [Promotion in signatures] If an unsolved metavariable in a signature is not generalized (because we're not generalizing the construct -- e.g., pattern sig -- or because the metavars are constrained -- see kindGeneralizeSome) -we need to promote to maintain (WantedTvInv) of Note [TcLevel and untouchable type variables] +we need to promote to maintain (WantedTvInv) of Note [TcLevel invariants] in GHC.Tc.Utils.TcType. Note that promotion is identical in effect to generalizing and the reinstantiating with a fresh metavariable at the current level. So in some sense, we generalize *all* variables, but then re-instantiate @@ -330,7 +330,7 @@ the pattern signature (which is not kind-generalized). When we are checking the *body* of foo, though, we need to unify the type of x with the argument type of bar. At this point, the ambient TcLevel is 1, and spotting a matavariable with level 2 would violate the (WantedTvInv) invariant of -Note [TcLevel and untouchable type variables]. So, instead of kind-generalizing, +Note [TcLevel invariants]. So, instead of kind-generalizing, we promote the metavariable to level 1. This is all done in kindGeneralizeNone. -} ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -264,7 +264,7 @@ floatKindEqualities wc = float_wc emptyVarSet wc = Nothing -- A short cut /plus/ we must keep track of IC_BadTelescope | otherwise = do { (simples, holes) <- float_wc new_trapping_tvs wanted - ; when (not (isEmptyBag simples) && given_eqs /= NoGivenEqs) $ + ; when (not (isEmptyBag simples) && given_eqs == MaybeGivenEqs) $ Nothing -- If there are some constraints to float out, but we can't -- because we don't float out past local equalities @@ -1282,7 +1282,8 @@ decideMonoTyVars infer_mode name_taus psigs candidates mr_msg ; traceTc "decideMonoTyVars" $ vcat - [ text "mono_tvs0 =" <+> ppr mono_tvs0 + [ text "infer_mode =" <+> ppr infer_mode + , text "mono_tvs0 =" <+> ppr mono_tvs0 , text "no_quant =" <+> ppr no_quant , text "maybe_quant =" <+> ppr maybe_quant , text "eq_constraints =" <+> ppr eq_constraints @@ -1325,7 +1326,7 @@ defaultTyVarsAndSimplify :: TcLevel -- and re-simplify in case the defaulting allows further simplification defaultTyVarsAndSimplify rhs_tclvl mono_tvs candidates = do { -- Promote any tyvars that we cannot generalise - -- See Note [Promote momomorphic tyvars] + -- See Note [Promote monomorphic tyvars] ; traceTc "decideMonoTyVars: promotion:" (ppr mono_tvs) ; any_promoted <- promoteTyVarSet mono_tvs @@ -1405,7 +1406,10 @@ decideQuantifiedTyVars name_taus psigs candidates dvs_plus = dv { dv_kvs = pick cand_kvs, dv_tvs = pick cand_tvs } ; traceTc "decideQuantifiedTyVars" (vcat - [ text "candidates =" <+> ppr candidates + [ text "tau_tys =" <+> ppr tau_tys + , text "candidates =" <+> ppr candidates + , text "cand_kvs =" <+> ppr cand_kvs + , text "cand_tvs =" <+> ppr cand_tvs , text "tau_tys =" <+> ppr tau_tys , text "seed_tys =" <+> ppr seed_tys , text "seed_tcvs =" <+> ppr (tyCoVarsOfTypes seed_tys) @@ -1434,7 +1438,7 @@ growThetaTyVars theta tcvs pred_tcvs = tyCoVarsOfType pred -{- Note [Promote momomorphic tyvars] +{- Note [Promote monomorphic tyvars] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Promote any type variables that are free in the environment. Eg f :: forall qtvs. bound_theta => zonked_tau @@ -1448,7 +1452,7 @@ we don't quantify over beta (since it is fixed by envt) so we must promote it! The inferred type is just f :: beta -> beta -NB: promoteTyVar ignores coercion variables +NB: promoteTyVarSet ignores coercion variables Note [Quantification and partial signatures] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1660,22 +1664,14 @@ solveWantedsAndDrop wanted solveWanteds :: WantedConstraints -> TcS WantedConstraints -- so that the inert set doesn't mindlessly propagate. -- NB: wc_simples may be wanted /or/ derived now -solveWanteds wc@(WC { wc_simple = simples, wc_impl = implics, wc_holes = holes }) +solveWanteds wc@(WC { wc_holes = holes }) = do { cur_lvl <- TcS.getTcLevel ; traceTcS "solveWanteds {" $ vcat [ text "Level =" <+> ppr cur_lvl , ppr wc ] - ; wc1 <- solveSimpleWanteds simples - -- Any insoluble constraints are in 'simples' and so get rewritten - -- See Note [Rewrite insolubles] in GHC.Tc.Solver.Monad - - ; (floated_eqs, implics2) <- solveNestedImplications $ - implics `unionBags` wc_impl wc1 - - ; dflags <- getDynFlags - ; solved_wc <- simpl_loop 0 (solverIterations dflags) floated_eqs - (wc1 { wc_impl = implics2 }) + ; dflags <- getDynFlags + ; solved_wc <- simplify_loop 0 (solverIterations dflags) True wc ; holes' <- simplifyHoles holes ; let final_wc = solved_wc { wc_holes = holes' } @@ -1688,9 +1684,44 @@ solveWanteds wc@(WC { wc_simple = simples, wc_impl = implics, wc_holes = holes } ; return final_wc } -simpl_loop :: Int -> IntWithInf -> Cts - -> WantedConstraints -> TcS WantedConstraints -simpl_loop n limit floated_eqs wc@(WC { wc_simple = simples }) +simplify_loop :: Int -> IntWithInf -> Bool + -> WantedConstraints -> TcS WantedConstraints +-- Do a round of solving, and call maybe_simplify_again to iterate +-- The 'definitely_redo_implications' flags is False if the only reason we +-- are iterating is that we have added some new Derived superclasses (from Wanteds) +-- hoping for fundeps to help us; see Note [Superclass iteration] +-- +-- Does not affect wc_holes at all; reason: wc_holes never affects anything +-- else, so we do them once, at the end in solveWanteds +simplify_loop n limit definitely_redo_implications + wc@(WC { wc_simple = simples, wc_impl = implics }) + = do { csTraceTcS $ + text "simplify_loop iteration=" <> int n + <+> (parens $ hsep [ text "definitely_redo =" <+> ppr definitely_redo_implications <> comma + , int (lengthBag simples) <+> text "simples to solve" ]) + ; traceTcS "simplify_loop: wc =" (ppr wc) + + ; (unifs1, wc1) <- reportUnifications $ -- See Note [Superclass iteration] + solveSimpleWanteds simples + -- Any insoluble constraints are in 'simples' and so get rewritten + -- See Note [Rewrite insolubles] in GHC.Tc.Solver.Monad + + ; wc2 <- if not definitely_redo_implications -- See Note [Superclass iteration] + && unifs1 == 0 -- for this conditional + && isEmptyBag (wc_impl wc1) + then return (wc { wc_simple = wc_simple wc1 }) -- Short cut + else do { implics2 <- solveNestedImplications $ + implics `unionBags` (wc_impl wc1) + ; return (wc { wc_simple = wc_simple wc1 + , wc_impl = implics2 }) } + + ; unif_happened <- resetUnificationFlag + -- Note [The Unification Level Flag] in GHC.Tc.Solver.Monad + ; maybe_simplify_again (n+1) limit unif_happened wc2 } + +maybe_simplify_again :: Int -> IntWithInf -> Bool + -> WantedConstraints -> TcS WantedConstraints +maybe_simplify_again n limit unif_happened wc@(WC { wc_simple = simples }) | n `intGtLimit` limit = do { -- Add an error (not a warning) if we blow the limit, -- Typically if we blow the limit we are going to report some other error @@ -1699,17 +1730,12 @@ simpl_loop n limit floated_eqs wc@(WC { wc_simple = simples }) addErrTcS (hang (text "solveWanteds: too many iterations" <+> parens (text "limit =" <+> ppr limit)) 2 (vcat [ text "Unsolved:" <+> ppr wc - , ppUnless (isEmptyBag floated_eqs) $ - text "Floated equalities:" <+> ppr floated_eqs , text "Set limit with -fconstraint-solver-iterations=n; n=0 for no limit" ])) ; return wc } - | not (isEmptyBag floated_eqs) - = simplify_again n limit True (wc { wc_simple = floated_eqs `unionBags` simples }) - -- Put floated_eqs first so they get solved first - -- NB: the floated_eqs may include /derived/ equalities - -- arising from fundeps inside an implication + | unif_happened + = simplify_loop n limit True wc | superClassesMightHelp wc = -- We still have unsolved goals, and apparently no way to solve them, @@ -1722,82 +1748,65 @@ simpl_loop n limit floated_eqs wc@(WC { wc_simple = simples }) do { new_given <- makeSuperClasses pending_given ; new_wanted <- makeSuperClasses pending_wanted ; solveSimpleGivens new_given -- Add the new Givens to the inert set - ; simplify_again n limit (null pending_given) + ; simplify_loop n limit (not (null pending_given)) $ wc { wc_simple = simples1 `unionBags` listToBag new_wanted } } } + -- (not (null pending_given)): see Note [Superclass iteration] | otherwise = return wc -simplify_again :: Int -> IntWithInf -> Bool - -> WantedConstraints -> TcS WantedConstraints --- We have definitely decided to have another go at solving --- the wanted constraints (we have tried at least once already -simplify_again n limit no_new_given_scs - wc@(WC { wc_simple = simples, wc_impl = implics }) - = do { csTraceTcS $ - text "simpl_loop iteration=" <> int n - <+> (parens $ hsep [ text "no new given superclasses =" <+> ppr no_new_given_scs <> comma - , int (lengthBag simples) <+> text "simples to solve" ]) - ; traceTcS "simpl_loop: wc =" (ppr wc) - - ; (unifs1, wc1) <- reportUnifications $ - solveSimpleWanteds $ - simples - - -- See Note [Cutting off simpl_loop] - -- We have already tried to solve the nested implications once - -- Try again only if we have unified some meta-variables - -- (which is a bit like adding more givens), or we have some - -- new Given superclasses - ; let new_implics = wc_impl wc1 - ; if unifs1 == 0 && - no_new_given_scs && - isEmptyBag new_implics - - then -- Do not even try to solve the implications - simpl_loop (n+1) limit emptyBag (wc1 { wc_impl = implics }) - - else -- Try to solve the implications - do { (floated_eqs2, implics2) <- solveNestedImplications $ - implics `unionBags` new_implics - ; simpl_loop (n+1) limit floated_eqs2 (wc1 { wc_impl = implics2 }) - } } +{- Note [Superclass iteration] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider this implication constraint + forall a. + [W] d: C Int beta + forall b. blah +where + class D a b | a -> b + class D a b => C a b +We will expand d's superclasses, giving [D] D Int beta, in the hope of geting +fundeps to unify beta. Doing so is usually fruitless (no useful fundeps), +and if so it seems a pity to waste time iterating the implications (forall b. blah) +(If we add new Given superclasses it's a different matter: it's really worth looking +at the implications.) + +Hence the definitely_redo_implications flag to simplify_loop. It's usually +True, but False in the case where the only reason to iterate is new Derived +superclasses. In that case we check whether the new Deriveds actually led to +any new unifications, and iterate the implications only if so. +-} solveNestedImplications :: Bag Implication - -> TcS (Cts, Bag Implication) + -> TcS (Bag Implication) -- Precondition: the TcS inerts may contain unsolved simples which have -- to be converted to givens before we go inside a nested implication. solveNestedImplications implics | isEmptyBag implics - = return (emptyBag, emptyBag) + = return (emptyBag) | otherwise = do { traceTcS "solveNestedImplications starting {" empty - ; (floated_eqs_s, unsolved_implics) <- mapAndUnzipBagM solveImplication implics - ; let floated_eqs = concatBag floated_eqs_s + ; unsolved_implics <- mapBagM solveImplication implics -- ... and we are back in the original TcS inerts -- Notice that the original includes the _insoluble_simples so it was safe to ignore -- them in the beginning of this function. ; traceTcS "solveNestedImplications end }" $ - vcat [ text "all floated_eqs =" <+> ppr floated_eqs - , text "unsolved_implics =" <+> ppr unsolved_implics ] + vcat [ text "unsolved_implics =" <+> ppr unsolved_implics ] - ; return (floated_eqs, catBagMaybes unsolved_implics) } + ; return (catBagMaybes unsolved_implics) } solveImplication :: Implication -- Wanted - -> TcS (Cts, -- All wanted or derived floated equalities: var = type - Maybe Implication) -- Simplified implication (empty or singleton) + -> TcS (Maybe Implication) -- Simplified implication (empty or singleton) -- Precondition: The TcS monad contains an empty worklist and given-only inerts -- which after trying to solve this implication we must restore to their original value solveImplication imp@(Implic { ic_tclvl = tclvl , ic_binds = ev_binds_var - , ic_skols = skols , ic_given = given_ids , ic_wanted = wanteds , ic_info = info , ic_status = status }) | isSolvedStatus status - = return (emptyCts, Just imp) -- Do nothing + = return (Just imp) -- Do nothing | otherwise -- Even for IC_Insoluble it is worth doing more work -- The insoluble stuff might be in one sub-implication @@ -1819,7 +1828,7 @@ solveImplication imp@(Implic { ic_tclvl = tclvl ; residual_wanted <- solveWanteds wanteds -- solveWanteds, *not* solveWantedsAndDrop, because -- we want to retain derived equalities so we can float - -- them out in floatEqualities + -- them out in floatEqualities. ; (has_eqs, given_insols) <- getHasGivenEqs tclvl -- Call getHasGivenEqs /after/ solveWanteds, because @@ -1828,10 +1837,6 @@ solveImplication imp@(Implic { ic_tclvl = tclvl ; return (has_eqs, given_insols, residual_wanted) } - ; (floated_eqs, residual_wanted) - <- floatEqualities skols given_ids ev_binds_var - has_given_eqs residual_wanted - ; traceTcS "solveImplication 2" (ppr given_insols $$ ppr residual_wanted) ; let final_wanted = residual_wanted `addInsols` given_insols @@ -1845,15 +1850,14 @@ solveImplication imp@(Implic { ic_tclvl = tclvl ; tcvs <- TcS.getTcEvTyCoVars ev_binds_var ; traceTcS "solveImplication end }" $ vcat [ text "has_given_eqs =" <+> ppr has_given_eqs - , text "floated_eqs =" <+> ppr floated_eqs , text "res_implic =" <+> ppr res_implic , text "implication evbinds =" <+> ppr (evBindMapBinds evbinds) , text "implication tvcs =" <+> ppr tcvs ] - ; return (floated_eqs, res_implic) } + ; return res_implic } -- TcLevels must be strictly increasing (see (ImplicInv) in - -- Note [TcLevel and untouchable type variables] in GHC.Tc.Utils.TcType), + -- Note [TcLevel invariants] in GHC.Tc.Utils.TcType), -- and in fact I think they should always increase one level at a time. -- Though sensible, this check causes lots of testsuite failures. It is @@ -2237,49 +2241,8 @@ Consider (see #9939) We report (Eq a) as redundant, whereas actually (Ord a) is. But it's really not easy to detect that! - -Note [Cutting off simpl_loop] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -It is very important not to iterate in simpl_loop unless there is a chance -of progress. #8474 is a classic example: - - * There's a deeply-nested chain of implication constraints. - ?x:alpha => ?y1:beta1 => ... ?yn:betan => [W] ?x:Int - - * From the innermost one we get a [D] alpha ~ Int, - but alpha is untouchable until we get out to the outermost one - - * We float [D] alpha~Int out (it is in floated_eqs), but since alpha - is untouchable, the solveInteract in simpl_loop makes no progress - - * So there is no point in attempting to re-solve - ?yn:betan => [W] ?x:Int - via solveNestedImplications, because we'll just get the - same [D] again - - * If we *do* re-solve, we'll get an infinite loop. It is cut off by - the fixed bound of 10, but solving the next takes 10*10*...*10 (ie - exponentially many) iterations! - -Conclusion: we should call solveNestedImplications only if we did -some unification in solveSimpleWanteds; because that's the only way -we'll get more Givens (a unification is like adding a Given) to -allow the implication to make progress. -} -promoteTyVarTcS :: TcTyVar -> TcS () --- When we float a constraint out of an implication we must restore --- invariant (WantedInv) in Note [TcLevel and untouchable type variables] in GHC.Tc.Utils.TcType --- See Note [Promoting unification variables] --- We don't just call promoteTyVar because we want to use unifyTyVar, --- not writeMetaTyVar -promoteTyVarTcS tv - = do { tclvl <- TcS.getTcLevel - ; when (isFloatedTouchableMetaTyVar tclvl tv) $ - do { cloned_tv <- TcS.cloneMetaTyVar tv - ; let rhs_tv = setMetaTyVarTcLevel cloned_tv tclvl - ; unifyTyVar tv (mkTyVarTy rhs_tv) } } - -- | Like 'defaultTyVar', but in the TcS monad. defaultTyVarTcS :: TcTyVar -> TcS Bool defaultTyVarTcS the_tv @@ -2314,7 +2277,7 @@ approximateWC float_past_equalities wc concatMapBag (float_implic trapping_tvs) implics float_implic :: TcTyCoVarSet -> Implication -> Cts float_implic trapping_tvs imp - | float_past_equalities || ic_given_eqs imp == NoGivenEqs + | float_past_equalities || ic_given_eqs imp /= MaybeGivenEqs = float_wc new_trapping_tvs (ic_wanted imp) | otherwise -- Take care with equalities = emptyCts -- See (1) under Note [ApproximateWC] @@ -2414,7 +2377,7 @@ approximateWC to produce a list of candidate constraints. Then we MUST a) Promote any meta-tyvars that have been floated out by approximateWC, to restore invariant (WantedInv) described in - Note [TcLevel and untouchable type variables] in GHC.Tc.Utils.TcType. + Note [TcLevel invariants] in GHC.Tc.Utils.TcType. b) Default the kind of any meta-tyvars that are not mentioned in in the environment. @@ -2430,8 +2393,7 @@ Note [Promoting unification variables] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When we float an equality out of an implication we must "promote" free unification variables of the equality, in order to maintain Invariant -(WantedInv) from Note [TcLevel and untouchable type variables] in -TcType. for the leftover implication. +(WantedInv) from Note [TcLevel invariants] in GHC.Tc.Types.TcType. This is absolutely necessary. Consider the following example. We start with two implications and a class with a functional dependency. @@ -2468,276 +2430,6 @@ beta! Concrete example is in indexed_types/should_fail/ExtraTcsUntch.hs: in (g1 '3', g2 undefined) - -********************************************************************************* -* * -* Floating equalities * -* * -********************************************************************************* - -Note [Float Equalities out of Implications] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -For ordinary pattern matches (including existentials) we float -equalities out of implications, for instance: - data T where - MkT :: Eq a => a -> T - f x y = case x of MkT _ -> (y::Int) -We get the implication constraint (x::T) (y::alpha): - forall a. [untouchable=alpha] Eq a => alpha ~ Int -We want to float out the equality into a scope where alpha is no -longer untouchable, to solve the implication! - -But we cannot float equalities out of implications whose givens may -yield or contain equalities: - - data T a where - T1 :: T Int - T2 :: T Bool - T3 :: T a - - h :: T a -> a -> Int - - f x y = case x of - T1 -> y::Int - T2 -> y::Bool - T3 -> h x y - -We generate constraint, for (x::T alpha) and (y :: beta): - [untouchables = beta] (alpha ~ Int => beta ~ Int) -- From 1st branch - [untouchables = beta] (alpha ~ Bool => beta ~ Bool) -- From 2nd branch - (alpha ~ beta) -- From 3rd branch - -If we float the equality (beta ~ Int) outside of the first implication and -the equality (beta ~ Bool) out of the second we get an insoluble constraint. -But if we just leave them inside the implications, we unify alpha := beta and -solve everything. - -Principle: - We do not want to float equalities out which may - need the given *evidence* to become soluble. - -Consequence: classes with functional dependencies don't matter (since there is -no evidence for a fundep equality), but equality superclasses do matter (since -they carry evidence). --} - -floatEqualities :: [TcTyVar] -> [EvId] -> EvBindsVar -> HasGivenEqs - -> WantedConstraints - -> TcS (Cts, WantedConstraints) --- Main idea: see Note [Float Equalities out of Implications] --- --- Precondition: the wc_simple of the incoming WantedConstraints are --- fully zonked, so that we can see their free variables --- --- Postcondition: The returned floated constraints (Cts) are only --- Wanted or Derived --- --- Also performs some unifications (via promoteTyVar), adding to --- monadically-carried ty_binds. These will be used when processing --- floated_eqs later --- --- Subtleties: Note [Float equalities from under a skolem binding] --- Note [Skolem escape] --- Note [What prevents a constraint from floating] -floatEqualities skols given_ids ev_binds_var has_given_eqs - wanteds@(WC { wc_simple = simples }) - | MaybeGivenEqs <- has_given_eqs -- There are some given equalities, so don't float - = return (emptyBag, wanteds) -- Note [Float Equalities out of Implications] - - | otherwise - = do { -- First zonk: the inert set (from whence they came) is not - -- necessarily fully zonked; equalities are not kicked out - -- if a unification cannot make progress. See Note - -- [inert_eqs: the inert equalities] in GHC.Tc.Solver.Monad, which - -- describes how the inert set might not actually be inert. - simples <- TcS.zonkSimples simples - ; binds <- TcS.getTcEvBindsMap ev_binds_var - - -- Now we can pick the ones to float - -- The constraints are de-canonicalised - ; let (candidate_eqs, no_float_cts) = partitionBag is_float_eq_candidate simples - - seed_skols = mkVarSet skols `unionVarSet` - mkVarSet given_ids `unionVarSet` - foldr add_non_flt_ct emptyVarSet no_float_cts `unionVarSet` - evBindMapToVarSet binds - -- seed_skols: See Note [What prevents a constraint from floating] (1,2,3) - -- Include the EvIds of any non-floating constraints - - extended_skols = transCloVarSet (add_captured_ev_ids candidate_eqs) seed_skols - -- extended_skols contains the EvIds of all the trapped constraints - -- See Note [What prevents a constraint from floating] (3) - - (flt_eqs, no_flt_eqs) = partitionBag (is_floatable extended_skols) - candidate_eqs - - remaining_simples = no_float_cts `andCts` no_flt_eqs - - -- Promote any unification variables mentioned in the floated equalities - -- See Note [Promoting unification variables] - ; mapM_ promoteTyVarTcS (tyCoVarsOfCtsList flt_eqs) - - ; traceTcS "floatEqualities" (vcat [ text "Skols =" <+> ppr skols - , text "Extended skols =" <+> ppr extended_skols - , text "Simples =" <+> ppr simples - , text "Candidate eqs =" <+> ppr candidate_eqs - , text "Floated eqs =" <+> ppr flt_eqs]) - ; return ( flt_eqs, wanteds { wc_simple = remaining_simples } ) } - - where - add_non_flt_ct :: Ct -> VarSet -> VarSet - add_non_flt_ct ct acc | isDerivedCt ct = acc - | otherwise = extendVarSet acc (ctEvId ct) - - is_floatable :: VarSet -> Ct -> Bool - is_floatable skols ct - | isDerivedCt ct = tyCoVarsOfCt ct `disjointVarSet` skols - | otherwise = not (ctEvId ct `elemVarSet` skols) - - add_captured_ev_ids :: Cts -> VarSet -> VarSet - add_captured_ev_ids cts skols = foldr extra_skol emptyVarSet cts - where - extra_skol ct acc - | isDerivedCt ct = acc - | tyCoVarsOfCt ct `intersectsVarSet` skols = extendVarSet acc (ctEvId ct) - | otherwise = acc - - -- Identify which equalities are candidates for floating - -- Float out alpha ~ ty which might be unified outside - -- See Note [Which equalities to float] - is_float_eq_candidate ct - | pred <- ctPred ct - , EqPred NomEq ty1 ty2 <- classifyPredType pred - , case ct of - CIrredCan {} -> False -- See Note [Do not float blocked constraints] - _ -> True -- See #18855 - = float_eq ty1 ty2 || float_eq ty2 ty1 - | otherwise - = False - - float_eq ty1 ty2 - = case getTyVar_maybe ty1 of - Just tv1 -> isMetaTyVar tv1 - && (not (isTyVarTyVar tv1) || isTyVarTy ty2) - Nothing -> False - -{- Note [Do not float blocked constraints] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -As #18855 showed, we must not float an equality that is blocked. -Consider - forall a[4]. [W] co1: alpha[4] ~ Maybe (a[4] |> bco) - [W] co2: alpha[4] ~ Maybe (beta[4] |> bco]) - [W] bco: kappa[2] ~ Type - -Now co1, co2 are blocked by bco. We will eventually float out bco -and solve it at level 2. But the danger is that we will *also* -float out co2, and that is bad bad bad. Because we'll promote alpha -and beta to level 2, and then fail to unify the promoted beta -with the skolem a[4]. - -Solution: don't float out blocked equalities. Remember: we only want -to float out if we can solve; see Note [Which equalities to float]. - -(Future plan: kill floating altogether.) - -Note [Float equalities from under a skolem binding] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Which of the simple equalities can we float out? Obviously, only -ones that don't mention the skolem-bound variables. But that is -over-eager. Consider - [2] forall a. F a beta[1] ~ gamma[2], G beta[1] gamma[2] ~ Int -The second constraint doesn't mention 'a'. But if we float it, -we'll promote gamma[2] to gamma'[1]. Now suppose that we learn that -beta := Bool, and F a Bool = a, and G Bool _ = Int. Then we'll -we left with the constraint - [2] forall a. a ~ gamma'[1] -which is insoluble because gamma became untouchable. - -Solution: float only constraints that stand a jolly good chance of -being soluble simply by being floated, namely ones of form - a ~ ty -where 'a' is a currently-untouchable unification variable, but may -become touchable by being floated (perhaps by more than one level). - -We had a very complicated rule previously, but this is nice and -simple. (To see the notes, look at this Note in a version of -GHC.Tc.Solver prior to Oct 2014). - -Note [Which equalities to float] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Which equalities should we float? We want to float ones where there -is a decent chance that floating outwards will allow unification to -happen. In particular, float out equalities that are: - -* Of form (alpha ~# ty) or (ty ~# alpha), where - * alpha is a meta-tyvar. - * And 'alpha' is not a TyVarTv with 'ty' being a non-tyvar. In that - case, floating out won't help either, and it may affect grouping - of error messages. - - NB: generally we won't see (ty ~ alpha), with alpha on the right because - of Note [Unification variables on the left] in GHC.Tc.Utils.Unify, - but if we have (F tys ~ alpha) and alpha is untouchable, then it will - appear on the right. Example T4494. - -* Nominal. No point in floating (alpha ~R# ty), because we do not - unify representational equalities even if alpha is touchable. - See Note [Do not unify representational equalities] in GHC.Tc.Solver.Interact. - -Note [Skolem escape] -~~~~~~~~~~~~~~~~~~~~ -You might worry about skolem escape with all this floating. -For example, consider - [2] forall a. (a ~ F beta[2] delta, - Maybe beta[2] ~ gamma[1]) - -The (Maybe beta ~ gamma) doesn't mention 'a', so we float it, and -solve with gamma := beta. But what if later delta:=Int, and - F b Int = b. -Then we'd get a ~ beta[2], and solve to get beta:=a, and now the -skolem has escaped! - -But it's ok: when we float (Maybe beta[2] ~ gamma[1]), we promote beta[2] -to beta[1], and that means the (a ~ beta[1]) will be stuck, as it should be. - -Note [What prevents a constraint from floating] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -What /prevents/ a constraint from floating? If it mentions one of the -"bound variables of the implication". What are they? - -The "bound variables of the implication" are - - 1. The skolem type variables `ic_skols` - - 2. The "given" evidence variables `ic_given`. Example: - forall a. (co :: t1 ~# t2) => [W] co2 : (a ~# b |> co) - Here 'co' is bound - - 3. The binders of all evidence bindings in `ic_binds`. Example - forall a. (d :: t1 ~ t2) - EvBinds { (co :: t1 ~# t2) = superclass-sel d } - => [W] co2 : (a ~# b |> co) - Here `co` is gotten by superclass selection from `d`, and the - wanted constraint co2 must not float. - - 4. And the evidence variable of any equality constraint (incl - Wanted ones) whose type mentions a bound variable. Example: - forall k. [W] co1 :: t1 ~# t2 |> co2 - [W] co2 :: k ~# * - Here, since `k` is bound, so is `co2` and hence so is `co1`. - -Here (1,2,3) are handled by the "seed_skols" calculation, and -(4) is done by the transCloVarSet call. - -The possible dependence on givens, and evidence bindings, is more -subtle than we'd realised at first. See #14584. - -How can (4) arise? Suppose we have (k :: *), (a :: k), and ([G} k ~ *). -Then form an equality like (a ~ Int) we might end up with - [W] co1 :: k ~ * - [W] co2 :: (a |> co1) ~ Int - - ********************************************************************************* * * * Defaulting and disambiguation * ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -4,9 +4,9 @@ module GHC.Tc.Solver.Canonical( canonicalize, - unifyDerived, + unifyDerived, unifyTest, UnifyTestResult(..), makeSuperClasses, - StopOrContinue(..), stopWith, continueWith, + StopOrContinue(..), stopWith, continueWith, andWhenContinue, solveCallStack -- For GHC.Tc.Solver ) where @@ -51,7 +51,8 @@ import GHC.Data.Bag import GHC.Utils.Monad import Control.Monad import Data.Maybe ( isJust, isNothing ) -import Data.List ( zip4 ) +import Data.List ( zip4, partition ) +import GHC.Types.Unique.Set( nonDetEltsUniqSet ) import GHC.Types.Basic import Data.Bifunctor ( bimap ) @@ -2246,10 +2247,10 @@ canEqCanLHS2 ev eq_rel swapped lhs1 ps_xi1 lhs2 ps_xi2 mco -- If we have F a ~ F (F a), we want to swap. swap_for_occurs - | MTVU_OK () <- checkTyFamEq dflags fun_tc2 fun_args2 - (mkTyConApp fun_tc1 fun_args1) - , MTVU_Occurs <- checkTyFamEq dflags fun_tc1 fun_args1 - (mkTyConApp fun_tc2 fun_args2) + | CTE_OK <- checkTyFamEq dflags fun_tc2 fun_args2 + (mkTyConApp fun_tc1 fun_args1) + , CTE_Occurs <- checkTyFamEq dflags fun_tc1 fun_args1 + (mkTyConApp fun_tc2 fun_args2) = True | otherwise @@ -2274,8 +2275,8 @@ canEqCanLHS2 ev eq_rel swapped lhs1 ps_xi1 lhs2 ps_xi2 mco -- This function handles the case where one side is a tyvar and the other is -- a type family application. Which to put on the left? --- If we can unify the variable, put it on the left, as this may be our only --- shot to unify. +-- If the tyvar is a touchable meta-tyvar, put it on the left, as this may +-- be our only shot to unify. -- Otherwise, put the function on the left, because it's generally better to -- rewrite away function calls. This makes types smaller. And it seems necessary: -- [W] F alpha ~ alpha @@ -2283,22 +2284,20 @@ canEqCanLHS2 ev eq_rel swapped lhs1 ps_xi1 lhs2 ps_xi2 mco -- [W] G alpha beta ~ Int ( where we have type instance G a a = a ) -- If we end up with a stuck alpha ~ F alpha, we won't be able to solve this. -- Test case: indexed-types/should_compile/CEqCanOccursCheck --- It would probably work to always put the variable on the left, but we think --- it would be less efficient. canEqTyVarFunEq :: CtEvidence -- :: lhs ~ (rhs |> mco) -- or (rhs |> mco) ~ lhs if swapped -> EqRel -> SwapFlag - -> TyVar -> TcType -- lhs, pretty lhs - -> TyCon -> [Xi] -> TcType -- rhs fun, rhs args, pretty rhs + -> TyVar -> TcType -- lhs (or if swapped rhs), pretty lhs + -> TyCon -> [Xi] -> TcType -- rhs (or if swapped lhs) fun and args, pretty rhs -> MCoercion -- :: kind(rhs) ~N kind(lhs) -> TcS (StopOrContinue Ct) canEqTyVarFunEq ev eq_rel swapped tv1 ps_xi1 fun_tc2 fun_args2 ps_xi2 mco - = do { tclvl <- getTcLevel - ; dflags <- getDynFlags - ; if | isTouchableMetaTyVar tclvl tv1 - , MTVU_OK _ <- checkTyVarEq dflags YesTypeFamilies tv1 (ps_xi2 `mkCastTyMCo` mco) - -> canEqCanLHSFinish ev eq_rel swapped (TyVarLHS tv1) - (ps_xi2 `mkCastTyMCo` mco) + = do { can_unify <- unifyTest ev tv1 rhs + ; dflags <- getDynFlags + ; if | case can_unify of { NoUnify -> False; _ -> True } + , CTE_OK <- checkTyVarEq dflags YesTypeFamilies tv1 rhs + -> canEqCanLHSFinish ev eq_rel swapped (TyVarLHS tv1) rhs + | otherwise -> do { new_ev <- rewriteCastedEquality ev eq_rel swapped (mkTyVarTy tv1) (mkTyConApp fun_tc2 fun_args2) @@ -2308,6 +2307,82 @@ canEqTyVarFunEq ev eq_rel swapped tv1 ps_xi1 fun_tc2 fun_args2 ps_xi2 mco (ps_xi1 `mkCastTyMCo` sym_mco) } } where sym_mco = mkTcSymMCo mco + rhs = ps_xi2 `mkCastTyMCo` mco + +data UnifyTestResult + -- See Note [Solve by unification] in GHC.Tc.Solver.Interact + -- which points out that having UnifySameLevel is just an optimisation; + -- we could manage with UnifyOuterLevel alone (suitably renamed) + = UnifySameLevel + | UnifyOuterLevel [TcTyVar] -- Promote these + TcLevel -- ..to this level + | NoUnify + +instance Outputable UnifyTestResult where + ppr UnifySameLevel = text "UnifySameLevel" + ppr (UnifyOuterLevel tvs lvl) = text "UnifyOuterLevel" <> parens (ppr lvl <+> ppr tvs) + ppr NoUnify = text "NoUnify" + +unifyTest :: CtEvidence -> TcTyVar -> TcType -> TcS UnifyTestResult +-- This is the key test for untouchability: +-- See Note [Unification preconditions] in GHC.Tc.Utils.Unify +-- and Note [Solve by unification] in GHC.Tc.Solver.Interact +unifyTest ev tv1 rhs + | not (isGiven ev) -- See Note [Do not unify Givens] + , MetaTv { mtv_tclvl = tv_lvl, mtv_info = info } <- tcTyVarDetails tv1 + , canSolveByUnification info rhs + = do { ambient_lvl <- getTcLevel + ; given_eq_lvl <- getInnermostGivenEqLevel + + ; if | tv_lvl `sameDepthAs` ambient_lvl + -> return UnifySameLevel + + | tv_lvl `deeperThanOrSame` given_eq_lvl -- No intervening given equalities + , all (does_not_escape tv_lvl) free_skols -- No skolem escapes + -> return (UnifyOuterLevel free_metas tv_lvl) + + | otherwise + -> return NoUnify } + | otherwise + = return NoUnify + where + (free_metas, free_skols) = partition isPromotableMetaTyVar $ + nonDetEltsUniqSet $ + tyCoVarsOfType rhs + + does_not_escape tv_lvl fv + | isTyVar fv = tv_lvl `deeperThanOrSame` tcTyVarLevel fv + | otherwise = True + -- Coercion variables are not an escape risk + -- If an implication binds a coercion variable, it'll have equalities, + -- so the "intervening given equalities" test above will catch it + -- Coercion holes get filled with coercions, so again no problem. + +{- Note [Do not unify Givens] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider this GADT match + data T a where + T1 :: T Int + ... + + f x = case x of + T1 -> True + ... + +So we get f :: T alpha[1] -> beta[1] + x :: T alpha[1] +and from the T1 branch we get the implication + forall[2] (alpha[1] ~ Int) => beta[1] ~ Bool + +Now, clearly we don't want to unify alpha:=Int! Yet at the moment we +process [G] alpha[1] ~ Int, we don't have any given-equalities in the +inert set, and hence there are no given equalities to make alpha untouchable. + +(NB: if it were alpha[2] ~ Int, this argument wouldn't hold. But that +almost never happens, and will never happen at all if we cure #18929.) + +Simple solution: never unify in Givens! +-} -- The RHS here is either not CanEqLHS, or it's one that we -- want to rewrite the LHS to (as per e.g. swapOverTyVars) @@ -2427,11 +2502,11 @@ canEqOK :: DynFlags -> EqRel -> CanEqLHS -> Xi -> CanEqOK canEqOK dflags eq_rel lhs rhs = ASSERT( good_rhs ) case checkTypeEq dflags YesTypeFamilies lhs rhs of - MTVU_OK () -> CanEqOK - MTVU_Bad -> CanEqNotOK OtherCIS + CTE_OK -> CanEqOK + CTE_Bad -> CanEqNotOK OtherCIS -- Violation of TyEq:F - MTVU_HoleBlocker -> CanEqNotOK (BlockedCIS holes) + CTE_HoleBlocker -> CanEqNotOK (BlockedCIS holes) where holes = coercionHolesOfType rhs -- This is the case detailed in -- Note [Equalities with incompatible kinds] @@ -2440,7 +2515,7 @@ canEqOK dflags eq_rel lhs rhs -- These are both a violation of TyEq:OC, but we -- want to differentiate for better production of -- error messages - MTVU_Occurs | TyVarLHS tv <- lhs + CTE_Occurs | TyVarLHS tv <- lhs , isInsolubleOccursCheck eq_rel tv rhs -> CanEqNotOK InsolubleCIS -- If we have a ~ [a], it is not canonical, and in particular -- we don't want to rewrite existing inerts with it, otherwise ===================================== compiler/GHC/Tc/Solver/Interact.hs ===================================== @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP, MultiWayIf #-} {-# OPTIONS_GHC -Wno-incomplete-record-updates #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} @@ -14,7 +14,6 @@ import GHC.Prelude import GHC.Types.Basic ( SwapFlag(..), infinity, IntWithInf, intGtLimit ) import GHC.Tc.Solver.Canonical -import GHC.Tc.Utils.Unify( canSolveByUnification ) import GHC.Types.Var.Set import GHC.Core.Type as Type import GHC.Core.InstEnv ( DFunInstType ) @@ -39,6 +38,7 @@ import GHC.Tc.Types import GHC.Tc.Types.Constraint import GHC.Core.Predicate import GHC.Tc.Types.Origin +import GHC.Tc.Utils.TcMType( promoteMetaTyVarTo ) import GHC.Tc.Solver.Monad import GHC.Data.Bag import GHC.Utils.Monad ( concatMapM, foldlM ) @@ -106,8 +106,6 @@ solveSimpleGivens givens go new_givens } solveSimpleWanteds :: Cts -> TcS WantedConstraints --- NB: 'simples' may contain /derived/ equalities, floated --- out from a nested implication. So don't discard deriveds! -- The result is not necessarily zonked solveSimpleWanteds simples = do { traceTcS "solveSimpleWanteds {" (ppr simples) @@ -430,12 +428,11 @@ interactWithInertsStage :: WorkItem -> TcS (StopOrContinue Ct) interactWithInertsStage wi = do { inerts <- getTcSInerts - ; lvl <- getTcLevel ; let ics = inert_cans inerts ; case wi of - CEqCan {} -> interactEq lvl ics wi - CIrredCan {} -> interactIrred ics wi - CDictCan {} -> interactDict ics wi + CEqCan {} -> interactEq ics wi + CIrredCan {} -> interactIrred ics wi + CDictCan {} -> interactDict ics wi _ -> pprPanic "interactWithInerts" (ppr wi) } -- CNonCanonical have been canonicalised @@ -734,25 +731,26 @@ Example of (b): assume a top-level class and instance declaration: Assume we have started with an implication: - forall c. Eq c => { wc_simple = D [c] c [W] } + forall c. Eq c => { wc_simple = [W] D [c] c } -which we have simplified to: +which we have simplified to, with a Derived constraing coming from +D's functional dependency: - forall c. Eq c => { wc_simple = D [c] c [W] - (c ~ [c]) [D] } + forall c. Eq c => { wc_simple = [W] D [c] c [W] + [D] (c ~ [c]) } -For some reason, e.g. because we floated an equality somewhere else, -we might try to re-solve this implication. If we do not do a -dropDerivedWC, then we will end up trying to solve the following -constraints the second time: +When iterating the solver, we might try to re-solve this +implication. If we do not do a dropDerivedWC, then we will end up +trying to solve the following constraints the second time: - (D [c] c) [W] - (c ~ [c]) [D] + [W] (D [c] c) + [D] (c ~ [c]) which will result in two Deriveds to end up in the insoluble set: - wc_simple = D [c] c [W] - (c ~ [c]) [D], (c ~ [c]) [D] + wc_simple = [W] D [c] c + [D] (c ~ [c]) + [D] (c ~ [c]) -} {- @@ -1439,8 +1437,8 @@ inertsCanDischarge inerts lhs rhs fr | otherwise = False -- Work item is fully discharged -interactEq :: TcLevel -> InertCans -> Ct -> TcS (StopOrContinue Ct) -interactEq tclvl inerts workItem@(CEqCan { cc_lhs = lhs +interactEq :: InertCans -> Ct -> TcS (StopOrContinue Ct) +interactEq inerts workItem@(CEqCan { cc_lhs = lhs , cc_rhs = rhs , cc_ev = ev , cc_eq_rel = eq_rel }) @@ -1465,24 +1463,43 @@ interactEq tclvl inerts workItem@(CEqCan { cc_lhs = lhs = do { traceTcS "Not unifying representational equality" (ppr workItem) ; continueWith workItem } - -- try improvement, if possible - | TyFamLHS fam_tc fam_args <- lhs - , isImprovable ev - = do { improveLocalFunEqs ev inerts fam_tc fam_args rhs - ; continueWith workItem } - - | TyVarLHS tv <- lhs - , canSolveByUnification tclvl tv rhs - = do { solveByUnification ev tv rhs - ; n_kicked <- kickOutAfterUnification tv - ; return (Stop ev (text "Solved by unification" <+> pprKicked n_kicked)) } - | otherwise - = continueWith workItem - -interactEq _ _ wi = pprPanic "interactEq" (ppr wi) - -solveByUnification :: CtEvidence -> TcTyVar -> Xi -> TcS () + = case lhs of + TyVarLHS tv -> tryToSolveByUnification workItem ev tv rhs + + TyFamLHS tc args -> do { when (isImprovable ev) $ + -- Try improvement, if possible + improveLocalFunEqs ev inerts tc args rhs + ; continueWith workItem } + +interactEq _ wi = pprPanic "interactEq" (ppr wi) + +---------------------- +-- We have a meta-tyvar on the left, and metaTyVarUpateOK has said "yes" +-- So try to solve by unifying. +-- Three reasons why not: +-- Skolem escape +-- Given equalities (GADTs) +-- Unifying a TyVarTv with a non-tyvar type +tryToSolveByUnification :: Ct -> CtEvidence + -> TcTyVar -- LHS tyvar + -> TcType -- RHS + -> TcS (StopOrContinue Ct) +tryToSolveByUnification work_item ev tv rhs + = do { can_unify <- unifyTest ev tv rhs + ; traceTcS "tryToSolveByUnification" (vcat [ ppr tv <+> char '~' <+> ppr rhs + , ppr can_unify ]) + + ; case can_unify of + NoUnify -> continueWith work_item + -- For the latter two cases see Note [Solve by unification] + UnifySameLevel -> solveByUnification ev tv rhs + UnifyOuterLevel free_metas tv_lvl + -> do { wrapTcS $ mapM_ (promoteMetaTyVarTo tv_lvl) free_metas + ; setUnificationFlag tv_lvl + ; solveByUnification ev tv rhs } } + +solveByUnification :: CtEvidence -> TcTyVar -> Xi -> TcS (StopOrContinue Ct) -- Solve with the identity coercion -- Precondition: kind(xi) equals kind(tv) -- Precondition: CtEvidence is Wanted or Derived @@ -1504,9 +1521,10 @@ solveByUnification wd tv xi text "Coercion:" <+> pprEq tv_ty xi, text "Left Kind is:" <+> ppr (tcTypeKind tv_ty), text "Right Kind is:" <+> ppr (tcTypeKind xi) ] - ; unifyTyVar tv xi - ; setEvBindIfWanted wd (evCoercion (mkTcNomReflCo xi)) } + ; setEvBindIfWanted wd (evCoercion (mkTcNomReflCo xi)) + ; n_kicked <- kickOutAfterUnification tv + ; return (Stop wd (text "Solved by unification" <+> pprKicked n_kicked)) } {- Note [Avoid double unifications] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1542,6 +1560,34 @@ and we want to get alpha := N b. See also #15144, which was caused by unifying a representational equality. +Note [Solve by unification] +~~~~~~~~~~~~~~~~~~~~~~~~~~~ +If we solve + alpha[n] ~ ty +by unification, there are two cases to consider + +* UnifySameLevel: if the ambient level is 'n', then + we can simply update alpha := ty, and do nothing else + +* UnifyOuterLevel free_metas n: if the ambient level is greater than + 'n' (the level of alpha), in addition to setting alpha := ty we must + do two other things: + + 1. Promote all the free meta-vars of 'ty' to level n. After all, + alpha[n] is at level n, and so if we set, say, + alpha[n] := Maybe beta[m], + we must ensure that when unifying beta we do skolem-escape checks + etc relevent to level n. Simple way to do that: promote beta to + level n. + + 2. Set the Unification Level Flag to record that a level-n unification has + taken place. See Note [The Unification Level Flag] in GHC.Tc.Solver.Monad + +NB: UnifySameLevel is just an optimisation for UnifyOuterLevel. Promotion +would be a no-op, and setting the unification flag unnecessarily would just +make the solver iterate more often. (We don't need to iterate when unifying +at the ambient level becuase of the kick-out mechanism.) + ************************************************************************ * * ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -17,7 +17,7 @@ module GHC.Tc.Solver.Monad ( -- The TcS monad TcS, runTcS, runTcSDeriveds, runTcSWithEvBinds, runTcSInerts, - failTcS, warnTcS, addErrTcS, + failTcS, warnTcS, addErrTcS, wrapTcS, runTcSEqualities, nestTcS, nestImplicTcS, setEvBindsTcS, emitImplicationTcS, emitTvImplicationTcS, @@ -31,6 +31,7 @@ module GHC.Tc.Solver.Monad ( panicTcS, traceTcS, traceFireTcS, bumpStepCountTcS, csTraceTcS, wrapErrTcS, wrapWarnTcS, + resetUnificationFlag, setUnificationFlag, -- Evidence creation and transformation MaybeNew(..), freshGoals, isFresh, getEvExpr, @@ -60,7 +61,7 @@ module GHC.Tc.Solver.Monad ( updInertTcS, updInertCans, updInertDicts, updInertIrreds, getHasGivenEqs, setInertCans, getInertEqs, getInertCans, getInertGivens, - getInertInsols, + getInertInsols, getInnermostGivenEqLevel, getTcSInerts, setTcSInerts, matchableGivens, prohibitedSuperClassSolve, mightMatchLater, getUnsolvedInerts, @@ -186,7 +187,6 @@ import Control.Monad import GHC.Utils.Monad import Data.IORef import Data.List ( partition, mapAccumL ) -import qualified Data.Semigroup as S import Data.List.NonEmpty ( NonEmpty(..), cons, toList, nonEmpty ) import qualified Data.List.NonEmpty as NE import Control.Arrow ( first ) @@ -418,12 +418,14 @@ instance Outputable InertSet where emptyInertCans :: InertCans emptyInertCans - = IC { inert_eqs = emptyDVarEnv - , inert_dicts = emptyDicts - , inert_safehask = emptyDicts - , inert_funeqs = emptyFunEqs - , inert_insts = [] - , inert_irreds = emptyCts } + = IC { inert_eqs = emptyDVarEnv + , inert_given_eq_lvl = topTcLevel + , inert_given_eqs = False + , inert_dicts = emptyDicts + , inert_safehask = emptyDicts + , inert_funeqs = emptyFunEqs + , inert_insts = [] + , inert_irreds = emptyCts } emptyInert :: InertSet emptyInert @@ -697,6 +699,19 @@ data InertCans -- See Note [Detailed InertCans Invariants] for more -- Irreducible predicates that cannot be made canonical, -- and which don't interact with others (e.g. (c a)) -- and insoluble predicates (e.g. Int ~ Bool, or a ~ [a]) + + , inert_given_eq_lvl :: TcLevel + -- The TcLevel of the innermost implication that has a Given + -- equality of the sort that make a unification variable untouchable + -- (see Note [Unification preconditions] in GHC.Tc.Utils.Unify). + -- See Note [Tracking Given equalities] below + + , inert_given_eqs :: Bool + -- True <=> The inert Givens *at this level* (tcl_tclvl) + -- could includes at least one equality /other than/ a + -- let-bound skolem equality. + -- Reason: report these givens when reporting a failed equality + -- See Note [Tracking Given equalities] } type InertEqs = DTyVarEnv EqualCtList @@ -730,7 +745,126 @@ listToEqualCtList :: [Ct] -> Maybe EqualCtList -- non-empty listToEqualCtList cts = EqualCtList <$> nonEmpty cts -{- Note [Detailed InertCans Invariants] +{- Note [Tracking Given equalities] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +For reasons described in (UNTOUCHABLE) in GHC.Tc.Utils.Unify +Note [Unification preconditions], we can't unify + alpha[2] ~ Int +under a level-4 implication if there are any Given equalities +bound by the implications at level 3 of 4. To that end, the +InertCans tracks + + inert_given_eq_lvl :: TcLevel + -- The TcLevel of the innermost implication that has a Given + -- equality of the sort that make a unification variable untouchable + -- (see Note [Unification preconditions] in GHC.Tc.Utils.Unify). + +We update inert_given_eq_lvl whenever we add a Given to the +inert set, in updateGivenEqs. + +Then a unification variable alpha[n] is untouchable iff + n < inert_given_eq_lvl +that is, if the unification variable was born outside an +enclosing Given equality. + +Exactly which constraints should trigger (UNTOUCHABLE), and hence +should update inert_given_eq_lvl? + +* We do /not/ need to worry about let-bound skolems, such ast + forall[2] a. a ~ [b] => blah + See Note [Let-bound skolems] + +* Consider an implication + forall[2]. beta[1] => alpha[1] ~ Int + where beta is a unification variable that has already been unified + to () in an outer scope. Then alpha[1] is perfectly touchable and + we can unify alpha := Int. So when deciding whether the givens contain + an equality, we should canonicalise first, rather than just looking at + the /original/ givens (#8644). + + * However, we must take account of *potential* equalities. Consider the + same example again, but this time we have /not/ yet unified beta: + forall[2] beta[1] => ...blah... + + Because beta might turn into an equality, updateGivenEqs conservatively + treats it as a potential equality, and updates inert_give_eq_lvl + + * What about something like forall[2] a b. a ~ F b => [W] alpha[1] ~ X y z? + + That Given cannot affect the Wanted, because the Given is entirely + *local*: it mentions only skolems bound in the very same + implication. Such equalities need not make alpha untouchable. (Test + case typecheck/should_compile/LocalGivenEqs has a real-life + motivating example, with some detailed commentary.) + Hence the 'mentionsOuterVar' test in updateGivenEqs. + + However, solely to support better error messages + (see Note [HasGivenEqs] in GHC.Tc.Types.Constraint) we also track + these "local" equalities in the boolean inert_given_eqs field. + This field is used only to set the ic_given_eqs field to LocalGivenEqs; + see the function getHasGivenEqs. + + Here is a simpler case that triggers this behaviour: + + data T where + MkT :: F a ~ G b => a -> b -> T + + f (MkT _ _) = True + + Because of this behaviour around local equality givens, we can infer the + type of f. This is typecheck/should_compile/LocalGivenEqs2. + + * We need not look at the equality relation involved (nominal vs + representational), because representational equalities can still + imply nominal ones. For example, if (G a ~R G b) and G's argument's + role is nominal, then we can deduce a ~N b. + +Note [Let-bound skolems] +~~~~~~~~~~~~~~~~~~~~~~~~ +If * the inert set contains a canonical Given CEqCan (a ~ ty) +and * 'a' is a skolem bound in this very implication, + +then: +a) The Given is pretty much a let-binding, like + f :: (a ~ b->c) => a -> a + Here the equality constraint is like saying + let a = b->c in ... + It is not adding any new, local equality information, + and hence can be ignored by has_given_eqs + +b) 'a' will have been completely substituted out in the inert set, + so we can safely discard it. + +For an example, see #9211. + +See also GHC.Tc.Utils.Unify Note [Deeper level on the left] for how we ensure +that the right variable is on the left of the equality when both are +tyvars. + +You might wonder whether the skolem really needs to be bound "in the +very same implication" as the equuality constraint. +Consider this (c.f. #15009): + + data S a where + MkS :: (a ~ Int) => S a + + g :: forall a. S a -> a -> blah + g x y = let h = \z. ( z :: Int + , case x of + MkS -> [y,z]) + in ... + +From the type signature for `g`, we get `y::a` . Then when we +encounter the `\z`, we'll assign `z :: alpha[1]`, say. Next, from the +body of the lambda we'll get + + [W] alpha[1] ~ Int -- From z::Int + [W] forall[2]. (a ~ Int) => [W] alpha[1] ~ a -- From [y,z] + +Now, unify alpha := a. Now we are stuck with an unsolved alpha~Int! +So we must treat alpha as untouchable under the forall[2] implication. + +Note [Detailed InertCans Invariants] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The InertCans represents a collection of constraints with the following properties: @@ -1027,6 +1161,8 @@ instance Outputable InertCans where ppr (IC { inert_eqs = eqs , inert_funeqs = funeqs, inert_dicts = dicts , inert_safehask = safehask, inert_irreds = irreds + , inert_given_eq_lvl = ge_lvl + , inert_given_eqs = given_eqs , inert_insts = insts }) = braces $ vcat @@ -1043,6 +1179,8 @@ instance Outputable InertCans where text "Irreds =" <+> pprCts irreds , ppUnless (null insts) $ text "Given instances =" <+> vcat (map ppr insts) + , text "Innermost given equalities =" <+> ppr ge_lvl + , text "Given eqs at this level =" <+> ppr given_eqs ] where folder (EqualCtList eqs) rest = nonEmptyToBag eqs `andCts` rest @@ -1456,20 +1594,32 @@ findEq icans (TyFamLHS fun_tc fun_args) addInertForAll :: QCInst -> TcS () -- Add a local Given instance, typically arising from a type signature addInertForAll new_qci - = do { ics <- getInertCans - ; insts' <- add_qci (inert_insts ics) - ; setInertCans (ics { inert_insts = insts' }) } + = do { ics <- getInertCans + ; ics1 <- add_qci ics + + -- Update given equalities. C.f updateGivenEqs + ; tclvl <- getTcLevel + ; let pred = qci_pred new_qci + not_equality = isClassPred pred && not (isEqPred pred) + -- True <=> definitely not an equality + -- A qci_pred like (f a) might be an equality + + ics2 | not_equality = ics1 + | otherwise = ics1 { inert_given_eq_lvl = tclvl + , inert_given_eqs = True } + + ; setInertCans ics2 } where - add_qci :: [QCInst] -> TcS [QCInst] + add_qci :: InertCans -> TcS InertCans -- See Note [Do not add duplicate quantified instances] - add_qci qcis + add_qci ics@(IC { inert_insts = qcis }) | any same_qci qcis = do { traceTcS "skipping duplicate quantified instance" (ppr new_qci) - ; return qcis } + ; return ics } | otherwise = do { traceTcS "adding new inert quantified instance" (ppr new_qci) - ; return (new_qci : qcis) } + ; return (ics { inert_insts = new_qci : qcis }) } same_qci old_qci = tcEqType (ctEvPred (qci_ev old_qci)) (ctEvPred (qci_ev new_qci)) @@ -1523,7 +1673,8 @@ addInertCan ct ; ics <- getInertCans ; ct <- maybeEmitShadow ics ct ; ics <- maybeKickOut ics ct - ; setInertCans (add_item ics ct) + ; tclvl <- getTcLevel + ; setInertCans (add_item tclvl ics ct) ; traceTcS "addInertCan }" $ empty } @@ -1536,23 +1687,54 @@ maybeKickOut ics ct | otherwise = return ics -add_item :: InertCans -> Ct -> InertCans -add_item ics item@(CEqCan { cc_lhs = TyFamLHS tc tys }) - = ics { inert_funeqs = addCanFunEq (inert_funeqs ics) tc tys item } - -add_item ics item@(CEqCan { cc_lhs = TyVarLHS tv }) - = ics { inert_eqs = addTyEq (inert_eqs ics) tv item } - -add_item ics@(IC { inert_irreds = irreds }) item@(CIrredCan {}) - = ics { inert_irreds = irreds `Bag.snocBag` item } - -add_item ics item@(CDictCan { cc_class = cls, cc_tyargs = tys }) +add_item :: TcLevel -> InertCans -> Ct -> InertCans +add_item tc_lvl + ics@(IC { inert_funeqs = funeqs, inert_eqs = eqs }) + item@(CEqCan { cc_lhs = lhs }) + = updateGivenEqs tc_lvl item $ + case lhs of + TyFamLHS tc tys -> ics { inert_funeqs = addCanFunEq funeqs tc tys item } + TyVarLHS tv -> ics { inert_eqs = addTyEq eqs tv item } + +add_item tc_lvl ics@(IC { inert_irreds = irreds }) item@(CIrredCan {}) + = updateGivenEqs tc_lvl item $ -- An Irred might turn out to be an + -- equality, so we play safe + ics { inert_irreds = irreds `Bag.snocBag` item } + +add_item _ ics item@(CDictCan { cc_class = cls, cc_tyargs = tys }) = ics { inert_dicts = addDict (inert_dicts ics) cls tys item } -add_item _ item +add_item _ _ item = pprPanic "upd_inert set: can't happen! Inserting " $ ppr item -- Can't be CNonCanonical because they only land in inert_irreds +updateGivenEqs :: TcLevel -> Ct -> InertCans -> InertCans +-- Set the inert_given_eq_level to the current level (tclvl) +-- if the constraint is a given equality that should prevent +-- filling in an outer unification variable. +-- See See Note [Tracking Given equalities] +updateGivenEqs tclvl ct inerts@(IC { inert_given_eq_lvl = ge_lvl }) + | not (isGivenCt ct) = inerts + | not_equality ct = inerts -- See Note [Let-bound skolems] + | otherwise = inerts { inert_given_eq_lvl = ge_lvl' + , inert_given_eqs = True } + where + ge_lvl' | mentionsOuterVar tclvl (ctEvidence ct) + -- Includes things like (c a), which *might* be an equality + = tclvl + | otherwise + = ge_lvl + + not_equality :: Ct -> Bool + -- True <=> definitely not an equality of any kind + -- except for a let-bound skolem, which doesn't count + -- See Note [Let-bound skolems] + -- NB: no need to spot the boxed CDictCan (a ~ b) because its + -- superclass (a ~# b) will be a CEqCan + not_equality (CEqCan { cc_lhs = TyVarLHS tv }) = not (isOuterTyVar tclvl tv) + not_equality (CDictCan {}) = True + not_equality _ = False + ----------------------------------------- kickOutRewritable :: CtFlavourRole -- Flavour/role of the equality that -- is being added to the inert set @@ -1596,7 +1778,6 @@ kick_out_rewritable :: CtFlavourRole -- Flavour/role of the equality that kick_out_rewritable new_fr new_lhs ics@(IC { inert_eqs = tv_eqs , inert_dicts = dictmap - , inert_safehask = safehask , inert_funeqs = funeqmap , inert_irreds = irreds , inert_insts = old_insts }) @@ -1610,12 +1791,12 @@ kick_out_rewritable new_fr new_lhs | otherwise = (kicked_out, inert_cans_in) where - inert_cans_in = IC { inert_eqs = tv_eqs_in - , inert_dicts = dicts_in - , inert_safehask = safehask -- ?? - , inert_funeqs = feqs_in - , inert_irreds = irs_in - , inert_insts = insts_in } + -- inert_safehask stays unchanged; is that right? + inert_cans_in = ics { inert_eqs = tv_eqs_in + , inert_dicts = dicts_in + , inert_funeqs = feqs_in + , inert_irreds = irs_in + , inert_insts = insts_in } kicked_out :: WorkList -- NB: use extendWorkList to ensure that kicked-out equalities get priority @@ -1968,6 +2149,10 @@ updInertIrreds upd_fn getInertEqs :: TcS (DTyVarEnv EqualCtList) getInertEqs = do { inert <- getInertCans; return (inert_eqs inert) } +getInnermostGivenEqLevel :: TcS TcLevel +getInnermostGivenEqLevel = do { inert <- getInertCans + ; return (inert_given_eq_lvl inert) } + getInertInsols :: TcS Cts -- Returns insoluble equality constraints -- specifically including Givens @@ -2077,63 +2262,46 @@ getUnsolvedInerts getHasGivenEqs :: TcLevel -- TcLevel of this implication -> TcS ( HasGivenEqs -- are there Given equalities? , Cts ) -- Insoluble equalities arising from givens --- See Note [When does an implication have given equalities?] +-- See Note [Tracking Given equalities] getHasGivenEqs tclvl - = do { inerts@(IC { inert_eqs = ieqs, inert_funeqs = funeqs, inert_irreds = irreds }) + = do { inerts@(IC { inert_irreds = irreds + , inert_given_eqs = given_eqs + , inert_given_eq_lvl = ge_lvl }) <- getInertCans - ; let has_given_eqs = foldMap check_local_given_ct irreds - S.<> foldMap (lift_equal_ct_list check_local_given_tv_eq) ieqs - S.<> foldMapFunEqs (lift_equal_ct_list check_local_given_ct) funeqs - insols = filterBag insolubleEqCt irreds + ; let insols = filterBag insolubleEqCt irreds -- Specifically includes ones that originated in some -- outer context but were refined to an insoluble by -- a local equality; so do /not/ add ct_given_here. + -- See Note [HasGivenEqs] in GHC.Tc.Types.Constraint, and + -- Note [Tracking Given equalities] in this module + has_ge | ge_lvl == tclvl = MaybeGivenEqs + | given_eqs = LocalGivenEqs + | otherwise = NoGivenEqs + ; traceTcS "getHasGivenEqs" $ - vcat [ text "has_given_eqs:" <+> ppr has_given_eqs + vcat [ text "given_eqs:" <+> ppr given_eqs + , text "ge_lvl:" <+> ppr ge_lvl + , text "ambient level:" <+> ppr tclvl , text "Inerts:" <+> ppr inerts , text "Insols:" <+> ppr insols] - ; return (has_given_eqs, insols) } - where - check_local_given_ct :: Ct -> HasGivenEqs - check_local_given_ct ct - | given_here ev = if mentions_outer_var ev then MaybeGivenEqs else LocalGivenEqs - | otherwise = NoGivenEqs - where - ev = ctEvidence ct - - lift_equal_ct_list :: (Ct -> HasGivenEqs) -> EqualCtList -> HasGivenEqs - -- returns NoGivenEqs for non-singleton lists, as Given lists are always - -- singletons - lift_equal_ct_list check (EqualCtList (ct :| [])) = check ct - lift_equal_ct_list _ _ = NoGivenEqs - - check_local_given_tv_eq :: Ct -> HasGivenEqs - check_local_given_tv_eq (CEqCan { cc_lhs = TyVarLHS tv, cc_ev = ev}) - | given_here ev - = if is_outer_var tv then MaybeGivenEqs else NoGivenEqs - -- See Note [Let-bound skolems] - | otherwise - = NoGivenEqs - check_local_given_tv_eq other_ct = check_local_given_ct other_ct - - given_here :: CtEvidence -> Bool - -- True for a Given bound by the current implication, - -- i.e. the current level - given_here ev = isGiven ev - && tclvl == ctLocLevel (ctEvLoc ev) - - mentions_outer_var :: CtEvidence -> Bool - mentions_outer_var = anyFreeVarsOfType is_outer_var . ctEvPred - - is_outer_var :: TyCoVar -> Bool - is_outer_var tv - -- NB: a meta-tv alpha[3] may end up unifying with skolem b[2], - -- so treat it as an "outer" var, even at level 3. - -- This will become redundant after fixing #18929. - | isTyVar tv = isTouchableMetaTyVar tclvl tv || - tclvl `strictlyDeeperThan` tcTyVarLevel tv - | otherwise = False + ; return (has_ge, insols) } + +mentionsOuterVar :: TcLevel -> CtEvidence -> Bool +mentionsOuterVar tclvl ev + = anyFreeVarsOfType (isOuterTyVar tclvl) $ + ctEvPred ev + +isOuterTyVar :: TcLevel -> TyCoVar -> Bool +-- True of a type variable that comes from a +-- shallower level than the ambient level (tclvl) +isOuterTyVar tclvl tv + | isTyVar tv = tclvl `strictlyDeeperThan` tcTyVarLevel tv + || isPromotableMetaTyVar tv + -- isPromotable: a meta-tv alpha[3] may end up unifying with skolem b[2], + -- so treat it as an "outer" var, even at level 3. + -- This will become redundant after fixing #18929. + | otherwise = False -- Coercion variables; doesn't much matter -- | Returns Given constraints that might, -- potentially, match the given pred. This is used when checking to see if a @@ -2267,112 +2435,6 @@ Examples: This treatment fixes #18910 and is tested in typecheck/should_compile/InstanceGivenOverlap{,2} -Note [When does an implication have given equalities?] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider an implication - beta => alpha ~ Int -where beta is a unification variable that has already been unified -to () in an outer scope. Then we can float the (alpha ~ Int) out -just fine. So when deciding whether the givens contain an equality, -we should canonicalise first, rather than just looking at the original -givens (#8644). - -So we simply look at the inert, canonical Givens and see if there are -any equalities among them, the calculation of has_given_eqs. There -are some wrinkles: - - * We must know which ones are bound in *this* implication and which - are bound further out. We can find that out from the TcLevel - of the Given, which is itself recorded in the tcl_tclvl field - of the TcLclEnv stored in the Given (ev_given_here). - - What about interactions between inner and outer givens? - - Outer given is rewritten by an inner given, then there must - have been an inner given equality, hence the “given-eq” flag - will be true anyway. - - - Inner given rewritten by outer, retains its level (ie. The inner one) - - * We must take account of *potential* equalities, like the one above: - beta => ...blah... - If we still don't know what beta is, we conservatively treat it as potentially - becoming an equality. Hence including 'irreds' in the calculation or has_given_eqs. - Note that we can't really know what's in an irred, so any irred is considered - a potential equality. - - * What about something like forall a b. a ~ F b => [W] c ~ X y z? That Given - cannot affect the Wanted, because the Given is entirely *local*: it mentions - only skolems bound in the very same implication. Such equalities need not - prevent floating. (Test case typecheck/should_compile/LocalGivenEqs has a - real-life motivating example, with some detailed commentary.) These - equalities are noted with LocalGivenEqs: they do not prevent floating, but - they also are allowed to show up in error messages. See - Note [Suppress redundant givens during error reporting] in GHC.Tc.Errors. - The difference between what stops floating and what is suppressed from - error messages is why we need three options for HasGivenEqs. - - There is also a simpler case that triggers this behaviour: - - data T where - MkT :: F a ~ G b => a -> b -> T - - f (MkT _ _) = True - - Because of this behaviour around local equality givens, we can infer the - type of f. This is typecheck/should_compile/LocalGivenEqs2. - - * See Note [Let-bound skolems] for another wrinkle - - * We need not look at the equality relation involved (nominal vs representational), - because representational equalities can still imply nominal ones. For example, - if (G a ~R G b) and G's argument's role is nominal, then we can deduce a ~N b. - -Note [Let-bound skolems] -~~~~~~~~~~~~~~~~~~~~~~~~ -If * the inert set contains a canonical Given CEqCan (a ~ ty) -and * 'a' is a skolem bound in this very implication, - -then: -a) The Given is pretty much a let-binding, like - f :: (a ~ b->c) => a -> a - Here the equality constraint is like saying - let a = b->c in ... - It is not adding any new, local equality information, - and hence can be ignored by has_given_eqs - -b) 'a' will have been completely substituted out in the inert set, - so we can safely discard it. - -For an example, see #9211. - -See also GHC.Tc.Utils.Unify Note [Deeper level on the left] for how we ensure -that the right variable is on the left of the equality when both are -tyvars. - -You might wonder whether the skokem really needs to be bound "in the -very same implication" as the equuality constraint. -(c.f. #15009) Consider this: - - data S a where - MkS :: (a ~ Int) => S a - - g :: forall a. S a -> a -> blah - g x y = let h = \z. ( z :: Int - , case x of - MkS -> [y,z]) - in ... - -From the type signature for `g`, we get `y::a` . Then when we -encounter the `\z`, we'll assign `z :: alpha[1]`, say. Next, from the -body of the lambda we'll get - - [W] alpha[1] ~ Int -- From z::Int - [W] forall[2]. (a ~ Int) => [W] alpha[1] ~ a -- From [y,z] - -Now, suppose we decide to float `alpha ~ a` out of the implication -and then unify `alpha := a`. Now we are stuck! But if treat -`alpha ~ Int` first, and unify `alpha := Int`, all is fine. -But we absolutely cannot float that equality or we will get stuck. -} removeInertCts :: [Ct] -> InertCans -> InertCans @@ -2552,9 +2614,6 @@ tcAppMapToBag m = foldTcAppMap consBag m emptyBag foldTcAppMap :: (a -> b -> b) -> TcAppMap a -> b -> b foldTcAppMap k m z = foldDTyConEnv (foldTM k) z m -foldMapTcAppMap :: Monoid m => (a -> m) -> TcAppMap a -> m -foldMapTcAppMap f = foldMap (foldMap f) - {- ********************************************************************* * * @@ -2688,9 +2747,6 @@ findFunEqsByTyCon m tc foldFunEqs :: (a -> b -> b) -> FunEqMap a -> b -> b foldFunEqs = foldTcAppMap -foldMapFunEqs :: Monoid m => (a -> m) -> FunEqMap a -> m -foldMapFunEqs = foldMapTcAppMap - insertFunEq :: FunEqMap a -> TyCon -> [Type] -> a -> FunEqMap a insertFunEq m tc tys val = insertTcApp m tc tys val @@ -2723,6 +2779,12 @@ data TcSEnv -- The number of unification variables we have filled -- The important thing is whether it is non-zero + tcs_unif_lvl :: IORef (Maybe TcLevel), + -- The Unification Level Flag + -- Outermost level at which we have unified a meta tyvar + -- Starts at Nothing, then (Just i), then (Just j) where j do { inerts <- TcM.readTcRef old_inert_var - ; let nest_inert = inerts { inert_cycle_breakers = [] } - -- all other InertSet fields are inherited + ; let nest_inert = inerts { inert_cycle_breakers = [] + , inert_cans = (inert_cans inerts) + { inert_given_eqs = False } } + -- All other InertSet fields are inherited ; new_inert_var <- TcM.newTcRef nest_inert ; new_wl_var <- TcM.newTcRef emptyWorkList - ; let nest_env = TcSEnv { tcs_ev_binds = ref + ; let nest_env = TcSEnv { tcs_count = count -- Inherited + , tcs_unif_lvl = unif_lvl -- Inherited + , tcs_ev_binds = ref , tcs_unified = unified_var - , tcs_count = count , tcs_inerts = new_inert_var , tcs_worklist = new_wl_var } ; res <- TcM.setTcLevel inner_tclvl $ @@ -3260,6 +3328,97 @@ pprKicked :: Int -> SDoc pprKicked 0 = empty pprKicked n = parens (int n <+> text "kicked out") +{- ********************************************************************* +* * +* The Unification Level Flag * +* * +********************************************************************* -} + +{- Note [The Unification Level Flag] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider a deep tree of implication constraints + forall[1] a. -- Outer-implic + C alpha[1] -- Simple + forall[2] c. ....(C alpha[1]).... -- Implic-1 + forall[2] b. ....(alpha[1] ~ Int).... -- Implic-2 + +The (C alpha) is insoluble until we know alpha. We solve alpha +by unifying alpha:=Int somewhere deep inside Implic-2. But then we +must try to solve the Outer-implic all over again. This time we can +solve (C alpha) both in Outer-implic, and nested inside Implic-1. + +When should we iterate solving a level-n implication? +Answer: if any unification of a tyvar at level n takes place + in the ic_implics of that implication. + +* What if a unification takes place at level n-1? Then don't iterate + level n, because we'll iterate level n-1, and that will in turn iterate + level n. + +* What if a unification takes place at level n, in the ic_simples of + level n? No need to track this, because the kick-out mechanism deals + with it. (We can't drop kick-out in favour of iteration, becuase kick-out + works for skolem-equalities, not just unifications.) + +So the monad-global Unification Level Flag, kept in tcs_unif_lvl keeps +track of + - Whether any unifications at all have taken place (Nothing => no unifications) + - If so, what is the outermost level that has seen a unification (Just lvl) + +The iteration done in the simplify_loop/maybe_simplify_again loop in GHC.Tc.Solver. + +It helpful not to iterate unless there is a chance of progress. #8474 is +an example: + + * There's a deeply-nested chain of implication constraints. + ?x:alpha => ?y1:beta1 => ... ?yn:betan => [W] ?x:Int + + * From the innermost one we get a [D] alpha[1] ~ Int, + so we can unify. + + * It's better not to iterate the inner implications, but go all the + way out to level 1 before iterating -- because iterating level 1 + will iterate the inner levels anyway. + +(In the olden days when we "floated" thse Derived constraints, this was +much, much more important -- we got exponential behaviour, as each iteration +produced the same Derived constraint.) +-} + + +resetUnificationFlag :: TcS Bool +-- We are at ambient level i +-- If the unification flag = Just i, reset it to Nothing and return True +-- Otherwise leave it unchanged and return False +resetUnificationFlag + = TcS $ \env -> + do { let ref = tcs_unif_lvl env + ; ambient_lvl <- TcM.getTcLevel + ; mb_lvl <- TcM.readTcRef ref + ; TcM.traceTc "resetUnificationFlag" $ + vcat [ text "ambient:" <+> ppr ambient_lvl + , text "unif_lvl:" <+> ppr mb_lvl ] + ; case mb_lvl of + Nothing -> return False + Just unif_lvl | ambient_lvl `strictlyDeeperThan` unif_lvl + -> return False + | otherwise + -> do { TcM.writeTcRef ref Nothing + ; return True } } + +setUnificationFlag :: TcLevel -> TcS () +-- (setUnificationFlag i) sets the unification level to (Just i) +-- unless it already is (Just j) where j <= i +setUnificationFlag lvl + = TcS $ \env -> + do { let ref = tcs_unif_lvl env + ; mb_lvl <- TcM.readTcRef ref + ; case mb_lvl of + Just unif_lvl | lvl `deeperThanOrSame` unif_lvl + -> return () + _ -> TcM.writeTcRef ref (Just lvl) } + + {- ********************************************************************* * * * Instantiation etc. ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -1095,7 +1095,7 @@ Yuk! data Implication = Implic { -- Invariants for a tree of implications: - -- see TcType Note [TcLevel and untouchable type variables] + -- see TcType Note [TcLevel invariants] ic_tclvl :: TcLevel, -- TcLevel of unification variables -- allocated /inside/ this implication @@ -1172,44 +1172,57 @@ data ImplicStatus | IC_Unsolved -- Neither of the above; might go either way --- | Does this implication have Given equalities? --- See Note [When does an implication have given equalities?] in GHC.Tc.Solver.Monad, --- which also explains why we need three options here. Also, see --- Note [Suppress redundant givens during error reporting] in GHC.Tc.Errors --- --- Stops floating | Suppresses Givens in errors --- ----------------------------------------------- --- NoGivenEqs NO | YES --- LocalGivenEqs NO | NO --- MaybeGivenEqs YES | NO --- --- Examples: --- --- NoGivenEqs: Eq a => ... --- (Show a, Num a) => ... --- forall a. a ~ Either Int Bool => ... --- See Note [Let-bound skolems] in GHC.Tc.Solver.Monad for --- that last one --- --- LocalGivenEqs: forall a b. F a ~ G b => ... --- forall a. F a ~ Int => ... --- --- MaybeGivenEqs: (a ~ b) => ... --- forall a. F a ~ b => ... --- --- The check is conservative. A MaybeGivenEqs might not have any equalities. --- A LocalGivenEqs might local equalities, but it definitely does not have non-local --- equalities. A NoGivenEqs definitely does not have equalities (except let-bound --- skolems). -data HasGivenEqs - = NoGivenEqs -- definitely no given equalities, - -- except by Note [Let-bound skolems] in GHC.Tc.Solver.Monad - | LocalGivenEqs -- might have Given equalities that affect only local skolems - -- e.g. forall a b. (a ~ F b) => ...; definitely no others - | MaybeGivenEqs -- might have any kind of Given equalities; no floating out - -- is possible. +data HasGivenEqs -- See Note [HasGivenEqs] + = NoGivenEqs -- Definitely no given equalities, + -- except by Note [Let-bound skolems] in GHC.Tc.Solver.Monad + | LocalGivenEqs -- Might have Given equalities, but only ones that affect only + -- local skolems e.g. forall a b. (a ~ F b) => ... + | MaybeGivenEqs -- Might have any kind of Given equalities; no floating out + -- is possible. deriving Eq +{- Note [HasGivenEqs] +~~~~~~~~~~~~~~~~~~~~~ +The GivenEqs data type describes the Given constraints of an implication constraint: + +* NoGivenEqs: definitely no Given equalities, except perhaps let-bound skolems + which don't count: see Note [Let-bound skolems] in GHC.Tc.Solver.Monad + Examples: forall a. Eq a => ... + forall a. (Show a, Num a) => ... + forall a. a ~ Either Int Bool => ... -- Let-bound skolem + +* LocalGivenEqs: definitely no Given equalities that would affect principal + types. But may have equalities that affect only skolems of this implication + (and hence do not affect princial types) + Examples: forall a. F a ~ Int => ... + forall a b. F a ~ G b => ... + +* MaybeGivenEqs: may have Given equalities that would affect principal + types + Examples: forall. (a ~ b) => ... + forall a. F a ~ b => ... + forall a. c a => ... -- The 'c' might be instantiated to (b ~) + forall a. C a b => .... + where class x~y => C a b + so there is an equality in the superclass of a Given + +The HasGivenEqs classifications affect two things: + +* Suppressing redundant givens during error reporting; see GHC.Tc.Errors + Note [Suppress redundant givens during error reporting] + +* Floating in approximateWC. + +Specifically, here's how it goes: + + Stops floating | Suppresses Givens in errors + in approximateWC | + ----------------------------------------------- + NoGivenEqs NO | YES + LocalGivenEqs NO | NO + MaybeGivenEqs YES | NO +-} + instance Outputable Implication where ppr (Implic { ic_tclvl = tclvl, ic_skols = skols , ic_given = given, ic_given_eqs = given_eqs ===================================== compiler/GHC/Tc/Utils/Env.hs ===================================== @@ -692,7 +692,8 @@ tcCheckUsage name id_mult thing_inside -- -- It works nicely in practice. (promote_mult, _, _, _) = mapTyCo mapper - mapper = TyCoMapper { tcm_tyvar = \ () tv -> do { _ <- promoteTyVar tv + mapper = TyCoMapper { tcm_tyvar = \ () tv -> do { tclvl <- getTcLevel + ; _ <- promoteMetaTyVarTo tclvl tv ; zonkTcTyVar tv } , tcm_covar = \ () cv -> return (mkCoVarCo cv) , tcm_hole = \ () h -> return (mkHoleCo h) ===================================== compiler/GHC/Tc/Utils/Monad.hs ===================================== @@ -1865,7 +1865,7 @@ It's distressingly delicate though: class constraints mentioned above. But we may /also/ end up taking constraints built at some inner level, and emitting them at some outer level, and then breaking the TcLevel invariants - See Note [TcLevel and untouchable type variables] in GHC.Tc.Utils.TcType + See Note [TcLevel invariants] in GHC.Tc.Utils.TcType So dropMisleading has a horridly ad-hoc structure. It keeps only /insoluble/ flat constraints (which are unlikely to very visibly trip ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -80,7 +80,7 @@ module GHC.Tc.Utils.TcMType ( --------------------------------- -- Promotion, defaulting, skolemisation - defaultTyVar, promoteTyVar, promoteTyVarSet, + defaultTyVar, promoteMetaTyVarTo, promoteTyVarSet, quantifyTyVars, isQuantifiableTv, skolemiseUnboundMetaTyVar, zonkAndSkolemise, skolemiseQuantifiedTyVar, @@ -964,12 +964,18 @@ writeMetaTyVarRef tyvar ref ty ; writeTcRef ref (Indirect ty) } -- Everything from here on only happens if DEBUG is on + -- Need to zonk 'ty' because we may only recently have promoted + -- its free meta-tyvars (see Solver.Interact.tryToSolveByUnification) | otherwise = do { meta_details <- readMutVar ref; -- Zonk kinds to allow the error check to work ; zonked_tv_kind <- zonkTcType tv_kind - ; zonked_ty_kind <- zonkTcType ty_kind - ; let kind_check_ok = tcIsConstraintKind zonked_tv_kind + ; zonked_ty <- zonkTcType ty + ; let zonked_ty_kind = tcTypeKind zonked_ty + zonked_ty_lvl = tcTypeLevel zonked_ty + level_check_ok = not (zonked_ty_lvl `strictlyDeeperThan` tv_lvl) + level_check_msg = ppr zonked_ty_lvl $$ ppr tv_lvl $$ ppr tyvar $$ ppr ty + kind_check_ok = tcIsConstraintKind zonked_tv_kind || tcEqKind zonked_ty_kind zonked_tv_kind -- Hack alert! tcIsConstraintKind: see GHC.Tc.Gen.HsType -- Note [Extra-constraint holes in partial type signatures] @@ -994,13 +1000,9 @@ writeMetaTyVarRef tyvar ref ty ; writeMutVar ref (Indirect ty) } where tv_kind = tyVarKind tyvar - ty_kind = tcTypeKind ty tv_lvl = tcTyVarLevel tyvar - ty_lvl = tcTypeLevel ty - level_check_ok = not (ty_lvl `strictlyDeeperThan` tv_lvl) - level_check_msg = ppr ty_lvl $$ ppr tv_lvl $$ ppr tyvar $$ ppr ty double_upd_msg details = hang (text "Double update of meta tyvar") 2 (ppr tyvar $$ ppr details) @@ -1569,8 +1571,8 @@ than the ambient level (see Note [Use level numbers of quantification]). Note [Use level numbers for quantification] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The level numbers assigned to metavariables are very useful. Not only -do they track touchability (Note [TcLevel and untouchable type variables] -in GHC.Tc.Utils.TcType), but they also allow us to determine which variables to +do they track touchability (Note [TcLevel invariants] in GHC.Tc.Utils.TcType), +but they also allow us to determine which variables to generalise. The rule is this: When generalising, quantify only metavariables with a TcLevel greater @@ -2004,29 +2006,31 @@ a \/\a in the final result but all the occurrences of a will be zonked to () * * ********************************************************************* -} -promoteTyVar :: TcTyVar -> TcM Bool +promoteMetaTyVarTo :: TcLevel -> TcTyVar -> TcM Bool -- When we float a constraint out of an implication we must restore --- invariant (WantedInv) in Note [TcLevel and untouchable type variables] in GHC.Tc.Utils.TcType +-- invariant (WantedInv) in Note [TcLevel invariants] in GHC.Tc.Utils.TcType -- Return True <=> we did some promotion -- Also returns either the original tyvar (no promotion) or the new one -- See Note [Promoting unification variables] -promoteTyVar tv - = do { tclvl <- getTcLevel - ; if (isFloatedTouchableMetaTyVar tclvl tv) - then do { cloned_tv <- cloneMetaTyVar tv - ; let rhs_tv = setMetaTyVarTcLevel cloned_tv tclvl - ; writeMetaTyVar tv (mkTyVarTy rhs_tv) - ; traceTc "promoteTyVar" (ppr tv <+> text "-->" <+> ppr rhs_tv) - ; return True } - else do { traceTc "promoteTyVar: no" (ppr tv) - ; return False } } +promoteMetaTyVarTo tclvl tv + | ASSERT2( isMetaTyVar tv, ppr tv ) + tcTyVarLevel tv `strictlyDeeperThan` tclvl + = do { cloned_tv <- cloneMetaTyVar tv + ; let rhs_tv = setMetaTyVarTcLevel cloned_tv tclvl + ; writeMetaTyVar tv (mkTyVarTy rhs_tv) + ; traceTc "promoteTyVar" (ppr tv <+> text "-->" <+> ppr rhs_tv) + ; return True } + | otherwise + = return False -- Returns whether or not *any* tyvar is defaulted promoteTyVarSet :: TcTyVarSet -> TcM Bool promoteTyVarSet tvs - = do { bools <- mapM promoteTyVar (nonDetEltsUniqSet tvs) + = do { tclvl <- getTcLevel + ; bools <- mapM (promoteMetaTyVarTo tclvl) $ + filter isPromotableMetaTyVar $ + nonDetEltsUniqSet tvs -- Non-determinism is OK because order of promotion doesn't matter - ; return (or bools) } ===================================== compiler/GHC/Tc/Utils/TcType.hs ===================================== @@ -33,7 +33,7 @@ module GHC.Tc.Utils.TcType ( -- TcLevel TcLevel(..), topTcLevel, pushTcLevel, isTopTcLevel, - strictlyDeeperThan, sameDepthAs, + strictlyDeeperThan, deeperThanOrSame, sameDepthAs, tcTypeLevel, tcTyVarLevel, maxTcLevel, promoteSkolem, promoteSkolemX, promoteSkolemsX, -------------------------------- @@ -45,8 +45,7 @@ module GHC.Tc.Utils.TcType ( isAmbiguousTyVar, isCycleBreakerTyVar, metaTyVarRef, metaTyVarInfo, isFlexi, isIndirect, isRuntimeUnkSkol, metaTyVarTcLevel, setMetaTyVarTcLevel, metaTyVarTcLevel_maybe, - isTouchableMetaTyVar, - isFloatedTouchableMetaTyVar, + isTouchableMetaTyVar, isPromotableMetaTyVar, findDupTyVarTvs, mkTyVarNamePairs, -------------------------------- @@ -516,7 +515,7 @@ data TcTyVarDetails | MetaTv { mtv_info :: MetaInfo , mtv_ref :: IORef MetaDetails - , mtv_tclvl :: TcLevel } -- See Note [TcLevel and untouchable type variables] + , mtv_tclvl :: TcLevel } -- See Note [TcLevel invariants] vanillaSkolemTv, superSkolemTv :: TcTyVarDetails -- See Note [Binding when looking up instances] in GHC.Core.InstEnv @@ -574,13 +573,14 @@ instance Outputable MetaInfo where ********************************************************************* -} newtype TcLevel = TcLevel Int deriving( Eq, Ord ) - -- See Note [TcLevel and untouchable type variables] for what this Int is + -- See Note [TcLevel invariants] for what this Int is -- See also Note [TcLevel assignment] {- -Note [TcLevel and untouchable type variables] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [TcLevel invariants] +~~~~~~~~~~~~~~~~~~~~~~~~~ * Each unification variable (MetaTv) + and skolem (SkolemTv) and each Implication has a level number (of type TcLevel) @@ -602,9 +602,8 @@ Note [TcLevel and untouchable type variables] LESS THAN OR EQUAL TO the ic_tclvl of I See Note [WantedInv] -* A unification variable is *touchable* if its level number - is EQUAL TO that of its immediate parent implication, - and it is a TauTv or TyVarTv (but /not/ CycleBreakerTv) +The level of a MetaTyVar also governs its untouchability. See +Note [Unification preconditions] in GHC.Tc.Utils.Unify. Note [WantedInv] ~~~~~~~~~~~~~~~~ @@ -679,13 +678,17 @@ strictlyDeeperThan :: TcLevel -> TcLevel -> Bool strictlyDeeperThan (TcLevel tv_tclvl) (TcLevel ctxt_tclvl) = tv_tclvl > ctxt_tclvl +deeperThanOrSame :: TcLevel -> TcLevel -> Bool +deeperThanOrSame (TcLevel tv_tclvl) (TcLevel ctxt_tclvl) + = tv_tclvl >= ctxt_tclvl + sameDepthAs :: TcLevel -> TcLevel -> Bool sameDepthAs (TcLevel ctxt_tclvl) (TcLevel tv_tclvl) = ctxt_tclvl == tv_tclvl -- NB: invariant ctxt_tclvl >= tv_tclvl -- So <= would be equivalent checkTcLevelInvariant :: TcLevel -> TcLevel -> Bool --- Checks (WantedInv) from Note [TcLevel and untouchable type variables] +-- Checks (WantedInv) from Note [TcLevel invariants] checkTcLevelInvariant (TcLevel ctxt_tclvl) (TcLevel tv_tclvl) = ctxt_tclvl >= tv_tclvl @@ -998,6 +1001,16 @@ tcIsTcTyVar :: TcTyVar -> Bool -- See Note [TcTyVars and TyVars in the typechecker] tcIsTcTyVar tv = isTyVar tv +isPromotableMetaTyVar :: TcTyVar -> Bool +-- True is this is a meta-tyvar that can be +-- promoted to an outer level +isPromotableMetaTyVar tv + | isTyVar tv -- See Note [Coercion variables in free variable lists] + , MetaTv { mtv_info = info } <- tcTyVarDetails tv + = isTouchableInfo info -- Can't promote cycle breakers + | otherwise + = False + isTouchableMetaTyVar :: TcLevel -> TcTyVar -> Bool isTouchableMetaTyVar ctxt_tclvl tv | isTyVar tv -- See Note [Coercion variables in free variable lists] @@ -1009,15 +1022,6 @@ isTouchableMetaTyVar ctxt_tclvl tv | otherwise = False -isFloatedTouchableMetaTyVar :: TcLevel -> TcTyVar -> Bool -isFloatedTouchableMetaTyVar ctxt_tclvl tv - | isTyVar tv -- See Note [Coercion variables in free variable lists] - , MetaTv { mtv_tclvl = tv_tclvl, mtv_info = info } <- tcTyVarDetails tv - , isTouchableInfo info - = tv_tclvl `strictlyDeeperThan` ctxt_tclvl - - | otherwise = False - isImmutableTyVar :: TyVar -> Bool isImmutableTyVar tv = isSkolemTyVar tv ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -37,7 +37,7 @@ module GHC.Tc.Utils.Unify ( matchExpectedFunKind, matchActualFunTySigma, matchActualFunTysRho, - metaTyVarUpdateOK, occCheckForErrors, MetaTyVarUpdateResult(..), + occCheckForErrors, CheckTyEqResult(..), checkTyVarEq, checkTyFamEq, checkTypeEq, AreTypeFamiliesOK(..) ) where @@ -78,6 +78,7 @@ import GHC.Utils.Panic import GHC.Exts ( inline ) import Control.Monad import Control.Arrow ( second ) +import qualified Data.Semigroup as S {- ********************************************************************* @@ -1169,17 +1170,17 @@ uType t_or_k origin orig_ty1 orig_ty2 -- so that type variables tend to get filled in with -- the most informative version of the type go (TyVarTy tv1) ty2 - = do { lookup_res <- lookupTcTyVar tv1 + = do { lookup_res <- isFilledMetaTyVar_maybe tv1 ; case lookup_res of - Filled ty1 -> do { traceTc "found filled tyvar" (ppr tv1 <+> text ":->" <+> ppr ty1) - ; go ty1 ty2 } - Unfilled _ -> uUnfilledVar origin t_or_k NotSwapped tv1 ty2 } + Just ty1 -> do { traceTc "found filled tyvar" (ppr tv1 <+> text ":->" <+> ppr ty1) + ; go ty1 ty2 } + Nothing -> uUnfilledVar origin t_or_k NotSwapped tv1 ty2 } go ty1 (TyVarTy tv2) - = do { lookup_res <- lookupTcTyVar tv2 + = do { lookup_res <- isFilledMetaTyVar_maybe tv2 ; case lookup_res of - Filled ty2 -> do { traceTc "found filled tyvar" (ppr tv2 <+> text ":->" <+> ppr ty2) - ; go ty1 ty2 } - Unfilled _ -> uUnfilledVar origin t_or_k IsSwapped tv2 ty1 } + Just ty2 -> do { traceTc "found filled tyvar" (ppr tv2 <+> text ":->" <+> ppr ty2) + ; go ty1 ty2 } + Nothing -> uUnfilledVar origin t_or_k IsSwapped tv2 ty1 } -- See Note [Expanding synonyms during unification] go ty1@(TyConApp tc1 []) (TyConApp tc2 []) @@ -1433,10 +1434,12 @@ uUnfilledVar2 origin t_or_k swapped tv1 ty2 ; go dflags cur_lvl } where go dflags cur_lvl - | canSolveByUnification cur_lvl tv1 ty2 + | isTouchableMetaTyVar cur_lvl tv1 + -- See Note [Unification preconditions], (UNTOUCHABLE) wrinkles + , canSolveByUnification (metaTyVarInfo tv1) ty2 + , CTE_OK <- checkTyVarEq dflags NoTypeFamilies tv1 ty2 -- See Note [Prevent unification with type families] about the NoTypeFamilies: - , MTVU_OK ty2' <- metaTyVarUpdateOK dflags NoTypeFamilies tv1 ty2 - = do { co_k <- uType KindLevel kind_origin (tcTypeKind ty2') (tyVarKind tv1) + = do { co_k <- uType KindLevel kind_origin (tcTypeKind ty2) (tyVarKind tv1) ; traceTc "uUnfilledVar2 ok" $ vcat [ ppr tv1 <+> dcolon <+> ppr (tyVarKind tv1) , ppr ty2 <+> dcolon <+> ppr (tcTypeKind ty2) @@ -1446,8 +1449,8 @@ uUnfilledVar2 origin t_or_k swapped tv1 ty2 -- Only proceed if the kinds match -- NB: tv1 should still be unfilled, despite the kind unification -- because tv1 is not free in ty2 (or, hence, in its kind) - then do { writeMetaTyVar tv1 ty2' - ; return (mkTcNomReflCo ty2') } + then do { writeMetaTyVar tv1 ty2 + ; return (mkTcNomReflCo ty2) } else defer } -- This cannot be solved now. See GHC.Tc.Solver.Canonical -- Note [Equalities with incompatible kinds] @@ -1464,6 +1467,22 @@ uUnfilledVar2 origin t_or_k swapped tv1 ty2 defer = unSwap swapped (uType_defer t_or_k origin) ty1 ty2 +canSolveByUnification :: MetaInfo -> TcType -> Bool +-- See Note [Unification preconditions, (TYVAR-TV)] +canSolveByUnification info xi + = case info of + CycleBreakerTv -> False + TyVarTv -> case tcGetTyVar_maybe xi of + Nothing -> False + Just tv -> case tcTyVarDetails tv of + MetaTv { mtv_info = info } + -> case info of + TyVarTv -> True + _ -> False + SkolemTv {} -> True + RuntimeUnk -> True + _ -> True + swapOverTyVars :: Bool -> TcTyVar -> TcTyVar -> Bool swapOverTyVars is_given tv1 tv2 -- See Note [Unification variables on the left] @@ -1507,8 +1526,94 @@ lhsPriority tv TauTv -> 2 RuntimeUnkTv -> 3 -{- Note [TyVar/TyVar orientation] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [Unification preconditions] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Question: given a homogeneous equality (alpha ~# ty), when is it OK to +unify alpha := ty? + +This note only applied to /homogeneous/ equalities, in which both +sides have the same kind. + +There are three reasons not to unify: + +1. (SKOL-ESC) Skolem-escape + Consider the constraint + forall[2] a[2]. alpha[1] ~ Maybe a[2] + If we unify alpha := Maybe a, the skolem 'a' may escape its scope. + The level alpha[1] says that alpha may be used outside this constraint, + where 'a' is not in scope at all. So we must not unify. + + Bottom line: when looking at a constraint alpha[n] := ty, do not unify + if any free variable of 'ty' has level deeper (greater) than n + +2. (UNTOUCHABLE) Untouchable unification variables + Consider the constraint + forall[2] a[2]. b[1] ~ Int => alpha[1] ~ Int + There is no (SKOL-ESC) problem with unifying alpha := Int, but it might + not be the principal solution. Perhaps the "right" solution is alpha := b. + We simply can't tell. See "OutsideIn(X): modular type inference with local + assumptions", section 2.2. We say that alpha[1] is "untouchable" inside + this implication. + + Bottom line: at amibient level 'l', when looking at a constraint + alpha[n] ~ ty, do not unify alpha := ty if there are any given equalities + between levels 'n' and 'l'. + + Exactly what is a "given equality" for the purpose of (UNTOUCHABLE)? + Answer: see Note [Tracking Given equalities] in GHC.Tc.Solver.Monad + +3. (TYVAR-TV) Unifying TyVarTvs and CycleBreakerTvs + This precondition looks at the MetaInfo of the unification variable: + + * TyVarTv: When considering alpha{tyv} ~ ty, if alpha{tyv} is a + TyVarTv it can only unify with a type variable, not with a + structured type. So if 'ty' is a structured type, such as (Maybe x), + don't unify. + + * CycleBreakerTv: never unified, except by restoreTyVarCycles. + + +Needless to say, all three have wrinkles: + +* (SKOL-ESC) Promotion. Given alpha[n] ~ ty, what if beta[k] is free + in 'ty', where beta is a unification variable, and k>n? 'beta' + stands for a monotype, and since it is part of a level-n type + (equal to alpha[n]), we must /promote/ beta to level n. Just make + up a fresh gamma[n], and unify beta[k] := gamma[n]. + +* (TYVAR-TV) Unification variables. Suppose alpha[tyv,n] is a level-n + TyVarTv (see Note [Signature skolems] in GHC.Tc.Types.TcType)? Now + consider alpha[tyv,n] ~ Bool. We don't want to unify because that + would break the TyVarTv invariant. + + What about alpha[tyv,n] ~ beta[tau,n], where beta is an ordinary + TauTv? Again, don't unify, because beta might later be unified + with, say Bool. (If levels permit, we reverse the orientation here; + see Note [TyVar/TyVar orientation].) + +* (UNTOUCHABLE) Untouchability. When considering (alpha[n] ~ ty), how + do we know whether there are any given equalities between level n + and the ambient level? We answer in two ways: + + * In the eager unifier, we only unify if l=n. If not, alpha may be + untouchable, and defer to the constraint solver. This check is + made in GHC.Tc.Utils.uUnifilledVar2, in the guard + isTouchableMetaTyVar. + + * In the constraint solver, we track where Given equalities occur + and use that to guard unification in GHC.Tc.Solver.Canonical.unifyTest + More details in Note [Tracking Given equalities] in GHC.Tc.Solver.Monad + + Historical note: in the olden days (pre 2021) the constraint solver + also used to unify only if l=n. Equalities were "floated" out of the + implication in a separate step, so that they would become touchable. + But the float/don't-float question turned out to be very delicate, + as you can see if you look at the long series of Notes associated with + GHC.Tc.Solver.floatEqualities, around Nov 2020. It's much easier + to unify in-place, with no floating. + +Note [TyVar/TyVar orientation] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Given (a ~ b), should we orient the CEqCan as (a~b) or (b~a)? This is a surprisingly tricky question! This is invariant (TyEq:TV). @@ -1616,8 +1721,8 @@ inert guy, so we get inert item: c ~ a And now the cycle just repeats -Note [Eliminate younger unification variables] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Historical Note [Eliminate younger unification variables] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Given a choice of unifying alpha := beta or beta := alpha we try, if possible, to eliminate the "younger" one, as determined @@ -1631,36 +1736,11 @@ This is a performance optimisation only. It turns out to fix It's simple to implement (see nicer_to_update_tv2 in swapOverTyVars). But, to my surprise, it didn't seem to make any significant difference to the compiler's performance, so I didn't take it any further. Still -it seemed to too nice to discard altogether, so I'm leaving these +it seemed too nice to discard altogether, so I'm leaving these notes. SLPJ Jan 18. --} --- @trySpontaneousSolve wi@ solves equalities where one side is a --- touchable unification variable. --- Returns True <=> spontaneous solve happened -canSolveByUnification :: TcLevel -> TcTyVar -> TcType -> Bool -canSolveByUnification tclvl tv xi - | isTouchableMetaTyVar tclvl tv - = case metaTyVarInfo tv of - TyVarTv -> is_tyvar xi - _ -> True - - | otherwise -- Untouchable - = False - where - is_tyvar xi - = case tcGetTyVar_maybe xi of - Nothing -> False - Just tv -> case tcTyVarDetails tv of - MetaTv { mtv_info = info } - -> case info of - TyVarTv -> True - _ -> False - SkolemTv {} -> True - RuntimeUnk -> True - -{- Note [Prevent unification with type families] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [Prevent unification with type families] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We prevent unification with type families because of an uneasy compromise. It's perfectly sound to unify with type families, and it even improves the error messages in the testsuite. It also modestly improves performance, at @@ -1764,35 +1844,6 @@ type-checking (with wrappers, etc.). Types get desugared very differently, causing this wibble in behavior seen here. -} -data LookupTyVarResult -- The result of a lookupTcTyVar call - = Unfilled TcTyVarDetails -- SkolemTv or virgin MetaTv - | Filled TcType - -lookupTcTyVar :: TcTyVar -> TcM LookupTyVarResult -lookupTcTyVar tyvar - | MetaTv { mtv_ref = ref } <- details - = do { meta_details <- readMutVar ref - ; case meta_details of - Indirect ty -> return (Filled ty) - Flexi -> do { is_touchable <- isTouchableTcM tyvar - -- Note [Unifying untouchables] - ; if is_touchable then - return (Unfilled details) - else - return (Unfilled vanillaSkolemTv) } } - | otherwise - = return (Unfilled details) - where - details = tcTyVarDetails tyvar - -{- -Note [Unifying untouchables] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We treat an untouchable type variable as if it was a skolem. That -ensures it won't unify with anything. It's a slight hack, because -we return a made-up TcTyVarDetails, but I think it works smoothly. --} - -- | Breaks apart a function kind into its pieces. matchExpectedFunKind :: Outputable fun @@ -1871,44 +1922,38 @@ with (forall k. k->*) -} -data MetaTyVarUpdateResult a - = MTVU_OK a - | MTVU_Bad -- Forall, predicate, or type family - | MTVU_HoleBlocker -- Blocking coercion hole +data CheckTyEqResult + = CTE_OK + | CTE_Bad -- Forall, predicate, or type family + | CTE_HoleBlocker -- Blocking coercion hole -- See Note [Equalities with incompatible kinds] in "GHC.Tc.Solver.Canonical" - | MTVU_Occurs - deriving (Functor) - -instance Applicative MetaTyVarUpdateResult where - pure = MTVU_OK - (<*>) = ap - -instance Monad MetaTyVarUpdateResult where - MTVU_OK x >>= k = k x - MTVU_Bad >>= _ = MTVU_Bad - MTVU_HoleBlocker >>= _ = MTVU_HoleBlocker - MTVU_Occurs >>= _ = MTVU_Occurs - -instance Outputable a => Outputable (MetaTyVarUpdateResult a) where - ppr (MTVU_OK a) = text "MTVU_OK" <+> ppr a - ppr MTVU_Bad = text "MTVU_Bad" - ppr MTVU_HoleBlocker = text "MTVU_HoleBlocker" - ppr MTVU_Occurs = text "MTVU_Occurs" - -occCheckForErrors :: DynFlags -> TcTyVar -> Type -> MetaTyVarUpdateResult () --- Just for error-message generation; so we return MetaTyVarUpdateResult + | CTE_Occurs + +instance S.Semigroup CheckTyEqResult where + CTE_OK <> x = x + x <> _ = x + +instance Monoid CheckTyEqResult where + mempty = CTE_OK + +instance Outputable CheckTyEqResult where + ppr CTE_OK = text "CTE_OK" + ppr CTE_Bad = text "CTE_Bad" + ppr CTE_HoleBlocker = text "CTE_HoleBlocker" + ppr CTE_Occurs = text "CTE_Occurs" + +occCheckForErrors :: DynFlags -> TcTyVar -> Type -> CheckTyEqResult +-- Just for error-message generation; so we return CheckTyEqResult -- so the caller can report the right kind of error -- Check whether -- a) the given variable occurs in the given type. -- b) there is a forall in the type (unless we have -XImpredicativeTypes) occCheckForErrors dflags tv ty = case checkTyVarEq dflags YesTypeFamilies tv ty of - MTVU_OK _ -> MTVU_OK () - MTVU_Bad -> MTVU_Bad - MTVU_HoleBlocker -> MTVU_HoleBlocker - MTVU_Occurs -> case occCheckExpand [tv] ty of - Nothing -> MTVU_Occurs - Just _ -> MTVU_OK () + CTE_Occurs -> case occCheckExpand [tv] ty of + Nothing -> CTE_Occurs + Just _ -> CTE_OK + other -> other ---------------- data AreTypeFamiliesOK = YesTypeFamilies @@ -1919,52 +1964,7 @@ instance Outputable AreTypeFamiliesOK where ppr YesTypeFamilies = text "YesTypeFamilies" ppr NoTypeFamilies = text "NoTypeFamilies" -metaTyVarUpdateOK :: DynFlags - -> AreTypeFamiliesOK -- allow type families in RHS? - -> TcTyVar -- tv :: k1 - -> TcType -- ty :: k2 - -> MetaTyVarUpdateResult TcType -- possibly-expanded ty --- (metaTyVarUpdateOK tv ty) --- Checks that the equality tv~ty is OK to be used to rewrite --- other equalities. Equivalently, checks the conditions for CEqCan --- (a) that tv doesn't occur in ty (occurs check) --- (b) that ty does not have any foralls or (perhaps) type functions --- (c) that ty does not have any blocking coercion holes --- See Note [Equalities with incompatible kinds] in "GHC.Tc.Solver.Canonical" --- --- Used in two places: --- - In the eager unifier: uUnfilledVar2 --- - In the canonicaliser: GHC.Tc.Solver.Canonical.canEqTyVar2 --- Note that in the latter case tv is not necessarily a meta-tyvar, --- despite the name of this function. - --- We have two possible outcomes: --- (1) Return the type to update the type variable with, --- [we know the update is ok] --- (2) Return Nothing, --- [the update might be dodgy] --- --- Note that "Nothing" does not mean "definite error". For example --- type family F a --- type instance F Int = Int --- consider --- a ~ F a --- This is perfectly reasonable, if we later get a ~ Int. For now, though, --- we return Nothing, leaving it to the later constraint simplifier to --- sort matters out. --- --- See Note [Refactoring hazard: metaTyVarUpdateOK] - -metaTyVarUpdateOK dflags ty_fam_ok tv ty - = case checkTyVarEq dflags ty_fam_ok tv ty of - MTVU_OK _ -> MTVU_OK ty - MTVU_Bad -> MTVU_Bad -- forall, predicate, type function - MTVU_HoleBlocker -> MTVU_HoleBlocker -- coercion hole - MTVU_Occurs -> case occCheckExpand [tv] ty of - Just expanded_ty -> MTVU_OK expanded_ty - Nothing -> MTVU_Occurs - -checkTyVarEq :: DynFlags -> AreTypeFamiliesOK -> TcTyVar -> TcType -> MetaTyVarUpdateResult () +checkTyVarEq :: DynFlags -> AreTypeFamiliesOK -> TcTyVar -> TcType -> CheckTyEqResult checkTyVarEq dflags ty_fam_ok tv ty = inline checkTypeEq dflags ty_fam_ok (TyVarLHS tv) ty -- inline checkTypeEq so that the `case`s over the CanEqLHS get blasted away @@ -1973,13 +1973,13 @@ checkTyFamEq :: DynFlags -> TyCon -- type function -> [TcType] -- args, exactly saturated -> TcType -- RHS - -> MetaTyVarUpdateResult () + -> CheckTyEqResult checkTyFamEq dflags fun_tc fun_args ty = inline checkTypeEq dflags YesTypeFamilies (TyFamLHS fun_tc fun_args) ty -- inline checkTypeEq so that the `case`s over the CanEqLHS get blasted away checkTypeEq :: DynFlags -> AreTypeFamiliesOK -> CanEqLHS -> TcType - -> MetaTyVarUpdateResult () + -> CheckTyEqResult -- Checks the invariants for CEqCan. In particular: -- (a) a forall type (forall a. blah) -- (b) a predicate type (c => ty) @@ -1987,6 +1987,14 @@ checkTypeEq :: DynFlags -> AreTypeFamiliesOK -> CanEqLHS -> TcType -- (d) a blocking coercion hole -- (e) an occurrence of the LHS (occurs check) -- +-- Note that an occurs-check does not mean "definite error". For example +-- type family F a +-- type instance F Int = Int +-- consider +-- b0 ~ F b0 +-- This is perfectly reasonable, if we later get b0 ~ Int. But we +-- certainly can't unify b0 := F b0 +-- -- For (a), (b), and (c) we check only the top level of the type, NOT -- inside the kinds of variables it mentions. For (d) we look deeply -- in coercions when the LHS is a tyvar (but skip coercions for type family @@ -1994,14 +2002,11 @@ checkTypeEq :: DynFlags -> AreTypeFamiliesOK -> CanEqLHS -> TcType -- -- checkTypeEq is called from -- * checkTyFamEq, checkTyVarEq (which inline it to specialise away the --- case-analysis on 'lhs' +-- case-analysis on 'lhs') -- * checkEqCanLHSFinish, which does not know the form of 'lhs' checkTypeEq dflags ty_fam_ok lhs ty = go ty where - ok :: MetaTyVarUpdateResult () - ok = MTVU_OK () - -- The GHCi runtime debugger does its type-matching with -- unification variables that can unify with a polytype -- or a TyCon that would usually be disallowed by bad_tc @@ -2014,71 +2019,70 @@ checkTypeEq dflags ty_fam_ok lhs ty | otherwise = False - go :: TcType -> MetaTyVarUpdateResult () + go :: TcType -> CheckTyEqResult go (TyVarTy tv') = go_tv tv' go (TyConApp tc tys) = go_tc tc tys - go (LitTy {}) = ok + go (LitTy {}) = CTE_OK go (FunTy{ft_af = af, ft_mult = w, ft_arg = a, ft_res = r}) | InvisArg <- af - , not ghci_tv = MTVU_Bad - | otherwise = go w >> go a >> go r - go (AppTy fun arg) = go fun >> go arg - go (CastTy ty co) = go ty >> go_co co + , not ghci_tv = CTE_Bad + | otherwise = go w S.<> go a S.<> go r + go (AppTy fun arg) = go fun S.<> go arg + go (CastTy ty co) = go ty S.<> go_co co go (CoercionTy co) = go_co co go (ForAllTy (Bndr tv' _) ty) - | not ghci_tv = MTVU_Bad + | not ghci_tv = CTE_Bad | otherwise = case lhs of - TyVarLHS tv | tv == tv' -> ok - | otherwise -> do { go_occ tv (tyVarKind tv') - ; go ty } + TyVarLHS tv | tv == tv' -> CTE_OK + | otherwise -> go_occ tv (tyVarKind tv') S.<> go ty _ -> go ty - go_tv :: TcTyVar -> MetaTyVarUpdateResult () + go_tv :: TcTyVar -> CheckTyEqResult -- this slightly peculiar way of defining this means -- we don't have to evaluate this `case` at every variable -- occurrence go_tv = case lhs of TyVarLHS tv -> \ tv' -> if tv == tv' - then MTVU_Occurs + then CTE_Occurs else go_occ tv (tyVarKind tv') - TyFamLHS {} -> \ _tv' -> ok + TyFamLHS {} -> \ _tv' -> CTE_OK -- See Note [Occurrence checking: look inside kinds] in GHC.Core.Type -- For kinds, we only do an occurs check; we do not worry -- about type families or foralls -- See Note [Checking for foralls] - go_occ tv k | tv `elemVarSet` tyCoVarsOfType k = MTVU_Occurs - | otherwise = ok + go_occ tv k | tv `elemVarSet` tyCoVarsOfType k = CTE_Occurs + | otherwise = CTE_OK - go_tc :: TyCon -> [TcType] -> MetaTyVarUpdateResult () + go_tc :: TyCon -> [TcType] -> CheckTyEqResult -- this slightly peculiar way of defining this means -- we don't have to evaluate this `case` at every tyconapp go_tc = case lhs of TyVarLHS {} -> \ tc tys -> - if | good_tc tc -> mapM go tys >> ok - | otherwise -> MTVU_Bad + if | good_tc tc -> mconcat (map go tys) + | otherwise -> CTE_Bad TyFamLHS fam_tc fam_args -> \ tc tys -> - if | tcEqTyConApps fam_tc fam_args tc tys -> MTVU_Occurs - | good_tc tc -> mapM go tys >> ok - | otherwise -> MTVU_Bad + if | tcEqTyConApps fam_tc fam_args tc tys -> CTE_Occurs + | good_tc tc -> mconcat (map go tys) + | otherwise -> CTE_Bad -- no bother about impredicativity in coercions, as they're -- inferred go_co co | not (gopt Opt_DeferTypeErrors dflags) , hasCoercionHoleCo co - = MTVU_HoleBlocker -- Wrinkle (2) in GHC.Tc.Solver.Canonical + = CTE_HoleBlocker -- Wrinkle (2) in GHC.Tc.Solver.Canonical -- See GHC.Tc.Solver.Canonical Note [Equalities with incompatible kinds] -- Wrinkle (2) about this case in general, Wrinkle (4b) about the check for -- deferred type errors. | TyVarLHS tv <- lhs , tv `elemVarSet` tyCoVarsOfCo co - = MTVU_Occurs + = CTE_Occurs -- Don't check coercions for type families; see commentary at top of function | otherwise - = ok + = CTE_OK good_tc :: TyCon -> Bool good_tc ===================================== testsuite/tests/ghci.debugger/scripts/break012.stdout ===================================== @@ -1,14 +1,14 @@ Stopped in Main.g, break012.hs:5:10-18 -_result :: (p, a1 -> a1, (), a -> a -> a) = _ -a :: p = _ -b :: a2 -> a2 = _ +_result :: (a1, a2 -> a2, (), a -> a -> a) = _ +a :: a1 = _ +b :: a3 -> a3 = _ c :: () = _ d :: a -> a -> a = _ -a :: p -b :: a2 -> a2 +a :: a1 +b :: a3 -> a3 c :: () d :: a -> a -> a -a = (_t1::p) -b = (_t2::a2 -> a2) +a = (_t1::a1) +b = (_t2::a3 -> a3) c = (_t3::()) d = (_t4::a -> a -> a) ===================================== testsuite/tests/partial-sigs/should_compile/T10403.stderr ===================================== @@ -14,35 +14,18 @@ T10403.hs:15:12: warning: [-Wpartial-type-signatures (in -Wdefault)] • In the type signature: h1 :: _ => _ T10403.hs:19:7: warning: [-Wpartial-type-signatures (in -Wdefault)] - • Found type wildcard ‘_’ standing for ‘(a -> a1) -> f0 a -> H f0’ - Where: ‘f0’ is an ambiguous type variable + • Found type wildcard ‘_’ + standing for ‘(a -> a1) -> B t0 a -> H (B t0)’ + Where: ‘t0’ is an ambiguous type variable ‘a1’, ‘a’ are rigid type variables bound by - the inferred type of h2 :: (a -> a1) -> f0 a -> H f0 + the inferred type of h2 :: (a -> a1) -> B t0 a -> H (B t0) at T10403.hs:22:1-41 • In the type signature: h2 :: _ -T10403.hs:22:15: warning: [-Wdeferred-type-errors (in -Wdefault)] - • Ambiguous type variable ‘f0’ arising from a use of ‘fmap’ - prevents the constraint ‘(Functor f0)’ from being solved. - Relevant bindings include - b :: f0 a (bound at T10403.hs:22:6) - h2 :: (a -> a1) -> f0 a -> H f0 (bound at T10403.hs:22:1) - Probable fix: use a type annotation to specify what ‘f0’ should be. - These potential instances exist: - instance Functor IO -- Defined in ‘GHC.Base’ - instance Functor (B t) -- Defined at T10403.hs:10:10 - instance Functor I -- Defined at T10403.hs:6:10 - ...plus five others - ...plus two instances involving out-of-scope types - (use -fprint-potential-instances to see them all) - • In the second argument of ‘(.)’, namely ‘fmap (const ())’ - In the expression: (H . fmap (const ())) (fmap f b) - In an equation for ‘h2’: h2 f b = (H . fmap (const ())) (fmap f b) - T10403.hs:28:8: warning: [-Wdeferred-type-errors (in -Wdefault)] - • Couldn't match type ‘f0’ with ‘B t’ + • Couldn't match type ‘t0’ with ‘t’ Expected: H (B t) - Actual: H f0 + Actual: H (B t0) because type variable ‘t’ would escape its scope This (rigid, skolem) type variable is bound by the type signature for: ===================================== testsuite/tests/partial-sigs/should_compile/T14715.stderr ===================================== @@ -1,12 +1,11 @@ T14715.hs:13:53: warning: [-Wpartial-type-signatures (in -Wdefault)] - • Found extra-constraints wildcard standing for - ‘Reduce (LiftOf zq) zq’ - Where: ‘zq’ is a rigid type variable bound by + • Found extra-constraints wildcard standing for ‘Reduce z zq’ + Where: ‘z’, ‘zq’ are rigid type variables bound by the inferred type of - bench_mulPublic :: (z ~ LiftOf zq, Reduce (LiftOf zq) zq) => + bench_mulPublic :: (z ~ LiftOf zq, Reduce z zq) => Cyc zp -> Cyc z -> IO (zp, zq) - at T14715.hs:13:32-33 + at T14715.hs:13:27-33 • In the type signature: - bench_mulPublic :: forall z zp zq. - (z ~ LiftOf zq, _) => Cyc zp -> Cyc z -> IO (zp, zq) + bench_mulPublic :: forall z zp zq. (z ~ LiftOf zq, _) => + Cyc zp -> Cyc z -> IO (zp, zq) ===================================== testsuite/tests/partial-sigs/should_fail/ScopedNamedWildcardsBad.stderr ===================================== @@ -1,6 +1,11 @@ -ScopedNamedWildcardsBad.hs:8:21: error: +ScopedNamedWildcardsBad.hs:11:15: error: • Couldn't match expected type ‘Bool’ with actual type ‘Char’ - • In the first argument of ‘not’, namely ‘x’ - In the expression: not x - In an equation for ‘v’: v = not x + • In the first argument of ‘g’, namely ‘'x'’ + In the expression: g 'x' + In the expression: + let + v = not x + g :: _a -> _a + g x = x + in (g 'x') ===================================== testsuite/tests/typecheck/should_fail/ExpandSynsFail2.stderr ===================================== @@ -1,6 +1,6 @@ ExpandSynsFail2.hs:19:37: error: - • Couldn't match type ‘Int’ with ‘Bool’ + • Couldn't match type ‘Bool’ with ‘Int’ Expected: ST s Foo Actual: MyBarST s Type synonyms expanded: ===================================== testsuite/tests/typecheck/should_fail/T7453.stderr ===================================== @@ -1,6 +1,8 @@ -T7453.hs:10:30: error: - • Couldn't match expected type ‘t’ with actual type ‘p’ +T7453.hs:9:15: error: + • Couldn't match type ‘t’ with ‘p’ + Expected: Id t + Actual: Id p ‘t’ is a rigid type variable bound by the type signature for: z :: forall t. Id t @@ -8,17 +10,29 @@ T7453.hs:10:30: error: ‘p’ is a rigid type variable bound by the inferred type of cast1 :: p -> a at T7453.hs:(7,1)-(10,30) - • In the first argument of ‘Id’, namely ‘v’ - In the expression: Id v - In an equation for ‘aux’: aux = Id v + • In the expression: aux + In an equation for ‘z’: + z = aux + where + aux = Id v + In an equation for ‘cast1’: + cast1 v + = runId z + where + z :: Id t + z = aux + where + aux = Id v • Relevant bindings include - aux :: Id t (bound at T7453.hs:10:21) + aux :: Id p (bound at T7453.hs:10:21) z :: Id t (bound at T7453.hs:9:11) v :: p (bound at T7453.hs:7:7) cast1 :: p -> a (bound at T7453.hs:7:1) -T7453.hs:16:33: error: - • Couldn't match expected type ‘t1’ with actual type ‘p’ +T7453.hs:15:15: error: + • Couldn't match type ‘t1’ with ‘p’ + Expected: () -> t1 + Actual: () -> p ‘t1’ is a rigid type variable bound by the type signature for: z :: forall t1. () -> t1 @@ -26,11 +40,21 @@ T7453.hs:16:33: error: ‘p’ is a rigid type variable bound by the inferred type of cast2 :: p -> t at T7453.hs:(13,1)-(16,33) - • In the first argument of ‘const’, namely ‘v’ - In the expression: const v - In an equation for ‘aux’: aux = const v + • In the expression: aux + In an equation for ‘z’: + z = aux + where + aux = const v + In an equation for ‘cast2’: + cast2 v + = z () + where + z :: () -> t + z = aux + where + aux = const v • Relevant bindings include - aux :: b -> t1 (bound at T7453.hs:16:21) + aux :: forall {b}. b -> p (bound at T7453.hs:16:21) z :: () -> t1 (bound at T7453.hs:15:11) v :: p (bound at T7453.hs:13:7) cast2 :: p -> t (bound at T7453.hs:13:1) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4f85f14177d0b2be1c1489bc69ad4f69372e1fb4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4f85f14177d0b2be1c1489bc69ad4f69372e1fb4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 18 09:55:20 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Fri, 18 Dec 2020 04:55:20 -0500 Subject: [Git][ghc/ghc][wip/sgraf-dmdanal-stuff] 2 commits: DmdAnal: Keep alive RULE vars in LetUp (#18971) Message-ID: <5fdc7c8840adb_6b2174471c2302564@gitlab.mail> Sebastian Graf pushed to branch wip/sgraf-dmdanal-stuff at Glasgow Haskell Compiler / GHC Commits: c6e5bbaf by Sebastian Graf at 2020-12-18T10:55:09+01:00 DmdAnal: Keep alive RULE vars in LetUp (#18971) I also took the liberty to refactor the logic around `ruleFVs`. - - - - - aeaa9126 by Sebastian Graf at 2020-12-18T10:55:09+01:00 WorkWrap: Unbox constructors with existentials (#18982) Consider ```hs data Ex where Ex :: e -> Int -> Ex f :: Ex -> Int f (Ex e n) = e `seq` n + 1 ``` Worker/wrapper should build the following worker for `f`: ```hs $wf :: forall e. e -> Int# -> Int# $wf e n = e `seq` n +# 1# ``` But previously it didn't, because `Ex` binds an existential. This patch lifts that condition. That entailed having to instantiate existential binders in `GHC.Core.Opt.WorkWrap.Utils.mkWWstr` via `GHC.Core.Utils.dataConRepFSInstPat`, requiring a bit of a refactoring around what is now `DataConPatContext`. CPR W/W still won't unbox DataCons with existentials. See `Note [Which types are unboxed?]` for details. I also refactored the various `tyCon*DataCon(s)_maybe` functions in `GHC.Core.TyCon`, deleting some of them which are no longer needed (`isDataProductType_maybe` and `isDataSumType_maybe`). I cleaned up a couple of call sites, some of which weren't very explicit about whether they cared for existentials or not. The test output of `T18013` changed, because we now unbox the `Rule` data type. Its constructor carries existential state and will be w/w'd now. In the particular example, the worker functions inlines right back into the wrapper, which then unnecessarily has a (quite big) stable unfolding. I think this kind of fallout is inevitable; see also Note [Don't w/w inline small non-loop-breaker things]. There's a new regression test case `T18982`. Fixes #18982. - - - - - 16 changed files: - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Opt/CprAnal.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/HsToCore/Foreign/Call.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Tc/Deriv/Utils.hs - compiler/GHC/Types/Demand.hs - testsuite/tests/simplCore/should_compile/T18013.stderr - + testsuite/tests/stranal/should_compile/T18982.hs - + testsuite/tests/stranal/should_compile/T18982.stderr - testsuite/tests/stranal/should_compile/all.T Changes: ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -1564,15 +1564,13 @@ promoteDataCon (MkData { dcPromoted = tc }) = tc -- | Extract the type constructor, type argument, data constructor and it's -- /representation/ argument types from a type if it is a product type. -- --- Precisely, we return @Just@ for any type that is all of: +-- Precisely, we return @Just@ for any data type that is all of: -- -- * Concrete (i.e. constructors visible) --- -- * Single-constructor +-- * ... which has no existentials -- --- * Not existentially quantified --- --- Whether the type is a @data@ type or a @newtype@ +-- Whether the type is a @data@ type or a @newtype at . splitDataProductType_maybe :: Type -- ^ A product type, perhaps -> Maybe (TyCon, -- The type constructor @@ -1580,13 +1578,14 @@ splitDataProductType_maybe DataCon, -- The data constructor [Scaled Type]) -- Its /representation/ arg types - -- Rejecting existentials is conservative. Maybe some things - -- could be made to work with them, but I'm not going to sweat - -- it through till someone finds it's important. + -- Rejecting existentials means we don't have to worry about + -- freshening and substituting type variables + -- (See "GHC.Type.Id.Make.dataConArgUnpack") splitDataProductType_maybe ty | Just (tycon, ty_args) <- splitTyConApp_maybe ty - , Just con <- isDataProductTyCon_maybe tycon + , Just con <- tyConSingleDataCon_maybe tycon + , null (dataConExTyCoVars con) -- no existentials! See above = Just (tycon, ty_args, con, dataConInstArgTys con ty_args) | otherwise = Nothing ===================================== compiler/GHC/Core/FVs.hs ===================================== @@ -28,12 +28,13 @@ module GHC.Core.FVs ( varTypeTyCoFVs, idUnfoldingVars, idFreeVars, dIdFreeVars, bndrRuleAndUnfoldingVarsDSet, + bndrRuleAndUnfoldingIds, idFVs, - idRuleVars, idRuleRhsVars, stableUnfoldingVars, + idRuleVars, stableUnfoldingVars, ruleFreeVars, rulesFreeVars, rulesFreeVarsDSet, mkRuleInfo, ruleLhsFreeIds, ruleLhsFreeIdsList, - ruleRhsFreeVars, ruleRhsFreeIds, + ruleRhsFreeVars, rulesRhsFreeIds, expr_fvs, @@ -62,8 +63,6 @@ import GHC.Core import GHC.Types.Id import GHC.Types.Id.Info import GHC.Types.Name.Set -import GHC.Types.Unique.Set -import GHC.Types.Unique (Uniquable (..)) import GHC.Types.Name import GHC.Types.Var.Set import GHC.Types.Var @@ -76,7 +75,6 @@ import GHC.Core.FamInstEnv import GHC.Builtin.Types( unrestrictedFunTyConName ) import GHC.Builtin.Types.Prim( funTyConName ) import GHC.Data.Maybe( orElse ) -import GHC.Types.Basic( Activation ) import GHC.Utils.FV as FV import GHC.Utils.Misc @@ -450,87 +448,71 @@ orph_names_of_fun_ty_con _ = emptyNameSet ************************************************************************ -} +data RuleFVsFrom + = LhsOnly + | RhsOnly + | BothSides + +-- | Those locally-defined variables free in the left and/or right hand sides +-- of the rule, depending on the first argument. Returns an 'FV' computation. +ruleFVs :: RuleFVsFrom -> CoreRule -> FV +ruleFVs !_ (BuiltinRule {}) = emptyFV +ruleFVs from (Rule { ru_fn = _do_not_include + -- See Note [Rule free var hack] + , ru_bndrs = bndrs + , ru_rhs = rhs, ru_args = args }) + = filterFV isLocalVar $ addBndrs bndrs (exprs_fvs exprs) + where + exprs = case from of + LhsOnly -> args + RhsOnly -> [rhs] + BothSides -> rhs:args + +-- | Those locally-defined variables free in the left and/or right hand sides +-- from several rules, depending on the first argument. +-- Returns an 'FV' computation. +rulesFVs :: RuleFVsFrom -> [CoreRule] -> FV +rulesFVs from = mapUnionFV (ruleFVs from) + -- | Those variables free in the right hand side of a rule returned as a -- non-deterministic set ruleRhsFreeVars :: CoreRule -> VarSet -ruleRhsFreeVars (BuiltinRule {}) = noFVs -ruleRhsFreeVars (Rule { ru_fn = _, ru_bndrs = bndrs, ru_rhs = rhs }) - = fvVarSet $ filterFV isLocalVar $ addBndrs bndrs (expr_fvs rhs) - -- See Note [Rule free var hack] +ruleRhsFreeVars = fvVarSet . ruleFVs RhsOnly --- | Those variables free in the both the left right hand sides of a rule +-- | Those locally-defined free 'Id's in the right hand side of several rules -- returned as a non-deterministic set -ruleFreeVars :: CoreRule -> VarSet -ruleFreeVars = fvVarSet . ruleFVs +rulesRhsFreeIds :: [CoreRule] -> VarSet +rulesRhsFreeIds = fvVarSet . filterFV isLocalId . rulesFVs RhsOnly --- | Those variables free in the both the left right hand sides of a rule --- returned as FV computation -ruleFVs :: CoreRule -> FV -ruleFVs (BuiltinRule {}) = emptyFV -ruleFVs (Rule { ru_fn = _do_not_include - -- See Note [Rule free var hack] - , ru_bndrs = bndrs - , ru_rhs = rhs, ru_args = args }) - = filterFV isLocalVar $ addBndrs bndrs (exprs_fvs (rhs:args)) +ruleLhsFreeIds :: CoreRule -> VarSet +-- ^ This finds all locally-defined free Ids on the left hand side of a rule +-- and returns them as a non-deterministic set +ruleLhsFreeIds = fvVarSet . filterFV isLocalId . ruleFVs LhsOnly --- | Those variables free in the both the left right hand sides of rules --- returned as FV computation -rulesFVs :: [CoreRule] -> FV -rulesFVs = mapUnionFV ruleFVs +ruleLhsFreeIdsList :: CoreRule -> [Var] +-- ^ This finds all locally-defined free Ids on the left hand side of a rule +-- and returns them as a deterministically ordered list +ruleLhsFreeIdsList = fvVarList . filterFV isLocalId . ruleFVs LhsOnly + +-- | Those variables free in the both the left right hand sides of a rule +-- returned as a non-deterministic set +ruleFreeVars :: CoreRule -> VarSet +ruleFreeVars = fvVarSet . ruleFVs BothSides -- | Those variables free in the both the left right hand sides of rules -- returned as a deterministic set rulesFreeVarsDSet :: [CoreRule] -> DVarSet -rulesFreeVarsDSet rules = fvDVarSet $ rulesFVs rules +rulesFreeVarsDSet rules = fvDVarSet $ rulesFVs BothSides rules + +-- | Those variables free in both the left right hand sides of several rules +rulesFreeVars :: [CoreRule] -> VarSet +rulesFreeVars rules = fvVarSet $ rulesFVs BothSides rules -- | Make a 'RuleInfo' containing a number of 'CoreRule's, suitable -- for putting into an 'IdInfo' mkRuleInfo :: [CoreRule] -> RuleInfo mkRuleInfo rules = RuleInfo rules (rulesFreeVarsDSet rules) -idRuleRhsVars :: (Activation -> Bool) -> Id -> VarSet --- Just the variables free on the *rhs* of a rule -idRuleRhsVars is_active id - = mapUnionVarSet get_fvs (idCoreRules id) - where - get_fvs (Rule { ru_fn = fn, ru_bndrs = bndrs - , ru_rhs = rhs, ru_act = act }) - | is_active act - -- See Note [Finding rule RHS free vars] in "GHC.Core.Opt.OccurAnal" - = delOneFromUniqSet_Directly fvs (getUnique fn) - -- Note [Rule free var hack] - where - fvs = fvVarSet $ filterFV isLocalVar $ addBndrs bndrs (expr_fvs rhs) - get_fvs _ = noFVs - --- | Those variables free in the right hand side of several rules -rulesFreeVars :: [CoreRule] -> VarSet -rulesFreeVars rules = mapUnionVarSet ruleFreeVars rules - -ruleLhsFreeIds :: CoreRule -> VarSet --- ^ This finds all locally-defined free Ids on the left hand side of a rule --- and returns them as a non-deterministic set -ruleLhsFreeIds = fvVarSet . ruleLhsFVIds - -ruleLhsFreeIdsList :: CoreRule -> [Var] --- ^ This finds all locally-defined free Ids on the left hand side of a rule --- and returns them as a deterministically ordered list -ruleLhsFreeIdsList = fvVarList . ruleLhsFVIds - -ruleLhsFVIds :: CoreRule -> FV --- ^ This finds all locally-defined free Ids on the left hand side of a rule --- and returns an FV computation -ruleLhsFVIds (BuiltinRule {}) = emptyFV -ruleLhsFVIds (Rule { ru_bndrs = bndrs, ru_args = args }) - = filterFV isLocalId $ addBndrs bndrs (exprs_fvs args) - -ruleRhsFreeIds :: CoreRule -> VarSet --- ^ This finds all locally-defined free Ids on the right hand side of a rule --- and returns them as a non-deterministic set -ruleRhsFreeIds (BuiltinRule {}) = emptyVarSet -ruleRhsFreeIds (Rule { ru_bndrs = bndrs, ru_rhs = rhs }) - = fvVarSet $ filterFV isLocalId $ addBndrs bndrs $ expr_fvs rhs - {- Note [Rule free var hack] (Not a hack any more) ~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -586,9 +568,6 @@ freeVarsOf (fvs, _) = fvs freeVarsOfAnn :: FVAnn -> DIdSet freeVarsOfAnn fvs = fvs -noFVs :: VarSet -noFVs = emptyVarSet - aFreeVar :: Var -> DVarSet aFreeVar = unitDVarSet @@ -660,6 +639,9 @@ idFVs id = ASSERT( isId id) bndrRuleAndUnfoldingVarsDSet :: Id -> DVarSet bndrRuleAndUnfoldingVarsDSet id = fvDVarSet $ bndrRuleAndUnfoldingFVs id +bndrRuleAndUnfoldingIds :: Id -> IdSet +bndrRuleAndUnfoldingIds id = fvVarSet $ filterFV isId $ bndrRuleAndUnfoldingFVs id + bndrRuleAndUnfoldingFVs :: Id -> FV bndrRuleAndUnfoldingFVs id | isId id = idRuleFVs id `unionFV` idUnfoldingFVs id ===================================== compiler/GHC/Core/Opt/CprAnal.hs ===================================== @@ -425,7 +425,7 @@ nonVirgin env = env { ae_virgin = False } extendSigEnvForDemand :: AnalEnv -> Id -> Demand -> AnalEnv extendSigEnvForDemand env id dmd | isId id - , Just (_, DataConAppContext { dcac_dc = dc }) + , Just (_, DataConPatContext { dcpc_dc = dc }) <- wantToUnbox (ae_fam_envs env) has_inlineable_prag (idType id) dmd = extendSigEnv env id (CprSig (conCprType (dataConTag dc))) | otherwise @@ -446,14 +446,12 @@ extendEnvForDataAlt env scrut case_bndr dc bndrs ids_w_strs = filter isId bndrs `zip` dataConRepStrictness dc - tycon = dataConTyCon dc - is_product = isJust (isDataProductTyCon_maybe tycon) - is_sum = isJust (isDataSumTyCon_maybe tycon) + is_algebraic = isJust (tyConAlgDataCons_maybe (dataConTyCon dc)) + no_exs = null (dataConExTyCoVars dc) case_bndr_ty - | is_product || is_sum = conCprType (dataConTag dc) - -- Any of the constructors had existentials. This is a little too - -- conservative (after all, we only care about the particular data con), - -- but there is no easy way to write is_sum and this won't happen much. + | is_algebraic, no_exs = conCprType (dataConTag dc) + -- The tycon wasn't algebraic or the datacon had existentials. + -- See Note [Which types are unboxed?] for why no existentials. | otherwise = topCprType -- We could have much deeper CPR info here with Nested CPR, which could ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -34,7 +34,7 @@ import GHC.Types.Id import GHC.Core.Utils import GHC.Core.TyCon import GHC.Core.Type -import GHC.Core.FVs ( exprFreeIds, ruleRhsFreeIds ) +import GHC.Core.FVs ( rulesRhsFreeIds, bndrRuleAndUnfoldingIds ) import GHC.Core.Coercion ( Coercion, coVarsOfCo ) import GHC.Core.FamInstEnv import GHC.Core.Opt.Arity ( typeArity ) @@ -96,7 +96,7 @@ dmdAnalProgram opts fam_envs rules binds = dmd_ty rule_fvs :: IdSet - rule_fvs = foldr (unionVarSet . ruleRhsFreeIds) emptyVarSet rules + rule_fvs = rulesRhsFreeIds rules -- | We attach useful (e.g. not 'topDmd') 'idDemandInfo' to top-level bindings -- that satisfy this function. @@ -265,7 +265,10 @@ dmdAnalBindLetUp top_lvl env id rhs anal_body = (final_ty, NonRec id' rhs', body (body_ty', id_dmd) = findBndrDmd env notArgOfDfun body_ty id id' = setBindIdDemandInfo top_lvl id id_dmd (rhs_ty, rhs') = dmdAnalStar env (dmdTransformThunkDmd rhs id_dmd) rhs - final_ty = body_ty' `plusDmdType` rhs_ty + + -- See Note [Absence analysis for stable unfoldings and RULES] + rule_fvs = bndrRuleAndUnfoldingIds id + final_ty = body_ty' `plusDmdType` rhs_ty `keepAliveDmdType` rule_fvs -- | Let bindings can be processed in two ways: -- Down (RHS before body) or Up (body before RHS). @@ -423,8 +426,8 @@ dmdAnal' env dmd (Lam var body) dmdAnal' env dmd (Case scrut case_bndr ty [(alt, bndrs, rhs)]) -- Only one alternative. - -- If it's a DataAlt, it should be a product constructor. - | is_non_sum_alt alt + -- If it's a DataAlt, it should be the only constructor of the type. + | is_single_data_alt alt = let (rhs_ty, rhs') = dmdAnal env dmd rhs (alt_ty1, dmds) = findBndrsDmds env rhs_ty bndrs @@ -463,8 +466,8 @@ dmdAnal' env dmd (Case scrut case_bndr ty [(alt, bndrs, rhs)]) -- , text "res_ty" <+> ppr res_ty ]) $ (res_ty, Case scrut' case_bndr' ty [(alt, bndrs', rhs')]) where - is_non_sum_alt (DataAlt dc) = isJust $ isDataProductTyCon_maybe $ dataConTyCon dc - is_non_sum_alt _ = True + is_single_data_alt (DataAlt dc) = isJust $ tyConSingleAlgDataCon_maybe $ dataConTyCon dc + is_single_data_alt _ = True dmdAnal' env dmd (Case scrut case_bndr ty alts) = let -- Case expression with multiple alternatives @@ -524,10 +527,11 @@ forcesRealWorld :: FamInstEnvs -> Type -> Bool forcesRealWorld fam_envs ty | ty `eqType` realWorldStatePrimTy = True - | Just DataConAppContext{ dcac_dc = dc, dcac_arg_tys = field_tys } + | Just DataConPatContext{ dcpc_dc = dc, dcpc_tc_args = tc_args } <- deepSplitProductType_maybe fam_envs ty , isUnboxedTupleDataCon dc - = any (\(ty,_) -> scaledThing ty `eqType` realWorldStatePrimTy) field_tys + , let field_tys = dataConInstArgTys dc tc_args + = any (eqType realWorldStatePrimTy . scaledThing) field_tys | otherwise = False @@ -809,21 +813,12 @@ dmdAnalRhsSig top_lvl rec_flag env let_dmd id rhs Recursive -> reuseEnv rhs_fv NonRecursive -> rhs_fv - rhs_fv2 = rhs_fv1 `keepAliveDmdEnv` extra_fvs - -- Find the RHS free vars of the unfoldings and RULES -- See Note [Absence analysis for stable unfoldings and RULES] - extra_fvs = foldr (unionVarSet . ruleRhsFreeIds) unf_fvs $ - idCoreRules id + rhs_fv2 = rhs_fv1 `keepAliveDmdEnv` bndrRuleAndUnfoldingIds id -- See Note [Lazy and unleashable free variables] (lazy_fv, sig_fv) = partitionVarEnv isWeakDmd rhs_fv2 - unf = realIdUnfolding id - unf_fvs | isStableUnfolding unf - , Just unf_body <- maybeUnfoldingTemplate unf - = exprFreeIds unf_body - | otherwise = emptyVarSet - -- | If given the (local, non-recursive) let-bound 'Id', 'useLetUp' determines -- whether we should process the binding up (body before rhs) or down (rhs -- before body). ===================================== compiler/GHC/Core/Opt/WorkWrap/Utils.hs ===================================== @@ -8,7 +8,7 @@ A library for the ``worker\/wrapper'' back-end to the strictness analyser module GHC.Core.Opt.WorkWrap.Utils ( mkWwBodies, mkWWstr, mkWorkerArgs - , DataConAppContext(..), deepSplitProductType_maybe, wantToUnbox + , DataConPatContext(..), deepSplitProductType_maybe, wantToUnbox , findTypeShape , isWorkerSmallEnough ) @@ -19,7 +19,8 @@ where import GHC.Prelude import GHC.Core -import GHC.Core.Utils ( exprType, mkCast, mkDefaultCase, mkSingleAltCase ) +import GHC.Core.Utils ( exprType, mkCast, mkDefaultCase, mkSingleAltCase + , dataConRepFSInstPat ) import GHC.Types.Id import GHC.Types.Id.Info ( JoinArity ) import GHC.Core.DataCon @@ -43,9 +44,11 @@ import GHC.Core.TyCon import GHC.Core.TyCon.RecWalk import GHC.Types.Unique.Supply import GHC.Types.Unique +import GHC.Types.Name ( getOccFS ) import GHC.Data.Maybe import GHC.Utils.Misc import GHC.Utils.Outputable +import GHC.Utils.Panic import GHC.Driver.Session import GHC.Driver.Ppr import GHC.Data.FastString @@ -606,53 +609,53 @@ mkWWstr_one dflags fam_envs has_inlineable_prag arg arg_ty = idType arg dmd = idDemandInfo arg -wantToUnbox :: FamInstEnvs -> Bool -> Type -> Demand -> Maybe ([Demand], DataConAppContext) +wantToUnbox :: FamInstEnvs -> Bool -> Type -> Demand -> Maybe ([Demand], DataConPatContext) +-- See Note [Which types are unboxed?] wantToUnbox fam_envs has_inlineable_prag ty dmd = case deepSplitProductType_maybe fam_envs ty of - Just dcac at DataConAppContext{ dcac_arg_tys = con_arg_tys } + Just dcpc at DataConPatContext{ dcpc_dc = dc } | isStrUsedDmd dmd + , let arity = dataConRepArity dc -- See Note [Unpacking arguments with product and polymorphic demands] - , Just cs <- split_prod_dmd_arity dmd (length con_arg_tys) + , Just cs <- split_prod_dmd_arity dmd arity -- See Note [Do not unpack class dictionaries] , not (has_inlineable_prag && isClassPred ty) -- See Note [mkWWstr and unsafeCoerce] - , cs `equalLength` con_arg_tys - -> Just (cs, dcac) + , cs `lengthIs` arity + -> Just (cs, dcpc) _ -> Nothing where - split_prod_dmd_arity dmd arty + split_prod_dmd_arity dmd arity -- For seqDmd, it should behave like , for some -- suitable arity - | isSeqDmd dmd = Just (replicate arty absDmd) + | isSeqDmd dmd = Just (replicate arity absDmd) | _ :* Prod ds <- dmd = Just ds | otherwise = Nothing unbox_one :: DynFlags -> FamInstEnvs -> Var -> [Demand] - -> DataConAppContext + -> DataConPatContext -> UniqSM (Bool, [Var], CoreExpr -> CoreExpr, CoreExpr -> CoreExpr) unbox_one dflags fam_envs arg cs - DataConAppContext { dcac_dc = data_con, dcac_tys = inst_tys - , dcac_arg_tys = inst_con_arg_tys - , dcac_co = co } - = do { (uniq1:uniqs) <- getUniquesM - ; let scale = scaleScaled (idMult arg) - scaled_inst_con_arg_tys = map (\(t,s) -> (scale t, s)) inst_con_arg_tys - -- See Note [Add demands for strict constructors] - cs' = addDataConStrictness data_con cs - unpk_args = zipWith3 mk_ww_arg uniqs scaled_inst_con_arg_tys cs' - unbox_fn = mkUnpackCase (Var arg) co (idMult arg) uniq1 - data_con unpk_args - arg_no_unf = zapStableUnfolding arg - -- See Note [Zap unfolding when beta-reducing] - -- in GHC.Core.Opt.Simplify; and see #13890 - rebox_fn = Let (NonRec arg_no_unf con_app) - con_app = mkConApp2 data_con inst_tys unpk_args `mkCast` mkSymCo co - ; (_, worker_args, wrap_fn, work_fn) <- mkWWstr dflags fam_envs False unpk_args - ; return (True, worker_args, unbox_fn . wrap_fn, work_fn . rebox_fn) } - -- Don't pass the arg, rebox instead - where - mk_ww_arg uniq ty sub_dmd = setIdDemandInfo (mk_ww_local uniq ty) sub_dmd + DataConPatContext { dcpc_dc = dc, dcpc_tc_args = tc_args + , dcpc_co = co } + = do { (case_bndr_uniq:pat_bndrs_uniqs) <- getUniquesM + ; let ex_name_fss = map getOccFS $ dataConExTyCoVars dc + (ex_tvs', arg_ids) = + dataConRepFSInstPat (ex_name_fss ++ repeat ww_prefix) pat_bndrs_uniqs (idMult arg) dc tc_args + -- See Note [Add demands for strict constructors] + cs' = addDataConStrictness dc cs + arg_ids' = zipWithEqual "unbox_one" setIdDemandInfo arg_ids cs' + unbox_fn = mkUnpackCase (Var arg) co (idMult arg) case_bndr_uniq + dc (ex_tvs' ++ arg_ids') + arg_no_unf = zapStableUnfolding arg + -- See Note [Zap unfolding when beta-reducing] + -- in GHC.Core.Opt.Simplify; and see #13890 + rebox_fn = Let (NonRec arg_no_unf con_app) + con_app = mkConApp2 dc tc_args (ex_tvs' ++ arg_ids') `mkCast` mkSymCo co + ; (_, worker_args, wrap_fn, work_fn) <- mkWWstr dflags fam_envs False (ex_tvs' ++ arg_ids') + ; return (True, worker_args, unbox_fn . wrap_fn, work_fn . rebox_fn) } + -- Don't pass the arg, rebox instead ---------------------- nop_fn :: CoreExpr -> CoreExpr @@ -932,73 +935,72 @@ off the unpacking in mkWWstr_one (see the isClassPred test). Historical note: #14955 describes how I got this fix wrong the first time. -} --- | Context for a 'DataCon' application with a hole for every field, including --- surrounding coercions. +-- | Context for a 'DataCon' pattern wrapped in a cast, where we know the type +-- arguments of the 'TyCon' but not any of the arguments to the 'DataCon' (type +-- or term). +-- -- The result of 'deepSplitProductType_maybe' and 'deepSplitCprType_maybe'. -- -- Example: -- --- > DataConAppContext Just [Int] [(Lazy, Int)] (co :: Maybe Int ~ First Int) +-- > DataConPatContext Right [Int, Bool] (co :: Right Int Bool ~ NT Char) -- -- represents -- --- > Just @Int (_1 :: Int) |> co :: First Int +-- > (Right ... :: Either Int Bool) |> co :: NT Char -- --- where _1 is a hole for the first argument. The number of arguments is --- determined by the length of @arg_tys at . -data DataConAppContext - = DataConAppContext - { dcac_dc :: !DataCon - , dcac_tys :: ![Type] - , dcac_arg_tys :: ![(Scaled Type, StrictnessMark)] - , dcac_co :: !Coercion +data DataConPatContext + = DataConPatContext + { dcpc_dc :: !DataCon + , dcpc_tc_args :: ![Type] + , dcpc_co :: !Coercion } -deepSplitProductType_maybe :: FamInstEnvs -> Type -> Maybe DataConAppContext --- If deepSplitProductType_maybe ty = Just (dc, tys, arg_tys, co) --- then dc @ tys (args::arg_tys) :: rep_ty --- co :: ty ~ rep_ty --- Why do we return the strictness of the data-con arguments? --- Answer: see Note [Record evaluated-ness in worker/wrapper] +-- | If @deepSplitProductType_maybe ty = Just (dc, tys, co)@ +-- then @dc \@tys \@_ex_tys (_args::_arg_tys) :: tc tys@ +-- and @co :: ty ~ tc tys@ +-- where underscore prefixes are holes, e.g. yet unspecified. +-- +-- See Note [Which types are unboxed?]. +deepSplitProductType_maybe :: FamInstEnvs -> Type -> Maybe DataConPatContext deepSplitProductType_maybe fam_envs ty | let (co, ty1) = topNormaliseType_maybe fam_envs ty `orElse` (mkRepReflCo ty, ty) , Just (tc, tc_args) <- splitTyConApp_maybe ty1 - , Just con <- isDataProductTyCon_maybe tc - , let arg_tys = dataConInstArgTys con tc_args - strict_marks = dataConRepStrictness con - = Just DataConAppContext { dcac_dc = con - , dcac_tys = tc_args - , dcac_arg_tys = zipEqual "dspt" arg_tys strict_marks - , dcac_co = co } + , Just con <- tyConSingleAlgDataCon_maybe tc + = Just DataConPatContext { dcpc_dc = con + , dcpc_tc_args = tc_args + , dcpc_co = co } deepSplitProductType_maybe _ _ = Nothing -deepSplitCprType_maybe - :: FamInstEnvs -> ConTag -> Type -> Maybe DataConAppContext --- If deepSplitCprType_maybe n ty = Just (dc, tys, arg_tys, co) --- then dc @ tys (args::arg_tys) :: rep_ty --- co :: ty ~ rep_ty --- Why do we return the strictness of the data-con arguments? --- Answer: see Note [Record evaluated-ness in worker/wrapper] +-- | If @deepSplitCprType_maybe n ty = Just (dc, tys, co)@ +-- then @dc \@tys \@_ex_tys (_args::_arg_tys) :: tc tys@ +-- and @co :: ty ~ tc tys@ +-- where underscore prefixes are holes, e.g. yet unspecified. +-- @dc@ is the @n at th data constructor of @tc at . +-- +-- See Note [Which types are unboxed?]. +deepSplitCprType_maybe :: FamInstEnvs -> ConTag -> Type -> Maybe DataConPatContext deepSplitCprType_maybe fam_envs con_tag ty | let (co, ty1) = topNormaliseType_maybe fam_envs ty `orElse` (mkRepReflCo ty, ty) , Just (tc, tc_args) <- splitTyConApp_maybe ty1 - , isDataTyCon tc + , isDataTyCon tc -- NB: rules out unboxed sums and pairs! , let cons = tyConDataCons tc , cons `lengthAtLeast` con_tag -- This might not be true if we import the - -- type constructor via a .hs-bool file (#8743) + -- type constructor via a .hs-boot file (#8743) , let con = cons `getNth` (con_tag - fIRST_TAG) - arg_tys = dataConInstArgTys con tc_args - strict_marks = dataConRepStrictness con - , all isLinear arg_tys + , null (dataConExTyCoVars con) -- no existentials; + -- See Note [Which types are unboxed?] + -- and GHC.Core.Opt.CprAnal.extendEnvForDataAlt + -- where we also check this. + , all isLinear (dataConInstArgTys con tc_args) -- Deactivates CPR worker/wrapper splits on constructors with non-linear -- arguments, for the moment, because they require unboxed tuple with variable -- multiplicity fields. - = Just DataConAppContext { dcac_dc = con - , dcac_tys = tc_args - , dcac_arg_tys = zipEqual "dspt" arg_tys strict_marks - , dcac_co = co } + = Just DataConPatContext { dcpc_dc = con + , dcpc_tc_args = tc_args + , dcpc_co = co } deepSplitCprType_maybe _ _ _ = Nothing isLinear :: Scaled a -> Bool @@ -1035,13 +1037,16 @@ findTypeShape fam_envs ty | Just (_, rhs, _) <- topReduceTyFamApp_maybe fam_envs tc tc_args = go rec_tc rhs - | Just con <- isDataProductTyCon_maybe tc + | Just con <- tyConSingleAlgDataCon_maybe tc , Just rec_tc <- if isTupleTyCon tc then Just rec_tc else checkRecTc rec_tc tc -- We treat tuples specially because they can't cause loops. -- Maybe we should do so in checkRecTc. - = TsProd (map (go rec_tc . scaledThing) (dataConInstArgTys con tc_args)) + -- The use of 'dubiousDataConInstArgTys' is OK, since this + -- function performs no substitution at all, hence the uniques + -- don't matter. + = TsProd (map (go rec_tc) (dubiousDataConInstArgTys con tc_args)) | Just (ty', _) <- instNewTyCon_maybe tc tc_args , Just rec_tc <- checkRecTc rec_tc tc @@ -1050,7 +1055,54 @@ findTypeShape fam_envs ty | otherwise = TsUnk -{- +-- | Exactly 'dataConInstArgTys', but lacks the (ASSERT'ed) precondition that +-- the 'DataCon' may not have existentials. The lack of cloning the existentials +-- compared to 'dataConInstExAndArgVars' makes this function \"dubious\"; +-- only use it where type variables aren't substituted for! +dubiousDataConInstArgTys :: DataCon -> [Type] -> [Type] +dubiousDataConInstArgTys dc tc_args = arg_tys + where + univ_tvs = dataConUnivTyVars dc + ex_tvs = dataConExTyCoVars dc + subst = extendTCvInScopeList (zipTvSubst univ_tvs tc_args) ex_tvs + arg_tys = substTy subst . scaledThing <$> dataConRepArgTys dc + +{- Note [Which types are unboxed?] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Worker/wrapper will unbox + + 1. A strict data type argument, that + * is an algebraic data type (not a newtype) + * has a single constructor (thus is a "product") + * that may bind existentials + We can transform + > f (D @ex a b) = e + to + > $wf @ex a b = e + via 'mkWWstr'. + + 2. The constructed result of a function, if + * its type is an algebraic data type (not a newtype) + * the applied data constructor *does not* bind existentials + We can transform + > f x y = let ... in D a b + to + > $wf x y = let ... in (# a, b #) + via 'mkWWcpr'. + + NB: We don't allow existentials for CPR W/W, because we don't have unboxed + dependent tuples (yet?). Otherwise, we could transform + > f x y = let ... in D @ex (a :: ..ex..) (b :: ..ex..) + to + > $wf x y = let ... in (# @ex, (a :: ..ex..), (b :: ..ex..) #) + +The respective tests are in 'deepSplitProductType_maybe' and +'deepSplitCprType_maybe', respectively. + +Note that the data constructor /can/ have evidence arguments: equality +constraints, type classes etc. So it can be GADT. These evidence +arguments are simply value arguments, and should not get in the way. + ************************************************************************ * * \subsection{CPR stuff} @@ -1083,35 +1135,36 @@ mkWWcpr opt_CprAnal fam_envs body_ty cpr | otherwise = case asConCpr cpr of Nothing -> return (False, id, id, body_ty) -- No CPR info - Just con_tag | Just dcac <- deepSplitCprType_maybe fam_envs con_tag body_ty - -> mkWWcpr_help dcac + Just con_tag | Just dcpc <- deepSplitCprType_maybe fam_envs con_tag body_ty + -> mkWWcpr_help dcpc | otherwise -- See Note [non-algebraic or open body type warning] -> WARN( True, text "mkWWcpr: non-algebraic or open body type" <+> ppr body_ty ) return (False, id, id, body_ty) -mkWWcpr_help :: DataConAppContext +mkWWcpr_help :: DataConPatContext -> UniqSM (Bool, CoreExpr -> CoreExpr, CoreExpr -> CoreExpr, Type) -mkWWcpr_help (DataConAppContext { dcac_dc = data_con, dcac_tys = inst_tys - , dcac_arg_tys = arg_tys, dcac_co = co }) - | [arg1@(arg_ty1, _)] <- arg_tys - , isUnliftedType (scaledThing arg_ty1) - , isLinear arg_ty1 +mkWWcpr_help (DataConPatContext { dcpc_dc = dc, dcpc_tc_args = tc_args + , dcpc_co = co }) + | [arg_ty] <- arg_tys + , [str_mark] <- str_marks + , isUnliftedType (scaledThing arg_ty) + , isLinear arg_ty -- Special case when there is a single result of unlifted, linear, type -- -- Wrapper: case (..call worker..) of x -> C x -- Worker: case ( ..body.. ) of C x -> x = do { (work_uniq : arg_uniq : _) <- getUniquesM - ; let arg = mk_ww_local arg_uniq arg1 - con_app = mkConApp2 data_con inst_tys [arg] `mkCast` mkSymCo co + ; let arg_id = mk_ww_local arg_uniq str_mark arg_ty + con_app = mkConApp2 dc tc_args [arg_id] `mkCast` mkSymCo co ; return ( True - , \ wkr_call -> mkDefaultCase wkr_call arg con_app - , \ body -> mkUnpackCase body co One work_uniq data_con [arg] (varToCoreExpr arg) + , \ wkr_call -> mkDefaultCase wkr_call arg_id con_app + , \ body -> mkUnpackCase body co One work_uniq dc [arg_id] (varToCoreExpr arg_id) -- varToCoreExpr important here: arg can be a coercion -- Lacking this caused #10658 - , scaledThing arg_ty1 ) } + , scaledThing arg_ty ) } | otherwise -- The general case -- Wrapper: case (..call worker..) of (# a, b #) -> C a b @@ -1123,19 +1176,26 @@ mkWWcpr_help (DataConAppContext { dcac_dc = data_con, dcac_tys = inst_tys -- parametrised by the multiplicity of its fields. Specifically, in this -- instance, the multiplicity of the fields of (#,#) is chosen to be the -- same as those of C. - = do { (work_uniq : wild_uniq : uniqs) <- getUniquesM - ; let wrap_wild = mk_ww_local wild_uniq (linear ubx_tup_ty,MarkedStrict) - args = zipWith mk_ww_local uniqs arg_tys - ubx_tup_ty = exprType ubx_tup_app - ubx_tup_app = mkCoreUbxTup (map (scaledThing . fst) arg_tys) (map varToCoreExpr args) - con_app = mkConApp2 data_con inst_tys args `mkCast` mkSymCo co - tup_con = tupleDataCon Unboxed (length arg_tys) + = do { (work_uniq : wild_uniq : pat_bndrs_uniqs) <- getUniquesM + ; let case_mult = One -- see above + (_exs, arg_ids) = + dataConRepFSInstPat (repeat ww_prefix) pat_bndrs_uniqs case_mult dc tc_args + wrap_wild = mk_ww_local wild_uniq MarkedStrict (Scaled case_mult ubx_tup_ty) + ubx_tup_ty = exprType ubx_tup_app + ubx_tup_app = mkCoreUbxTup (map scaledThing arg_tys) (map varToCoreExpr arg_ids) + con_app = mkConApp2 dc tc_args arg_ids `mkCast` mkSymCo co + tup_con = tupleDataCon Unboxed (length arg_tys) + + ; MASSERT( null _exs ) -- Should have been caught by deepSplitCprType_maybe ; return (True , \ wkr_call -> mkSingleAltCase wkr_call wrap_wild - (DataAlt tup_con) args con_app - , \ body -> mkUnpackCase body co One work_uniq data_con args ubx_tup_app + (DataAlt tup_con) arg_ids con_app + , \ body -> mkUnpackCase body co case_mult work_uniq dc arg_ids ubx_tup_app , ubx_tup_ty ) } + where + arg_tys = dataConInstArgTys dc tc_args -- NB: No existentials! + str_marks = dataConRepStrictness dc mkUnpackCase :: CoreExpr -> Coercion -> Mult -> Unique -> DataCon -> [Id] -> CoreExpr -> CoreExpr -- (mkUnpackCase e co uniq Con args body) @@ -1149,7 +1209,7 @@ mkUnpackCase scrut co mult uniq boxing_con unpk_args body (DataAlt boxing_con) unpk_args body where casted_scrut = scrut `mkCast` co - bndr = mk_ww_local uniq (Scaled mult (exprType casted_scrut), MarkedStrict) + bndr = mk_ww_local uniq MarkedStrict (Scaled mult (exprType casted_scrut)) -- An unpacking case can always be chosen linear, because the variables -- are always passed to a constructor. This limits the {- @@ -1291,10 +1351,13 @@ mk_absent_let dflags fam_envs arg -- See also Note [Unique Determinism] in GHC.Types.Unique unlifted_rhs = mkTyApps (Lit rubbishLit) [arg_ty] -mk_ww_local :: Unique -> (Scaled Type, StrictnessMark) -> Id +ww_prefix :: FastString +ww_prefix = fsLit "ww" + +mk_ww_local :: Unique -> StrictnessMark -> Scaled Type -> Id -- The StrictnessMark comes form the data constructor and says -- whether this field is strict -- See Note [Record evaluated-ness in worker/wrapper] -mk_ww_local uniq (Scaled w ty,str) +mk_ww_local uniq str (Scaled w ty) = setCaseBndrEvald str $ - mkSysLocalOrCoVar (fsLit "ww") uniq w ty + mkSysLocalOrCoVar ww_prefix uniq w ty ===================================== compiler/GHC/Core/TyCon.hs ===================================== @@ -58,8 +58,7 @@ module GHC.Core.TyCon( isKindTyCon, isLiftedTypeKindTyConName, isTauTyCon, isFamFreeTyCon, isForgetfulSynTyCon, - isDataTyCon, isProductTyCon, isDataProductTyCon_maybe, - isDataSumTyCon_maybe, + isDataTyCon, isEnumerationTyCon, isNewTyCon, isAbstractTyCon, isFamilyTyCon, isOpenFamilyTyCon, @@ -84,6 +83,7 @@ module GHC.Core.TyCon( tyConCType, tyConCType_maybe, tyConDataCons, tyConDataCons_maybe, tyConSingleDataCon_maybe, tyConSingleDataCon, + tyConAlgDataCons_maybe, tyConSingleAlgDataCon_maybe, tyConFamilySize, tyConStupidTheta, @@ -143,7 +143,7 @@ import {-# SOURCE #-} GHC.Builtin.Types , multiplicityTyCon , vecCountTyCon, vecElemTyCon, liftedTypeKind ) import {-# SOURCE #-} GHC.Core.DataCon - ( DataCon, dataConExTyCoVars, dataConFieldLabels + ( DataCon, dataConFieldLabels , dataConTyCon, dataConFullSig , isUnboxedSumDataCon ) import GHC.Builtin.Uniques @@ -1976,72 +1976,6 @@ unwrapNewTyConEtad_maybe (AlgTyCon { algTcRhs = NewTyCon { nt_co = co, = Just (tvs, rhs, co) unwrapNewTyConEtad_maybe _ = Nothing -isProductTyCon :: TyCon -> Bool --- True of datatypes or newtypes that have --- one, non-existential, data constructor --- See Note [Product types] -isProductTyCon tc@(AlgTyCon {}) - = case algTcRhs tc of - TupleTyCon {} -> True - DataTyCon{ data_cons = [data_con] } - -> null (dataConExTyCoVars data_con) - NewTyCon {} -> True - _ -> False -isProductTyCon _ = False - -isDataProductTyCon_maybe :: TyCon -> Maybe DataCon --- True of datatypes (not newtypes) with --- one, vanilla, data constructor --- See Note [Product types] -isDataProductTyCon_maybe (AlgTyCon { algTcRhs = rhs }) - = case rhs of - DataTyCon { data_cons = [con] } - | null (dataConExTyCoVars con) -- non-existential - -> Just con - TupleTyCon { data_con = con } - -> Just con - _ -> Nothing -isDataProductTyCon_maybe _ = Nothing - -isDataSumTyCon_maybe :: TyCon -> Maybe [DataCon] -isDataSumTyCon_maybe (AlgTyCon { algTcRhs = rhs }) - = case rhs of - DataTyCon { data_cons = cons } - | cons `lengthExceeds` 1 - , all (null . dataConExTyCoVars) cons -- FIXME(osa): Why do we need this? - -> Just cons - SumTyCon { data_cons = cons } - | all (null . dataConExTyCoVars) cons -- FIXME(osa): Why do we need this? - -> Just cons - _ -> Nothing -isDataSumTyCon_maybe _ = Nothing - -{- Note [Product types] -~~~~~~~~~~~~~~~~~~~~~~~ -A product type is - * A data type (not a newtype) - * With one, boxed data constructor - * That binds no existential type variables - -The main point is that product types are amenable to unboxing for - * Strict function calls; we can transform - f (D a b) = e - to - fw a b = e - via the worker/wrapper transformation. (Question: couldn't this - work for existentials too?) - - * CPR for function results; we can transform - f x y = let ... in D a b - to - fw x y = let ... in (# a, b #) - -Note that the data constructor /can/ have evidence arguments: equality -constraints, type classes etc. So it can be GADT. These evidence -arguments are simply value arguments, and should not get in the way. --} - - -- | Is this a 'TyCon' representing a regular H98 type synonym (@type@)? {-# INLINE isTypeSynonymTyCon #-} -- See Note [Inlining coreView] in GHC.Core.Type isTypeSynonymTyCon :: TyCon -> Bool @@ -2380,8 +2314,7 @@ tyConDataCons_maybe _ = Nothing -- | If the given 'TyCon' has a /single/ data constructor, i.e. it is a @data@ -- type with one alternative, a tuple type or a @newtype@ then that constructor -- is returned. If the 'TyCon' has more than one constructor, or represents a --- primitive or function type constructor then @Nothing@ is returned. In any --- other case, the function panics +-- primitive or function type constructor then @Nothing@ is returned. tyConSingleDataCon_maybe :: TyCon -> Maybe DataCon tyConSingleDataCon_maybe (AlgTyCon { algTcRhs = rhs }) = case rhs of @@ -2391,21 +2324,29 @@ tyConSingleDataCon_maybe (AlgTyCon { algTcRhs = rhs }) _ -> Nothing tyConSingleDataCon_maybe _ = Nothing +-- | Like 'tyConSingleDataCon_maybe', but panics if 'Nothing'. tyConSingleDataCon :: TyCon -> DataCon tyConSingleDataCon tc = case tyConSingleDataCon_maybe tc of Just c -> c Nothing -> pprPanic "tyConDataCon" (ppr tc) +-- | Like 'tyConSingleDataCon_maybe', but returns 'Nothing' for newtypes. tyConSingleAlgDataCon_maybe :: TyCon -> Maybe DataCon --- Returns (Just con) for single-constructor --- *algebraic* data types *not* newtypes -tyConSingleAlgDataCon_maybe (AlgTyCon { algTcRhs = rhs }) - = case rhs of - DataTyCon { data_cons = [c] } -> Just c - TupleTyCon { data_con = c } -> Just c - _ -> Nothing -tyConSingleAlgDataCon_maybe _ = Nothing +tyConSingleAlgDataCon_maybe tycon + | isNewTyCon tycon = Nothing + | otherwise = tyConSingleDataCon_maybe tycon + +-- | Returns @Just dcs@ if the given 'TyCon' is a @data@ type, a tuple type +-- or a sum type with data constructors dcs. If the 'TyCon' has more than one +-- constructor, or represents a primitive or function type constructor then +-- @Nothing@ is returned. +-- +-- Like 'tyConDataCons_maybe', but returns 'Nothing' for newtypes. +tyConAlgDataCons_maybe :: TyCon -> Maybe [DataCon] +tyConAlgDataCons_maybe tycon + | isNewTyCon tycon = Nothing + | otherwise = tyConDataCons_maybe tycon -- | Determine the number of value constructors a 'TyCon' has. Panics if the -- 'TyCon' is not algebraic or a tuple ===================================== compiler/GHC/CoreToIface.hs ===================================== @@ -245,7 +245,7 @@ toIfaceTyCon tc , Just tsort <- tupleSort tc' = tsort | isUnboxedSumTyCon tc - , Just cons <- isDataSumTyCon_maybe tc = IfaceSumTyCon (length cons) + , Just cons <- tyConDataCons_maybe tc = IfaceSumTyCon (length cons) | otherwise = IfaceNormalTyCon ===================================== compiler/GHC/Hs/Pat.hs ===================================== @@ -771,8 +771,6 @@ isIrrefutableHsPat L _ (PatSynCon _pat) -> False -- Conservative L _ (RealDataCon con) -> isJust (tyConSingleDataCon_maybe (dataConTyCon con)) - -- NB: tyConSingleDataCon_maybe, *not* isProductTyCon, because - -- the latter is false of existentials. See #4439 && all goL (hsConPatArgs details) go (LitPat {}) = False go (NPat {}) = False ===================================== compiler/GHC/HsToCore/Foreign/Call.hs ===================================== @@ -350,7 +350,8 @@ resultWrapper result_ty -- Data types with a single constructor, which has a single arg -- This includes types like Ptr and ForeignPtr | Just (tycon, tycon_arg_tys) <- maybe_tc_app - , Just data_con <- isDataProductTyCon_maybe tycon -- One constructor, no existentials + , Just data_con <- tyConSingleAlgDataCon_maybe tycon -- One constructor + , null (dataConExTyCoVars data_con) -- no existentials , [Scaled _ unwrapped_res_ty] <- dataConInstOrigArgTys data_con tycon_arg_tys -- One argument = do { (maybe_ty, wrapper) <- resultWrapper unwrapped_res_ty ; let marshal_con e = Var (dataConWrapId data_con) ===================================== compiler/GHC/HsToCore/Utils.hs ===================================== @@ -737,7 +737,7 @@ is_flat_prod_pat (TuplePat _ ps Boxed) = all is_triv_lpat ps is_flat_prod_pat (ConPat { pat_con = L _ pcon , pat_args = ps}) | RealDataCon con <- pcon - , isProductTyCon (dataConTyCon con) + , Just _ <- tyConSingleDataCon_maybe (dataConTyCon con) = all is_triv_lpat (hsConPatArgs ps) is_flat_prod_pat _ = False ===================================== compiler/GHC/Tc/Deriv/Utils.hs ===================================== @@ -928,8 +928,8 @@ cond_isEnumeration _ _ rep_tc cond_isProduct :: Condition cond_isProduct _ _ rep_tc - | isProductTyCon rep_tc = IsValid - | otherwise = NotValid why + | Just _ <- tyConSingleDataCon_maybe rep_tc = IsValid + | otherwise = NotValid why where why = quotes (pprSourceTyCon rep_tc) <+> text "must have precisely one constructor" ===================================== compiler/GHC/Types/Demand.hs ===================================== @@ -55,6 +55,7 @@ module GHC.Types.Demand ( PlusDmdArg, mkPlusDmdArg, toPlusDmdArg, -- ** Other operations peelFV, findIdDemand, addDemand, splitDmdTy, deferAfterPreciseException, + keepAliveDmdType, -- * Demand signatures StrictSig(..), mkStrictSigForArity, mkClosedStrictSig, @@ -1196,6 +1197,11 @@ findIdDemand (DmdType fv _ res) id deferAfterPreciseException :: DmdType -> DmdType deferAfterPreciseException = lubDmdType exnDmdType +-- | See 'keepAliveDmdEnv'. +keepAliveDmdType :: DmdType -> VarSet -> DmdType +keepAliveDmdType (DmdType fvs ds res) vars = + DmdType (fvs `keepAliveDmdEnv` vars) ds res + {- Note [Demand type Divergence] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== testsuite/tests/simplCore/should_compile/T18013.stderr ===================================== @@ -132,33 +132,58 @@ Result size of Tidy Core = {terms: 52, types: 106, coercions: 17, joins: 0/1} -- RHS size: {terms: 37, types: 87, coercions: 17, joins: 0/1} -mapMaybeRule +mapMaybeRule [InlPrag=[2]] :: forall a b. Rule IO a b -> Rule IO (Maybe a) (Maybe b) [GblId, Arity=1, - Str=, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 150 10}] + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (@a) (@b) (w [Occ=Once1!] :: Rule IO a b) -> + case w of { Rule @s ww1 ww2 [Occ=OnceL1!] -> + T18013a.Rule + @IO + @(Maybe a) + @(Maybe b) + @s + ww1 + ((\ (s2 [Occ=Once1] :: s) + (a1 [Occ=Once1!] :: Maybe a) + (s1 [Occ=Once2] :: GHC.Prim.State# GHC.Prim.RealWorld) -> + case a1 of { + Nothing -> + (# s1, T18013a.Result @s @(Maybe b) ww1 (GHC.Maybe.Nothing @b) #); + Just x [Occ=Once1] -> + case ((ww2 s2 x) `cast` ) s1 of + { (# ipv [Occ=Once1], ipv1 [Occ=Once1!] #) -> + case ipv1 of { Result t2 [Occ=Once1] c1 [Occ=Once1] -> + (# ipv, T18013a.Result @s @(Maybe b) t2 (GHC.Maybe.Just @b c1) #) + } + } + }) + `cast` ) + }}] mapMaybeRule - = \ (@a) (@b) (f :: Rule IO a b) -> - case f of { Rule @s t0 g -> + = \ (@a) (@b) (w :: Rule IO a b) -> + case w of { Rule @s ww1 ww2 -> let { lvl :: Result s (Maybe b) [LclId, Unf=OtherCon []] - lvl = T18013a.Result @s @(Maybe b) t0 (GHC.Maybe.Nothing @b) } in + lvl = T18013a.Result @s @(Maybe b) ww1 (GHC.Maybe.Nothing @b) } in T18013a.Rule @IO @(Maybe a) @(Maybe b) @s - t0 + ww1 ((\ (s2 :: s) (a1 :: Maybe a) (s1 :: GHC.Prim.State# GHC.Prim.RealWorld) -> case a1 of { Nothing -> (# s1, lvl #); Just x -> - case ((g s2 x) `cast` ) s1 of { (# ipv, ipv1 #) -> + case ((ww2 s2 x) `cast` ) s1 of { (# ipv, ipv1 #) -> case ipv1 of { Result t2 c1 -> (# ipv, T18013a.Result @s @(Maybe b) t2 (GHC.Maybe.Just @b c1) #) } ===================================== testsuite/tests/stranal/should_compile/T18982.hs ===================================== @@ -0,0 +1,41 @@ +{-# OPTIONS_GHC -O -fforce-recomp #-} +{-# LANGUAGE GADTs #-} + +module T18982 where + +data Box a where + Box :: a -> Box a + +data Ex a where + Ex :: e -> a -> Ex a + +data GADT a where + GADT :: Int -> GADT Int + +data ExGADT a where + ExGADT :: (e ~ Int) => e -> Int -> ExGADT Int + +-- | Expected worker type: +-- $wf :: Int# -> Int# +f :: Box Int -> Int +f (Box n) = n + 1 +{-# NOINLINE f #-} + +-- | Expected worker type: +-- $wg :: forall {e}. e -> Int# -> Int# +g :: Ex Int -> Int +g (Ex e n) = e `seq` n + 1 +{-# NOINLINE g #-} + +-- | Expected worker type: +-- $wh :: Int# -> Int# +h :: GADT a -> Int +h (GADT n) = n + 1 +{-# NOINLINE h #-} + +-- | Expected worker type: +-- $wi :: forall {e}. e -> Int# -> Int# +i :: ExGADT a -> Int +i (ExGADT e n) = e `seq` n + 1 +{-# NOINLINE i #-} + ===================================== testsuite/tests/stranal/should_compile/T18982.stderr ===================================== @@ -0,0 +1,246 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core = {terms: 311, types: 249, coercions: 4, joins: 0/0} + +-- RHS size: {terms: 8, types: 11, coercions: 1, joins: 0/0} +T18982.$WExGADT :: forall e. (e ~ Int) => e %1 -> Int %1 -> ExGADT Int +T18982.$WExGADT = \ (@e) (dt :: e ~ Int) (dt :: e) (dt :: Int) -> T18982.ExGADT @Int @e @~(_N :: Int GHC.Prim.~# Int) dt dt dt + +-- RHS size: {terms: 3, types: 2, coercions: 1, joins: 0/0} +T18982.$WGADT :: Int %1 -> GADT Int +T18982.$WGADT = \ (dt :: Int) -> T18982.GADT @Int @~(_N :: Int GHC.Prim.~# Int) dt + +-- RHS size: {terms: 7, types: 8, coercions: 0, joins: 0/0} +T18982.$WEx :: forall e a. e %1 -> a %1 -> Ex a +T18982.$WEx = \ (@e) (@a) (dt :: e) (dt :: a) -> T18982.Ex @a @e dt dt + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$trModule4 :: GHC.Prim.Addr# +T18982.$trModule4 = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$trModule3 :: GHC.Types.TrName +T18982.$trModule3 = GHC.Types.TrNameS T18982.$trModule4 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$trModule2 :: GHC.Prim.Addr# +T18982.$trModule2 = "T18982"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$trModule1 :: GHC.Types.TrName +T18982.$trModule1 = GHC.Types.TrNameS T18982.$trModule2 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18982.$trModule :: GHC.Types.Module +T18982.$trModule = GHC.Types.Module T18982.$trModule3 T18982.$trModule1 + +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} +$krep :: GHC.Types.KindRep +$krep = GHC.Types.KindRepTyConApp GHC.Types.$tcInt (GHC.Types.[] @GHC.Types.KindRep) + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$krep1 :: GHC.Types.KindRep +$krep1 = GHC.Types.KindRepVar 1# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$krep2 :: GHC.Types.KindRep +$krep2 = GHC.Types.KindRepVar 0# + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +$krep3 :: [GHC.Types.KindRep] +$krep3 = GHC.Types.: @GHC.Types.KindRep $krep (GHC.Types.[] @GHC.Types.KindRep) + +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} +$krep4 :: [GHC.Types.KindRep] +$krep4 = GHC.Types.: @GHC.Types.KindRep $krep2 $krep3 + +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} +$krep5 :: [GHC.Types.KindRep] +$krep5 = GHC.Types.: @GHC.Types.KindRep GHC.Types.krep$* $krep4 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep6 :: GHC.Types.KindRep +$krep6 = GHC.Types.KindRepTyConApp GHC.Types.$tc~ $krep5 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tcBox2 :: GHC.Prim.Addr# +T18982.$tcBox2 = "Box"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tcBox1 :: GHC.Types.TrName +T18982.$tcBox1 = GHC.Types.TrNameS T18982.$tcBox2 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tcBox :: GHC.Types.TyCon +T18982.$tcBox = GHC.Types.TyCon 16948648223906549518## 2491460178135962649## T18982.$trModule T18982.$tcBox1 0# GHC.Types.krep$*Arr* + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +$krep7 :: [GHC.Types.KindRep] +$krep7 = GHC.Types.: @GHC.Types.KindRep $krep2 (GHC.Types.[] @GHC.Types.KindRep) + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep8 :: GHC.Types.KindRep +$krep8 = GHC.Types.KindRepTyConApp T18982.$tcBox $krep7 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Box1 :: GHC.Types.KindRep +T18982.$tc'Box1 = GHC.Types.KindRepFun $krep2 $krep8 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Box3 :: GHC.Prim.Addr# +T18982.$tc'Box3 = "'Box"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Box2 :: GHC.Types.TrName +T18982.$tc'Box2 = GHC.Types.TrNameS T18982.$tc'Box3 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Box :: GHC.Types.TyCon +T18982.$tc'Box = GHC.Types.TyCon 1412068769125067428## 8727214667407894081## T18982.$trModule T18982.$tc'Box2 1# T18982.$tc'Box1 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tcEx2 :: GHC.Prim.Addr# +T18982.$tcEx2 = "Ex"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tcEx1 :: GHC.Types.TrName +T18982.$tcEx1 = GHC.Types.TrNameS T18982.$tcEx2 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tcEx :: GHC.Types.TyCon +T18982.$tcEx = GHC.Types.TyCon 4376661818164435927## 18005417598910668817## T18982.$trModule T18982.$tcEx1 0# GHC.Types.krep$*Arr* + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +$krep9 :: [GHC.Types.KindRep] +$krep9 = GHC.Types.: @GHC.Types.KindRep $krep1 (GHC.Types.[] @GHC.Types.KindRep) + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep10 :: GHC.Types.KindRep +$krep10 = GHC.Types.KindRepTyConApp T18982.$tcEx $krep9 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep11 :: GHC.Types.KindRep +$krep11 = GHC.Types.KindRepFun $krep1 $krep10 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Ex1 :: GHC.Types.KindRep +T18982.$tc'Ex1 = GHC.Types.KindRepFun $krep2 $krep11 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Ex3 :: GHC.Prim.Addr# +T18982.$tc'Ex3 = "'Ex"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Ex2 :: GHC.Types.TrName +T18982.$tc'Ex2 = GHC.Types.TrNameS T18982.$tc'Ex3 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Ex :: GHC.Types.TyCon +T18982.$tc'Ex = GHC.Types.TyCon 14609381081172201359## 3077219645053200509## T18982.$trModule T18982.$tc'Ex2 2# T18982.$tc'Ex1 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tcGADT2 :: GHC.Prim.Addr# +T18982.$tcGADT2 = "GADT"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tcGADT1 :: GHC.Types.TrName +T18982.$tcGADT1 = GHC.Types.TrNameS T18982.$tcGADT2 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tcGADT :: GHC.Types.TyCon +T18982.$tcGADT = GHC.Types.TyCon 9243924476135839950## 5096619276488416461## T18982.$trModule T18982.$tcGADT1 0# GHC.Types.krep$*Arr* + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep12 :: GHC.Types.KindRep +$krep12 = GHC.Types.KindRepTyConApp T18982.$tcGADT $krep3 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'GADT1 :: GHC.Types.KindRep +T18982.$tc'GADT1 = GHC.Types.KindRepFun $krep $krep12 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'GADT3 :: GHC.Prim.Addr# +T18982.$tc'GADT3 = "'GADT"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'GADT2 :: GHC.Types.TrName +T18982.$tc'GADT2 = GHC.Types.TrNameS T18982.$tc'GADT3 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'GADT :: GHC.Types.TyCon +T18982.$tc'GADT = GHC.Types.TyCon 2077850259354179864## 16731205864486799217## T18982.$trModule T18982.$tc'GADT2 0# T18982.$tc'GADT1 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tcExGADT2 :: GHC.Prim.Addr# +T18982.$tcExGADT2 = "ExGADT"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tcExGADT1 :: GHC.Types.TrName +T18982.$tcExGADT1 = GHC.Types.TrNameS T18982.$tcExGADT2 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tcExGADT :: GHC.Types.TyCon +T18982.$tcExGADT = GHC.Types.TyCon 6470898418160489500## 10361108917441214060## T18982.$trModule T18982.$tcExGADT1 0# GHC.Types.krep$*Arr* + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep13 :: GHC.Types.KindRep +$krep13 = GHC.Types.KindRepTyConApp T18982.$tcExGADT $krep3 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep14 :: GHC.Types.KindRep +$krep14 = GHC.Types.KindRepFun $krep $krep13 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep15 :: GHC.Types.KindRep +$krep15 = GHC.Types.KindRepFun $krep2 $krep14 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'ExGADT1 :: GHC.Types.KindRep +T18982.$tc'ExGADT1 = GHC.Types.KindRepFun $krep6 $krep15 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'ExGADT3 :: GHC.Prim.Addr# +T18982.$tc'ExGADT3 = "'ExGADT"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'ExGADT2 :: GHC.Types.TrName +T18982.$tc'ExGADT2 = GHC.Types.TrNameS T18982.$tc'ExGADT3 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'ExGADT :: GHC.Types.TyCon +T18982.$tc'ExGADT = GHC.Types.TyCon 8468257409157161049## 5503123603717080600## T18982.$trModule T18982.$tc'ExGADT2 1# T18982.$tc'ExGADT1 + +-- RHS size: {terms: 11, types: 14, coercions: 0, joins: 0/0} +T18982.$wi :: forall {a} {e}. (a GHC.Prim.~# Int) -> e -> GHC.Prim.Int# -> GHC.Prim.Int# +T18982.$wi = \ (@a) (@e) (ww :: a GHC.Prim.~# Int) (ww1 :: e) (ww2 :: GHC.Prim.Int#) -> case ww1 of { __DEFAULT -> GHC.Prim.+# ww2 1# } + +-- RHS size: {terms: 15, types: 27, coercions: 1, joins: 0/0} +i :: forall a. ExGADT a -> Int +i = \ (@a) (w :: ExGADT a) -> case w of { ExGADT @e ww1 ww2 ww3 ww4 -> case ww4 of { GHC.Types.I# ww6 -> case T18982.$wi @a @e @~(ww1 :: a GHC.Prim.~# Int) ww3 ww6 of ww7 { __DEFAULT -> GHC.Types.I# ww7 } } } + +-- RHS size: {terms: 6, types: 10, coercions: 0, joins: 0/0} +T18982.$wh :: forall {a}. (a GHC.Prim.~# Int) -> GHC.Prim.Int# -> GHC.Prim.Int# +T18982.$wh = \ (@a) (ww :: a GHC.Prim.~# Int) (ww1 :: GHC.Prim.Int#) -> GHC.Prim.+# ww1 1# + +-- RHS size: {terms: 14, types: 18, coercions: 1, joins: 0/0} +h :: forall a. GADT a -> Int +h = \ (@a) (w :: GADT a) -> case w of { GADT ww1 ww2 -> case ww2 of { GHC.Types.I# ww4 -> case T18982.$wh @a @~(ww1 :: a GHC.Prim.~# Int) ww4 of ww5 { __DEFAULT -> GHC.Types.I# ww5 } } } + +-- RHS size: {terms: 9, types: 5, coercions: 0, joins: 0/0} +T18982.$wg :: forall {e}. e -> GHC.Prim.Int# -> GHC.Prim.Int# +T18982.$wg = \ (@e) (ww :: e) (ww1 :: GHC.Prim.Int#) -> case ww of { __DEFAULT -> GHC.Prim.+# ww1 1# } + +-- RHS size: {terms: 14, types: 12, coercions: 0, joins: 0/0} +g :: Ex Int -> Int +g = \ (w :: Ex Int) -> case w of { Ex @e ww1 ww2 -> case ww2 of { GHC.Types.I# ww4 -> case T18982.$wg @e ww1 ww4 of ww5 { __DEFAULT -> GHC.Types.I# ww5 } } } + +-- RHS size: {terms: 4, types: 1, coercions: 0, joins: 0/0} +T18982.$wf :: GHC.Prim.Int# -> GHC.Prim.Int# +T18982.$wf = \ (ww :: GHC.Prim.Int#) -> GHC.Prim.+# ww 1# + +-- RHS size: {terms: 13, types: 8, coercions: 0, joins: 0/0} +f :: Box Int -> Int +f = \ (w :: Box Int) -> case w of { Box ww1 -> case ww1 of { GHC.Types.I# ww3 -> case T18982.$wf ww3 of ww4 { __DEFAULT -> GHC.Types.I# ww4 } } } + + + ===================================== testsuite/tests/stranal/should_compile/all.T ===================================== @@ -62,3 +62,5 @@ test('T18903', [ grep_errmsg(r'Dmd=\S+C\S+') ], compile, ['-ddump-simpl -dsuppr test('T18894', [ grep_errmsg(r'Dmd=\S+C\S+') ], compile, ['-ddump-stranal -dsuppress-uniques']) # We care about the Arity 2 on eta, as a result of the annotated Dmd test('T18894b', [ grep_errmsg(r'Arity=2') ], compile, ['-ddump-stranal -dsuppress-uniques -fno-call-arity -dppr-cols=200']) +# We care about the workers of f,g,h,i: +test('T18982', [ grep_errmsg(r'\$w. .*Int#$') ], compile, ['-dppr-cols=1000 -ddump-simpl -dsuppress-idinfo -dsuppress-uniques']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a7ff359a55016727f6495f529a4c2964dda24db9...aeaa91260a3d6ae57605dfa415e56d2691e74ade -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a7ff359a55016727f6495f529a4c2964dda24db9...aeaa91260a3d6ae57605dfa415e56d2691e74ade You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 18 10:50:43 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 18 Dec 2020 05:50:43 -0500 Subject: [Git][ghc/ghc][master] Use HsOuterExplicit in instance sigs in deriving-generated code Message-ID: <5fdc8983c8cf4_6b217c5d45423180b@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 7a93435b by Ryan Scott at 2020-12-18T05:50:33-05:00 Use HsOuterExplicit in instance sigs in deriving-generated code Issue #18914 revealed that `GeneralizedNewtypeDeriving` would generate code that mentions unbound type variables, which is dangerously fragile. The problem (and fix) is described in the new `Wrinkle: Use HsOuterExplicit` in `Note [GND and QuantifiedConstraints]`. The gist of it: make sure to put the top-level `forall`s in `deriving`-generated instance signatures in an `HsOuterExplicit` to ensure that they scope over the bodies of methods correctly. A side effect of this process is that it will expand any type synonyms in the instance signature, which will surface any `forall`s that are hidden underneath type synonyms (such as in the test case for #18914). While I was in town, I also performed some maintenance on `NewHsTypeX`, which powers `GeneralizedNewtypeDeriving`: * I renamed `NewHsTypeX` to `HsCoreTy`, which more accurately describes its intended purpose (#15706). I also made `HsCoreTy` a type synonym instead of a newtype, as making it a distinct data type wasn't buying us much. * To make sure that mistakes similar to #18914 do not occur later, I added an additional validity check when renaming `HsCoreTy`s that complains if an `HsCoreTy`s contains an out-of-scope type variable. See the new `Note [Renaming HsCoreTys]` in `GHC.Rename.HsType` for the details. Fixes #15706. Fixes #18914. Bumps the `haddock` submodule. - - - - - 10 changed files: - compiler/GHC/Hs/Type.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Sig.hs - compiler/GHC/Tc/TyCl/Instance.hs - testsuite/tests/deriving/should_compile/T14578.stderr - + testsuite/tests/deriving/should_compile/T18914.hs - testsuite/tests/deriving/should_compile/all.T - utils/haddock Changes: ===================================== compiler/GHC/Hs/Type.hs ===================================== @@ -24,7 +24,7 @@ module GHC.Hs.Type ( HsArrow(..), arrowToHsType, hsLinear, hsUnrestricted, isUnrestricted, - HsType(..), NewHsTypeX(..), LHsType, HsKind, LHsKind, + HsType(..), HsCoreTy, LHsType, HsKind, LHsKind, HsForAllTelescope(..), HsTyVarBndr(..), LHsTyVarBndr, LHsQTyVars(..), HsOuterTyVarBndrs(..), HsOuterFamEqnTyVarBndrs, HsOuterSigTyVarBndrs, @@ -1040,12 +1040,6 @@ data HsType pass -- For details on above see note [Api annotations] in GHC.Parser.Annotation - -- | HsCoreTy (XCoreTy pass) Type -- An escape hatch for tunnelling a *closed* - -- -- Core Type through HsSyn. - -- -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : None - - -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | HsExplicitListTy -- A promoted explicit list (XExplicitListTy pass) PromotionFlag -- whether explicitly promoted, for pretty printer @@ -1078,16 +1072,13 @@ data HsType pass | XHsType (XXType pass) -data NewHsTypeX - = NHsCoreTy Type -- An escape hatch for tunnelling a *closed* - -- Core Type through HsSyn. - -- See also Note [Typechecking NHsCoreTys] in - -- GHC.Tc.Gen.HsType. - deriving Data - -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : None - -instance Outputable NewHsTypeX where - ppr (NHsCoreTy ty) = ppr ty +-- An escape hatch for tunnelling a Core 'Type' through 'HsType'. +-- For more details on how this works, see: +-- +-- * @Note [Renaming HsCoreTys]@ in "GHC.Rename.HsType" +-- +-- * @Note [Typechecking HsCoreTys]@ in "GHC.Tc.Gen.HsType" +type HsCoreTy = Type type instance XForAllTy (GhcPass _) = NoExtField type instance XQualTy (GhcPass _) = NoExtField @@ -1125,7 +1116,7 @@ type instance XTyLit (GhcPass _) = NoExtField type instance XWildCardTy (GhcPass _) = NoExtField -type instance XXType (GhcPass _) = NewHsTypeX +type instance XXType (GhcPass _) = HsCoreTy -- Note [Literal source text] in GHC.Types.Basic for SourceText fields in @@ -2256,7 +2247,7 @@ hsTypeNeedsParens p = go_hs_ty go_hs_ty (HsOpTy{}) = p >= opPrec go_hs_ty (HsParTy{}) = False go_hs_ty (HsDocTy _ (L _ t) _) = go_hs_ty t - go_hs_ty (XHsType (NHsCoreTy ty)) = go_core_ty ty + go_hs_ty (XHsType ty) = go_core_ty ty go_core_ty (TyVarTy{}) = False go_core_ty (AppTy{}) = p >= appPrec ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -41,6 +41,7 @@ import GHC.Prelude import {-# SOURCE #-} GHC.Rename.Splice( rnSpliceType ) +import GHC.Core.TyCo.FVs ( tyCoVarsOfTypeList ) import GHC.Driver.Session import GHC.Hs import GHC.Rename.Env @@ -50,6 +51,7 @@ import GHC.Rename.Utils ( HsDocContext(..), inHsDocContext, withHsDocContext , checkShadowedRdrNames ) import GHC.Rename.Fixity ( lookupFieldFixityRn, lookupFixityRn , lookupTyFixityRn ) +import GHC.Rename.Unbound ( notInScopeErr ) import GHC.Tc.Utils.Monad import GHC.Types.Name.Reader import GHC.Builtin.Names @@ -717,10 +719,20 @@ rnHsTyKi env (HsDocTy _ ty haddock_doc) = do { (ty', fvs) <- rnLHsTyKi env ty ; return (HsDocTy noExtField ty' haddock_doc, fvs) } -rnHsTyKi _ (XHsType (NHsCoreTy ty)) - = return (XHsType (NHsCoreTy ty), emptyFVs) - -- The emptyFVs probably isn't quite right - -- but I don't think it matters +-- See Note [Renaming HsCoreTys] +rnHsTyKi env (XHsType ty) + = do mapM_ (check_in_scope . nameRdrName) fvs_list + return (XHsType ty, fvs) + where + fvs_list = map getName $ tyCoVarsOfTypeList ty + fvs = mkFVs fvs_list + + check_in_scope :: RdrName -> RnM () + check_in_scope rdr_name = do + mb_name <- lookupLocalOccRn_maybe rdr_name + when (isNothing mb_name) $ + addErr $ withHsDocContext (rtke_ctxt env) $ + notInScopeErr rdr_name rnHsTyKi env ty@(HsExplicitListTy _ ip tys) = do { data_kinds <- xoptM LangExt.DataKinds @@ -744,6 +756,39 @@ rnHsArrow _env (HsLinearArrow u) = return (HsLinearArrow u, emptyFVs) rnHsArrow env (HsExplicitMult u p) = (\(mult, fvs) -> (HsExplicitMult u mult, fvs)) <$> rnLHsTyKi env p +{- +Note [Renaming HsCoreTys] +~~~~~~~~~~~~~~~~~~~~~~~~~ +HsCoreTy is an escape hatch that allows embedding Core Types in HsTypes. +As such, there's not much to be done in order to rename an HsCoreTy, +since it's already been renamed to some extent. However, in an attempt to +detect ill-formed HsCoreTys, the renamer checks to see if all free type +variables in an HsCoreTy are in scope. To see why this can matter, consider +this example from #18914: + + type T f = forall a. f a + + class C f where + m :: T f + + newtype N f a = MkN (f a) + deriving C + +Because of #18914, a previous GHC would generate the following code: + + instance C f => C (N f) where + m :: T (N f) + m = coerce @(f a) -- The type within @(...) is an HsCoreTy + @(N f a) -- So is this + (m @f) + +There are two HsCoreTys in play—(f a) and (N f a)—both of which have +`f` and `a` as free type variables. The `f` is in scope from the instance head, +but `a` is completely unbound, which is what led to #18914. To avoid this sort +of mistake going forward, the renamer will now detect that `a` is unbound and +throw an error accordingly. +-} + -------------- rnTyVar :: RnTyKiEnv -> RdrName -> RnM Name rnTyVar env rdr_name ===================================== compiler/GHC/Tc/Deriv/Generate.hs ===================================== @@ -1819,6 +1819,94 @@ a truly higher-rank type like so: Then the same situation will arise again. But at least it won't arise for the common case of methods with ordinary, prenex-quantified types. +----- +-- Wrinkle: Use HsOuterExplicit +----- + +One minor complication with the plan above is that we need to ensure that the +type variables from a method's instance signature properly scope over the body +of the method. For example, recall: + + instance (C m, forall p q. Coercible p q => Coercible (m p) (m q)) => + C (T m) where + join :: forall a. T m (T m a) -> T m a + join = coerce @( m (m a) -> m a) + @(T m (T m a) -> T m a) + join + +In the example above, it is imperative that the `a` in the instance signature +for `join` scope over the body of `join` by way of ScopedTypeVariables. +This might sound obvious, but note that in gen_Newtype_binds, which is +responsible for generating the code above, the type in `join`'s instance +signature is given as a Core type, whereas gen_Newtype_binds will eventually +produce HsBinds (i.e., source Haskell) that is renamed and typechecked. We +must ensure that `a` is in scope over the body of `join` during renaming +or else the generated code will be rejected. + +In short, we need to convert the instance signature from a Core type to an +HsType (i.e., a source Haskell type). Two possible options are: + +1. Convert the Core type entirely to an HsType (i.e., a source Haskell type). +2. Embed the entire Core type using HsCoreTy. + +Neither option is quite satisfactory: + +1. Converting a Core type to an HsType in full generality is surprisingly + complicated. Previous versions of GHCs did this, but it was the source of + numerous bugs (see #14579 and #16518, for instance). +2. While HsCoreTy is much less complicated that option (1), it's not quite + what we want. In order for `a` to be in scope over the body of `join` during + renaming, the `forall` must be contained in an HsOuterExplicit. + (See Note [Lexically scoped type variables] in GHC.Hs.Type.) HsCoreTy + bypasses HsOuterExplicit, so this won't work either. + +As a compromise, we adopt a combination of the two options above: + +* Split apart the top-level ForAllTys in the instance signature's Core type, +* Convert the top-level ForAllTys to an HsOuterExplicit, and +* Embed the remainder of the Core type in an HsCoreTy. + +This retains most of the simplicity of option (2) while still ensuring that +the type variables are correctly scoped. + +Note that splitting apart top-level ForAllTys will expand any type synonyms +in the Core type itself. This ends up being important to fix a corner case +observed in #18914. Consider this example: + + type T f = forall a. f a + + class C f where + m :: T f + + newtype N f a = MkN (f a) + deriving C + +What code should `deriving C` generate? It will have roughly the following +shape: + + instance C f => C (N f) where + m :: T (N f) + m = coerce @(...) (...) (m @f) + +At a minimum, we must instantiate `coerce` with `@(T f)` and `@(T (N f))`, but +with the `forall`s removed in order to make them monotypes. However, the +`forall` is hidden underneath the `T` type synonym, so we must first expand `T` +before we can strip of the `forall`. Expanding `T`, we get +`coerce @(forall a. f a) @(forall a. N f a)`, and after omitting the `forall`s, +we get `coerce @(f a) @(N f a)`. + +We can't stop there, however, or else we would end up with this code: + + instance C f => C (N f) where + m :: T (N f) + m = coerce @(f a) @(N f a) (m @f) + +Notice that the type variable `a` is completely unbound. In order to make sure +that `a` is in scope, we must /also/ expand the `T` in `m :: T (N f)` to get +`m :: forall a. N f a`. Fortunately, we will do just that in the plan outlined +above, since when we split off the top-level ForAllTys in the instance +signature, we must first expand the T type synonym. + Note [GND and ambiguity] ~~~~~~~~~~~~~~~~~~~~~~~~ We make an effort to make the code generated through GND be robust w.r.t. @@ -1891,13 +1979,30 @@ gen_Newtype_binds loc cls inst_tvs inst_tys rhs_ty , -- The derived instance signature, e.g., -- -- op :: forall c. a -> [T x] -> c -> Int + -- + -- Make sure that `forall c` is in an HsOuterExplicit so that it + -- scopes over the body of `op`. See "Wrinkle: Use HsOuterExplicit" in + -- Note [GND and QuantifiedConstraints]. L loc $ ClassOpSig noExtField False [loc_meth_RDR] - $ L loc $ mkHsImplicitSigType $ nlHsCoreTy to_ty + $ L loc $ mkHsExplicitSigType + (map mk_hs_tvb to_tvbs) + (nlHsCoreTy to_rho) ) where Pair from_ty to_ty = mkCoerceClassMethEqn cls inst_tvs inst_tys rhs_ty meth_id - (_, _, from_tau) = tcSplitSigmaTy from_ty - (_, _, to_tau) = tcSplitSigmaTy to_ty + (_, _, from_tau) = tcSplitSigmaTy from_ty + (to_tvbs, to_rho) = tcSplitForAllInvisTVBinders to_ty + (_, to_tau) = tcSplitPhiTy to_rho + -- The use of tcSplitForAllInvisTVBinders above expands type synonyms, + -- which is important to ensure correct type variable scoping. + -- See "Wrinkle: Use HsOuterExplicit" in + -- Note [GND and QuantifiedConstraints]. + + mk_hs_tvb :: VarBndr TyVar flag -> LHsTyVarBndr flag GhcPs + mk_hs_tvb (Bndr tv flag) = noLoc $ KindedTyVar noExtField + flag + (noLoc (getRdrName tv)) + (nlHsCoreTy (tyVarKind tv)) meth_RDR = getRdrName meth_id loc_meth_RDR = L loc meth_RDR @@ -1950,8 +2055,8 @@ nlHsAppType e s = noLoc (HsAppType noExtField e hs_ty) where hs_ty = mkHsWildCardBndrs $ parenthesizeHsType appPrec $ nlHsCoreTy s -nlHsCoreTy :: Type -> LHsType GhcPs -nlHsCoreTy = noLoc . XHsType . NHsCoreTy +nlHsCoreTy :: HsCoreTy -> LHsType GhcPs +nlHsCoreTy = noLoc . XHsType mkCoerceClassMethEqn :: Class -- the class being derived -> [TyVar] -- the tvs in the instance head (this includes @@ -2079,15 +2184,15 @@ genAuxBindSpecDup loc original_rdr_name dup_spec genAuxBindSpecSig :: SrcSpan -> AuxBindSpec -> LHsSigWcType GhcPs genAuxBindSpecSig loc spec = case spec of DerivCon2Tag tycon _ - -> mk_sig $ L loc $ XHsType $ NHsCoreTy $ + -> mk_sig $ L loc $ XHsType $ mkSpecSigmaTy (tyConTyVars tycon) (tyConStupidTheta tycon) $ mkParentType tycon `mkVisFunTyMany` intPrimTy DerivTag2Con tycon _ -> mk_sig $ L loc $ - XHsType $ NHsCoreTy $ mkSpecForAllTys (tyConTyVars tycon) $ + XHsType $ mkSpecForAllTys (tyConTyVars tycon) $ intTy `mkVisFunTyMany` mkParentType tycon DerivMaxTag _ _ - -> mk_sig (L loc (XHsType (NHsCoreTy intTy))) + -> mk_sig (L loc (XHsType intTy)) DerivDataDataType _ _ _ -> mk_sig (nlHsTyVar dataType_RDR) DerivDataConstr _ _ _ ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -947,8 +947,8 @@ tc_infer_hs_type mode (HsSpliceTy _ (HsSpliced _ _ (HsSplicedTy ty))) tc_infer_hs_type mode (HsDocTy _ ty _) = tc_infer_lhs_type mode ty --- See Note [Typechecking NHsCoreTys] -tc_infer_hs_type _ (XHsType (NHsCoreTy ty)) +-- See Note [Typechecking HsCoreTys] +tc_infer_hs_type _ (XHsType ty) = do env <- getLclEnv -- Raw uniques since we go from NameEnv to TvSubstEnv. let subst_prs :: [(Unique, TcTyVar)] @@ -972,21 +972,21 @@ tc_infer_hs_type mode other_ty ; return (ty', kv) } {- -Note [Typechecking NHsCoreTys] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -NHsCoreTy is an escape hatch that allows embedding Core Types in HsTypes. -As such, there's not much to be done in order to typecheck an NHsCoreTy, +Note [Typechecking HsCoreTys] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +HsCoreTy is an escape hatch that allows embedding Core Types in HsTypes. +As such, there's not much to be done in order to typecheck an HsCoreTy, since it's already been typechecked to some extent. There is one thing that we must do, however: we must substitute the type variables from the tcl_env. To see why, consider GeneralizedNewtypeDeriving, which is one of the main -clients of NHsCoreTy (example adapted from #14579): +clients of HsCoreTy (example adapted from #14579): newtype T a = MkT a deriving newtype Eq This will produce an InstInfo GhcPs that looks roughly like this: instance forall a_1. Eq a_1 => Eq (T a_1) where - (==) = coerce @( a_1 -> a_1 -> Bool) -- The type within @(...) is an NHsCoreTy + (==) = coerce @( a_1 -> a_1 -> Bool) -- The type within @(...) is an HsCoreTy @(T a_1 -> T a_1 -> Bool) -- So is this (==) @@ -1002,9 +1002,9 @@ environment (tcl_env) with [a_1 :-> a_2]. This gives us: To ensure that the body of this instance is well scoped, every occurrence of the `a` type variable should refer to a_2, the new skolem. However, the -NHsCoreTys mention a_1, not a_2. Luckily, the tcl_env provides exactly the +HsCoreTys mention a_1, not a_2. Luckily, the tcl_env provides exactly the substitution we need ([a_1 :-> a_2]) to fix up the scoping. We apply this -substitution to each NHsCoreTy and all is well: +substitution to each HsCoreTy and all is well: instance forall a_2. Eq a_2 => Eq (T a_2) where (==) = coerce @( a_2 -> a_2 -> Bool) @@ -1206,7 +1206,7 @@ tc_hs_type mode ty@(HsAppTy {}) ek = tc_infer_hs_type_ek mode ty ek tc_hs_type mode ty@(HsAppKindTy{}) ek = tc_infer_hs_type_ek mode ty ek tc_hs_type mode ty@(HsOpTy {}) ek = tc_infer_hs_type_ek mode ty ek tc_hs_type mode ty@(HsKindSig {}) ek = tc_infer_hs_type_ek mode ty ek -tc_hs_type mode ty@(XHsType (NHsCoreTy{})) ek = tc_infer_hs_type_ek mode ty ek +tc_hs_type mode ty@(XHsType {}) ek = tc_infer_hs_type_ek mode ty ek {- Note [Variable Specificity and Forall Visibility] ===================================== compiler/GHC/Tc/Gen/Sig.hs ===================================== @@ -291,7 +291,7 @@ no_anon_wc_ty lty = go lty HsTyLit{} -> True HsTyVar{} -> True HsStarTy{} -> True - XHsType (NHsCoreTy{}) -> True -- Core type, which does not have any wildcard + XHsType{} -> True -- HsCoreTy, which does not have any wildcard gos = all go ===================================== compiler/GHC/Tc/TyCl/Instance.hs ===================================== @@ -2082,7 +2082,7 @@ mkDefMethBind dfun_id clas sel_id dm_name mk_vta :: LHsExpr GhcRn -> Type -> LHsExpr GhcRn mk_vta fun ty = noLoc (HsAppType noExtField fun (mkEmptyWildCardBndrs $ nlHsParTy - $ noLoc $ XHsType $ NHsCoreTy ty)) + $ noLoc $ XHsType ty)) -- NB: use visible type application -- See Note [Default methods in instances] ===================================== testsuite/tests/deriving/should_compile/T14578.stderr ===================================== @@ -9,9 +9,8 @@ Derived class instances: GHC.Base.sconcat :: GHC.Base.NonEmpty (T14578.Wat f g a) -> T14578.Wat f g a GHC.Base.stimes :: - forall b. - GHC.Real.Integral b => - b -> T14578.Wat f g a -> T14578.Wat f g a + forall (b :: *). + GHC.Real.Integral b => b -> T14578.Wat f g a -> T14578.Wat f g a (GHC.Base.<>) = GHC.Prim.coerce @(T14578.App (Data.Functor.Compose.Compose f g) a @@ -38,8 +37,10 @@ Derived class instances: instance GHC.Base.Functor f => GHC.Base.Functor (T14578.App f) where GHC.Base.fmap :: - forall a b. (a -> b) -> T14578.App f a -> T14578.App f b - (GHC.Base.<$) :: forall a b. a -> T14578.App f b -> T14578.App f a + forall (a :: *) (b :: *). + (a -> b) -> T14578.App f a -> T14578.App f b + (GHC.Base.<$) :: + forall (a :: *) (b :: *). a -> T14578.App f b -> T14578.App f a GHC.Base.fmap = GHC.Prim.coerce @((a -> b) -> f a -> f b) @@ -51,17 +52,19 @@ Derived class instances: instance GHC.Base.Applicative f => GHC.Base.Applicative (T14578.App f) where - GHC.Base.pure :: forall a. a -> T14578.App f a + GHC.Base.pure :: forall (a :: *). a -> T14578.App f a (GHC.Base.<*>) :: - forall a b. + forall (a :: *) (b :: *). T14578.App f (a -> b) -> T14578.App f a -> T14578.App f b GHC.Base.liftA2 :: - forall a b c. + forall (a :: *) (b :: *) (c :: *). (a -> b -> c) -> T14578.App f a -> T14578.App f b -> T14578.App f c (GHC.Base.*>) :: - forall a b. T14578.App f a -> T14578.App f b -> T14578.App f b + forall (a :: *) (b :: *). + T14578.App f a -> T14578.App f b -> T14578.App f b (GHC.Base.<*) :: - forall a b. T14578.App f a -> T14578.App f b -> T14578.App f a + forall (a :: *) (b :: *). + T14578.App f a -> T14578.App f b -> T14578.App f a GHC.Base.pure = GHC.Prim.coerce @(a -> f a) @(a -> T14578.App f a) (GHC.Base.pure @f) ===================================== testsuite/tests/deriving/should_compile/T18914.hs ===================================== @@ -0,0 +1,12 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE RankNTypes #-} +module T18914 where + +type T f = forall a. f a + +class C f where + m1 :: T f + m2 :: forall a. f a + +newtype N f a = MkN (f a) + deriving C ===================================== testsuite/tests/deriving/should_compile/all.T ===================================== @@ -127,3 +127,4 @@ test('T17339', normal, compile, test('T17880', normal, compile, ['']) test('T18055', normal, compile, ['']) test('T18321', normal, compile, ['']) +test('T18914', normal, compile, ['']) ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 059acb11d6134ee0d896bcf73c870958557a3909 +Subproject commit c3b276d94e207717731512d1e1f8b59b729b653a View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7a93435b991513b71174c807b4e99ad90f4e5058 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7a93435b991513b71174c807b4e99ad90f4e5058 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 18 10:51:17 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 18 Dec 2020 05:51:17 -0500 Subject: [Git][ghc/ghc][master] 3 commits: OSMem.c: Use proper type for mbinds mask argument. Message-ID: <5fdc89a55286e_6b21962d8e823213ac@gitlab.mail> Spam detection software, running on the system "mail.haskell.org", has identified this incoming email as possible spam. The original message has been attached to this so you can view it (if it isn't spam) or label similar future email. If you have any questions, see @@CONTACT_ADDRESS@@ for details. Content preview: Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: b4fcfd0f by Andreas Klebinger at 2020-12-18T05:51:09-05:00 OSMem.c: Use proper type for mbinds mask argument. StgWord has different widths on 32/64bit. So use the proper type instead. [...] Content analysis details: (5.0 points, 5.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- 1.1 URI_HEX URI: URI hostname has long hexadecimal sequence 5.0 UNWANTED_LANGUAGE_BODY BODY: Message written in an undesired language -1.9 BAYES_00 BODY: Bayes spam probability is 0 to 1% [score: 0.0000] 0.0 HTML_MESSAGE BODY: HTML included in message 0.8 RDNS_NONE Delivered to internal network by a host with no rDNS 0.0 T_DKIM_INVALID DKIM-Signature header exists but is not valid The original message was not completely plain text, and may be unsafe to open with some email clients; in particular, it may contain a virus, or confirm that your address can receive spam. If you wish to view it, it may be safer to save it to a file and open it with an editor. -------------- next part -------------- An embedded message was scrubbed... From: Marge Bot Subject: [Git][ghc/ghc][master] 3 commits: OSMem.c: Use proper type for mbinds mask argument. Date: Fri, 18 Dec 2020 05:51:17 -0500 Size: 50770 URL: From gitlab at gitlab.haskell.org Fri Dec 18 10:51:55 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 18 Dec 2020 05:51:55 -0500 Subject: [Git][ghc/ghc][master] Split Driver.Env module Message-ID: <5fdc89cbc0904_6b21962d8e82325884@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 52498cfa by Alfredo Di Napoli at 2020-12-18T05:51:48-05:00 Split Driver.Env module This commit splits the GHC.Driver.Env module creating a separate GHC.Driver.Env.Types module where HscEnv and Hsc would live. This will pave the way to the structured error values by avoiding one boot module later down the line. - - - - - 4 changed files: - compiler/GHC/Driver/Env.hs - + compiler/GHC/Driver/Env/Types.hs - compiler/ghc.cabal.in - testsuite/tests/parser/should_run/CountParserDeps.stdout Changes: ===================================== compiler/GHC/Driver/Env.hs ===================================== @@ -29,11 +29,9 @@ import GHC.Prelude import GHC.Driver.Ppr import GHC.Driver.Session -import {-# SOURCE #-} GHC.Driver.Plugins import GHC.Runtime.Context -import GHC.Runtime.Interpreter.Types (Interp) -import GHC.Linker.Types ( Loader ) +import GHC.Driver.Env.Types ( Hsc(..), HscEnv(..) ) import GHC.Unit import GHC.Unit.Module.ModGuts @@ -43,7 +41,6 @@ import GHC.Unit.Module.Deps import GHC.Unit.Home.ModInfo import GHC.Unit.Env import GHC.Unit.External -import GHC.Unit.Finder.Types import GHC.Core ( CoreRule ) import GHC.Core.FamInstEnv @@ -52,10 +49,7 @@ import GHC.Core.InstEnv ( ClsInst ) import GHC.Types.Annotations ( Annotation, AnnEnv, mkAnnEnv, plusAnnEnv ) import GHC.Types.CompleteMatch import GHC.Types.Name -import GHC.Types.Name.Cache import GHC.Types.Name.Env -import GHC.Types.Target -import GHC.Types.TypeEnv import GHC.Types.TyThing import GHC.Builtin.Names ( gHC_PRIM ) @@ -63,36 +57,15 @@ import GHC.Builtin.Names ( gHC_PRIM ) import GHC.Data.Maybe import GHC.Data.Bag -import GHC.Unit.Module.Graph - import GHC.Utils.Outputable import GHC.Utils.Monad import GHC.Utils.Error import GHC.Utils.Panic import GHC.Utils.Misc -import Control.Monad ( guard, ap ) +import Control.Monad ( guard ) import Data.IORef --- | The Hsc monad: Passing an environment and warning state -newtype Hsc a = Hsc (HscEnv -> WarningMessages -> IO (a, WarningMessages)) - deriving (Functor) - -instance Applicative Hsc where - pure a = Hsc $ \_ w -> return (a, w) - (<*>) = ap - -instance Monad Hsc where - Hsc m >>= k = Hsc $ \e w -> do (a, w1) <- m e w - case k a of - Hsc k' -> k' e w1 - -instance MonadIO Hsc where - liftIO io = Hsc $ \_ w -> do a <- io; return (a, w) - -instance HasDynFlags Hsc where - getDynFlags = Hsc $ \e w -> return (hsc_dflags e, w) - runHsc :: HscEnv -> Hsc a -> IO a runHsc hsc_env (Hsc hsc) = do (a, w) <- hsc hsc_env emptyBag @@ -112,111 +85,6 @@ mkInteractiveHscEnv hsc_env = runInteractiveHsc :: HscEnv -> Hsc a -> IO a runInteractiveHsc hsc_env = runHsc (mkInteractiveHscEnv hsc_env) --- | HscEnv is like 'GHC.Driver.Monad.Session', except that some of the fields are immutable. --- An HscEnv is used to compile a single module from plain Haskell source --- code (after preprocessing) to either C, assembly or C--. It's also used --- to store the dynamic linker state to allow for multiple linkers in the --- same address space. --- Things like the module graph don't change during a single compilation. --- --- Historical note: \"hsc\" used to be the name of the compiler binary, --- when there was a separate driver and compiler. To compile a single --- module, the driver would invoke hsc on the source code... so nowadays --- we think of hsc as the layer of the compiler that deals with compiling --- a single module. -data HscEnv - = HscEnv { - hsc_dflags :: DynFlags, - -- ^ The dynamic flag settings - - hsc_targets :: [Target], - -- ^ The targets (or roots) of the current session - - hsc_mod_graph :: ModuleGraph, - -- ^ The module graph of the current session - - hsc_IC :: InteractiveContext, - -- ^ The context for evaluating interactive statements - - hsc_HPT :: HomePackageTable, - -- ^ The home package table describes already-compiled - -- home-package modules, /excluding/ the module we - -- are compiling right now. - -- (In one-shot mode the current module is the only - -- home-package module, so hsc_HPT is empty. All other - -- modules count as \"external-package\" modules. - -- However, even in GHCi mode, hi-boot interfaces are - -- demand-loaded into the external-package table.) - -- - -- 'hsc_HPT' is not mutable because we only demand-load - -- external packages; the home package is eagerly - -- loaded, module by module, by the compilation manager. - -- - -- The HPT may contain modules compiled earlier by @--make@ - -- but not actually below the current module in the dependency - -- graph. - -- - -- (This changes a previous invariant: changed Jan 05.) - - hsc_EPS :: {-# UNPACK #-} !(IORef ExternalPackageState), - -- ^ Information about the currently loaded external packages. - -- This is mutable because packages will be demand-loaded during - -- a compilation run as required. - - hsc_NC :: {-# UNPACK #-} !(IORef NameCache), - -- ^ As with 'hsc_EPS', this is side-effected by compiling to - -- reflect sucking in interface files. They cache the state of - -- external interface files, in effect. - - hsc_FC :: {-# UNPACK #-} !(IORef FinderCache), - -- ^ The cached result of performing finding in the file system - - hsc_type_env_var :: Maybe (Module, IORef TypeEnv) - -- ^ Used for one-shot compilation only, to initialise - -- the 'IfGblEnv'. See 'GHC.Tc.Utils.tcg_type_env_var' for - -- 'GHC.Tc.Utils.TcGblEnv'. See also Note [hsc_type_env_var hack] - - , hsc_interp :: Maybe Interp - -- ^ target code interpreter (if any) to use for TH and GHCi. - -- See Note [Target code interpreter] - - , hsc_loader :: Loader - -- ^ Loader (dynamic linker) - - , hsc_plugins :: ![LoadedPlugin] - -- ^ plugins dynamically loaded after processing arguments. What - -- will be loaded here is directed by DynFlags.pluginModNames. - -- Arguments are loaded from DynFlags.pluginModNameOpts. - -- - -- The purpose of this field is to cache the plugins so they - -- don't have to be loaded each time they are needed. See - -- 'GHC.Runtime.Loader.initializePlugins'. - - , hsc_static_plugins :: ![StaticPlugin] - -- ^ static plugins which do not need dynamic loading. These plugins are - -- intended to be added by GHC API users directly to this list. - -- - -- To add dynamically loaded plugins through the GHC API see - -- 'addPluginModuleName' instead. - - , hsc_unit_dbs :: !(Maybe [UnitDatabase UnitId]) - -- ^ Stack of unit databases for the target platform. - -- - -- This field is populated with the result of `initUnits`. - -- - -- 'Nothing' means the databases have never been read from disk. - -- - -- Usually we don't reload the databases from disk if they are - -- cached, even if the database flags changed! - - , hsc_unit_env :: UnitEnv - -- ^ Unit environment (unit state, home unit, etc.). - -- - -- Initialized from the databases cached in 'hsc_unit_dbs' and - -- from the DynFlags. - } - - hsc_home_unit :: HscEnv -> HomeUnit hsc_home_unit = ue_home_unit . hsc_unit_env ===================================== compiler/GHC/Driver/Env/Types.hs ===================================== @@ -0,0 +1,151 @@ +{-# LANGUAGE DeriveFunctor #-} +module GHC.Driver.Env.Types + ( Hsc(..) + , HscEnv(..) + ) where + +import GHC.Driver.Session ( DynFlags, HasDynFlags(..) ) +import GHC.Linker.Types ( Loader ) +import GHC.Prelude +import GHC.Runtime.Context +import GHC.Runtime.Interpreter.Types ( Interp ) +import GHC.Types.Error ( WarningMessages ) +import GHC.Types.Name.Cache +import GHC.Types.Target +import GHC.Types.TypeEnv +import GHC.Unit.External +import GHC.Unit.Finder.Types +import GHC.Unit.Home.ModInfo +import GHC.Unit.Module.Graph +import GHC.Unit.Env +import GHC.Unit.State +import GHC.Unit.Types +import {-# SOURCE #-} GHC.Driver.Plugins + +import Control.Monad ( ap ) +import Control.Monad.IO.Class +import Data.IORef + +-- | The Hsc monad: Passing an environment and warning state +newtype Hsc a = Hsc (HscEnv -> WarningMessages -> IO (a, WarningMessages)) + deriving (Functor) + +instance Applicative Hsc where + pure a = Hsc $ \_ w -> return (a, w) + (<*>) = ap + +instance Monad Hsc where + Hsc m >>= k = Hsc $ \e w -> do (a, w1) <- m e w + case k a of + Hsc k' -> k' e w1 + +instance MonadIO Hsc where + liftIO io = Hsc $ \_ w -> do a <- io; return (a, w) + +instance HasDynFlags Hsc where + getDynFlags = Hsc $ \e w -> return (hsc_dflags e, w) + +-- | HscEnv is like 'GHC.Driver.Monad.Session', except that some of the fields are immutable. +-- An HscEnv is used to compile a single module from plain Haskell source +-- code (after preprocessing) to either C, assembly or C--. It's also used +-- to store the dynamic linker state to allow for multiple linkers in the +-- same address space. +-- Things like the module graph don't change during a single compilation. +-- +-- Historical note: \"hsc\" used to be the name of the compiler binary, +-- when there was a separate driver and compiler. To compile a single +-- module, the driver would invoke hsc on the source code... so nowadays +-- we think of hsc as the layer of the compiler that deals with compiling +-- a single module. +data HscEnv + = HscEnv { + hsc_dflags :: DynFlags, + -- ^ The dynamic flag settings + + hsc_targets :: [Target], + -- ^ The targets (or roots) of the current session + + hsc_mod_graph :: ModuleGraph, + -- ^ The module graph of the current session + + hsc_IC :: InteractiveContext, + -- ^ The context for evaluating interactive statements + + hsc_HPT :: HomePackageTable, + -- ^ The home package table describes already-compiled + -- home-package modules, /excluding/ the module we + -- are compiling right now. + -- (In one-shot mode the current module is the only + -- home-package module, so hsc_HPT is empty. All other + -- modules count as \"external-package\" modules. + -- However, even in GHCi mode, hi-boot interfaces are + -- demand-loaded into the external-package table.) + -- + -- 'hsc_HPT' is not mutable because we only demand-load + -- external packages; the home package is eagerly + -- loaded, module by module, by the compilation manager. + -- + -- The HPT may contain modules compiled earlier by @--make@ + -- but not actually below the current module in the dependency + -- graph. + -- + -- (This changes a previous invariant: changed Jan 05.) + + hsc_EPS :: {-# UNPACK #-} !(IORef ExternalPackageState), + -- ^ Information about the currently loaded external packages. + -- This is mutable because packages will be demand-loaded during + -- a compilation run as required. + + hsc_NC :: {-# UNPACK #-} !(IORef NameCache), + -- ^ As with 'hsc_EPS', this is side-effected by compiling to + -- reflect sucking in interface files. They cache the state of + -- external interface files, in effect. + + hsc_FC :: {-# UNPACK #-} !(IORef FinderCache), + -- ^ The cached result of performing finding in the file system + + hsc_type_env_var :: Maybe (Module, IORef TypeEnv) + -- ^ Used for one-shot compilation only, to initialise + -- the 'IfGblEnv'. See 'GHC.Tc.Utils.tcg_type_env_var' for + -- 'GHC.Tc.Utils.TcGblEnv'. See also Note [hsc_type_env_var hack] + + , hsc_interp :: Maybe Interp + -- ^ target code interpreter (if any) to use for TH and GHCi. + -- See Note [Target code interpreter] + + , hsc_loader :: Loader + -- ^ Loader (dynamic linker) + + , hsc_plugins :: ![LoadedPlugin] + -- ^ plugins dynamically loaded after processing arguments. What + -- will be loaded here is directed by DynFlags.pluginModNames. + -- Arguments are loaded from DynFlags.pluginModNameOpts. + -- + -- The purpose of this field is to cache the plugins so they + -- don't have to be loaded each time they are needed. See + -- 'GHC.Runtime.Loader.initializePlugins'. + + , hsc_static_plugins :: ![StaticPlugin] + -- ^ static plugins which do not need dynamic loading. These plugins are + -- intended to be added by GHC API users directly to this list. + -- + -- To add dynamically loaded plugins through the GHC API see + -- 'addPluginModuleName' instead. + + , hsc_unit_dbs :: !(Maybe [UnitDatabase UnitId]) + -- ^ Stack of unit databases for the target platform. + -- + -- This field is populated with the result of `initUnits`. + -- + -- 'Nothing' means the databases have never been read from disk. + -- + -- Usually we don't reload the databases from disk if they are + -- cached, even if the database flags changed! + + , hsc_unit_env :: UnitEnv + -- ^ Unit environment (unit state, home unit, etc.). + -- + -- Initialized from the databases cached in 'hsc_unit_dbs' and + -- from the DynFlags. + } + ===================================== compiler/ghc.cabal.in ===================================== @@ -384,6 +384,7 @@ Library GHC.Driver.CodeOutput GHC.Driver.Config GHC.Driver.Env + GHC.Driver.Env.Types GHC.Driver.Flags GHC.Driver.Hooks GHC.Driver.Main ===================================== testsuite/tests/parser/should_run/CountParserDeps.stdout ===================================== @@ -1,4 +1,4 @@ -Found 236 parser module dependencies +Found 237 parser module dependencies GHC.Builtin.Names GHC.Builtin.PrimOps GHC.Builtin.Types @@ -80,6 +80,7 @@ GHC.Driver.Backend GHC.Driver.Backpack.Syntax GHC.Driver.CmdLine GHC.Driver.Env +GHC.Driver.Env.Types GHC.Driver.Flags GHC.Driver.Hooks GHC.Driver.Monad View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/52498cfaf2d130552b8a8c6b01f7a8114152aee0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/52498cfaf2d130552b8a8c6b01f7a8114152aee0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 18 10:52:40 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 18 Dec 2020 05:52:40 -0500 Subject: [Git][ghc/ghc][master] Rename parser Error and Warning types Message-ID: <5fdc89f85144a_6b21725c11c2328955@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: d66b4bcd by Alfredo Di Napoli at 2020-12-18T05:52:25-05:00 Rename parser Error and Warning types This commit renames parser's Error and Warning types (and their constructors) to have a 'Ps' prefix, so that this would play nicely when more errors and warnings for other phases of the pipeline will be added. This will make more explicit which is the particular type of error and warning we are dealing with, and will be more informative for users to see in the generated Haddock. - - - - - 11 changed files: - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Parser/Monad.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Errors.hs - compiler/GHC/Parser/Errors/Ppr.hs - compiler/GHC/Parser/Header.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Parser/PostProcess/Haddock.hs Changes: ===================================== compiler/GHC/Cmm/Lexer.x ===================================== @@ -326,7 +326,7 @@ lexToken = do AlexEOF -> do let span = mkPsSpan loc1 loc1 liftP (setLastToken span 0) return (L span CmmT_EOF) - AlexError (loc2,_) -> liftP $ failLocMsgP (psRealLoc loc1) (psRealLoc loc2) (Error ErrCmmLexer []) + AlexError (loc2,_) -> liftP $ failLocMsgP (psRealLoc loc1) (psRealLoc loc2) (PsError PsErrCmmLexer []) AlexSkip inp2 _ -> do setInput inp2 lexToken ===================================== compiler/GHC/Cmm/Parser.y ===================================== @@ -919,7 +919,7 @@ getLit _ = panic "invalid literal" -- TODO messy failure nameToMachOp :: FastString -> PD (Width -> MachOp) nameToMachOp name = case lookupUFM machOps name of - Nothing -> failMsgPD $ Error (ErrCmmParser (CmmUnknownPrimitive name)) [] + Nothing -> failMsgPD $ PsError (PsErrCmmParser (CmmUnknownPrimitive name)) [] Just m -> return m exprOp :: FastString -> [CmmParse CmmExpr] -> PD (CmmParse CmmExpr) @@ -1081,12 +1081,12 @@ parseSafety :: String -> PD Safety parseSafety "safe" = return PlaySafe parseSafety "unsafe" = return PlayRisky parseSafety "interruptible" = return PlayInterruptible -parseSafety str = failMsgPD $ Error (ErrCmmParser (CmmUnrecognisedSafety str)) [] +parseSafety str = failMsgPD $ PsError (PsErrCmmParser (CmmUnrecognisedSafety str)) [] parseCmmHint :: String -> PD ForeignHint parseCmmHint "ptr" = return AddrHint parseCmmHint "signed" = return SignedHint -parseCmmHint str = failMsgPD $ Error (ErrCmmParser (CmmUnrecognisedHint str)) [] +parseCmmHint str = failMsgPD $ PsError (PsErrCmmParser (CmmUnrecognisedHint str)) [] -- labels are always pointers, so we might as well infer the hint inferCmmHint :: CmmExpr -> ForeignHint @@ -1113,7 +1113,7 @@ happyError = PD $ \_ _ s -> unP srcParseFail s stmtMacro :: FastString -> [CmmParse CmmExpr] -> PD (CmmParse ()) stmtMacro fun args_code = do case lookupUFM stmtMacros fun of - Nothing -> failMsgPD $ Error (ErrCmmParser (CmmUnknownMacro fun)) [] + Nothing -> failMsgPD $ PsError (PsErrCmmParser (CmmUnknownMacro fun)) [] Just fcode -> return $ do args <- sequence args_code code (fcode args) @@ -1216,7 +1216,7 @@ foreignCall conv_string results_code expr_code args_code safety ret = do conv <- case conv_string of "C" -> return CCallConv "stdcall" -> return StdCallConv - _ -> failMsgPD $ Error (ErrCmmParser (CmmUnknownCConv conv_string)) [] + _ -> failMsgPD $ PsError (PsErrCmmParser (CmmUnknownCConv conv_string)) [] return $ do platform <- getPlatform results <- sequence results_code @@ -1294,7 +1294,7 @@ primCall results_code name args_code = do platform <- PD.getPlatform case lookupUFM (callishMachOps platform) name of - Nothing -> failMsgPD $ Error (ErrCmmParser (CmmUnknownPrimitive name)) [] + Nothing -> failMsgPD $ PsError (PsErrCmmParser (CmmUnknownPrimitive name)) [] Just f -> return $ do results <- sequence results_code args <- sequence args_code @@ -1448,7 +1448,7 @@ initEnv profile = listToUFM [ ] where platform = profilePlatform profile -parseCmmFile :: DynFlags -> HomeUnit -> FilePath -> IO (Bag Warning, Bag Error, Maybe CmmGroup) +parseCmmFile :: DynFlags -> HomeUnit -> FilePath -> IO (Bag PsWarning, Bag PsError, Maybe CmmGroup) parseCmmFile dflags home_unit filename = do buf <- hGetStringBuffer filename let ===================================== compiler/GHC/Cmm/Parser/Monad.hs ===================================== @@ -47,7 +47,7 @@ instance Monad PD where liftP :: P a -> PD a liftP (P f) = PD $ \_ _ s -> f s -failMsgPD :: (SrcSpan -> Error) -> PD a +failMsgPD :: (SrcSpan -> PsError) -> PD a failMsgPD = liftP . failMsgP returnPD :: a -> PD a ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -285,7 +285,7 @@ handleWarnings = do -- | log warning in the monad, and if there are errors then -- throw a SourceError exception. -logWarningsReportErrors :: (Bag Warning, Bag Error) -> Hsc () +logWarningsReportErrors :: (Bag PsWarning, Bag PsError) -> Hsc () logWarningsReportErrors (warnings,errors) = do let warns = fmap pprWarning warnings errs = fmap pprError errors @@ -294,7 +294,7 @@ logWarningsReportErrors (warnings,errors) = do -- | Log warnings and throw errors, assuming the messages -- contain at least one error (e.g. coming from PFailed) -handleWarningsThrowErrors :: (Bag Warning, Bag Error) -> Hsc a +handleWarningsThrowErrors :: (Bag PsWarning, Bag PsError) -> Hsc a handleWarningsThrowErrors (warnings, errors) = do let warns = fmap pprWarning warnings errs = fmap pprError errors ===================================== compiler/GHC/Parser.y ===================================== @@ -788,7 +788,7 @@ HYPHEN :: { [AddAnn] } | PREFIX_MINUS { [mj AnnMinus $1 ] } | VARSYM {% if (getVARSYM $1 == fsLit "-") then return [mj AnnMinus $1] - else do { addError $ Error ErrExpectedHyphen [] (getLoc $1) + else do { addError $ PsError PsErrExpectedHyphen [] (getLoc $1) ; return [] } } @@ -1087,7 +1087,7 @@ maybe_safe :: { ([AddAnn],Bool) } maybe_pkg :: { ([AddAnn],Maybe StringLiteral) } : STRING {% do { let { pkgFS = getSTRING $1 } ; unless (looksLikePackageName (unpackFS pkgFS)) $ - addError $ Error (ErrInvalidPackageName pkgFS) [] (getLoc $1) + addError $ PsError (PsErrInvalidPackageName pkgFS) [] (getLoc $1) ; return ([mj AnnPackageName $1], Just (StringLiteral (getSTRINGs $1) pkgFS)) } } | {- empty -} { ([],Nothing) } @@ -1788,7 +1788,7 @@ rule_activation_marker :: { [AddAnn] } : PREFIX_TILDE { [mj AnnTilde $1] } | VARSYM {% if (getVARSYM $1 == fsLit "~") then return [mj AnnTilde $1] - else do { addError $ Error ErrInvalidRuleActivationMarker [] (getLoc $1) + else do { addError $ PsError PsErrInvalidRuleActivationMarker [] (getLoc $1) ; return [] } } rule_explicit_activation :: { ([AddAnn] @@ -3847,7 +3847,7 @@ getSCC :: Located Token -> P FastString getSCC lt = do let s = getSTRING lt -- We probably actually want to be more restrictive than this if ' ' `elem` unpackFS s - then addFatalError $ Error ErrSpaceInSCC [] (getLoc lt) + then addFatalError $ PsError PsErrSpaceInSCC [] (getLoc lt) else return s -- Utilities for combining source spans @@ -3937,7 +3937,7 @@ fileSrcSpan = do hintLinear :: MonadP m => SrcSpan -> m () hintLinear span = do linearEnabled <- getBit LinearTypesBit - unless linearEnabled $ addError $ Error ErrLinearFunction [] span + unless linearEnabled $ addError $ PsError PsErrLinearFunction [] span -- Does this look like (a %m)? looksLikeMult :: LHsType GhcPs -> Located RdrName -> LHsType GhcPs -> Bool @@ -3956,14 +3956,14 @@ looksLikeMult ty1 l_op ty2 hintMultiWayIf :: SrcSpan -> P () hintMultiWayIf span = do mwiEnabled <- getBit MultiWayIfBit - unless mwiEnabled $ addError $ Error ErrMultiWayIf [] span + unless mwiEnabled $ addError $ PsError PsErrMultiWayIf [] span -- Hint about explicit-forall hintExplicitForall :: Located Token -> P () hintExplicitForall tok = do forall <- getBit ExplicitForallBit rulePrag <- getBit InRulePragBit - unless (forall || rulePrag) $ addError $ Error (ErrExplicitForall (isUnicode tok)) [] (getLoc tok) + unless (forall || rulePrag) $ addError $ PsError (PsErrExplicitForall (isUnicode tok)) [] (getLoc tok) -- Hint about qualified-do hintQualifiedDo :: Located Token -> P () @@ -3971,7 +3971,7 @@ hintQualifiedDo tok = do qualifiedDo <- getBit QualifiedDoBit case maybeQDoDoc of Just qdoDoc | not qualifiedDo -> - addError $ Error (ErrIllegalQualifiedDo qdoDoc) [] (getLoc tok) + addError $ PsError (PsErrIllegalQualifiedDo qdoDoc) [] (getLoc tok) _ -> return () where maybeQDoDoc = case unLoc tok of @@ -3985,7 +3985,7 @@ hintQualifiedDo tok = do reportEmptyDoubleQuotes :: SrcSpan -> P a reportEmptyDoubleQuotes span = do thQuotes <- getBit ThQuotesBit - addFatalError $ Error (ErrEmptyDoubleQuotes thQuotes) [] span + addFatalError $ PsError (PsErrEmptyDoubleQuotes thQuotes) [] span {- %************************************************************************ ===================================== compiler/GHC/Parser/Errors.hs ===================================== @@ -1,11 +1,11 @@ module GHC.Parser.Errors - ( Warning(..) + ( PsWarning(..) , TransLayoutReason(..) , OperatorWhitespaceSymbol(..) , OperatorWhitespaceOccurrence(..) , NumUnderscoreReason(..) - , Error(..) - , ErrorDesc(..) + , PsError(..) + , PsErrorDesc(..) , LexErr(..) , CmmParserError(..) , LexErrKind(..) @@ -30,37 +30,38 @@ import GHC.Utils.Outputable (SDoc) import GHC.Data.FastString import GHC.Unit.Module.Name -data Warning +-- | A warning that might arise during parsing. +data PsWarning -- | Warn when tabulations are found - = WarnTab + = PsWarnTab { tabFirst :: !SrcSpan -- ^ First occurence of a tab , tabCount :: !Word -- ^ Number of other occurences } - | WarnTransitionalLayout !SrcSpan !TransLayoutReason + | PsWarnTransitionalLayout !SrcSpan !TransLayoutReason -- ^ Transitional layout warnings - | WarnUnrecognisedPragma !SrcSpan + | PsWarnUnrecognisedPragma !SrcSpan -- ^ Unrecognised pragma - | WarnHaddockInvalidPos !SrcSpan + | PsWarnHaddockInvalidPos !SrcSpan -- ^ Invalid Haddock comment position - | WarnHaddockIgnoreMulti !SrcSpan + | PsWarnHaddockIgnoreMulti !SrcSpan -- ^ Multiple Haddock comment for the same entity - | WarnStarBinder !SrcSpan + | PsWarnStarBinder !SrcSpan -- ^ Found binding occurence of "*" while StarIsType is enabled - | WarnStarIsType !SrcSpan + | PsWarnStarIsType !SrcSpan -- ^ Using "*" for "Type" without StarIsType enabled - | WarnImportPreQualified !SrcSpan + | PsWarnImportPreQualified !SrcSpan -- ^ Pre qualified import with 'WarnPrepositiveQualifiedModule' enabled - | WarnOperatorWhitespaceExtConflict !SrcSpan !OperatorWhitespaceSymbol - | WarnOperatorWhitespace !SrcSpan !FastString !OperatorWhitespaceOccurrence + | PsWarnOperatorWhitespaceExtConflict !SrcSpan !OperatorWhitespaceSymbol + | PsWarnOperatorWhitespace !SrcSpan !FastString !OperatorWhitespaceOccurrence -- | The operator symbol in the 'WarnOperatorWhitespaceExtConflict' warning. data OperatorWhitespaceSymbol @@ -78,146 +79,146 @@ data TransLayoutReason = TransLayout_Where -- ^ "`where' clause at the same depth as implicit layout block" | TransLayout_Pipe -- ^ "`|' at the same depth as implicit layout block") -data Error = Error - { errDesc :: !ErrorDesc -- ^ Error description +data PsError = PsError + { errDesc :: !PsErrorDesc -- ^ Error description , errHints :: ![Hint] -- ^ Hints , errLoc :: !SrcSpan -- ^ Error position } -data ErrorDesc - = ErrLambdaCase +data PsErrorDesc + = PsErrLambdaCase -- ^ LambdaCase syntax used without the extension enabled - | ErrNumUnderscores !NumUnderscoreReason + | PsErrNumUnderscores !NumUnderscoreReason -- ^ Underscores in literals without the extension enabled - | ErrPrimStringInvalidChar + | PsErrPrimStringInvalidChar -- ^ Invalid character in primitive string - | ErrMissingBlock + | PsErrMissingBlock -- ^ Missing block - | ErrLexer !LexErr !LexErrKind + | PsErrLexer !LexErr !LexErrKind -- ^ Lexer error - | ErrSuffixAT + | PsErrSuffixAT -- ^ Suffix occurence of `@` - | ErrParse !String + | PsErrParse !String -- ^ Parse errors - | ErrCmmLexer + | PsErrCmmLexer -- ^ Cmm lexer error - | ErrUnsupportedBoxedSumExpr !(SumOrTuple (HsExpr GhcPs)) + | PsErrUnsupportedBoxedSumExpr !(SumOrTuple (HsExpr GhcPs)) -- ^ Unsupported boxed sum in expression - | ErrUnsupportedBoxedSumPat !(SumOrTuple (PatBuilder GhcPs)) + | PsErrUnsupportedBoxedSumPat !(SumOrTuple (PatBuilder GhcPs)) -- ^ Unsupported boxed sum in pattern - | ErrUnexpectedQualifiedConstructor !RdrName + | PsErrUnexpectedQualifiedConstructor !RdrName -- ^ Unexpected qualified constructor - | ErrTupleSectionInPat + | PsErrTupleSectionInPat -- ^ Tuple section in pattern context - | ErrIllegalBangPattern !(Pat GhcPs) + | PsErrIllegalBangPattern !(Pat GhcPs) -- ^ Bang-pattern without BangPattterns enabled - | ErrOpFewArgs !StarIsType !RdrName + | PsErrOpFewArgs !StarIsType !RdrName -- ^ Operator applied to too few arguments - | ErrImportQualifiedTwice + | PsErrImportQualifiedTwice -- ^ Import: multiple occurrences of 'qualified' - | ErrImportPostQualified + | PsErrImportPostQualified -- ^ Post qualified import without 'ImportQualifiedPost' - | ErrIllegalExplicitNamespace + | PsErrIllegalExplicitNamespace -- ^ Explicit namespace keyword without 'ExplicitNamespaces' - | ErrVarForTyCon !RdrName + | PsErrVarForTyCon !RdrName -- ^ Expecting a type constructor but found a variable - | ErrIllegalPatSynExport + | PsErrIllegalPatSynExport -- ^ Illegal export form allowed by PatternSynonyms - | ErrMalformedEntityString + | PsErrMalformedEntityString -- ^ Malformed entity string - | ErrDotsInRecordUpdate + | PsErrDotsInRecordUpdate -- ^ Dots used in record update - | ErrPrecedenceOutOfRange !Int + | PsErrPrecedenceOutOfRange !Int -- ^ Precedence out of range - | ErrInvalidDataCon !(HsType GhcPs) + | PsErrInvalidDataCon !(HsType GhcPs) -- ^ Cannot parse data constructor in a data/newtype declaration - | ErrInvalidInfixDataCon !(HsType GhcPs) !RdrName !(HsType GhcPs) + | PsErrInvalidInfixDataCon !(HsType GhcPs) !RdrName !(HsType GhcPs) -- ^ Cannot parse data constructor in a data/newtype declaration - | ErrUnpackDataCon + | PsErrUnpackDataCon -- ^ UNPACK applied to a data constructor - | ErrUnexpectedKindAppInDataCon !DataConBuilder !(HsType GhcPs) + | PsErrUnexpectedKindAppInDataCon !DataConBuilder !(HsType GhcPs) -- ^ Unexpected kind application in data/newtype declaration - | ErrInvalidRecordCon !(PatBuilder GhcPs) + | PsErrInvalidRecordCon !(PatBuilder GhcPs) -- ^ Not a record constructor - | ErrIllegalUnboxedStringInPat !(HsLit GhcPs) + | PsErrIllegalUnboxedStringInPat !(HsLit GhcPs) -- ^ Illegal unboxed string literal in pattern - | ErrDoNotationInPat + | PsErrDoNotationInPat -- ^ Do-notation in pattern - | ErrIfTheElseInPat + | PsErrIfTheElseInPat -- ^ If-then-else syntax in pattern - | ErrLambdaCaseInPat + | PsErrLambdaCaseInPat -- ^ Lambda-case in pattern - | ErrCaseInPat + | PsErrCaseInPat -- ^ case..of in pattern - | ErrLetInPat + | PsErrLetInPat -- ^ let-syntax in pattern - | ErrLambdaInPat + | PsErrLambdaInPat -- ^ Lambda-syntax in pattern - | ErrArrowExprInPat !(HsExpr GhcPs) + | PsErrArrowExprInPat !(HsExpr GhcPs) -- ^ Arrow expression-syntax in pattern - | ErrArrowCmdInPat !(HsCmd GhcPs) + | PsErrArrowCmdInPat !(HsCmd GhcPs) -- ^ Arrow command-syntax in pattern - | ErrArrowCmdInExpr !(HsCmd GhcPs) + | PsErrArrowCmdInExpr !(HsCmd GhcPs) -- ^ Arrow command-syntax in expression - | ErrViewPatInExpr !(LHsExpr GhcPs) !(LHsExpr GhcPs) + | PsErrViewPatInExpr !(LHsExpr GhcPs) !(LHsExpr GhcPs) -- ^ View-pattern in expression - | ErrTypeAppWithoutSpace !RdrName !(LHsExpr GhcPs) + | PsErrTypeAppWithoutSpace !RdrName !(LHsExpr GhcPs) -- ^ Type-application without space before '@' - | ErrLazyPatWithoutSpace !(LHsExpr GhcPs) + | PsErrLazyPatWithoutSpace !(LHsExpr GhcPs) -- ^ Lazy-pattern ('~') without space after it - | ErrBangPatWithoutSpace !(LHsExpr GhcPs) + | PsErrBangPatWithoutSpace !(LHsExpr GhcPs) -- ^ Bang-pattern ('!') without space after it - | ErrUnallowedPragma !(HsPragE GhcPs) + | PsErrUnallowedPragma !(HsPragE GhcPs) -- ^ Pragma not allowed in this position - | ErrQualifiedDoInCmd !ModuleName + | PsErrQualifiedDoInCmd !ModuleName -- ^ Qualified do block in command - | ErrInvalidInfixHole + | PsErrInvalidInfixHole -- ^ Invalid infix hole, expected an infix operator - | ErrSemiColonsInCondExpr + | PsErrSemiColonsInCondExpr -- ^ Unexpected semi-colons in conditional expression !(HsExpr GhcPs) -- ^ conditional expr !Bool -- ^ "then" semi-colon? @@ -225,7 +226,7 @@ data ErrorDesc !Bool -- ^ "else" semi-colon? !(HsExpr GhcPs) -- ^ "else" expr - | ErrSemiColonsInCondCmd + | PsErrSemiColonsInCondCmd -- ^ Unexpected semi-colons in conditional command !(HsExpr GhcPs) -- ^ conditional expr !Bool -- ^ "then" semi-colon? @@ -233,143 +234,143 @@ data ErrorDesc !Bool -- ^ "else" semi-colon? !(HsCmd GhcPs) -- ^ "else" expr - | ErrAtInPatPos + | PsErrAtInPatPos -- ^ @-operator in a pattern position - | ErrLambdaCmdInFunAppCmd !(LHsCmd GhcPs) + | PsErrLambdaCmdInFunAppCmd !(LHsCmd GhcPs) -- ^ Unexpected lambda command in function application - | ErrCaseCmdInFunAppCmd !(LHsCmd GhcPs) + | PsErrCaseCmdInFunAppCmd !(LHsCmd GhcPs) -- ^ Unexpected case command in function application - | ErrIfCmdInFunAppCmd !(LHsCmd GhcPs) + | PsErrIfCmdInFunAppCmd !(LHsCmd GhcPs) -- ^ Unexpected if command in function application - | ErrLetCmdInFunAppCmd !(LHsCmd GhcPs) + | PsErrLetCmdInFunAppCmd !(LHsCmd GhcPs) -- ^ Unexpected let command in function application - | ErrDoCmdInFunAppCmd !(LHsCmd GhcPs) + | PsErrDoCmdInFunAppCmd !(LHsCmd GhcPs) -- ^ Unexpected do command in function application - | ErrDoInFunAppExpr !(Maybe ModuleName) !(LHsExpr GhcPs) + | PsErrDoInFunAppExpr !(Maybe ModuleName) !(LHsExpr GhcPs) -- ^ Unexpected do block in function application - | ErrMDoInFunAppExpr !(Maybe ModuleName) !(LHsExpr GhcPs) + | PsErrMDoInFunAppExpr !(Maybe ModuleName) !(LHsExpr GhcPs) -- ^ Unexpected mdo block in function application - | ErrLambdaInFunAppExpr !(LHsExpr GhcPs) + | PsErrLambdaInFunAppExpr !(LHsExpr GhcPs) -- ^ Unexpected lambda expression in function application - | ErrCaseInFunAppExpr !(LHsExpr GhcPs) + | PsErrCaseInFunAppExpr !(LHsExpr GhcPs) -- ^ Unexpected case expression in function application - | ErrLambdaCaseInFunAppExpr !(LHsExpr GhcPs) + | PsErrLambdaCaseInFunAppExpr !(LHsExpr GhcPs) -- ^ Unexpected lambda-case expression in function application - | ErrLetInFunAppExpr !(LHsExpr GhcPs) + | PsErrLetInFunAppExpr !(LHsExpr GhcPs) -- ^ Unexpected let expression in function application - | ErrIfInFunAppExpr !(LHsExpr GhcPs) + | PsErrIfInFunAppExpr !(LHsExpr GhcPs) -- ^ Unexpected if expression in function application - | ErrProcInFunAppExpr !(LHsExpr GhcPs) + | PsErrProcInFunAppExpr !(LHsExpr GhcPs) -- ^ Unexpected proc expression in function application - | ErrMalformedTyOrClDecl !(LHsType GhcPs) + | PsErrMalformedTyOrClDecl !(LHsType GhcPs) -- ^ Malformed head of type or class declaration - | ErrIllegalWhereInDataDecl + | PsErrIllegalWhereInDataDecl -- ^ Illegal 'where' keyword in data declaration - | ErrIllegalDataTypeContext !(LHsContext GhcPs) + | PsErrIllegalDataTypeContext !(LHsContext GhcPs) -- ^ Illegal datatyp context - | ErrParseErrorOnInput !OccName + | PsErrParseErrorOnInput !OccName -- ^ Parse error on input - | ErrMalformedDecl !SDoc !RdrName + | PsErrMalformedDecl !SDoc !RdrName -- ^ Malformed ... declaration for ... - | ErrUnexpectedTypeAppInDecl !(LHsType GhcPs) !SDoc !RdrName + | PsErrUnexpectedTypeAppInDecl !(LHsType GhcPs) !SDoc !RdrName -- ^ Unexpected type application in a declaration - | ErrNotADataCon !RdrName + | PsErrNotADataCon !RdrName -- ^ Not a data constructor - | ErrRecordSyntaxInPatSynDecl !(LPat GhcPs) + | PsErrRecordSyntaxInPatSynDecl !(LPat GhcPs) -- ^ Record syntax used in pattern synonym declaration - | ErrEmptyWhereInPatSynDecl !RdrName + | PsErrEmptyWhereInPatSynDecl !RdrName -- ^ Empty 'where' clause in pattern-synonym declaration - | ErrInvalidWhereBindInPatSynDecl !RdrName !(HsDecl GhcPs) + | PsErrInvalidWhereBindInPatSynDecl !RdrName !(HsDecl GhcPs) -- ^ Invalid binding name in 'where' clause of pattern-synonym declaration - | ErrNoSingleWhereBindInPatSynDecl !RdrName !(HsDecl GhcPs) + | PsErrNoSingleWhereBindInPatSynDecl !RdrName !(HsDecl GhcPs) -- ^ Multiple bindings in 'where' clause of pattern-synonym declaration - | ErrDeclSpliceNotAtTopLevel !(SpliceDecl GhcPs) + | PsErrDeclSpliceNotAtTopLevel !(SpliceDecl GhcPs) -- ^ Declaration splice not a top-level - | ErrInferredTypeVarNotAllowed + | PsErrInferredTypeVarNotAllowed -- ^ Inferred type variables not allowed here - | ErrMultipleNamesInStandaloneKindSignature [LIdP GhcPs] + | PsErrMultipleNamesInStandaloneKindSignature [LIdP GhcPs] -- ^ Multiple names in standalone kind signatures - | ErrIllegalImportBundleForm + | PsErrIllegalImportBundleForm -- ^ Illegal import bundle form - | ErrIllegalRoleName !FastString [Role] + | PsErrIllegalRoleName !FastString [Role] -- ^ Illegal role name - | ErrInvalidTypeSignature !(LHsExpr GhcPs) + | PsErrInvalidTypeSignature !(LHsExpr GhcPs) -- ^ Invalid type signature - | ErrUnexpectedTypeInDecl !(LHsType GhcPs) !SDoc !RdrName [LHsTypeArg GhcPs] !SDoc + | PsErrUnexpectedTypeInDecl !(LHsType GhcPs) !SDoc !RdrName [LHsTypeArg GhcPs] !SDoc -- ^ Unexpected type in declaration - | ErrExpectedHyphen + | PsErrExpectedHyphen -- ^ Expected a hyphen - | ErrSpaceInSCC + | PsErrSpaceInSCC -- ^ Found a space in a SCC - | ErrEmptyDoubleQuotes !Bool-- Is TH on? + | PsErrEmptyDoubleQuotes !Bool-- Is TH on? -- ^ Found two single quotes - | ErrInvalidPackageName !FastString + | PsErrInvalidPackageName !FastString -- ^ Invalid package name - | ErrInvalidRuleActivationMarker + | PsErrInvalidRuleActivationMarker -- ^ Invalid rule activation marker - | ErrLinearFunction + | PsErrLinearFunction -- ^ Linear function found but LinearTypes not enabled - | ErrMultiWayIf + | PsErrMultiWayIf -- ^ Multi-way if-expression found but MultiWayIf not enabled - | ErrExplicitForall !Bool -- is Unicode forall? + | PsErrExplicitForall !Bool -- is Unicode forall? -- ^ Explicit forall found but no extension allowing it is enabled - | ErrIllegalQualifiedDo !SDoc + | PsErrIllegalQualifiedDo !SDoc -- ^ Found qualified-do without QualifiedDo enabled - | ErrCmmParser !CmmParserError + | PsErrCmmParser !CmmParserError -- ^ Cmm parser error - | ErrIllegalTraditionalRecordSyntax !SDoc + | PsErrIllegalTraditionalRecordSyntax !SDoc -- ^ Illegal traditional record syntax -- -- TODO: distinguish errors without using SDoc - | ErrParseErrorInCmd !SDoc + | PsErrParseErrorInCmd !SDoc -- ^ Parse error in command -- -- TODO: distinguish errors without using SDoc - | ErrParseErrorInPat !SDoc + | PsErrParseErrorInPat !SDoc -- ^ Parse error in pattern -- -- TODO: distinguish errors without using SDoc ===================================== compiler/GHC/Parser/Errors/Ppr.hs ===================================== @@ -44,9 +44,9 @@ mkParserWarn flag span doc = ErrMsg , errMsgReason = Reason flag } -pprWarning :: Warning -> ErrMsg +pprWarning :: PsWarning -> ErrMsg pprWarning = \case - WarnTab loc tc + PsWarnTab loc tc -> mkParserWarn Opt_WarnTabs loc $ text "Tab character found here" <> (if tc == 1 @@ -55,7 +55,7 @@ pprWarning = \case <> text "." $+$ text "Please use spaces instead." - WarnTransitionalLayout loc reason + PsWarnTransitionalLayout loc reason -> mkParserWarn Opt_WarnAlternativeLayoutRuleTransitional loc $ text "transitional layout will not be accepted in the future:" $$ text (case reason of @@ -63,20 +63,20 @@ pprWarning = \case TransLayout_Pipe -> "`|' at the same depth as implicit layout block" ) - WarnUnrecognisedPragma loc + PsWarnUnrecognisedPragma loc -> mkParserWarn Opt_WarnUnrecognisedPragmas loc $ text "Unrecognised pragma" - WarnHaddockInvalidPos loc + PsWarnHaddockInvalidPos loc -> mkParserWarn Opt_WarnInvalidHaddock loc $ text "A Haddock comment cannot appear in this position and will be ignored." - WarnHaddockIgnoreMulti loc + PsWarnHaddockIgnoreMulti loc -> mkParserWarn Opt_WarnInvalidHaddock loc $ text "Multiple Haddock comments for a single entity are not allowed." $$ text "The extraneous comment will be ignored." - WarnStarBinder loc + PsWarnStarBinder loc -> mkParserWarn Opt_WarnStarBinder loc $ text "Found binding occurrence of" <+> quotes (text "*") <+> text "yet StarIsType is enabled." @@ -84,7 +84,7 @@ pprWarning = \case <+> text "modules with StarIsType," $$ text " including the definition module, you must qualify it." - WarnStarIsType loc + PsWarnStarIsType loc -> mkParserWarn Opt_WarnStarIsType loc $ text "Using" <+> quotes (text "*") <+> text "(or its Unicode variant) to mean" @@ -94,7 +94,7 @@ pprWarning = \case $$ text "Suggested fix: use" <+> quotes (text "Type") <+> text "from" <+> quotes (text "Data.Kind") <+> text "instead." - WarnImportPreQualified loc + PsWarnImportPreQualified loc -> mkParserWarn Opt_WarnPrepositiveQualifiedModule loc $ text "Found" <+> quotes (text "qualified") <+> text "in prepositive position" @@ -102,7 +102,7 @@ pprWarning = \case <+> text "after the module name instead." $$ text "To allow this, enable language extension 'ImportQualifiedPost'" - WarnOperatorWhitespaceExtConflict loc sym + PsWarnOperatorWhitespaceExtConflict loc sym -> mkParserWarn Opt_WarnOperatorWhitespaceExtConflict loc $ let mk_prefix_msg operator_symbol extension_name syntax_meaning = text "The prefix use of a" <+> quotes (text operator_symbol) @@ -117,7 +117,7 @@ pprWarning = \case OperatorWhitespaceSymbol_PrefixDollarDollar -> mk_prefix_msg "$$" "TemplateHaskell" "a typed splice" - WarnOperatorWhitespace loc sym occ_type + PsWarnOperatorWhitespace loc sym occ_type -> mkParserWarn Opt_WarnOperatorWhitespace loc $ let mk_msg occ_type_str = text "The" <+> text occ_type_str <+> text "use of a" <+> quotes (ftext sym) @@ -130,27 +130,27 @@ pprWarning = \case OperatorWhitespaceOccurrence_Suffix -> mk_msg "suffix" OperatorWhitespaceOccurrence_TightInfix -> mk_msg "tight infix" -pprError :: Error -> ErrMsg +pprError :: PsError -> ErrMsg pprError err = mkParserErr (errLoc err) $ vcat (pp_err (errDesc err) : map pp_hint (errHints err)) -pp_err :: ErrorDesc -> SDoc +pp_err :: PsErrorDesc -> SDoc pp_err = \case - ErrLambdaCase + PsErrLambdaCase -> text "Illegal lambda-case (use LambdaCase)" - ErrNumUnderscores reason + PsErrNumUnderscores reason -> text $ case reason of NumUnderscore_Integral -> "Use NumericUnderscores to allow underscores in integer literals" NumUnderscore_Float -> "Use NumericUnderscores to allow underscores in floating literals" - ErrPrimStringInvalidChar + PsErrPrimStringInvalidChar -> text "primitive string literal must contain only characters <= \'\\xFF\'" - ErrMissingBlock + PsErrMissingBlock -> text "Missing block" - ErrLexer err kind + PsErrLexer err kind -> hcat [ text $ case err of LexError -> "lexical error" @@ -170,53 +170,53 @@ pp_err = \case LexErrKind_Char c -> " at character " ++ show c ] - ErrSuffixAT + PsErrSuffixAT -> text "Suffix occurrence of @. For an as-pattern, remove the leading whitespace." - ErrParse token + PsErrParse token | null token -> text "parse error (possibly incorrect indentation or mismatched brackets)" | otherwise -> text "parse error on input" <+> quotes (text token) - ErrCmmLexer + PsErrCmmLexer -> text "Cmm lexical error" - ErrUnsupportedBoxedSumExpr s + PsErrUnsupportedBoxedSumExpr s -> hang (text "Boxed sums not supported:") 2 (pprSumOrTuple Boxed s) - ErrUnsupportedBoxedSumPat s + PsErrUnsupportedBoxedSumPat s -> hang (text "Boxed sums not supported:") 2 (pprSumOrTuple Boxed s) - ErrUnexpectedQualifiedConstructor v + PsErrUnexpectedQualifiedConstructor v -> hang (text "Expected an unqualified type constructor:") 2 (ppr v) - ErrTupleSectionInPat + PsErrTupleSectionInPat -> text "Tuple section in pattern context" - ErrIllegalBangPattern e + PsErrIllegalBangPattern e -> text "Illegal bang-pattern (use BangPatterns):" $$ ppr e - ErrOpFewArgs (StarIsType star_is_type) op + PsErrOpFewArgs (StarIsType star_is_type) op -> text "Operator applied to too few arguments:" <+> ppr op $$ starInfo star_is_type op - ErrImportQualifiedTwice + PsErrImportQualifiedTwice -> text "Multiple occurrences of 'qualified'" - ErrImportPostQualified + PsErrImportPostQualified -> text "Found" <+> quotes (text "qualified") <+> text "in postpositive position. " $$ text "To allow this, enable language extension 'ImportQualifiedPost'" - ErrIllegalExplicitNamespace + PsErrIllegalExplicitNamespace -> text "Illegal keyword 'type' (use ExplicitNamespaces to enable)" - ErrVarForTyCon name + PsErrVarForTyCon name -> text "Expecting a type constructor but found a variable," <+> quotes (ppr name) <> text "." $$ if isSymOcc $ rdrNameOcc name @@ -224,114 +224,114 @@ pp_err = \case <+> text "then enable ExplicitNamespaces and use the 'type' keyword." else empty - ErrIllegalPatSynExport + PsErrIllegalPatSynExport -> text "Illegal export form (use PatternSynonyms to enable)" - ErrMalformedEntityString + PsErrMalformedEntityString -> text "Malformed entity string" - ErrDotsInRecordUpdate + PsErrDotsInRecordUpdate -> text "You cannot use `..' in a record update" - ErrPrecedenceOutOfRange i + PsErrPrecedenceOutOfRange i -> text "Precedence out of range: " <> int i - ErrInvalidDataCon t + PsErrInvalidDataCon t -> hang (text "Cannot parse data constructor in a data/newtype declaration:") 2 (ppr t) - ErrInvalidInfixDataCon lhs tc rhs + PsErrInvalidInfixDataCon lhs tc rhs -> hang (text "Cannot parse an infix data constructor in a data/newtype declaration:") 2 (ppr lhs <+> ppr tc <+> ppr rhs) - ErrUnpackDataCon + PsErrUnpackDataCon -> text "{-# UNPACK #-} cannot be applied to a data constructor." - ErrUnexpectedKindAppInDataCon lhs ki + PsErrUnexpectedKindAppInDataCon lhs ki -> hang (text "Unexpected kind application in a data/newtype declaration:") 2 (ppr lhs <+> text "@" <> ppr ki) - ErrInvalidRecordCon p + PsErrInvalidRecordCon p -> text "Not a record constructor:" <+> ppr p - ErrIllegalUnboxedStringInPat lit + PsErrIllegalUnboxedStringInPat lit -> text "Illegal unboxed string literal in pattern:" $$ ppr lit - ErrDoNotationInPat + PsErrDoNotationInPat -> text "do-notation in pattern" - ErrIfTheElseInPat + PsErrIfTheElseInPat -> text "(if ... then ... else ...)-syntax in pattern" - ErrLambdaCaseInPat + PsErrLambdaCaseInPat -> text "(\\case ...)-syntax in pattern" - ErrCaseInPat + PsErrCaseInPat -> text "(case ... of ...)-syntax in pattern" - ErrLetInPat + PsErrLetInPat -> text "(let ... in ...)-syntax in pattern" - ErrLambdaInPat + PsErrLambdaInPat -> text "Lambda-syntax in pattern." $$ text "Pattern matching on functions is not possible." - ErrArrowExprInPat e + PsErrArrowExprInPat e -> text "Expression syntax in pattern:" <+> ppr e - ErrArrowCmdInPat c + PsErrArrowCmdInPat c -> text "Command syntax in pattern:" <+> ppr c - ErrArrowCmdInExpr c + PsErrArrowCmdInExpr c -> vcat [ text "Arrow command found where an expression was expected:" , nest 2 (ppr c) ] - ErrViewPatInExpr a b + PsErrViewPatInExpr a b -> sep [ text "View pattern in expression context:" , nest 4 (ppr a <+> text "->" <+> ppr b) ] - ErrTypeAppWithoutSpace v e + PsErrTypeAppWithoutSpace v e -> sep [ text "@-pattern in expression context:" , nest 4 (pprPrefixOcc v <> text "@" <> ppr e) ] $$ text "Type application syntax requires a space before '@'" - ErrLazyPatWithoutSpace e + PsErrLazyPatWithoutSpace e -> sep [ text "Lazy pattern in expression context:" , nest 4 (text "~" <> ppr e) ] $$ text "Did you mean to add a space after the '~'?" - ErrBangPatWithoutSpace e + PsErrBangPatWithoutSpace e -> sep [ text "Bang pattern in expression context:" , nest 4 (text "!" <> ppr e) ] $$ text "Did you mean to add a space after the '!'?" - ErrUnallowedPragma prag + PsErrUnallowedPragma prag -> hang (text "A pragma is not allowed in this position:") 2 (ppr prag) - ErrQualifiedDoInCmd m + PsErrQualifiedDoInCmd m -> hang (text "Parse error in command:") 2 $ text "Found a qualified" <+> ppr m <> text ".do block in a command, but" $$ text "qualified 'do' is not supported in commands." - ErrParseErrorInCmd s + PsErrParseErrorInCmd s -> hang (text "Parse error in command:") 2 s - ErrParseErrorInPat s + PsErrParseErrorInPat s -> text "Parse error in pattern:" <+> s - ErrInvalidInfixHole + PsErrInvalidInfixHole -> text "Invalid infix hole, expected an infix operator" - ErrSemiColonsInCondExpr c st t se e + PsErrSemiColonsInCondExpr c st t se e -> text "Unexpected semi-colons in conditional:" $$ nest 4 expr $$ text "Perhaps you meant to use DoAndIfThenElse?" @@ -342,7 +342,7 @@ pp_err = \case text "then" <+> ppr t <> pprOptSemi se <+> text "else" <+> ppr e - ErrSemiColonsInCondCmd c st t se e + PsErrSemiColonsInCondCmd c st t se e -> text "Unexpected semi-colons in conditional:" $$ nest 4 expr $$ text "Perhaps you meant to use DoAndIfThenElse?" @@ -354,78 +354,78 @@ pp_err = \case text "else" <+> ppr e - ErrAtInPatPos + PsErrAtInPatPos -> text "Found a binding for the" <+> quotes (text "@") <+> text "operator in a pattern position." $$ perhaps_as_pat - ErrLambdaCmdInFunAppCmd a + PsErrLambdaCmdInFunAppCmd a -> pp_unexpected_fun_app (text "lambda command") a - ErrCaseCmdInFunAppCmd a + PsErrCaseCmdInFunAppCmd a -> pp_unexpected_fun_app (text "case command") a - ErrIfCmdInFunAppCmd a + PsErrIfCmdInFunAppCmd a -> pp_unexpected_fun_app (text "if command") a - ErrLetCmdInFunAppCmd a + PsErrLetCmdInFunAppCmd a -> pp_unexpected_fun_app (text "let command") a - ErrDoCmdInFunAppCmd a + PsErrDoCmdInFunAppCmd a -> pp_unexpected_fun_app (text "do command") a - ErrDoInFunAppExpr m a + PsErrDoInFunAppExpr m a -> pp_unexpected_fun_app (prependQualified m (text "do block")) a - ErrMDoInFunAppExpr m a + PsErrMDoInFunAppExpr m a -> pp_unexpected_fun_app (prependQualified m (text "mdo block")) a - ErrLambdaInFunAppExpr a + PsErrLambdaInFunAppExpr a -> pp_unexpected_fun_app (text "lambda expression") a - ErrCaseInFunAppExpr a + PsErrCaseInFunAppExpr a -> pp_unexpected_fun_app (text "case expression") a - ErrLambdaCaseInFunAppExpr a + PsErrLambdaCaseInFunAppExpr a -> pp_unexpected_fun_app (text "lambda-case expression") a - ErrLetInFunAppExpr a + PsErrLetInFunAppExpr a -> pp_unexpected_fun_app (text "let expression") a - ErrIfInFunAppExpr a + PsErrIfInFunAppExpr a -> pp_unexpected_fun_app (text "if expression") a - ErrProcInFunAppExpr a + PsErrProcInFunAppExpr a -> pp_unexpected_fun_app (text "proc expression") a - ErrMalformedTyOrClDecl ty + PsErrMalformedTyOrClDecl ty -> text "Malformed head of type or class declaration:" <+> ppr ty - ErrIllegalWhereInDataDecl + PsErrIllegalWhereInDataDecl -> vcat [ text "Illegal keyword 'where' in data declaration" , text "Perhaps you intended to use GADTs or a similar language" , text "extension to enable syntax: data T where" ] - ErrIllegalTraditionalRecordSyntax s + PsErrIllegalTraditionalRecordSyntax s -> text "Illegal record syntax (use TraditionalRecordSyntax):" <+> s - ErrParseErrorOnInput occ + PsErrParseErrorOnInput occ -> text "parse error on input" <+> ftext (occNameFS occ) - ErrIllegalDataTypeContext c + PsErrIllegalDataTypeContext c -> text "Illegal datatype context (use DatatypeContexts):" <+> pprLHsContext c - ErrMalformedDecl what for + PsErrMalformedDecl what for -> text "Malformed" <+> what <+> text "declaration for" <+> quotes (ppr for) - ErrUnexpectedTypeAppInDecl ki what for + PsErrUnexpectedTypeAppInDecl ki what for -> vcat [ text "Unexpected type application" <+> text "@" <> ppr ki , text "In the" <+> what @@ -433,35 +433,35 @@ pp_err = \case <+> quotes (ppr for) ] - ErrNotADataCon name + PsErrNotADataCon name -> text "Not a data constructor:" <+> quotes (ppr name) - ErrRecordSyntaxInPatSynDecl pat + PsErrRecordSyntaxInPatSynDecl pat -> text "record syntax not supported for pattern synonym declarations:" $$ ppr pat - ErrEmptyWhereInPatSynDecl patsyn_name + PsErrEmptyWhereInPatSynDecl patsyn_name -> text "pattern synonym 'where' clause cannot be empty" $$ text "In the pattern synonym declaration for: " <+> ppr (patsyn_name) - ErrInvalidWhereBindInPatSynDecl patsyn_name decl + PsErrInvalidWhereBindInPatSynDecl patsyn_name decl -> text "pattern synonym 'where' clause must bind the pattern synonym's name" <+> quotes (ppr patsyn_name) $$ ppr decl - ErrNoSingleWhereBindInPatSynDecl _patsyn_name decl + PsErrNoSingleWhereBindInPatSynDecl _patsyn_name decl -> text "pattern synonym 'where' clause must contain a single binding:" $$ ppr decl - ErrDeclSpliceNotAtTopLevel d + PsErrDeclSpliceNotAtTopLevel d -> hang (text "Declaration splices are allowed only" <+> text "at the top level:") 2 (ppr d) - ErrInferredTypeVarNotAllowed + PsErrInferredTypeVarNotAllowed -> text "Inferred type variables are not allowed here" - ErrIllegalRoleName role nearby + PsErrIllegalRoleName role nearby -> text "Illegal role name" <+> quotes (ppr role) $$ case nearby of [] -> empty @@ -470,17 +470,17 @@ pp_err = \case _ -> hang (text "Perhaps you meant one of these:") 2 (pprWithCommas (quotes . ppr) nearby) - ErrMultipleNamesInStandaloneKindSignature vs + PsErrMultipleNamesInStandaloneKindSignature vs -> vcat [ hang (text "Standalone kind signatures do not support multiple names at the moment:") 2 (pprWithCommas ppr vs) , text "See https://gitlab.haskell.org/ghc/ghc/issues/16754 for details." ] - ErrIllegalImportBundleForm + PsErrIllegalImportBundleForm -> text "Illegal import form, this syntax can only be used to bundle" $+$ text "pattern synonyms with types in module exports." - ErrInvalidTypeSignature lhs + PsErrInvalidTypeSignature lhs -> text "Invalid type signature:" <+> ppr lhs <+> text ":: ..." @@ -507,7 +507,7 @@ pp_err = \case default_RDR = mkUnqual varName (fsLit "default") pattern_RDR = mkUnqual varName (fsLit "pattern") - ErrUnexpectedTypeInDecl t what tc tparms equals_or_where + PsErrUnexpectedTypeInDecl t what tc tparms equals_or_where -> vcat [ text "Unexpected type" <+> quotes (ppr t) , text "In the" <+> what <+> ptext (sLit "declaration for") <+> quotes tc' @@ -524,20 +524,20 @@ pp_err = \case -- wrote). See #14907 tc' = ppr $ filterCTuple tc - ErrCmmParser cmm_err -> case cmm_err of + PsErrCmmParser cmm_err -> case cmm_err of CmmUnknownPrimitive name -> text "unknown primitive" <+> ftext name CmmUnknownMacro fun -> text "unknown macro" <+> ftext fun CmmUnknownCConv cconv -> text "unknown calling convention:" <+> text cconv CmmUnrecognisedSafety safety -> text "unrecognised safety" <+> text safety CmmUnrecognisedHint hint -> text "unrecognised hint:" <+> text hint - ErrExpectedHyphen + PsErrExpectedHyphen -> text "Expected a hyphen" - ErrSpaceInSCC + PsErrSpaceInSCC -> text "Spaces are not allowed in SCCs" - ErrEmptyDoubleQuotes th_on + PsErrEmptyDoubleQuotes th_on -> if th_on then vcat (msg ++ th_msg) else vcat msg where msg = [ text "Parser error on `''`" @@ -547,23 +547,23 @@ pp_err = \case , text "but the type variable or constructor is missing" ] - ErrInvalidPackageName pkg + PsErrInvalidPackageName pkg -> vcat [ text "Parse error" <> colon <+> quotes (ftext pkg) , text "Version number or non-alphanumeric" <+> text "character in package name" ] - ErrInvalidRuleActivationMarker + PsErrInvalidRuleActivationMarker -> text "Invalid rule activation marker" - ErrLinearFunction + PsErrLinearFunction -> text "Enable LinearTypes to allow linear functions" - ErrMultiWayIf + PsErrMultiWayIf -> text "Multi-way if-expressions need MultiWayIf turned on" - ErrExplicitForall is_unicode + PsErrExplicitForall is_unicode -> vcat [ text "Illegal symbol" <+> quotes (forallSym is_unicode) <+> text "in type" , text "Perhaps you intended to use RankNTypes or a similar language" @@ -574,7 +574,7 @@ pp_err = \case forallSym True = text "∀" forallSym False = text "forall" - ErrIllegalQualifiedDo qdoDoc + PsErrIllegalQualifiedDo qdoDoc -> vcat [ text "Illegal qualified" <+> quotes qdoDoc <+> text "block" , text "Perhaps you intended to use QualifiedDo" ===================================== compiler/GHC/Parser/Header.hs ===================================== @@ -73,7 +73,7 @@ getImports :: ParserOpts -- ^ Parser options -> FilePath -- ^ The original source filename (used for locations -- in the function result) -> IO (Either - (Bag Error) + (Bag PsError) ([(Maybe FastString, Located ModuleName)], [(Maybe FastString, Located ModuleName)], Located ModuleName)) ===================================== compiler/GHC/Parser/Lexer.x ===================================== @@ -353,7 +353,7 @@ $tab { warnTab } } <0,option_prags> { - "{-#" { warnThen Opt_WarnUnrecognisedPragmas WarnUnrecognisedPragma + "{-#" { warnThen Opt_WarnUnrecognisedPragmas PsWarnUnrecognisedPragma (nested_comment lexToken) } } @@ -1103,7 +1103,7 @@ hopefully_open_brace span buf len Layout prev_off _ : _ -> prev_off < offset _ -> True if isOK then pop_and open_brace span buf len - else addFatalError $ Error ErrMissingBlock [] (mkSrcSpanPs span) + else addFatalError $ PsError PsErrMissingBlock [] (mkSrcSpanPs span) pop_and :: Action -> Action pop_and act span buf len = do _ <- popLexState @@ -1482,7 +1482,7 @@ docCommentEnd input commentAcc docType buf span = do commentEnd lexToken input commentAcc finalizeComment buf span errBrace :: AlexInput -> RealSrcSpan -> P a -errBrace (AI end _) span = failLocMsgP (realSrcSpanStart span) (psRealLoc end) (Error (ErrLexer LexUnterminatedComment LexErrKind_EOF) []) +errBrace (AI end _) span = failLocMsgP (realSrcSpanStart span) (psRealLoc end) (PsError (PsErrLexer LexUnterminatedComment LexErrKind_EOF) []) open_brace, close_brace :: Action open_brace span _str _len = do @@ -1541,7 +1541,7 @@ varid span buf len = lambdaCase <- getBit LambdaCaseBit unless lambdaCase $ do pState <- getPState - addError $ Error ErrLambdaCase [] (mkSrcSpanPs (last_loc pState)) + addError $ PsError PsErrLambdaCase [] (mkSrcSpanPs (last_loc pState)) return ITlcase _ -> return ITcase maybe_layout keyword @@ -1574,7 +1574,7 @@ varsym_prefix :: Action varsym_prefix = sym $ \span exts s -> let warnExtConflict errtok = do { addWarning Opt_WarnOperatorWhitespaceExtConflict $ - WarnOperatorWhitespaceExtConflict (mkSrcSpanPs span) errtok + PsWarnOperatorWhitespaceExtConflict (mkSrcSpanPs span) errtok ; return (ITvarsym s) } in if | s == fsLit "@" -> @@ -1598,17 +1598,17 @@ varsym_prefix = sym $ \span exts s -> | s == fsLit "~" -> return ITtilde | otherwise -> do { addWarning Opt_WarnOperatorWhitespace $ - WarnOperatorWhitespace (mkSrcSpanPs span) s + PsWarnOperatorWhitespace (mkSrcSpanPs span) s OperatorWhitespaceOccurrence_Prefix ; return (ITvarsym s) } -- See Note [Whitespace-sensitive operator parsing] varsym_suffix :: Action varsym_suffix = sym $ \span _ s -> - if | s == fsLit "@" -> failMsgP (Error ErrSuffixAT []) + if | s == fsLit "@" -> failMsgP (PsError PsErrSuffixAT []) | otherwise -> do { addWarning Opt_WarnOperatorWhitespace $ - WarnOperatorWhitespace (mkSrcSpanPs span) s + PsWarnOperatorWhitespace (mkSrcSpanPs span) s OperatorWhitespaceOccurrence_Suffix ; return (ITvarsym s) } @@ -1618,7 +1618,7 @@ varsym_tight_infix = sym $ \span _ s -> if | s == fsLit "@" -> return ITat | otherwise -> do { addWarning Opt_WarnOperatorWhitespace $ - WarnOperatorWhitespace (mkSrcSpanPs span) s + PsWarnOperatorWhitespace (mkSrcSpanPs span) s OperatorWhitespaceOccurrence_TightInfix ; return (ITvarsym s) } @@ -1666,7 +1666,7 @@ tok_integral itint transint transbuf translen (radix,char_to_int) span buf len = let src = lexemeToString buf len when ((not numericUnderscores) && ('_' `elem` src)) $ do pState <- getPState - addError $ Error (ErrNumUnderscores NumUnderscore_Integral) [] (mkSrcSpanPs (last_loc pState)) + addError $ PsError (PsErrNumUnderscores NumUnderscore_Integral) [] (mkSrcSpanPs (last_loc pState)) return $ L span $ itint (SourceText src) $! transint $ parseUnsignedInteger (offsetBytes transbuf buf) (subtract translen len) radix char_to_int @@ -1707,7 +1707,7 @@ tok_frac drop f span buf len = do let src = lexemeToString buf (len-drop) when ((not numericUnderscores) && ('_' `elem` src)) $ do pState <- getPState - addError $ Error (ErrNumUnderscores NumUnderscore_Float) [] (mkSrcSpanPs (last_loc pState)) + addError $ PsError (PsErrNumUnderscores NumUnderscore_Float) [] (mkSrcSpanPs (last_loc pState)) return (L span $! (f $! src)) tok_float, tok_primfloat, tok_primdouble :: String -> Token @@ -1877,7 +1877,7 @@ lex_string_prag mkTok span _buf _len = case alexGetChar i of Just (c,i') | c == x -> isString i' xs _other -> False - err (AI end _) = failLocMsgP (realSrcSpanStart (psRealSpan span)) (psRealLoc end) (Error (ErrLexer LexUnterminatedOptions LexErrKind_EOF) []) + err (AI end _) = failLocMsgP (realSrcSpanStart (psRealSpan span)) (psRealLoc end) (PsError (PsErrLexer LexUnterminatedOptions LexErrKind_EOF) []) -- ----------------------------------------------------------------------------- @@ -1915,7 +1915,7 @@ lex_string s = do setInput i when (any (> '\xFF') s') $ do pState <- getPState - let err = Error ErrPrimStringInvalidChar [] (mkSrcSpanPs (last_loc pState)) + let err = PsError PsErrPrimStringInvalidChar [] (mkSrcSpanPs (last_loc pState)) addError err return (ITprimstring (SourceText s') (unsafeMkByteString s')) _other -> @@ -2178,7 +2178,7 @@ quasiquote_error :: RealSrcLoc -> P a quasiquote_error start = do (AI end buf) <- getInput reportLexError start (psRealLoc end) buf - (\k -> Error (ErrLexer LexUnterminatedQQ k) []) + (\k -> PsError (PsErrLexer LexUnterminatedQQ k) []) -- ----------------------------------------------------------------------------- -- Warnings @@ -2188,7 +2188,7 @@ warnTab srcspan _buf _len = do addTabWarning (psRealSpan srcspan) lexToken -warnThen :: WarningFlag -> (SrcSpan -> Warning) -> Action -> Action +warnThen :: WarningFlag -> (SrcSpan -> PsWarning) -> Action -> Action warnThen flag warning action srcspan buf len = do addWarning flag (warning (RealSrcSpan (psRealSpan srcspan) Nothing)) action srcspan buf len @@ -2248,8 +2248,8 @@ data HdkComment data PState = PState { buffer :: StringBuffer, options :: ParserOpts, - warnings :: Bag Warning, - errors :: Bag Error, + warnings :: Bag PsWarning, + errors :: Bag PsError, tab_first :: Maybe RealSrcSpan, -- pos of first tab warning in the file tab_count :: !Word, -- number of tab warnings in the file last_tk :: Maybe Token, @@ -2329,12 +2329,12 @@ thenP :: P a -> (a -> P b) -> P b POk s1 a -> (unP (k a)) s1 PFailed s1 -> PFailed s1 -failMsgP :: (SrcSpan -> Error) -> P a +failMsgP :: (SrcSpan -> PsError) -> P a failMsgP f = do pState <- getPState addFatalError (f (mkSrcSpanPs (last_loc pState))) -failLocMsgP :: RealSrcLoc -> RealSrcLoc -> (SrcSpan -> Error) -> P a +failLocMsgP :: RealSrcLoc -> RealSrcLoc -> (SrcSpan -> PsError) -> P a failLocMsgP loc1 loc2 f = addFatalError (f (RealSrcSpan (mkRealSrcSpan loc1 loc2) Nothing)) @@ -2786,15 +2786,15 @@ class Monad m => MonadP m where -- to the accumulator and parsing continues. This allows GHC to report -- more than one parse error per file. -- - addError :: Error -> m () + addError :: PsError -> m () -- | Add a warning to the accumulator. -- Use 'getMessages' to get the accumulated warnings. - addWarning :: WarningFlag -> Warning -> m () + addWarning :: WarningFlag -> PsWarning -> m () -- | Add a fatal error. This will be the last error reported by the parser, and -- the parser will not produce any result, ending in a 'PFailed' state. - addFatalError :: Error -> m a + addFatalError :: PsError -> m a -- | Check if a given flag is currently set in the bitmap. getBit :: ExtBits -> m Bool @@ -2840,19 +2840,19 @@ addTabWarning srcspan -- | Get a bag of the errors that have been accumulated so far. -- Does not take -Werror into account. -getErrorMessages :: PState -> Bag Error +getErrorMessages :: PState -> Bag PsError getErrorMessages p = errors p -- | Get the warnings and errors accumulated so far. -- Does not take -Werror into account. -getMessages :: PState -> (Bag Warning, Bag Error) +getMessages :: PState -> (Bag PsWarning, Bag PsError) getMessages p = let ws = warnings p -- we add the tabulation warning on the fly because -- we count the number of occurences of tab characters ws' = case tab_first p of Nothing -> ws - Just tf -> WarnTab (RealSrcSpan tf Nothing) (tab_count p) + Just tf -> PsWarnTab (RealSrcSpan tf Nothing) (tab_count p) `consBag` ws in (ws', errors p) @@ -2900,8 +2900,8 @@ srcParseErr -> StringBuffer -- current buffer (placed just after the last token) -> Int -- length of the previous token -> SrcSpan - -> Error -srcParseErr options buf len loc = Error (ErrParse token) suggests loc + -> PsError +srcParseErr options buf len loc = PsError (PsErrParse token) suggests loc where token = lexemeToString (offsetBytes (-len) buf) len pattern = decodePrevNChars 8 buf @@ -2936,7 +2936,7 @@ lexError e = do loc <- getRealSrcLoc (AI end buf) <- getInput reportLexError loc (psRealLoc end) buf - (\k -> Error (ErrLexer e k) []) + (\k -> PsError (PsErrLexer e k) []) -- ----------------------------------------------------------------------------- -- This is the top-level function: called from the parser each time a @@ -3052,7 +3052,7 @@ alternativeLayoutRuleToken t (ITwhere, ALRLayout _ col : ls, _) | newLine && thisCol == col && transitional -> do addWarning Opt_WarnAlternativeLayoutRuleTransitional - $ WarnTransitionalLayout (mkSrcSpanPs thisLoc) TransLayout_Where + $ PsWarnTransitionalLayout (mkSrcSpanPs thisLoc) TransLayout_Where setALRContext ls setNextToken t -- Note that we use lastLoc, as we may need to close @@ -3062,7 +3062,7 @@ alternativeLayoutRuleToken t (ITvbar, ALRLayout _ col : ls, _) | newLine && thisCol == col && transitional -> do addWarning Opt_WarnAlternativeLayoutRuleTransitional - $ WarnTransitionalLayout (mkSrcSpanPs thisLoc) TransLayout_Pipe + $ PsWarnTransitionalLayout (mkSrcSpanPs thisLoc) TransLayout_Pipe setALRContext ls setNextToken t -- Note that we use lastLoc, as we may need to close @@ -3184,7 +3184,7 @@ lexToken = do return (L span ITeof) AlexError (AI loc2 buf) -> reportLexError (psRealLoc loc1) (psRealLoc loc2) buf - (\k -> Error (ErrLexer LexError k) []) + (\k -> PsError (PsErrLexer LexError k) []) AlexSkip inp2 _ -> do setInput inp2 lexToken @@ -3198,7 +3198,7 @@ lexToken = do unless (isComment lt') (setLastTk lt') return lt -reportLexError :: RealSrcLoc -> RealSrcLoc -> StringBuffer -> (LexErrKind -> SrcSpan -> Error) -> P a +reportLexError :: RealSrcLoc -> RealSrcLoc -> StringBuffer -> (LexErrKind -> SrcSpan -> PsError) -> P a reportLexError loc1 loc2 buf f | atEnd buf = failLocMsgP loc1 loc2 (f LexErrKind_EOF) | otherwise = ===================================== compiler/GHC/Parser/PostProcess.hs ===================================== @@ -260,12 +260,12 @@ mkStandaloneKindSig loc lhs rhs = check_lhs_name v@(unLoc->name) = if isUnqual name && isTcOcc (rdrNameOcc name) then return v - else addFatalError $ Error (ErrUnexpectedQualifiedConstructor (unLoc v)) [] (getLoc v) + else addFatalError $ PsError (PsErrUnexpectedQualifiedConstructor (unLoc v)) [] (getLoc v) check_singular_lhs vs = case vs of [] -> panic "mkStandaloneKindSig: empty left-hand side" [v] -> return v - _ -> addFatalError $ Error (ErrMultipleNamesInStandaloneKindSignature vs) [] (getLoc lhs) + _ -> addFatalError $ PsError (PsErrMultipleNamesInStandaloneKindSignature vs) [] (getLoc lhs) mkTyFamInstEqn :: HsOuterFamEqnTyVarBndrs GhcPs -> LHsType GhcPs @@ -374,7 +374,7 @@ mkRoleAnnotDecl loc tycon roles let nearby = fuzzyLookup (unpackFS role) (mapFst unpackFS possible_roles) in - addFatalError $ Error (ErrIllegalRoleName role nearby) [] loc_role + addFatalError $ PsError (PsErrIllegalRoleName role nearby) [] loc_role -- | Converts a list of 'LHsTyVarBndr's annotated with their 'Specificity' to -- binders without annotations. Only accepts specified variables, and errors if @@ -394,7 +394,7 @@ fromSpecTyVarBndr bndr = case bndr of where check_spec :: Specificity -> SrcSpan -> P () check_spec SpecifiedSpec _ = return () - check_spec InferredSpec loc = addFatalError $ Error ErrInferredTypeVarNotAllowed [] loc + check_spec InferredSpec loc = addFatalError $ PsError PsErrInferredTypeVarNotAllowed [] loc {- ********************************************************************** @@ -445,7 +445,7 @@ cvBindsAndSigs fb = do -- called on top-level declarations. drop_bad_decls [] = return [] drop_bad_decls (L l (SpliceD _ d) : ds) = do - addError $ Error (ErrDeclSpliceNotAtTopLevel d) [] l + addError $ PsError (PsErrDeclSpliceNotAtTopLevel d) [] l drop_bad_decls ds drop_bad_decls (d:ds) = (d:) <$> drop_bad_decls ds @@ -550,14 +550,14 @@ constructor, a type, or a context, we would need unlimited lookahead which -- | Reinterpret a type constructor, including type operators, as a data -- constructor. -- See Note [Parsing data constructors is hard] -tyConToDataCon :: SrcSpan -> RdrName -> Either Error (Located RdrName) +tyConToDataCon :: SrcSpan -> RdrName -> Either PsError (Located RdrName) tyConToDataCon loc tc | isTcOcc occ || isDataOcc occ , isLexCon (occNameFS occ) = return (L loc (setRdrNameSpace tc srcDataName)) | otherwise - = Left $ Error (ErrNotADataCon tc) [] loc + = Left $ PsError (PsErrNotADataCon tc) [] loc where occ = rdrNameOcc tc @@ -597,17 +597,17 @@ mkPatSynMatchGroup (L loc patsyn_name) (L _ decls) = fromDecl (L loc decl) = extraDeclErr loc decl extraDeclErr loc decl = - addFatalError $ Error (ErrNoSingleWhereBindInPatSynDecl patsyn_name decl) [] loc + addFatalError $ PsError (PsErrNoSingleWhereBindInPatSynDecl patsyn_name decl) [] loc wrongNameBindingErr loc decl = - addFatalError $ Error (ErrInvalidWhereBindInPatSynDecl patsyn_name decl) [] loc + addFatalError $ PsError (PsErrInvalidWhereBindInPatSynDecl patsyn_name decl) [] loc wrongNumberErr loc = - addFatalError $ Error (ErrEmptyWhereInPatSynDecl patsyn_name) [] loc + addFatalError $ PsError (PsErrEmptyWhereInPatSynDecl patsyn_name) [] loc recordPatSynErr :: SrcSpan -> LPat GhcPs -> P a recordPatSynErr loc pat = - addFatalError $ Error (ErrRecordSyntaxInPatSynDecl pat) [] loc + addFatalError $ PsError (PsErrRecordSyntaxInPatSynDecl pat) [] loc mkConDeclH98 :: Located RdrName -> Maybe [LHsTyVarBndr Specificity GhcPs] -> Maybe (LHsContext GhcPs) -> HsConDeclH98Details GhcPs @@ -737,7 +737,7 @@ to make setRdrNameSpace partial, so we just make an Unqual name instead. It really doesn't matter! -} -eitherToP :: MonadP m => Either Error a -> m a +eitherToP :: MonadP m => Either PsError a -> m a -- Adapts the Either monad to the P monad eitherToP (Left err) = addFatalError err eitherToP (Right thing) = return thing @@ -751,9 +751,9 @@ checkTyVars pp_what equals_or_where tc tparms = do { (tvs, anns) <- fmap unzip $ mapM check tparms ; return (mkHsQTvs tvs, concat anns) } where - check (HsTypeArg _ ki@(L loc _)) = addFatalError $ Error (ErrUnexpectedTypeAppInDecl ki pp_what (unLoc tc)) [] loc + check (HsTypeArg _ ki@(L loc _)) = addFatalError $ PsError (PsErrUnexpectedTypeAppInDecl ki pp_what (unLoc tc)) [] loc check (HsValArg ty) = chkParens [] ty - check (HsArgPar sp) = addFatalError $ Error (ErrMalformedDecl pp_what (unLoc tc)) [] sp + check (HsArgPar sp) = addFatalError $ PsError (PsErrMalformedDecl pp_what (unLoc tc)) [] sp -- Keep around an action for adjusting the annotations of extra parens chkParens :: [AddAnn] -> LHsType GhcPs -> P (LHsTyVarBndr () GhcPs, [AddAnn]) @@ -769,7 +769,7 @@ checkTyVars pp_what equals_or_where tc tparms chk (L l (HsTyVar _ _ (L ltv tv))) | isRdrTyVar tv = return (L l (UserTyVar noExtField () (L ltv tv))) chk t@(L loc _) - = addFatalError $ Error (ErrUnexpectedTypeInDecl t pp_what (unLoc tc) tparms equals_or_where) [] loc + = addFatalError $ PsError (PsErrUnexpectedTypeInDecl t pp_what (unLoc tc) tparms equals_or_where) [] loc whereDots, equalsDots :: SDoc @@ -781,7 +781,7 @@ checkDatatypeContext :: Maybe (LHsContext GhcPs) -> P () checkDatatypeContext Nothing = return () checkDatatypeContext (Just c) = do allowed <- getBit DatatypeContextsBit - unless allowed $ addError $ Error (ErrIllegalDataTypeContext c) [] (getLoc c) + unless allowed $ addError $ PsError (PsErrIllegalDataTypeContext c) [] (getLoc c) type LRuleTyTmVar = Located RuleTyTmVar data RuleTyTmVar = RuleTyTmVar (Located RdrName) (Maybe (LHsType GhcPs)) @@ -811,13 +811,13 @@ checkRuleTyVarBndrNames = mapM_ (check . fmap hsTyVarName) where check (L loc (Unqual occ)) = -- TODO: don't use string here, OccName has a Unique/FastString when ((occNameString occ ==) `any` ["forall","family","role"]) - (addFatalError $ Error (ErrParseErrorOnInput occ) [] loc) + (addFatalError $ PsError (PsErrParseErrorOnInput occ) [] loc) check _ = panic "checkRuleTyVarBndrNames" checkRecordSyntax :: (MonadP m, Outputable a) => Located a -> m (Located a) checkRecordSyntax lr@(L loc r) = do allowed <- getBit TraditionalRecordSyntaxBit - unless allowed $ addError $ Error (ErrIllegalTraditionalRecordSyntax (ppr r)) [] loc + unless allowed $ addError $ PsError (PsErrIllegalTraditionalRecordSyntax (ppr r)) [] loc return lr -- | Check if the gadt_constrlist is empty. Only raise parse error for @@ -826,7 +826,7 @@ checkEmptyGADTs :: Located ([AddAnn], [LConDecl GhcPs]) -> P (Located ([AddAnn], [LConDecl GhcPs])) checkEmptyGADTs gadts@(L span (_, [])) -- Empty GADT declaration. = do gadtSyntax <- getBit GadtSyntaxBit -- GADTs implies GADTSyntax - unless gadtSyntax $ addError $ Error ErrIllegalWhereInDataDecl [] span + unless gadtSyntax $ addError $ PsError PsErrIllegalWhereInDataDecl [] span return gadts checkEmptyGADTs gadts = return gadts -- Ordinary GADT declaration. @@ -848,7 +848,7 @@ checkTyClHdr is_cls ty -- workaround to define '*' despite StarIsType go lp (HsParTy _ (L l (HsStarTy _ isUni))) acc ann fix - = do { addWarning Opt_WarnStarBinder (WarnStarBinder l) + = do { addWarning Opt_WarnStarBinder (PsWarnStarBinder l) ; let name = mkOccName tcClsName (starSym isUni) ; return (L l (Unqual name), acc, fix, (ann ++ mkParensApiAnn lp)) } @@ -867,7 +867,7 @@ checkTyClHdr is_cls ty | otherwise = getName (tupleTyCon Boxed arity) -- See Note [Unit tuples] in GHC.Hs.Type (TODO: is this still relevant?) go l _ _ _ _ - = addFatalError $ Error (ErrMalformedTyOrClDecl ty) [] l + = addFatalError $ PsError (PsErrMalformedTyOrClDecl ty) [] l -- | Yield a parse error if we have a function applied directly to a do block -- etc. and BlockArguments is not enabled. @@ -877,29 +877,29 @@ checkCmdBlockArguments :: LHsCmd GhcPs -> PV () where checkExpr :: LHsExpr GhcPs -> PV () checkExpr expr = case unLoc expr of - HsDo _ (DoExpr m) _ -> check (ErrDoInFunAppExpr m) expr - HsDo _ (MDoExpr m) _ -> check (ErrMDoInFunAppExpr m) expr - HsLam {} -> check ErrLambdaInFunAppExpr expr - HsCase {} -> check ErrCaseInFunAppExpr expr - HsLamCase {} -> check ErrLambdaCaseInFunAppExpr expr - HsLet {} -> check ErrLetInFunAppExpr expr - HsIf {} -> check ErrIfInFunAppExpr expr - HsProc {} -> check ErrProcInFunAppExpr expr + HsDo _ (DoExpr m) _ -> check (PsErrDoInFunAppExpr m) expr + HsDo _ (MDoExpr m) _ -> check (PsErrMDoInFunAppExpr m) expr + HsLam {} -> check PsErrLambdaInFunAppExpr expr + HsCase {} -> check PsErrCaseInFunAppExpr expr + HsLamCase {} -> check PsErrLambdaCaseInFunAppExpr expr + HsLet {} -> check PsErrLetInFunAppExpr expr + HsIf {} -> check PsErrIfInFunAppExpr expr + HsProc {} -> check PsErrProcInFunAppExpr expr _ -> return () checkCmd :: LHsCmd GhcPs -> PV () checkCmd cmd = case unLoc cmd of - HsCmdLam {} -> check ErrLambdaCmdInFunAppCmd cmd - HsCmdCase {} -> check ErrCaseCmdInFunAppCmd cmd - HsCmdIf {} -> check ErrIfCmdInFunAppCmd cmd - HsCmdLet {} -> check ErrLetCmdInFunAppCmd cmd - HsCmdDo {} -> check ErrDoCmdInFunAppCmd cmd + HsCmdLam {} -> check PsErrLambdaCmdInFunAppCmd cmd + HsCmdCase {} -> check PsErrCaseCmdInFunAppCmd cmd + HsCmdIf {} -> check PsErrIfCmdInFunAppCmd cmd + HsCmdLet {} -> check PsErrLetCmdInFunAppCmd cmd + HsCmdDo {} -> check PsErrDoCmdInFunAppCmd cmd _ -> return () check err a = do blockArguments <- getBit BlockArgumentsBit unless blockArguments $ - addError $ Error (err a) [] (getLoc a) + addError $ PsError (err a) [] (getLoc a) -- | Validate the context constraints and break up a context into a list -- of predicates. @@ -1014,7 +1014,7 @@ checkAPat loc e0 = do -- Improve error messages for the @-operator when the user meant an @-pattern PatBuilderOpApp _ op _ | opIsAt (unLoc op) -> do - addError $ Error ErrAtInPatPos [] (getLoc op) + addError $ PsError PsErrAtInPatPos [] (getLoc op) return (WildPat noExtField) PatBuilderOpApp l (L cl c) r @@ -1046,7 +1046,7 @@ checkPatField (L l fld) = do p <- checkLPat (hsRecFieldArg fld) return (L l (fld { hsRecFieldArg = p })) patFail :: SrcSpan -> SDoc -> PV a -patFail loc e = addFatalError $ Error (ErrParseErrorInPat e) [] loc +patFail loc e = addFatalError $ PsError (PsErrParseErrorInPat e) [] loc patIsRec :: RdrName -> Bool patIsRec e = e == mkUnqual varName (fsLit "rec") @@ -1138,11 +1138,11 @@ checkValSigLhs (L _ (HsVar _ lrdr@(L _ v))) = return lrdr checkValSigLhs lhs@(L l _) - = addFatalError $ Error (ErrInvalidTypeSignature lhs) [] l + = addFatalError $ PsError (PsErrInvalidTypeSignature lhs) [] l checkDoAndIfThenElse :: (Outputable a, Outputable b, Outputable c) - => (a -> Bool -> b -> Bool -> c -> ErrorDesc) + => (a -> Bool -> b -> Bool -> c -> PsErrorDesc) -> Located a -> Bool -> Located b -> Bool -> Located c -> PV () checkDoAndIfThenElse err guardExpr semiThen thenExpr semiElse elseExpr | semiThen || semiElse = do @@ -1152,7 +1152,7 @@ checkDoAndIfThenElse err guardExpr semiThen thenExpr semiElse elseExpr semiElse (unLoc elseExpr) loc = combineLocs guardExpr elseExpr - unless doAndIfThenElse $ addError (Error e [] loc) + unless doAndIfThenElse $ addError (PsError e [] loc) | otherwise = return () isFunLhs :: Located (PatBuilder GhcPs) @@ -1259,7 +1259,7 @@ instance DisambInfixOp (HsExpr GhcPs) where instance DisambInfixOp RdrName where mkHsConOpPV (L l v) = return $ L l v mkHsVarOpPV (L l v) = return $ L l v - mkHsInfixHolePV l = addFatalError $ Error ErrInvalidInfixHole [] l + mkHsInfixHolePV l = addFatalError $ PsError PsErrInvalidInfixHole [] l -- | Disambiguate constructs that may appear when we do not know ahead of time whether we are -- parsing an expression, a command, or a pattern. @@ -1415,10 +1415,10 @@ instance DisambECP (HsCmd GhcPs) where return $ L l (HsCmdApp noExtField c e) mkHsAppTypePV l c t = cmdFail l (ppr c <+> text "@" <> ppr t) mkHsIfPV l c semi1 a semi2 b = do - checkDoAndIfThenElse ErrSemiColonsInCondCmd c semi1 a semi2 b + checkDoAndIfThenElse PsErrSemiColonsInCondCmd c semi1 a semi2 b return $ L l (mkHsCmdIf c a b) mkHsDoPV l Nothing stmts = return $ L l (HsCmdDo noExtField stmts) - mkHsDoPV l (Just m) _ = addFatalError $ Error (ErrQualifiedDoInCmd m) [] l + mkHsDoPV l (Just m) _ = addFatalError $ PsError (PsErrQualifiedDoInCmd m) [] l mkHsParPV l c = return $ L l (HsCmdPar noExtField c) mkHsVarPV (L l v) = cmdFail l (ppr v) mkHsLitPV (L l a) = cmdFail l (ppr a) @@ -1447,12 +1447,12 @@ instance DisambECP (HsCmd GhcPs) where rejectPragmaPV _ = return () cmdFail :: SrcSpan -> SDoc -> PV a -cmdFail loc e = addFatalError $ Error (ErrParseErrorInCmd e) [] loc +cmdFail loc e = addFatalError $ PsError (PsErrParseErrorInCmd e) [] loc instance DisambECP (HsExpr GhcPs) where type Body (HsExpr GhcPs) = HsExpr ecpFromCmd' (L l c) = do - addError $ Error (ErrArrowCmdInExpr c) [] l + addError $ PsError (PsErrArrowCmdInExpr c) [] l return (L l hsHoleExpr) ecpFromExp' = return mkHsLamPV l mg = return $ L l (HsLam noExtField mg) @@ -1473,7 +1473,7 @@ instance DisambECP (HsExpr GhcPs) where checkExpBlockArguments e return $ L l (HsAppType noExtField e (mkHsWildCardBndrs t)) mkHsIfPV l c semi1 a semi2 b = do - checkDoAndIfThenElse ErrSemiColonsInCondExpr c semi1 a semi2 b + checkDoAndIfThenElse PsErrSemiColonsInCondExpr c semi1 a semi2 b return $ L l (mkHsIf c a b) mkHsDoPV l mod stmts = return $ L l (HsDo noExtField (DoExpr mod) stmts) mkHsParPV l e = return $ L l (HsPar noExtField e) @@ -1489,19 +1489,19 @@ instance DisambECP (HsExpr GhcPs) where checkRecordSyntax (L l r) mkHsNegAppPV l a = return $ L l (NegApp noExtField a noSyntaxExpr) mkHsSectionR_PV l op e = return $ L l (SectionR noExtField op e) - mkHsViewPatPV l a b = addError (Error (ErrViewPatInExpr a b) [] l) + mkHsViewPatPV l a b = addError (PsError (PsErrViewPatInExpr a b) [] l) >> return (L l hsHoleExpr) - mkHsAsPatPV l v e = addError (Error (ErrTypeAppWithoutSpace (unLoc v) e) [] l) + mkHsAsPatPV l v e = addError (PsError (PsErrTypeAppWithoutSpace (unLoc v) e) [] l) >> return (L l hsHoleExpr) - mkHsLazyPatPV l e = addError (Error (ErrLazyPatWithoutSpace e) [] l) + mkHsLazyPatPV l e = addError (PsError (PsErrLazyPatWithoutSpace e) [] l) >> return (L l hsHoleExpr) - mkHsBangPatPV l e = addError (Error (ErrBangPatWithoutSpace e) [] l) + mkHsBangPatPV l e = addError (PsError (PsErrBangPatWithoutSpace e) [] l) >> return (L l hsHoleExpr) mkSumOrTuplePV = mkSumOrTupleExpr rejectPragmaPV (L _ (OpApp _ _ _ e)) = -- assuming left-associative parsing of operators rejectPragmaPV e - rejectPragmaPV (L l (HsPragE _ prag _)) = addError $ Error (ErrUnallowedPragma prag) [] l + rejectPragmaPV (L l (HsPragE _ prag _)) = addError $ PsError (PsErrUnallowedPragma prag) [] l rejectPragmaPV _ = return () hsHoleExpr :: HsExpr GhcPs @@ -1509,21 +1509,21 @@ hsHoleExpr = HsUnboundVar noExtField (mkVarOcc "_") instance DisambECP (PatBuilder GhcPs) where type Body (PatBuilder GhcPs) = PatBuilder - ecpFromCmd' (L l c) = addFatalError $ Error (ErrArrowCmdInPat c) [] l - ecpFromExp' (L l e) = addFatalError $ Error (ErrArrowExprInPat e) [] l - mkHsLamPV l _ = addFatalError $ Error ErrLambdaInPat [] l - mkHsLetPV l _ _ = addFatalError $ Error ErrLetInPat [] l + ecpFromCmd' (L l c) = addFatalError $ PsError (PsErrArrowCmdInPat c) [] l + ecpFromExp' (L l e) = addFatalError $ PsError (PsErrArrowExprInPat e) [] l + mkHsLamPV l _ = addFatalError $ PsError PsErrLambdaInPat [] l + mkHsLetPV l _ _ = addFatalError $ PsError PsErrLetInPat [] l type InfixOp (PatBuilder GhcPs) = RdrName superInfixOp m = m mkHsOpAppPV l p1 op p2 = return $ L l $ PatBuilderOpApp p1 op p2 - mkHsCasePV l _ _ = addFatalError $ Error ErrCaseInPat [] l - mkHsLamCasePV l _ = addFatalError $ Error ErrLambdaCaseInPat [] l + mkHsCasePV l _ _ = addFatalError $ PsError PsErrCaseInPat [] l + mkHsLamCasePV l _ = addFatalError $ PsError PsErrLambdaCaseInPat [] l type FunArg (PatBuilder GhcPs) = PatBuilder GhcPs superFunArg m = m mkHsAppPV l p1 p2 = return $ L l (PatBuilderApp p1 p2) mkHsAppTypePV l p t = return $ L l (PatBuilderAppType p (mkHsPatSigType t)) - mkHsIfPV l _ _ _ _ _ = addFatalError $ Error ErrIfTheElseInPat [] l - mkHsDoPV l _ _ = addFatalError $ Error ErrDoNotationInPat [] l + mkHsIfPV l _ _ _ _ _ = addFatalError $ PsError PsErrIfTheElseInPat [] l + mkHsDoPV l _ _ = addFatalError $ PsError PsErrDoNotationInPat [] l mkHsParPV l p = return $ L l (PatBuilderPar p) mkHsVarPV v@(getLoc -> l) = return $ L l (PatBuilderVar v) mkHsLitPV lit@(L l a) = do @@ -1568,7 +1568,7 @@ checkUnboxedStringLitPat :: Located (HsLit GhcPs) -> PV () checkUnboxedStringLitPat (L loc lit) = case lit of HsStringPrim _ _ -- Trac #13260 - -> addFatalError $ Error (ErrIllegalUnboxedStringInPat lit) [] loc + -> addFatalError $ PsError (PsErrIllegalUnboxedStringInPat lit) [] loc _ -> return () mkPatRec :: @@ -1584,7 +1584,7 @@ mkPatRec (unLoc -> PatBuilderVar c) (HsRecFields fs dd) , pat_args = RecCon (HsRecFields fs dd) } mkPatRec p _ = - addFatalError $ Error (ErrInvalidRecordCon (unLoc p)) [] (getLoc p) + addFatalError $ PsError (PsErrInvalidRecordCon (unLoc p)) [] (getLoc p) -- | Disambiguate constructs that may appear when we do not know -- ahead of time whether we are parsing a type or a newtype/data constructor. @@ -1648,7 +1648,7 @@ instance DisambTD DataConBuilder where panic "mkHsAppTyPV: InfixDataConBuilder" mkHsAppKindTyPV lhs l_at ki = - addFatalError $ Error (ErrUnexpectedKindAppInDataCon (unLoc lhs) (unLoc ki)) [] l_at + addFatalError $ PsError (PsErrUnexpectedKindAppInDataCon (unLoc lhs) (unLoc ki)) [] l_at mkHsOpTyPV lhs (L l_tc tc) rhs = do check_no_ops (unLoc rhs) -- check the RHS because parsing type operators is right-associative @@ -1658,7 +1658,7 @@ instance DisambTD DataConBuilder where l = combineLocs lhs rhs check_no_ops (HsBangTy _ _ t) = check_no_ops (unLoc t) check_no_ops (HsOpTy{}) = - addError $ Error (ErrInvalidInfixDataCon (unLoc lhs) tc (unLoc rhs)) [] l + addError $ PsError (PsErrInvalidInfixDataCon (unLoc lhs) tc (unLoc rhs)) [] l check_no_ops _ = return () mkUnpackednessPV unpk constr_stuff @@ -1669,7 +1669,7 @@ instance DisambTD DataConBuilder where let l = combineLocs unpk constr_stuff return $ L l (InfixDataConBuilder lhs' data_con rhs) | otherwise = - do addError $ Error ErrUnpackDataCon [] (getLoc unpk) + do addError $ PsError PsErrUnpackDataCon [] (getLoc unpk) return constr_stuff tyToDataConBuilder :: LHsType GhcPs -> PV (Located DataConBuilder) @@ -1680,7 +1680,7 @@ tyToDataConBuilder (L l (HsTupleTy _ HsBoxedOrConstraintTuple ts)) = do let data_con = L l (getRdrName (tupleDataCon Boxed (length ts))) return $ L l (PrefixDataConBuilder (toOL ts) data_con) tyToDataConBuilder t = - addFatalError $ Error (ErrInvalidDataCon (unLoc t)) [] (getLoc t) + addFatalError $ PsError (PsErrInvalidDataCon (unLoc t)) [] (getLoc t) {- Note [Ambiguous syntactic categories] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2129,7 +2129,7 @@ checkPrecP checkPrecP (L l (_,i)) (L _ ol) | 0 <= i, i <= maxPrecedence = pure () | all specialOp ol = pure () - | otherwise = addFatalError $ Error (ErrPrecedenceOutOfRange i) [] l + | otherwise = addFatalError $ PsError (PsErrPrecedenceOutOfRange i) [] l where -- If you change this, consider updating Note [Fixity of (->)] in GHC/Types.hs specialOp op = unLoc op `elem` [ eqTyCon_RDR @@ -2145,7 +2145,7 @@ mkRecConstrOrUpdate (L l (HsVar _ (L _ c))) _ (fs,dd) | isRdrDataCon c = return (mkRdrRecordCon (L l c) (mk_rec_fields fs dd)) mkRecConstrOrUpdate exp _ (fs,dd) - | Just dd_loc <- dd = addFatalError $ Error ErrDotsInRecordUpdate [] dd_loc + | Just dd_loc <- dd = addFatalError $ PsError PsErrDotsInRecordUpdate [] dd_loc | otherwise = return (mkRdrRecordUpd exp (map (fmap mk_rec_upd_field) fs)) mkRdrRecordUpd :: LHsExpr GhcPs -> [LHsRecUpdField GhcPs] -> HsExpr GhcPs @@ -2209,7 +2209,7 @@ mkImport cconv safety (L loc (StringLiteral esrc entity), v, ty) = mkCImport = do let e = unpackFS entity case parseCImport cconv safety (mkExtName (unLoc v)) e (L loc esrc) of - Nothing -> addFatalError $ Error ErrMalformedEntityString [] loc + Nothing -> addFatalError $ PsError PsErrMalformedEntityString [] loc Just importSpec -> returnSpec importSpec -- currently, all the other import conventions only support a symbol name in @@ -2347,12 +2347,12 @@ mkModuleImpExp (L l specname) subs = in (\newName -> IEThingWith noExtField (L l newName) pos ies []) <$> nameT - else addFatalError $ Error ErrIllegalPatSynExport [] l + else addFatalError $ PsError PsErrIllegalPatSynExport [] l where name = ieNameVal specname nameT = if isVarNameSpace (rdrNameSpace name) - then addFatalError $ Error (ErrVarForTyCon name) [] l + then addFatalError $ PsError (PsErrVarForTyCon name) [] l else return $ ieNameFromSpec specname ieNameVal (ImpExpQcName ln) = unLoc ln @@ -2369,7 +2369,7 @@ mkTypeImpExp :: Located RdrName -- TcCls or Var name space -> P (Located RdrName) mkTypeImpExp name = do allowed <- getBit ExplicitNamespacesBit - unless allowed $ addError $ Error ErrIllegalExplicitNamespace [] (getLoc name) + unless allowed $ addError $ PsError PsErrIllegalExplicitNamespace [] (getLoc name) return (fmap (`setRdrNameSpace` tcClsName) name) checkImportSpec :: Located [LIE GhcPs] -> P (Located [LIE GhcPs]) @@ -2379,7 +2379,7 @@ checkImportSpec ie@(L _ specs) = (l:_) -> importSpecError l where importSpecError l = - addFatalError $ Error ErrIllegalImportBundleForm [] l + addFatalError $ PsError PsErrIllegalImportBundleForm [] l -- In the correct order mkImpExpSubSpec :: [Located ImpExpQcSpec] -> P ([AddAnn], ImpExpSubSpec) @@ -2400,21 +2400,21 @@ isImpExpQcWildcard _ = False warnPrepositiveQualifiedModule :: SrcSpan -> P () warnPrepositiveQualifiedModule span = - addWarning Opt_WarnPrepositiveQualifiedModule (WarnImportPreQualified span) + addWarning Opt_WarnPrepositiveQualifiedModule (PsWarnImportPreQualified span) failOpNotEnabledImportQualifiedPost :: SrcSpan -> P () -failOpNotEnabledImportQualifiedPost loc = addError $ Error ErrImportPostQualified [] loc +failOpNotEnabledImportQualifiedPost loc = addError $ PsError PsErrImportPostQualified [] loc failOpImportQualifiedTwice :: SrcSpan -> P () -failOpImportQualifiedTwice loc = addError $ Error ErrImportQualifiedTwice [] loc +failOpImportQualifiedTwice loc = addError $ PsError PsErrImportQualifiedTwice [] loc warnStarIsType :: SrcSpan -> P () -warnStarIsType span = addWarning Opt_WarnStarIsType (WarnStarIsType span) +warnStarIsType span = addWarning Opt_WarnStarIsType (PsWarnStarIsType span) failOpFewArgs :: MonadP m => Located RdrName -> m a failOpFewArgs (L loc op) = do { star_is_type <- getBit StarIsTypeBit - ; addFatalError $ Error (ErrOpFewArgs (StarIsType star_is_type) op) [] loc } + ; addFatalError $ PsError (PsErrOpFewArgs (StarIsType star_is_type) op) [] loc } ----------------------------------------------------------------------------- -- Misc utils @@ -2427,8 +2427,8 @@ data PV_Context = data PV_Accum = PV_Accum - { pv_warnings :: Bag Warning - , pv_errors :: Bag Error + { pv_warnings :: Bag PsWarning + , pv_errors :: Bag PsError , pv_annotations :: [(ApiAnnKey,[RealSrcSpan])] , pv_comment_q :: [RealLocated AnnotationComment] , pv_annotations_comments :: [(RealSrcSpan,[RealLocated AnnotationComment])] @@ -2503,10 +2503,10 @@ add_hint hint m = PV (\ctx acc -> unPV m (modifyHint ctx) acc) instance MonadP PV where - addError err@(Error e hints loc) = + addError err@(PsError e hints loc) = PV $ \ctx acc -> let err' | null (pv_hints ctx) = err - | otherwise = Error e (hints ++ pv_hints ctx) loc + | otherwise = PsError e (hints ++ pv_hints ctx) loc in PV_Ok acc{pv_errors = err' `consBag` pv_errors acc} () addWarning option w = PV $ \ctx acc -> @@ -2580,7 +2580,7 @@ hintBangPat :: SrcSpan -> Pat GhcPs -> PV () hintBangPat span e = do bang_on <- getBit BangPatBit unless bang_on $ - addError $ Error (ErrIllegalBangPattern e) [] span + addError $ PsError (PsErrIllegalBangPattern e) [] span mkSumOrTupleExpr :: SrcSpan -> Boxity -> SumOrTuple (HsExpr GhcPs) -> PV (LHsExpr GhcPs) @@ -2595,7 +2595,7 @@ mkSumOrTupleExpr l boxity (Tuple es) = mkSumOrTupleExpr l Unboxed (Sum alt arity e) = return $ L l (ExplicitSum noExtField alt arity e) mkSumOrTupleExpr l Boxed a at Sum{} = - addFatalError $ Error (ErrUnsupportedBoxedSumExpr a) [] l + addFatalError $ PsError (PsErrUnsupportedBoxedSumExpr a) [] l mkSumOrTuplePat :: SrcSpan -> Boxity -> SumOrTuple (PatBuilder GhcPs) -> PV (Located (PatBuilder GhcPs)) @@ -2606,7 +2606,7 @@ mkSumOrTuplePat l boxity (Tuple ps) = do where toTupPat :: Located (Maybe (Located (PatBuilder GhcPs))) -> PV (LPat GhcPs) toTupPat (L l p) = case p of - Nothing -> addFatalError $ Error ErrTupleSectionInPat [] l + Nothing -> addFatalError $ PsError PsErrTupleSectionInPat [] l Just p' -> checkLPat p' -- Sum @@ -2614,7 +2614,7 @@ mkSumOrTuplePat l Unboxed (Sum alt arity p) = do p' <- checkLPat p return $ L l (PatBuilderPat (SumPat noExtField p' alt arity)) mkSumOrTuplePat l Boxed a at Sum{} = - addFatalError $ Error (ErrUnsupportedBoxedSumPat a) [] l + addFatalError $ PsError (PsErrUnsupportedBoxedSumPat a) [] l mkLHsOpTy :: LHsType GhcPs -> Located RdrName -> LHsType GhcPs -> LHsType GhcPs mkLHsOpTy x op y = ===================================== compiler/GHC/Parser/PostProcess/Haddock.hs ===================================== @@ -192,9 +192,9 @@ addHaddockToModule lmod = do reportHdkWarning :: HdkWarn -> P () reportHdkWarning (HdkWarnInvalidComment (L l _)) = - addWarning Opt_WarnInvalidHaddock $ WarnHaddockInvalidPos (mkSrcSpanPs l) + addWarning Opt_WarnInvalidHaddock $ PsWarnHaddockInvalidPos (mkSrcSpanPs l) reportHdkWarning (HdkWarnExtraComment (L l _)) = - addWarning Opt_WarnInvalidHaddock $ WarnHaddockIgnoreMulti l + addWarning Opt_WarnInvalidHaddock $ PsWarnHaddockIgnoreMulti l collectHdkWarnings :: HdkSt -> [HdkWarn] collectHdkWarnings HdkSt{ hdk_st_pending, hdk_st_warnings } = View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d66b4bcd383867368172c82fc92fa150a4988b23 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d66b4bcd383867368172c82fc92fa150a4988b23 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 18 10:53:45 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 18 Dec 2020 05:53:45 -0500 Subject: [Git][ghc/ghc][master] rts: Fix typo in macro name Message-ID: <5fdc8a39688d4_6b217be38c023396f5@gitlab.mail> Spam detection software, running on the system "mail.haskell.org", has identified this incoming email as possible spam. The original message has been attached to this so you can view it (if it isn't spam) or label similar future email. If you have any questions, see @@CONTACT_ADDRESS@@ for details. Content preview: Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 0204b4aa by Ben Gamari at 2020-12-18T05:53:37-05:00 rts: Fix typo in macro name THREADED_RTS was previously misspelled as THREADEDED_RTS. [...] Content analysis details: (5.0 points, 5.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- 1.1 URI_HEX URI: URI hostname has long hexadecimal sequence 5.0 UNWANTED_LANGUAGE_BODY BODY: Message written in an undesired language -1.9 BAYES_00 BODY: Bayes spam probability is 0 to 1% [score: 0.0000] 0.0 HTML_MESSAGE BODY: HTML included in message 0.8 RDNS_NONE Delivered to internal network by a host with no rDNS 0.0 T_DKIM_INVALID DKIM-Signature header exists but is not valid The original message was not completely plain text, and may be unsafe to open with some email clients; in particular, it may contain a virus, or confirm that your address can receive spam. If you wish to view it, it may be safer to save it to a file and open it with an editor. -------------- next part -------------- An embedded message was scrubbed... From: Marge Bot Subject: [Git][ghc/ghc][master] rts: Fix typo in macro name Date: Fri, 18 Dec 2020 05:53:45 -0500 Size: 12273 URL: From gitlab at gitlab.haskell.org Fri Dec 18 10:53:12 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 18 Dec 2020 05:53:12 -0500 Subject: [Git][ghc/ghc][master] Fix #19044 by tweaking unification in inst lookup Message-ID: <5fdc8a18737d9_6b2167418542335274@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 29f77584 by Richard Eisenberg at 2020-12-18T05:53:01-05:00 Fix #19044 by tweaking unification in inst lookup See Note [Infinitary substitution in lookup] in GHC.Core.InstEnv and Note [Unification result] in GHC.Core.Unify. Test case: typecheck/should_compile/T190{44,52} Close #19044 Close #19052 - - - - - 5 changed files: - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/Unify.hs - + testsuite/tests/typecheck/should_compile/T19044.hs - + testsuite/tests/typecheck/should_compile/T19052.hs - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== compiler/GHC/Core/InstEnv.hs ===================================== @@ -760,6 +760,49 @@ When we match this against D [ty], we return the instantiating types where the 'Nothing' indicates that 'b' can be freely instantiated. (The caller instantiates it to a flexi type variable, which will presumably later become fixed via functional dependencies.) + +Note [Infinitary substitution in lookup] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + + class C a b + instance C c c + instance C d (Maybe d) + [W] C e (Maybe e) + +You would think we could just use the second instance, because the first doesn't +unify. But that's just ever so slightly wrong. The reason we check for unifiers +along with matchers is that we don't want the possibility that a type variable +instantiation could cause an instance choice to change. Yet if we have + type family M = Maybe M +and choose (e |-> M), then both instances match. This is absurd, but we cannot +rule it out. Yet, worrying about this case is awfully inconvenient to users, +and so we pretend the problem doesn't exist, by considering a lookup that runs into +this occurs-check issue to indicate that an instance surely does not apply (i.e. +is like the SurelyApart case). In the brief time that we didn't treat infinitary +substitutions specially, two tickets were filed: #19044 and #19052, both trying +to do Real Work. + +Why don't we just exclude any instances that are MaybeApart? Because we might +have a [W] C e (F e), where F is a type family. The second instance above does +not match, but it should be included as a future possibility. Unification will +return MaybeApart MARTypeFamily in this case. + +What can go wrong with this design choice? We might get incoherence -- but not +loss of type safety. In particular, if we have [W] C M M (for the M type family +above), then GHC might arbitrarily choose either instance, depending on how +M reduces (or doesn't). + +For type families, we can't just ignore the problem (as we essentially do here), +because doing so would give us a hole in the type safety proof (as explored in +Section 6 of "Closed Type Families with Overlapping Equations", POPL'14). This +possibility of an infinitary substitution manifests as closed type families that +look like they should reduce, but don't. Users complain: #9082 and #17311. For +open type families, we actually can have unsoundness if we don't take infinitary +substitutions into account: #8162. But, luckily, for class instances, we just +risk coherence -- not great, but it seems better to give users what they likely +want. (Also, note that this problem existed for the entire decade of 201x without +anyone noticing, so it's manifestly not ruining anyone's day.) -} -- |Look up an instance in the given instance environment. The given class application must match exactly @@ -839,8 +882,10 @@ lookupInstEnv' ie vis_mods cls tys -- We consider MaybeApart to be a case where the instance might -- apply in the future. This covers an instance like C Int and -- a target like [W] C (F a), where F is a type family. - SurelyApart -> find ms us rest - _ -> find ms (item:us) rest + SurelyApart -> find ms us rest + -- Note [Infinitary substitution in lookup] + MaybeApart MARInfinite _ -> find ms us rest + _ -> find ms (item:us) rest where tpl_tv_set = mkVarSet tpl_tvs tys_tv_set = tyCoVarsOfTypes tys ===================================== compiler/GHC/Core/Unify.hs ===================================== @@ -18,7 +18,7 @@ module GHC.Core.Unify ( tcUnifyTy, tcUnifyTyKi, tcUnifyTys, tcUnifyTyKis, tcUnifyTysFG, tcUnifyTyWithTFs, BindFlag(..), - UnifyResult, UnifyResultM(..), + UnifyResult, UnifyResultM(..), MaybeApartReason(..), -- Matching a type against a lifted type (coercion) liftCoMatch, @@ -55,8 +55,7 @@ import GHC.Data.FastString import Data.List ( mapAccumL ) import Control.Monad -import Control.Applicative hiding ( empty ) -import qualified Control.Applicative +import qualified Data.Semigroup as S {- @@ -347,6 +346,46 @@ complete. This means that, sometimes, a closed type family does not reduce when it should. See test case indexed-types/should_fail/Overlap15 for an example. +Note [Unificiation result] +~~~~~~~~~~~~~~~~~~~~~~~~~~ +When unifying t1 ~ t2, we return +* Unifiable s, if s is a substitution such that s(t1) is syntactically the + same as s(t2), modulo type-synonym expansion. +* SurelyApart, if there is no substitution s such that s(t1) = s(t2), + where "=" includes type-family reductions. +* MaybeApart mar s, when we aren't sure. `mar` is a MaybeApartReason. + +Examples +* [a] ~ Maybe b: SurelyApart, because [] and Maybe can't unify +* [(a,Int)] ~ [(Bool,b)]: Unifiable +* [F Int] ~ [Bool]: MaybeApart MARTypeFamily, because F Int might reduce to Bool (the unifier + does not try this) +* a ~ Maybe a: MaybeApart MARInfinite. Not Unifiable clearly, but not SurelyApart either; consider + a := Loop + where type family Loop where Loop = Maybe Loop + +There is the possibility that two types are MaybeApart for *both* reasons: + +* (a, F Int) ~ (Maybe a, Bool) + +What reason should we use? The *only* consumer of the reason is described +in Note [Infinitary substitution in lookup] in GHC.Core.InstEnv. The goal +there is identify which instances might match a target later (but don't +match now) -- except that we want to ignore the possibility of infinitary +substitutions. So let's examine a concrete scenario: + + class C a b c + instance C a (Maybe a) Bool + -- other instances, including one that will actually match + [W] C b b (F Int) + +Do we want the instance as a future possibility? No. The only way that +instance can match is in the presence of an infinite type (infinitely +nested Maybes). We thus say that MARInfinite takes precedence, so that +InstEnv treats this case as an infinitary substitution case; the fact +that a type family is involved is only incidental. We thus define +the Semigroup instance for MaybeApartReason to prefer MARInfinite. + Note [The substitution in MaybeApart] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The constructor MaybeApart carries data with it, typically a TvSubstEnv. Why? @@ -391,8 +430,8 @@ tcUnifyTyWithTFs twoWay t1 t2 = case tc_unify_tys (const BindMe) twoWay True False rn_env emptyTvSubstEnv emptyCvSubstEnv [t1] [t2] of - Unifiable (subst, _) -> Just $ maybe_fix subst - MaybeApart (subst, _) -> Just $ maybe_fix subst + Unifiable (subst, _) -> Just $ maybe_fix subst + MaybeApart _reason (subst, _) -> Just $ maybe_fix subst -- we want to *succeed* in questionable cases. This is a -- pre-unification algorithm. SurelyApart -> Nothing @@ -431,36 +470,42 @@ tcUnifyTyKis bind_fn tys1 tys2 -- This type does double-duty. It is used in the UM (unifier monad) and to -- return the final result. See Note [Fine-grained unification] type UnifyResult = UnifyResultM TCvSubst + +-- | See Note [Unificiation result] data UnifyResultM a = Unifiable a -- the subst that unifies the types - | MaybeApart a -- the subst has as much as we know + | MaybeApart MaybeApartReason + a -- the subst has as much as we know -- it must be part of a most general unifier -- See Note [The substitution in MaybeApart] | SurelyApart deriving Functor +-- | Why are two types 'MaybeApart'? 'MARTypeFamily' takes precedence: +-- This is used (only) in Note [Infinitary substitution in lookup] in GHC.Core.InstEnv +data MaybeApartReason = MARTypeFamily -- ^ matching e.g. F Int ~? Bool + | MARInfinite -- ^ matching e.g. a ~? Maybe a + +instance Outputable MaybeApartReason where + ppr MARTypeFamily = text "MARTypeFamily" + ppr MARInfinite = text "MARInfinite" + +instance Semigroup MaybeApartReason where + -- see end of Note [Unification result] for why + MARTypeFamily <> r = r + MARInfinite <> _ = MARInfinite + instance Applicative UnifyResultM where pure = Unifiable (<*>) = ap instance Monad UnifyResultM where - SurelyApart >>= _ = SurelyApart - MaybeApart x >>= f = case f x of - Unifiable y -> MaybeApart y - other -> other + MaybeApart r1 x >>= f = case f x of + Unifiable y -> MaybeApart r1 y + MaybeApart r2 y -> MaybeApart (r1 S.<> r2) y + SurelyApart -> SurelyApart Unifiable x >>= f = f x -instance Alternative UnifyResultM where - empty = SurelyApart - - a@(Unifiable {}) <|> _ = a - _ <|> b@(Unifiable {}) = b - a@(MaybeApart {}) <|> _ = a - _ <|> b@(MaybeApart {}) = b - SurelyApart <|> SurelyApart = SurelyApart - -instance MonadPlus UnifyResultM - -- | @tcUnifyTysFG bind_tv tys1 tys2@ attepts to find a substitution @s@ (whose -- domain elements all respond 'BindMe' to @bind_tv@) such that -- @s(tys1)@ and that of @s(tys2)@ are equal, as witnessed by the returned @@ -530,9 +575,9 @@ tc_unify_tys bind_fn unif inj_check match_kis rn_env tv_env cv_env tys1 tys2 kis2 = map typeKind tys2 instance Outputable a => Outputable (UnifyResultM a) where - ppr SurelyApart = text "SurelyApart" - ppr (Unifiable x) = text "Unifiable" <+> ppr x - ppr (MaybeApart x) = text "MaybeApart" <+> ppr x + ppr SurelyApart = text "SurelyApart" + ppr (Unifiable x) = text "Unifiable" <+> ppr x + ppr (MaybeApart r x) = text "MaybeApart" <+> ppr r <+> ppr x {- ************************************************************************ @@ -773,7 +818,7 @@ this, but we mustn't map a to anything else!) We thus must parameterize the algorithm over whether it's being used for an injectivity check (refrain from looking at non-injective arguments to type families) or not (do indeed look at those arguments). This is -implemented by the uf_inj_tf field of UmEnv. +implemented by the um_inj_tf field of UMEnv. (It's all a question of whether or not to include equation (7) from Fig. 2 of [ITF].) @@ -999,7 +1044,7 @@ unify_ty env ty1 ty2 _kco ; unify_tys env inj_tys1 inj_tys2 ; unless (um_inj_tf env) $ -- See (end of) Note [Specification of unification] - don'tBeSoSure $ unify_tys env noninj_tys1 noninj_tys2 } + don'tBeSoSure MARTypeFamily $ unify_tys env noninj_tys1 noninj_tys2 } | Just (tc1, _) <- mb_tc_app1 , not (isGenerativeTyCon tc1 Nominal) @@ -1007,7 +1052,7 @@ unify_ty env ty1 ty2 _kco -- because the (F ty1) behaves like a variable -- NB: if unifying, we have already dealt -- with the 'ty2 = variable' case - = maybeApart + = maybeApart MARTypeFamily | Just (tc2, _) <- mb_tc_app2 , not (isGenerativeTyCon tc2 Nominal) @@ -1015,7 +1060,7 @@ unify_ty env ty1 ty2 _kco -- E.g. unify_ty [a] (F ty2) = MaybeApart, when unifying (only) -- because the (F ty2) behaves like a variable -- NB: we have already dealt with the 'ty1 = variable' case - = maybeApart + = maybeApart MARTypeFamily where mb_tc_app1 = tcSplitTyConApp_maybe ty1 @@ -1125,7 +1170,8 @@ uVar env tv1 ty kco -- this is because the range of the subst is the target -- type, not the template type. So, just check for -- normal type equality. - guard ((ty' `mkCastTy` kco) `eqType` ty) + unless ((ty' `mkCastTy` kco) `eqType` ty) $ + surelyApart Nothing -> uUnrefined env tv1' ty ty kco } -- No, continue uUnrefined :: UMEnv @@ -1195,7 +1241,7 @@ bindTv env tv1 ty2 -- Make sure you include 'kco' (which ty2 does) #14846 ; occurs <- occursCheck env tv1 free_tvs2 - ; if occurs then maybeApart + ; if occurs then maybeApart MARInfinite else extendTvEnv tv1 ty2 } occursCheck :: UMEnv -> TyVar -> VarSet -> UM Bool @@ -1279,15 +1325,6 @@ instance Monad UM where do { (state', v) <- unUM m state ; unUM (k v) state' }) --- need this instance because of a use of 'guard' above -instance Alternative UM where - empty = UM (\_ -> Control.Applicative.empty) - m1 <|> m2 = UM (\state -> - unUM m1 state <|> - unUM m2 state) - -instance MonadPlus UM - instance MonadFail UM where fail _ = UM (\_ -> SurelyApart) -- failed pattern match @@ -1296,9 +1333,9 @@ initUM :: TvSubstEnv -- subst to extend -> UM a -> UnifyResultM a initUM subst_env cv_subst_env um = case unUM um state of - Unifiable (_, subst) -> Unifiable subst - MaybeApart (_, subst) -> MaybeApart subst - SurelyApart -> SurelyApart + Unifiable (_, subst) -> Unifiable subst + MaybeApart r (_, subst) -> MaybeApart r subst + SurelyApart -> SurelyApart where state = UMState { um_tv_env = subst_env , um_cv_env = cv_subst_env } @@ -1338,9 +1375,7 @@ checkRnEnv :: UMEnv -> VarSet -> UM () checkRnEnv env varset | isEmptyVarSet skol_vars = return () | varset `disjointVarSet` skol_vars = return () - | otherwise = maybeApart - -- ToDo: why MaybeApart? - -- I think SurelyApart would be right + | otherwise = surelyApart where skol_vars = um_skols env -- NB: That isEmptyVarSet guard is a critical optimization; @@ -1348,10 +1383,10 @@ checkRnEnv env varset -- the type, often saving quite a bit of allocation. -- | Converts any SurelyApart to a MaybeApart -don'tBeSoSure :: UM () -> UM () -don'tBeSoSure um = UM $ \ state -> +don'tBeSoSure :: MaybeApartReason -> UM () -> UM () +don'tBeSoSure r um = UM $ \ state -> case unUM um state of - SurelyApart -> MaybeApart (state, ()) + SurelyApart -> MaybeApart r (state, ()) other -> other umRnOccL :: UMEnv -> TyVar -> TyVar @@ -1363,8 +1398,8 @@ umRnOccR env v = rnOccR (um_rn_env env) v umSwapRn :: UMEnv -> UMEnv umSwapRn env = env { um_rn_env = rnSwap (um_rn_env env) } -maybeApart :: UM () -maybeApart = UM (\state -> MaybeApart (state, ())) +maybeApart :: MaybeApartReason -> UM () +maybeApart r = UM (\state -> MaybeApart r (state, ())) surelyApart :: UM a surelyApart = UM (\_ -> SurelyApart) ===================================== testsuite/tests/typecheck/should_compile/T19044.hs ===================================== @@ -0,0 +1,20 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +module T19044 where + +class C a b where + m :: a -> b + +instance C a a where + m = id + +instance C a (Maybe a) where + m _ = Nothing + +f :: a -> Maybe a +f = g + where + g x = h (m x) x + +h :: Maybe a -> a -> Maybe a +h = const ===================================== testsuite/tests/typecheck/should_compile/T19052.hs ===================================== @@ -0,0 +1,14 @@ +{-# LANGUAGE AllowAmbiguousTypes, DataKinds, FlexibleInstances, KindSignatures, MultiParamTypeClasses, ScopedTypeVariables, TypeApplications, TypeFamilies, TypeOperators, UndecidableInstances #-} +module Overlap where + +import Data.Kind (Type) + +class Sub (xs :: [Type]) (ys :: [Type]) where + subIndex :: Int +instance {-# OVERLAPPING #-} Sub xs xs where + subIndex = 0 +instance (ys ~ (y ': ys'), Sub xs ys') => Sub xs ys where + subIndex = subIndex @xs @ys' + 1 + +subIndex1 :: forall (x :: Type) (xs :: [Type]). Int +subIndex1 = subIndex @xs @(x ': xs) ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -734,6 +734,8 @@ test('T17186', normal, compile, ['']) test('CbvOverlap', normal, compile, ['']) test('InstanceGivenOverlap', normal, compile, ['']) test('InstanceGivenOverlap2', normal, compile, ['']) +test('T19044', normal, compile, ['']) +test('T19052', normal, compile, ['']) test('LocalGivenEqs', normal, compile, ['']) test('LocalGivenEqs2', normal, compile, ['']) test('T18891', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/29f77584cbce54b1063145e65585641918ae5e56 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/29f77584cbce54b1063145e65585641918ae5e56 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 18 10:54:29 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 18 Dec 2020 05:54:29 -0500 Subject: [Git][ghc/ghc][master] primops: Document semantics of Float/Int conversions Message-ID: <5fdc8a65f028c_6b21725c11c23440c4@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 3e9b7452 by Ben Gamari at 2020-12-18T05:54:21-05:00 primops: Document semantics of Float/Int conversions Fixes #18840. - - - - - 1 changed file: - compiler/GHC/Builtin/primops.txt.pp Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -627,10 +627,22 @@ primop IntToWordOp "int2Word#" GenPrimOp Int# -> Word# with code_size = 0 primop IntToFloatOp "int2Float#" GenPrimOp Int# -> Float# + {Convert an {\tt Int#} to the corresponding {\tt Float#} with the same + integral value (up to truncation due to floating-point precision). e.g. + {\tt int2Float# 1# == 1.0#}} primop IntToDoubleOp "int2Double#" GenPrimOp Int# -> Double# + {Convert an {\tt Int#} to the corresponding {\tt Double#} with the same + integral value (up to truncation due to floating-point precision). e.g. + {\tt int2Double# 1# == 1.0##}} primop WordToFloatOp "word2Float#" GenPrimOp Word# -> Float# + {Convert an {\tt Word#} to the corresponding {\tt Float#} with the same + integral value (up to truncation due to floating-point precision). e.g. + {\tt word2Float# 1## == 1.0#}} primop WordToDoubleOp "word2Double#" GenPrimOp Word# -> Double# + {Convert an {\tt Word#} to the corresponding {\tt Double#} with the same + integral value (up to truncation due to floating-point precision). e.g. + {\tt word2Double# 1## == 1.0##}} primop IntSllOp "uncheckedIShiftL#" GenPrimOp Int# -> Int# -> Int# {Shift left. Result undefined if shift amount is not View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3e9b745253cdf7299a692a95dceac87d6d0ff82f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3e9b745253cdf7299a692a95dceac87d6d0ff82f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 18 10:55:41 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 18 Dec 2020 05:55:41 -0500 Subject: [Git][ghc/ghc][master] Cite "Kind Inference for Datatypes" Message-ID: <5fdc8aade3ece_6b21725c11c23530e4@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 59a07641 by Richard Eisenberg at 2020-12-18T05:55:33-05:00 Cite "Kind Inference for Datatypes" - - - - - 1 changed file: - compiler/GHC/Tc/Utils/TcMType.hs Changes: ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -1229,6 +1229,9 @@ We do this eager erroring in candidateQTyVars, which always precedes generalisation, because at that moment we have a clear picture of what skolems are in scope within the type itself (e.g. that 'forall arg'). +This change is inspired by and described in Section 7.2 of "Kind Inference +for Datatypes", POPL'20. + Wrinkle: We must make absolutely sure that alpha indeed is not View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/59a07641090eec9dcaf5af97026b94911ca3191c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/59a07641090eec9dcaf5af97026b94911ca3191c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 18 10:55:17 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 18 Dec 2020 05:55:17 -0500 Subject: [Git][ghc/ghc][master] testsuite: Fix two shell quoting issues Message-ID: <5fdc8a95e1b8a_6b2174471c23485a1@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: c53b38dd by Ben Gamari at 2020-12-18T05:54:56-05:00 testsuite: Fix two shell quoting issues Fixes two ancient bugs in the testsuite driver makefiles due to insufficient quoting. I have no idea how these went unnoticed for so long. Thanks to @tomjaguarpaw for testing. - - - - - 2 changed files: - testsuite/mk/boilerplate.mk - testsuite/mk/test.mk Changes: ===================================== testsuite/mk/boilerplate.mk ===================================== @@ -244,7 +244,7 @@ ifeq "$(ghc_config_mk)" "" ghc_config_mk = $(TOP)/mk/ghcconfig$(subst $(space),_,$(subst :,_,$(subst /,_,$(subst \,_,$(TEST_HC))))).mk $(ghc_config_mk) : $(TOP)/mk/ghc-config - $(TOP)/mk/ghc-config "$(TEST_HC)" >"$@"; if [ $$? != 0 ]; then $(RM) "$@"; exit 1; fi + $(TOP)/mk/ghc-config "$(TEST_HC)" >"$@"; if [ "$$?" != "0" ]; then $(RM) "$@"; exit 1; fi # If the ghc-config fails, remove $@, and fail endif ===================================== testsuite/mk/test.mk ===================================== @@ -100,9 +100,9 @@ RUNTEST_OPTS += -e "config.leading_underscore=False" endif GHC_PRIM_LIBDIR := $(subst library-dirs: ,,$(shell "$(GHC_PKG)" field ghc-prim library-dirs --simple-output)) -HAVE_VANILLA := $(shell if [ -f $(subst \,/,$(GHC_PRIM_LIBDIR))/GHC/PrimopWrappers.hi ]; then echo YES; else echo NO; fi) -HAVE_DYNAMIC := $(shell if [ -f $(subst \,/,$(GHC_PRIM_LIBDIR))/GHC/PrimopWrappers.dyn_hi ]; then echo YES; else echo NO; fi) -HAVE_PROFILING := $(shell if [ -f $(subst \,/,$(GHC_PRIM_LIBDIR))/GHC/PrimopWrappers.p_hi ]; then echo YES; else echo NO; fi) +HAVE_VANILLA := $(shell if [ -f "$(subst \,/,$(GHC_PRIM_LIBDIR))/GHC/PrimopWrappers.hi" ]; then echo YES; else echo NO; fi) +HAVE_DYNAMIC := $(shell if [ -f "$(subst \,/,$(GHC_PRIM_LIBDIR))/GHC/PrimopWrappers.dyn_hi" ]; then echo YES; else echo NO; fi) +HAVE_PROFILING := $(shell if [ -f "$(subst \,/,$(GHC_PRIM_LIBDIR))/GHC/PrimopWrappers.p_hi" ]; then echo YES; else echo NO; fi) HAVE_GDB := $(shell if gdb --version > /dev/null 2> /dev/null; then echo YES; else echo NO; fi) HAVE_READELF := $(shell if readelf --version > /dev/null 2> /dev/null; then echo YES; else echo NO; fi) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c53b38dd5c1e38517a0c686d2aa9f8187629299c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c53b38dd5c1e38517a0c686d2aa9f8187629299c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Dec 18 11:43:23 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Fri, 18 Dec 2020 06:43:23 -0500 Subject: [Git][ghc/ghc][wip/sgraf-dmdanal-stuff] WorkWrap: Unbox constructors with existentials (#18982) Message-ID: <5fdc95dbeb46d_6b21962d8e82366133@gitlab.mail> Sebastian Graf pushed to branch wip/sgraf-dmdanal-stuff at Glasgow Haskell Compiler / GHC Commits: 8f415e76 by Sebastian Graf at 2020-12-18T12:43:14+01:00 WorkWrap: Unbox constructors with existentials (#18982) Consider ```hs data Ex where Ex :: e -> Int -> Ex f :: Ex -> Int f (Ex e n) = e `seq` n + 1 ``` Worker/wrapper should build the following worker for `f`: ```hs $wf :: forall e. e -> Int# -> Int# $wf e n = e `seq` n +# 1# ``` But previously it didn't, because `Ex` binds an existential. This patch lifts that condition. That entailed having to instantiate existential binders in `GHC.Core.Opt.WorkWrap.Utils.mkWWstr` via `GHC.Core.Utils.dataConRepFSInstPat`, requiring a bit of a refactoring around what is now `DataConPatContext`. CPR W/W still won't unbox DataCons with existentials. See `Note [Which types are unboxed?]` for details. I also refactored the various `tyCon*DataCon(s)_maybe` functions in `GHC.Core.TyCon`, deleting some of them which are no longer needed (`isDataProductType_maybe` and `isDataSumType_maybe`). I cleaned up a couple of call sites, some of which weren't very explicit about whether they cared for existentials or not. The test output of `T18013` changed, because we now unbox the `Rule` data type. Its constructor carries existential state and will be w/w'd now. In the particular example, the worker functions inlines right back into the wrapper, which then unnecessarily has a (quite big) stable unfolding. I think this kind of fallout is inevitable; see also Note [Don't w/w inline small non-loop-breaker things]. There's a new regression test case `T18982`. Fixes #18982. - - - - - 14 changed files: - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Opt/CprAnal.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/HsToCore/Foreign/Call.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Tc/Deriv/Utils.hs - testsuite/tests/simplCore/should_compile/T18013.stderr - + testsuite/tests/stranal/should_compile/T18982.hs - + testsuite/tests/stranal/should_compile/T18982.stderr - testsuite/tests/stranal/should_compile/all.T Changes: ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -1564,15 +1564,13 @@ promoteDataCon (MkData { dcPromoted = tc }) = tc -- | Extract the type constructor, type argument, data constructor and it's -- /representation/ argument types from a type if it is a product type. -- --- Precisely, we return @Just@ for any type that is all of: +-- Precisely, we return @Just@ for any data type that is all of: -- -- * Concrete (i.e. constructors visible) --- -- * Single-constructor +-- * ... which has no existentials -- --- * Not existentially quantified --- --- Whether the type is a @data@ type or a @newtype@ +-- Whether the type is a @data@ type or a @newtype at . splitDataProductType_maybe :: Type -- ^ A product type, perhaps -> Maybe (TyCon, -- The type constructor @@ -1580,13 +1578,14 @@ splitDataProductType_maybe DataCon, -- The data constructor [Scaled Type]) -- Its /representation/ arg types - -- Rejecting existentials is conservative. Maybe some things - -- could be made to work with them, but I'm not going to sweat - -- it through till someone finds it's important. + -- Rejecting existentials means we don't have to worry about + -- freshening and substituting type variables + -- (See "GHC.Type.Id.Make.dataConArgUnpack") splitDataProductType_maybe ty | Just (tycon, ty_args) <- splitTyConApp_maybe ty - , Just con <- isDataProductTyCon_maybe tycon + , Just con <- tyConSingleDataCon_maybe tycon + , null (dataConExTyCoVars con) -- no existentials! See above = Just (tycon, ty_args, con, dataConInstArgTys con ty_args) | otherwise = Nothing ===================================== compiler/GHC/Core/Opt/CprAnal.hs ===================================== @@ -322,7 +322,7 @@ cprAnalBind top_lvl env id rhs not_strict = not (isStrUsedDmd (idDemandInfo id)) -- See Note [CPR for sum types] (_, ret_ty) = splitPiTys (idType id) - not_a_prod = isNothing (deepSplitProductType_maybe (ae_fam_envs env) ret_ty) + not_a_prod = isNothing (splitArgType_maybe (ae_fam_envs env) ret_ty) returns_sum = not (isTopLevel top_lvl) && not_a_prod isDataStructure :: Id -> CoreExpr -> Bool @@ -425,7 +425,7 @@ nonVirgin env = env { ae_virgin = False } extendSigEnvForDemand :: AnalEnv -> Id -> Demand -> AnalEnv extendSigEnvForDemand env id dmd | isId id - , Just (_, DataConAppContext { dcac_dc = dc }) + , Just (_, DataConPatContext { dcpc_dc = dc }) <- wantToUnbox (ae_fam_envs env) has_inlineable_prag (idType id) dmd = extendSigEnv env id (CprSig (conCprType (dataConTag dc))) | otherwise @@ -446,14 +446,12 @@ extendEnvForDataAlt env scrut case_bndr dc bndrs ids_w_strs = filter isId bndrs `zip` dataConRepStrictness dc - tycon = dataConTyCon dc - is_product = isJust (isDataProductTyCon_maybe tycon) - is_sum = isJust (isDataSumTyCon_maybe tycon) + is_algebraic = isJust (tyConAlgDataCons_maybe (dataConTyCon dc)) + no_exs = null (dataConExTyCoVars dc) case_bndr_ty - | is_product || is_sum = conCprType (dataConTag dc) - -- Any of the constructors had existentials. This is a little too - -- conservative (after all, we only care about the particular data con), - -- but there is no easy way to write is_sum and this won't happen much. + | is_algebraic, no_exs = conCprType (dataConTag dc) + -- The tycon wasn't algebraic or the datacon had existentials. + -- See Note [Which types are unboxed?] for why no existentials. | otherwise = topCprType -- We could have much deeper CPR info here with Nested CPR, which could ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -426,8 +426,8 @@ dmdAnal' env dmd (Lam var body) dmdAnal' env dmd (Case scrut case_bndr ty [(alt, bndrs, rhs)]) -- Only one alternative. - -- If it's a DataAlt, it should be a product constructor. - | is_non_sum_alt alt + -- If it's a DataAlt, it should be the only constructor of the type. + | is_single_data_alt alt = let (rhs_ty, rhs') = dmdAnal env dmd rhs (alt_ty1, dmds) = findBndrsDmds env rhs_ty bndrs @@ -466,8 +466,8 @@ dmdAnal' env dmd (Case scrut case_bndr ty [(alt, bndrs, rhs)]) -- , text "res_ty" <+> ppr res_ty ]) $ (res_ty, Case scrut' case_bndr' ty [(alt, bndrs', rhs')]) where - is_non_sum_alt (DataAlt dc) = isJust $ isDataProductTyCon_maybe $ dataConTyCon dc - is_non_sum_alt _ = True + is_single_data_alt (DataAlt dc) = isJust $ tyConSingleAlgDataCon_maybe $ dataConTyCon dc + is_single_data_alt _ = True dmdAnal' env dmd (Case scrut case_bndr ty alts) = let -- Case expression with multiple alternatives @@ -527,10 +527,11 @@ forcesRealWorld :: FamInstEnvs -> Type -> Bool forcesRealWorld fam_envs ty | ty `eqType` realWorldStatePrimTy = True - | Just DataConAppContext{ dcac_dc = dc, dcac_arg_tys = field_tys } - <- deepSplitProductType_maybe fam_envs ty + | Just DataConPatContext{ dcpc_dc = dc, dcpc_tc_args = tc_args } + <- splitArgType_maybe fam_envs ty , isUnboxedTupleDataCon dc - = any (\(ty,_) -> scaledThing ty `eqType` realWorldStatePrimTy) field_tys + , let field_tys = dataConInstArgTys dc tc_args + = any (eqType realWorldStatePrimTy . scaledThing) field_tys | otherwise = False ===================================== compiler/GHC/Core/Opt/WorkWrap/Utils.hs ===================================== @@ -8,7 +8,7 @@ A library for the ``worker\/wrapper'' back-end to the strictness analyser module GHC.Core.Opt.WorkWrap.Utils ( mkWwBodies, mkWWstr, mkWorkerArgs - , DataConAppContext(..), deepSplitProductType_maybe, wantToUnbox + , DataConPatContext(..), splitArgType_maybe, wantToUnbox , findTypeShape , isWorkerSmallEnough ) @@ -19,7 +19,8 @@ where import GHC.Prelude import GHC.Core -import GHC.Core.Utils ( exprType, mkCast, mkDefaultCase, mkSingleAltCase ) +import GHC.Core.Utils ( exprType, mkCast, mkDefaultCase, mkSingleAltCase + , dataConRepFSInstPat ) import GHC.Types.Id import GHC.Types.Id.Info ( JoinArity ) import GHC.Core.DataCon @@ -43,9 +44,11 @@ import GHC.Core.TyCon import GHC.Core.TyCon.RecWalk import GHC.Types.Unique.Supply import GHC.Types.Unique +import GHC.Types.Name ( getOccFS ) import GHC.Data.Maybe import GHC.Utils.Misc import GHC.Utils.Outputable +import GHC.Utils.Panic import GHC.Driver.Session import GHC.Driver.Ppr import GHC.Data.FastString @@ -606,53 +609,53 @@ mkWWstr_one dflags fam_envs has_inlineable_prag arg arg_ty = idType arg dmd = idDemandInfo arg -wantToUnbox :: FamInstEnvs -> Bool -> Type -> Demand -> Maybe ([Demand], DataConAppContext) +wantToUnbox :: FamInstEnvs -> Bool -> Type -> Demand -> Maybe ([Demand], DataConPatContext) +-- See Note [Which types are unboxed?] wantToUnbox fam_envs has_inlineable_prag ty dmd = - case deepSplitProductType_maybe fam_envs ty of - Just dcac at DataConAppContext{ dcac_arg_tys = con_arg_tys } + case splitArgType_maybe fam_envs ty of + Just dcpc at DataConPatContext{ dcpc_dc = dc } | isStrUsedDmd dmd + , let arity = dataConRepArity dc -- See Note [Unpacking arguments with product and polymorphic demands] - , Just cs <- split_prod_dmd_arity dmd (length con_arg_tys) + , Just cs <- split_prod_dmd_arity dmd arity -- See Note [Do not unpack class dictionaries] , not (has_inlineable_prag && isClassPred ty) -- See Note [mkWWstr and unsafeCoerce] - , cs `equalLength` con_arg_tys - -> Just (cs, dcac) + , cs `lengthIs` arity + -> Just (cs, dcpc) _ -> Nothing where - split_prod_dmd_arity dmd arty + split_prod_dmd_arity dmd arity -- For seqDmd, it should behave like , for some -- suitable arity - | isSeqDmd dmd = Just (replicate arty absDmd) + | isSeqDmd dmd = Just (replicate arity absDmd) | _ :* Prod ds <- dmd = Just ds | otherwise = Nothing unbox_one :: DynFlags -> FamInstEnvs -> Var -> [Demand] - -> DataConAppContext + -> DataConPatContext -> UniqSM (Bool, [Var], CoreExpr -> CoreExpr, CoreExpr -> CoreExpr) unbox_one dflags fam_envs arg cs - DataConAppContext { dcac_dc = data_con, dcac_tys = inst_tys - , dcac_arg_tys = inst_con_arg_tys - , dcac_co = co } - = do { (uniq1:uniqs) <- getUniquesM - ; let scale = scaleScaled (idMult arg) - scaled_inst_con_arg_tys = map (\(t,s) -> (scale t, s)) inst_con_arg_tys - -- See Note [Add demands for strict constructors] - cs' = addDataConStrictness data_con cs - unpk_args = zipWith3 mk_ww_arg uniqs scaled_inst_con_arg_tys cs' - unbox_fn = mkUnpackCase (Var arg) co (idMult arg) uniq1 - data_con unpk_args - arg_no_unf = zapStableUnfolding arg - -- See Note [Zap unfolding when beta-reducing] - -- in GHC.Core.Opt.Simplify; and see #13890 - rebox_fn = Let (NonRec arg_no_unf con_app) - con_app = mkConApp2 data_con inst_tys unpk_args `mkCast` mkSymCo co - ; (_, worker_args, wrap_fn, work_fn) <- mkWWstr dflags fam_envs False unpk_args - ; return (True, worker_args, unbox_fn . wrap_fn, work_fn . rebox_fn) } - -- Don't pass the arg, rebox instead - where - mk_ww_arg uniq ty sub_dmd = setIdDemandInfo (mk_ww_local uniq ty) sub_dmd + DataConPatContext { dcpc_dc = dc, dcpc_tc_args = tc_args + , dcpc_co = co } + = do { (case_bndr_uniq:pat_bndrs_uniqs) <- getUniquesM + ; let ex_name_fss = map getOccFS $ dataConExTyCoVars dc + (ex_tvs', arg_ids) = + dataConRepFSInstPat (ex_name_fss ++ repeat ww_prefix) pat_bndrs_uniqs (idMult arg) dc tc_args + -- See Note [Add demands for strict constructors] + cs' = addDataConStrictness dc cs + arg_ids' = zipWithEqual "unbox_one" setIdDemandInfo arg_ids cs' + unbox_fn = mkUnpackCase (Var arg) co (idMult arg) case_bndr_uniq + dc (ex_tvs' ++ arg_ids') + arg_no_unf = zapStableUnfolding arg + -- See Note [Zap unfolding when beta-reducing] + -- in GHC.Core.Opt.Simplify; and see #13890 + rebox_fn = Let (NonRec arg_no_unf con_app) + con_app = mkConApp2 dc tc_args (ex_tvs' ++ arg_ids') `mkCast` mkSymCo co + ; (_, worker_args, wrap_fn, work_fn) <- mkWWstr dflags fam_envs False (ex_tvs' ++ arg_ids') + ; return (True, worker_args, unbox_fn . wrap_fn, work_fn . rebox_fn) } + -- Don't pass the arg, rebox instead ---------------------- nop_fn :: CoreExpr -> CoreExpr @@ -932,74 +935,68 @@ off the unpacking in mkWWstr_one (see the isClassPred test). Historical note: #14955 describes how I got this fix wrong the first time. -} --- | Context for a 'DataCon' application with a hole for every field, including --- surrounding coercions. --- The result of 'deepSplitProductType_maybe' and 'deepSplitCprType_maybe'. --- --- Example: --- --- > DataConAppContext Just [Int] [(Lazy, Int)] (co :: Maybe Int ~ First Int) +-- | The result of 'splitArgType_maybe' and 'splitResultType_maybe'. -- --- represents --- --- > Just @Int (_1 :: Int) |> co :: First Int --- --- where _1 is a hole for the first argument. The number of arguments is --- determined by the length of @arg_tys at . -data DataConAppContext - = DataConAppContext - { dcac_dc :: !DataCon - , dcac_tys :: ![Type] - , dcac_arg_tys :: ![(Scaled Type, StrictnessMark)] - , dcac_co :: !Coercion +-- Both splits +-- * Take a type `ty` +-- * Succeed with (DataConPatContext dc tys co) +-- iff co :: T tys ~ ty +-- and `dc` is the appropriate DataCon of `T` +-- and `T` is suitable for the kind of split +-- (differs for strictness and CPR, see Note [Which types are unboxed?]) +data DataConPatContext + = DataConPatContext + { dcpc_dc :: !DataCon + , dcpc_tc_args :: ![Type] + , dcpc_co :: !Coercion } -deepSplitProductType_maybe :: FamInstEnvs -> Type -> Maybe DataConAppContext --- If deepSplitProductType_maybe ty = Just (dc, tys, arg_tys, co) --- then dc @ tys (args::arg_tys) :: rep_ty --- co :: ty ~ rep_ty --- Why do we return the strictness of the data-con arguments? --- Answer: see Note [Record evaluated-ness in worker/wrapper] -deepSplitProductType_maybe fam_envs ty +-- | If @splitArgType_maybe ty = Just (dc, tys, co)@ +-- then @dc \@tys \@_ex_tys (_args::_arg_tys) :: tc tys@ +-- and @co :: ty ~ tc tys@ +-- where underscore prefixes are holes, e.g. yet unspecified. +-- +-- See Note [Which types are unboxed?]. +splitArgType_maybe :: FamInstEnvs -> Type -> Maybe DataConPatContext +splitArgType_maybe fam_envs ty | let (co, ty1) = topNormaliseType_maybe fam_envs ty `orElse` (mkRepReflCo ty, ty) , Just (tc, tc_args) <- splitTyConApp_maybe ty1 - , Just con <- isDataProductTyCon_maybe tc - , let arg_tys = dataConInstArgTys con tc_args - strict_marks = dataConRepStrictness con - = Just DataConAppContext { dcac_dc = con - , dcac_tys = tc_args - , dcac_arg_tys = zipEqual "dspt" arg_tys strict_marks - , dcac_co = co } -deepSplitProductType_maybe _ _ = Nothing - -deepSplitCprType_maybe - :: FamInstEnvs -> ConTag -> Type -> Maybe DataConAppContext --- If deepSplitCprType_maybe n ty = Just (dc, tys, arg_tys, co) --- then dc @ tys (args::arg_tys) :: rep_ty --- co :: ty ~ rep_ty --- Why do we return the strictness of the data-con arguments? --- Answer: see Note [Record evaluated-ness in worker/wrapper] -deepSplitCprType_maybe fam_envs con_tag ty + , Just con <- tyConSingleAlgDataCon_maybe tc + = Just DataConPatContext { dcpc_dc = con + , dcpc_tc_args = tc_args + , dcpc_co = co } +splitArgType_maybe _ _ = Nothing + +-- | If @splitResultType_maybe n ty = Just (dc, tys, co)@ +-- then @dc \@tys \@_ex_tys (_args::_arg_tys) :: tc tys@ +-- and @co :: ty ~ tc tys@ +-- where underscore prefixes are holes, e.g. yet unspecified. +-- @dc@ is the @n at th data constructor of @tc at . +-- +-- See Note [Which types are unboxed?]. +splitResultType_maybe :: FamInstEnvs -> ConTag -> Type -> Maybe DataConPatContext +splitResultType_maybe fam_envs con_tag ty | let (co, ty1) = topNormaliseType_maybe fam_envs ty `orElse` (mkRepReflCo ty, ty) , Just (tc, tc_args) <- splitTyConApp_maybe ty1 - , isDataTyCon tc + , isDataTyCon tc -- NB: rules out unboxed sums and pairs! , let cons = tyConDataCons tc , cons `lengthAtLeast` con_tag -- This might not be true if we import the - -- type constructor via a .hs-bool file (#8743) + -- type constructor via a .hs-boot file (#8743) , let con = cons `getNth` (con_tag - fIRST_TAG) - arg_tys = dataConInstArgTys con tc_args - strict_marks = dataConRepStrictness con - , all isLinear arg_tys + , null (dataConExTyCoVars con) -- no existentials; + -- See Note [Which types are unboxed?] + -- and GHC.Core.Opt.CprAnal.extendEnvForDataAlt + -- where we also check this. + , all isLinear (dataConInstArgTys con tc_args) -- Deactivates CPR worker/wrapper splits on constructors with non-linear -- arguments, for the moment, because they require unboxed tuple with variable -- multiplicity fields. - = Just DataConAppContext { dcac_dc = con - , dcac_tys = tc_args - , dcac_arg_tys = zipEqual "dspt" arg_tys strict_marks - , dcac_co = co } -deepSplitCprType_maybe _ _ _ = Nothing + = Just DataConPatContext { dcpc_dc = con + , dcpc_tc_args = tc_args + , dcpc_co = co } +splitResultType_maybe _ _ _ = Nothing isLinear :: Scaled a -> Bool isLinear (Scaled w _ ) = @@ -1035,13 +1032,16 @@ findTypeShape fam_envs ty | Just (_, rhs, _) <- topReduceTyFamApp_maybe fam_envs tc tc_args = go rec_tc rhs - | Just con <- isDataProductTyCon_maybe tc + | Just con <- tyConSingleAlgDataCon_maybe tc , Just rec_tc <- if isTupleTyCon tc then Just rec_tc else checkRecTc rec_tc tc -- We treat tuples specially because they can't cause loops. -- Maybe we should do so in checkRecTc. - = TsProd (map (go rec_tc . scaledThing) (dataConInstArgTys con tc_args)) + -- The use of 'dubiousDataConInstArgTys' is OK, since this + -- function performs no substitution at all, hence the uniques + -- don't matter. + = TsProd (map (go rec_tc) (dubiousDataConInstArgTys con tc_args)) | Just (ty', _) <- instNewTyCon_maybe tc tc_args , Just rec_tc <- checkRecTc rec_tc tc @@ -1050,7 +1050,55 @@ findTypeShape fam_envs ty | otherwise = TsUnk -{- +-- | Exactly 'dataConInstArgTys', but lacks the (ASSERT'ed) precondition that +-- the 'DataCon' may not have existentials. The lack of cloning the existentials +-- compared to 'dataConInstExAndArgVars' makes this function \"dubious\"; +-- only use it where type variables aren't substituted for! +dubiousDataConInstArgTys :: DataCon -> [Type] -> [Type] +dubiousDataConInstArgTys dc tc_args = arg_tys + where + univ_tvs = dataConUnivTyVars dc + ex_tvs = dataConExTyCoVars dc + subst = extendTCvInScopeList (zipTvSubst univ_tvs tc_args) ex_tvs + arg_tys = map (substTy subst . scaledThing) (dataConRepArgTys dc) + +{- Note [Which types are unboxed?] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Worker/wrapper will unbox + + 1. A strict data type argument, that + * is an algebraic data type (not a newtype) + * has a single constructor (thus is a "product") + * that may bind existentials + We can transform + > f (D @ex a b) = e + to + > $wf @ex a b = e + via 'mkWWstr'. + + 2. The constructed result of a function, if + * its type is an algebraic data type (not a newtype) + * (might have multiple constructors, in contrast to (1)) + * the applied data constructor *does not* bind existentials + We can transform + > f x y = let ... in D a b + to + > $wf x y = let ... in (# a, b #) + via 'mkWWcpr'. + + NB: We don't allow existentials for CPR W/W, because we don't have unboxed + dependent tuples (yet?). Otherwise, we could transform + > f x y = let ... in D @ex (a :: ..ex..) (b :: ..ex..) + to + > $wf x y = let ... in (# @ex, (a :: ..ex..), (b :: ..ex..) #) + +The respective tests are in 'splitArgType_maybe' and +'splitResultType_maybe', respectively. + +Note that the data constructor /can/ have evidence arguments: equality +constraints, type classes etc. So it can be GADT. These evidence +arguments are simply value arguments, and should not get in the way. + ************************************************************************ * * \subsection{CPR stuff} @@ -1083,35 +1131,36 @@ mkWWcpr opt_CprAnal fam_envs body_ty cpr | otherwise = case asConCpr cpr of Nothing -> return (False, id, id, body_ty) -- No CPR info - Just con_tag | Just dcac <- deepSplitCprType_maybe fam_envs con_tag body_ty - -> mkWWcpr_help dcac + Just con_tag | Just dcpc <- splitResultType_maybe fam_envs con_tag body_ty + -> mkWWcpr_help dcpc | otherwise -- See Note [non-algebraic or open body type warning] -> WARN( True, text "mkWWcpr: non-algebraic or open body type" <+> ppr body_ty ) return (False, id, id, body_ty) -mkWWcpr_help :: DataConAppContext +mkWWcpr_help :: DataConPatContext -> UniqSM (Bool, CoreExpr -> CoreExpr, CoreExpr -> CoreExpr, Type) -mkWWcpr_help (DataConAppContext { dcac_dc = data_con, dcac_tys = inst_tys - , dcac_arg_tys = arg_tys, dcac_co = co }) - | [arg1@(arg_ty1, _)] <- arg_tys - , isUnliftedType (scaledThing arg_ty1) - , isLinear arg_ty1 +mkWWcpr_help (DataConPatContext { dcpc_dc = dc, dcpc_tc_args = tc_args + , dcpc_co = co }) + | [arg_ty] <- dataConInstArgTys dc tc_args -- NB: No existentials! + , [str_mark] <- dataConRepStrictness dc + , isUnliftedType (scaledThing arg_ty) + , isLinear arg_ty -- Special case when there is a single result of unlifted, linear, type -- -- Wrapper: case (..call worker..) of x -> C x -- Worker: case ( ..body.. ) of C x -> x = do { (work_uniq : arg_uniq : _) <- getUniquesM - ; let arg = mk_ww_local arg_uniq arg1 - con_app = mkConApp2 data_con inst_tys [arg] `mkCast` mkSymCo co + ; let arg_id = mk_ww_local arg_uniq str_mark arg_ty + con_app = mkConApp2 dc tc_args [arg_id] `mkCast` mkSymCo co ; return ( True - , \ wkr_call -> mkDefaultCase wkr_call arg con_app - , \ body -> mkUnpackCase body co One work_uniq data_con [arg] (varToCoreExpr arg) + , \ wkr_call -> mkDefaultCase wkr_call arg_id con_app + , \ body -> mkUnpackCase body co One work_uniq dc [arg_id] (varToCoreExpr arg_id) -- varToCoreExpr important here: arg can be a coercion -- Lacking this caused #10658 - , scaledThing arg_ty1 ) } + , scaledThing arg_ty ) } | otherwise -- The general case -- Wrapper: case (..call worker..) of (# a, b #) -> C a b @@ -1123,18 +1172,22 @@ mkWWcpr_help (DataConAppContext { dcac_dc = data_con, dcac_tys = inst_tys -- parametrised by the multiplicity of its fields. Specifically, in this -- instance, the multiplicity of the fields of (#,#) is chosen to be the -- same as those of C. - = do { (work_uniq : wild_uniq : uniqs) <- getUniquesM - ; let wrap_wild = mk_ww_local wild_uniq (linear ubx_tup_ty,MarkedStrict) - args = zipWith mk_ww_local uniqs arg_tys - ubx_tup_ty = exprType ubx_tup_app - ubx_tup_app = mkCoreUbxTup (map (scaledThing . fst) arg_tys) (map varToCoreExpr args) - con_app = mkConApp2 data_con inst_tys args `mkCast` mkSymCo co - tup_con = tupleDataCon Unboxed (length arg_tys) + = do { (work_uniq : wild_uniq : pat_bndrs_uniqs) <- getUniquesM + ; let case_mult = One -- see above + (_exs, arg_ids) = + dataConRepFSInstPat (repeat ww_prefix) pat_bndrs_uniqs case_mult dc tc_args + wrap_wild = mk_ww_local wild_uniq MarkedStrict (Scaled case_mult ubx_tup_ty) + ubx_tup_ty = exprType ubx_tup_app + ubx_tup_app = mkCoreUbxTup (map idType arg_ids) (map varToCoreExpr arg_ids) + con_app = mkConApp2 dc tc_args arg_ids `mkCast` mkSymCo co + tup_con = tupleDataCon Unboxed (length arg_ids) + + ; MASSERT( null _exs ) -- Should have been caught by splitResultType_maybe ; return (True , \ wkr_call -> mkSingleAltCase wkr_call wrap_wild - (DataAlt tup_con) args con_app - , \ body -> mkUnpackCase body co One work_uniq data_con args ubx_tup_app + (DataAlt tup_con) arg_ids con_app + , \ body -> mkUnpackCase body co case_mult work_uniq dc arg_ids ubx_tup_app , ubx_tup_ty ) } mkUnpackCase :: CoreExpr -> Coercion -> Mult -> Unique -> DataCon -> [Id] -> CoreExpr -> CoreExpr @@ -1149,7 +1202,7 @@ mkUnpackCase scrut co mult uniq boxing_con unpk_args body (DataAlt boxing_con) unpk_args body where casted_scrut = scrut `mkCast` co - bndr = mk_ww_local uniq (Scaled mult (exprType casted_scrut), MarkedStrict) + bndr = mk_ww_local uniq MarkedStrict (Scaled mult (exprType casted_scrut)) -- An unpacking case can always be chosen linear, because the variables -- are always passed to a constructor. This limits the {- @@ -1291,10 +1344,13 @@ mk_absent_let dflags fam_envs arg -- See also Note [Unique Determinism] in GHC.Types.Unique unlifted_rhs = mkTyApps (Lit rubbishLit) [arg_ty] -mk_ww_local :: Unique -> (Scaled Type, StrictnessMark) -> Id +ww_prefix :: FastString +ww_prefix = fsLit "ww" + +mk_ww_local :: Unique -> StrictnessMark -> Scaled Type -> Id -- The StrictnessMark comes form the data constructor and says -- whether this field is strict -- See Note [Record evaluated-ness in worker/wrapper] -mk_ww_local uniq (Scaled w ty,str) +mk_ww_local uniq str (Scaled w ty) = setCaseBndrEvald str $ - mkSysLocalOrCoVar (fsLit "ww") uniq w ty + mkSysLocalOrCoVar ww_prefix uniq w ty ===================================== compiler/GHC/Core/TyCon.hs ===================================== @@ -58,8 +58,7 @@ module GHC.Core.TyCon( isKindTyCon, isLiftedTypeKindTyConName, isTauTyCon, isFamFreeTyCon, isForgetfulSynTyCon, - isDataTyCon, isProductTyCon, isDataProductTyCon_maybe, - isDataSumTyCon_maybe, + isDataTyCon, isEnumerationTyCon, isNewTyCon, isAbstractTyCon, isFamilyTyCon, isOpenFamilyTyCon, @@ -84,6 +83,7 @@ module GHC.Core.TyCon( tyConCType, tyConCType_maybe, tyConDataCons, tyConDataCons_maybe, tyConSingleDataCon_maybe, tyConSingleDataCon, + tyConAlgDataCons_maybe, tyConSingleAlgDataCon_maybe, tyConFamilySize, tyConStupidTheta, @@ -143,7 +143,7 @@ import {-# SOURCE #-} GHC.Builtin.Types , multiplicityTyCon , vecCountTyCon, vecElemTyCon, liftedTypeKind ) import {-# SOURCE #-} GHC.Core.DataCon - ( DataCon, dataConExTyCoVars, dataConFieldLabels + ( DataCon, dataConFieldLabels , dataConTyCon, dataConFullSig , isUnboxedSumDataCon ) import GHC.Builtin.Uniques @@ -1976,72 +1976,6 @@ unwrapNewTyConEtad_maybe (AlgTyCon { algTcRhs = NewTyCon { nt_co = co, = Just (tvs, rhs, co) unwrapNewTyConEtad_maybe _ = Nothing -isProductTyCon :: TyCon -> Bool --- True of datatypes or newtypes that have --- one, non-existential, data constructor --- See Note [Product types] -isProductTyCon tc@(AlgTyCon {}) - = case algTcRhs tc of - TupleTyCon {} -> True - DataTyCon{ data_cons = [data_con] } - -> null (dataConExTyCoVars data_con) - NewTyCon {} -> True - _ -> False -isProductTyCon _ = False - -isDataProductTyCon_maybe :: TyCon -> Maybe DataCon --- True of datatypes (not newtypes) with --- one, vanilla, data constructor --- See Note [Product types] -isDataProductTyCon_maybe (AlgTyCon { algTcRhs = rhs }) - = case rhs of - DataTyCon { data_cons = [con] } - | null (dataConExTyCoVars con) -- non-existential - -> Just con - TupleTyCon { data_con = con } - -> Just con - _ -> Nothing -isDataProductTyCon_maybe _ = Nothing - -isDataSumTyCon_maybe :: TyCon -> Maybe [DataCon] -isDataSumTyCon_maybe (AlgTyCon { algTcRhs = rhs }) - = case rhs of - DataTyCon { data_cons = cons } - | cons `lengthExceeds` 1 - , all (null . dataConExTyCoVars) cons -- FIXME(osa): Why do we need this? - -> Just cons - SumTyCon { data_cons = cons } - | all (null . dataConExTyCoVars) cons -- FIXME(osa): Why do we need this? - -> Just cons - _ -> Nothing -isDataSumTyCon_maybe _ = Nothing - -{- Note [Product types] -~~~~~~~~~~~~~~~~~~~~~~~ -A product type is - * A data type (not a newtype) - * With one, boxed data constructor - * That binds no existential type variables - -The main point is that product types are amenable to unboxing for - * Strict function calls; we can transform - f (D a b) = e - to - fw a b = e - via the worker/wrapper transformation. (Question: couldn't this - work for existentials too?) - - * CPR for function results; we can transform - f x y = let ... in D a b - to - fw x y = let ... in (# a, b #) - -Note that the data constructor /can/ have evidence arguments: equality -constraints, type classes etc. So it can be GADT. These evidence -arguments are simply value arguments, and should not get in the way. --} - - -- | Is this a 'TyCon' representing a regular H98 type synonym (@type@)? {-# INLINE isTypeSynonymTyCon #-} -- See Note [Inlining coreView] in GHC.Core.Type isTypeSynonymTyCon :: TyCon -> Bool @@ -2380,8 +2314,7 @@ tyConDataCons_maybe _ = Nothing -- | If the given 'TyCon' has a /single/ data constructor, i.e. it is a @data@ -- type with one alternative, a tuple type or a @newtype@ then that constructor -- is returned. If the 'TyCon' has more than one constructor, or represents a --- primitive or function type constructor then @Nothing@ is returned. In any --- other case, the function panics +-- primitive or function type constructor then @Nothing@ is returned. tyConSingleDataCon_maybe :: TyCon -> Maybe DataCon tyConSingleDataCon_maybe (AlgTyCon { algTcRhs = rhs }) = case rhs of @@ -2391,21 +2324,29 @@ tyConSingleDataCon_maybe (AlgTyCon { algTcRhs = rhs }) _ -> Nothing tyConSingleDataCon_maybe _ = Nothing +-- | Like 'tyConSingleDataCon_maybe', but panics if 'Nothing'. tyConSingleDataCon :: TyCon -> DataCon tyConSingleDataCon tc = case tyConSingleDataCon_maybe tc of Just c -> c Nothing -> pprPanic "tyConDataCon" (ppr tc) +-- | Like 'tyConSingleDataCon_maybe', but returns 'Nothing' for newtypes. tyConSingleAlgDataCon_maybe :: TyCon -> Maybe DataCon --- Returns (Just con) for single-constructor --- *algebraic* data types *not* newtypes -tyConSingleAlgDataCon_maybe (AlgTyCon { algTcRhs = rhs }) - = case rhs of - DataTyCon { data_cons = [c] } -> Just c - TupleTyCon { data_con = c } -> Just c - _ -> Nothing -tyConSingleAlgDataCon_maybe _ = Nothing +tyConSingleAlgDataCon_maybe tycon + | isNewTyCon tycon = Nothing + | otherwise = tyConSingleDataCon_maybe tycon + +-- | Returns @Just dcs@ if the given 'TyCon' is a @data@ type, a tuple type +-- or a sum type with data constructors dcs. If the 'TyCon' has more than one +-- constructor, or represents a primitive or function type constructor then +-- @Nothing@ is returned. +-- +-- Like 'tyConDataCons_maybe', but returns 'Nothing' for newtypes. +tyConAlgDataCons_maybe :: TyCon -> Maybe [DataCon] +tyConAlgDataCons_maybe tycon + | isNewTyCon tycon = Nothing + | otherwise = tyConDataCons_maybe tycon -- | Determine the number of value constructors a 'TyCon' has. Panics if the -- 'TyCon' is not algebraic or a tuple ===================================== compiler/GHC/CoreToIface.hs ===================================== @@ -245,7 +245,7 @@ toIfaceTyCon tc , Just tsort <- tupleSort tc' = tsort | isUnboxedSumTyCon tc - , Just cons <- isDataSumTyCon_maybe tc = IfaceSumTyCon (length cons) + , Just cons <- tyConDataCons_maybe tc = IfaceSumTyCon (length cons) | otherwise = IfaceNormalTyCon ===================================== compiler/GHC/Hs/Pat.hs ===================================== @@ -771,8 +771,6 @@ isIrrefutableHsPat L _ (PatSynCon _pat) -> False -- Conservative L _ (RealDataCon con) -> isJust (tyConSingleDataCon_maybe (dataConTyCon con)) - -- NB: tyConSingleDataCon_maybe, *not* isProductTyCon, because - -- the latter is false of existentials. See #4439 && all goL (hsConPatArgs details) go (LitPat {}) = False go (NPat {}) = False ===================================== compiler/GHC/HsToCore/Foreign/Call.hs ===================================== @@ -350,7 +350,8 @@ resultWrapper result_ty -- Data types with a single constructor, which has a single arg -- This includes types like Ptr and ForeignPtr | Just (tycon, tycon_arg_tys) <- maybe_tc_app - , Just data_con <- isDataProductTyCon_maybe tycon -- One constructor, no existentials + , Just data_con <- tyConSingleAlgDataCon_maybe tycon -- One constructor + , null (dataConExTyCoVars data_con) -- no existentials , [Scaled _ unwrapped_res_ty] <- dataConInstOrigArgTys data_con tycon_arg_tys -- One argument = do { (maybe_ty, wrapper) <- resultWrapper unwrapped_res_ty ; let marshal_con e = Var (dataConWrapId data_con) ===================================== compiler/GHC/HsToCore/Utils.hs ===================================== @@ -737,7 +737,7 @@ is_flat_prod_pat (TuplePat _ ps Boxed) = all is_triv_lpat ps is_flat_prod_pat (ConPat { pat_con = L _ pcon , pat_args = ps}) | RealDataCon con <- pcon - , isProductTyCon (dataConTyCon con) + , Just _ <- tyConSingleDataCon_maybe (dataConTyCon con) = all is_triv_lpat (hsConPatArgs ps) is_flat_prod_pat _ = False ===================================== compiler/GHC/Tc/Deriv/Utils.hs ===================================== @@ -928,8 +928,8 @@ cond_isEnumeration _ _ rep_tc cond_isProduct :: Condition cond_isProduct _ _ rep_tc - | isProductTyCon rep_tc = IsValid - | otherwise = NotValid why + | Just _ <- tyConSingleDataCon_maybe rep_tc = IsValid + | otherwise = NotValid why where why = quotes (pprSourceTyCon rep_tc) <+> text "must have precisely one constructor" ===================================== testsuite/tests/simplCore/should_compile/T18013.stderr ===================================== @@ -132,33 +132,58 @@ Result size of Tidy Core = {terms: 52, types: 106, coercions: 17, joins: 0/1} -- RHS size: {terms: 37, types: 87, coercions: 17, joins: 0/1} -mapMaybeRule +mapMaybeRule [InlPrag=[2]] :: forall a b. Rule IO a b -> Rule IO (Maybe a) (Maybe b) [GblId, Arity=1, - Str=, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 150 10}] + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (@a) (@b) (w [Occ=Once1!] :: Rule IO a b) -> + case w of { Rule @s ww1 ww2 [Occ=OnceL1!] -> + T18013a.Rule + @IO + @(Maybe a) + @(Maybe b) + @s + ww1 + ((\ (s2 [Occ=Once1] :: s) + (a1 [Occ=Once1!] :: Maybe a) + (s1 [Occ=Once2] :: GHC.Prim.State# GHC.Prim.RealWorld) -> + case a1 of { + Nothing -> + (# s1, T18013a.Result @s @(Maybe b) ww1 (GHC.Maybe.Nothing @b) #); + Just x [Occ=Once1] -> + case ((ww2 s2 x) `cast` ) s1 of + { (# ipv [Occ=Once1], ipv1 [Occ=Once1!] #) -> + case ipv1 of { Result t2 [Occ=Once1] c1 [Occ=Once1] -> + (# ipv, T18013a.Result @s @(Maybe b) t2 (GHC.Maybe.Just @b c1) #) + } + } + }) + `cast` ) + }}] mapMaybeRule - = \ (@a) (@b) (f :: Rule IO a b) -> - case f of { Rule @s t0 g -> + = \ (@a) (@b) (w :: Rule IO a b) -> + case w of { Rule @s ww1 ww2 -> let { lvl :: Result s (Maybe b) [LclId, Unf=OtherCon []] - lvl = T18013a.Result @s @(Maybe b) t0 (GHC.Maybe.Nothing @b) } in + lvl = T18013a.Result @s @(Maybe b) ww1 (GHC.Maybe.Nothing @b) } in T18013a.Rule @IO @(Maybe a) @(Maybe b) @s - t0 + ww1 ((\ (s2 :: s) (a1 :: Maybe a) (s1 :: GHC.Prim.State# GHC.Prim.RealWorld) -> case a1 of { Nothing -> (# s1, lvl #); Just x -> - case ((g s2 x) `cast` ) s1 of { (# ipv, ipv1 #) -> + case ((ww2 s2 x) `cast` ) s1 of { (# ipv, ipv1 #) -> case ipv1 of { Result t2 c1 -> (# ipv, T18013a.Result @s @(Maybe b) t2 (GHC.Maybe.Just @b c1) #) } ===================================== testsuite/tests/stranal/should_compile/T18982.hs ===================================== @@ -0,0 +1,41 @@ +{-# OPTIONS_GHC -O -fforce-recomp #-} +{-# LANGUAGE GADTs #-} + +module T18982 where + +data Box a where + Box :: a -> Box a + +data Ex a where + Ex :: e -> a -> Ex a + +data GADT a where + GADT :: Int -> GADT Int + +data ExGADT a where + ExGADT :: (e ~ Int) => e -> Int -> ExGADT Int + +-- | Expected worker type: +-- $wf :: Int# -> Int# +f :: Box Int -> Int +f (Box n) = n + 1 +{-# NOINLINE f #-} + +-- | Expected worker type: +-- $wg :: forall {e}. e -> Int# -> Int# +g :: Ex Int -> Int +g (Ex e n) = e `seq` n + 1 +{-# NOINLINE g #-} + +-- | Expected worker type: +-- $wh :: Int# -> Int# +h :: GADT a -> Int +h (GADT n) = n + 1 +{-# NOINLINE h #-} + +-- | Expected worker type: +-- $wi :: forall {e}. e -> Int# -> Int# +i :: ExGADT a -> Int +i (ExGADT e n) = e `seq` n + 1 +{-# NOINLINE i #-} + ===================================== testsuite/tests/stranal/should_compile/T18982.stderr ===================================== @@ -0,0 +1,246 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core = {terms: 311, types: 249, coercions: 4, joins: 0/0} + +-- RHS size: {terms: 8, types: 11, coercions: 1, joins: 0/0} +T18982.$WExGADT :: forall e. (e ~ Int) => e %1 -> Int %1 -> ExGADT Int +T18982.$WExGADT = \ (@e) (dt :: e ~ Int) (dt :: e) (dt :: Int) -> T18982.ExGADT @Int @e @~(_N :: Int GHC.Prim.~# Int) dt dt dt + +-- RHS size: {terms: 3, types: 2, coercions: 1, joins: 0/0} +T18982.$WGADT :: Int %1 -> GADT Int +T18982.$WGADT = \ (dt :: Int) -> T18982.GADT @Int @~(_N :: Int GHC.Prim.~# Int) dt + +-- RHS size: {terms: 7, types: 8, coercions: 0, joins: 0/0} +T18982.$WEx :: forall e a. e %1 -> a %1 -> Ex a +T18982.$WEx = \ (@e) (@a) (dt :: e) (dt :: a) -> T18982.Ex @a @e dt dt + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$trModule4 :: GHC.Prim.Addr# +T18982.$trModule4 = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$trModule3 :: GHC.Types.TrName +T18982.$trModule3 = GHC.Types.TrNameS T18982.$trModule4 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$trModule2 :: GHC.Prim.Addr# +T18982.$trModule2 = "T18982"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$trModule1 :: GHC.Types.TrName +T18982.$trModule1 = GHC.Types.TrNameS T18982.$trModule2 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18982.$trModule :: GHC.Types.Module +T18982.$trModule = GHC.Types.Module T18982.$trModule3 T18982.$trModule1 + +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} +$krep :: GHC.Types.KindRep +$krep = GHC.Types.KindRepTyConApp GHC.Types.$tcInt (GHC.Types.[] @GHC.Types.KindRep) + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$krep1 :: GHC.Types.KindRep +$krep1 = GHC.Types.KindRepVar 1# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$krep2 :: GHC.Types.KindRep +$krep2 = GHC.Types.KindRepVar 0# + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +$krep3 :: [GHC.Types.KindRep] +$krep3 = GHC.Types.: @GHC.Types.KindRep $krep (GHC.Types.[] @GHC.Types.KindRep) + +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} +$krep4 :: [GHC.Types.KindRep] +$krep4 = GHC.Types.: @GHC.Types.KindRep $krep2 $krep3 + +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} +$krep5 :: [GHC.Types.KindRep] +$krep5 = GHC.Types.: @GHC.Types.KindRep GHC.Types.krep$* $krep4 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep6 :: GHC.Types.KindRep +$krep6 = GHC.Types.KindRepTyConApp GHC.Types.$tc~ $krep5 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tcBox2 :: GHC.Prim.Addr# +T18982.$tcBox2 = "Box"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tcBox1 :: GHC.Types.TrName +T18982.$tcBox1 = GHC.Types.TrNameS T18982.$tcBox2 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tcBox :: GHC.Types.TyCon +T18982.$tcBox = GHC.Types.TyCon 16948648223906549518## 2491460178135962649## T18982.$trModule T18982.$tcBox1 0# GHC.Types.krep$*Arr* + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +$krep7 :: [GHC.Types.KindRep] +$krep7 = GHC.Types.: @GHC.Types.KindRep $krep2 (GHC.Types.[] @GHC.Types.KindRep) + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep8 :: GHC.Types.KindRep +$krep8 = GHC.Types.KindRepTyConApp T18982.$tcBox $krep7 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Box1 :: GHC.Types.KindRep +T18982.$tc'Box1 = GHC.Types.KindRepFun $krep2 $krep8 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Box3 :: GHC.Prim.Addr# +T18982.$tc'Box3 = "'Box"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Box2 :: GHC.Types.TrName +T18982.$tc'Box2 = GHC.Types.TrNameS T18982.$tc'Box3 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Box :: GHC.Types.TyCon +T18982.$tc'Box = GHC.Types.TyCon 1412068769125067428## 8727214667407894081## T18982.$trModule T18982.$tc'Box2 1# T18982.$tc'Box1 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tcEx2 :: GHC.Prim.Addr# +T18982.$tcEx2 = "Ex"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tcEx1 :: GHC.Types.TrName +T18982.$tcEx1 = GHC.Types.TrNameS T18982.$tcEx2 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tcEx :: GHC.Types.TyCon +T18982.$tcEx = GHC.Types.TyCon 4376661818164435927## 18005417598910668817## T18982.$trModule T18982.$tcEx1 0# GHC.Types.krep$*Arr* + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +$krep9 :: [GHC.Types.KindRep] +$krep9 = GHC.Types.: @GHC.Types.KindRep $krep1 (GHC.Types.[] @GHC.Types.KindRep) + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep10 :: GHC.Types.KindRep +$krep10 = GHC.Types.KindRepTyConApp T18982.$tcEx $krep9 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep11 :: GHC.Types.KindRep +$krep11 = GHC.Types.KindRepFun $krep1 $krep10 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Ex1 :: GHC.Types.KindRep +T18982.$tc'Ex1 = GHC.Types.KindRepFun $krep2 $krep11 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Ex3 :: GHC.Prim.Addr# +T18982.$tc'Ex3 = "'Ex"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Ex2 :: GHC.Types.TrName +T18982.$tc'Ex2 = GHC.Types.TrNameS T18982.$tc'Ex3 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Ex :: GHC.Types.TyCon +T18982.$tc'Ex = GHC.Types.TyCon 14609381081172201359## 3077219645053200509## T18982.$trModule T18982.$tc'Ex2 2# T18982.$tc'Ex1 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tcGADT2 :: GHC.Prim.Addr# +T18982.$tcGADT2 = "GADT"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tcGADT1 :: GHC.Types.TrName +T18982.$tcGADT1 = GHC.Types.TrNameS T18982.$tcGADT2 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tcGADT :: GHC.Types.TyCon +T18982.$tcGADT = GHC.Types.TyCon 9243924476135839950## 5096619276488416461## T18982.$trModule T18982.$tcGADT1 0# GHC.Types.krep$*Arr* + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep12 :: GHC.Types.KindRep +$krep12 = GHC.Types.KindRepTyConApp T18982.$tcGADT $krep3 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'GADT1 :: GHC.Types.KindRep +T18982.$tc'GADT1 = GHC.Types.KindRepFun $krep $krep12 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'GADT3 :: GHC.Prim.Addr# +T18982.$tc'GADT3 = "'GADT"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'GADT2 :: GHC.Types.TrName +T18982.$tc'GADT2 = GHC.Types.TrNameS T18982.$tc'GADT3 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'GADT :: GHC.Types.TyCon +T18982.$tc'GADT = GHC.Types.TyCon 2077850259354179864## 16731205864486799217## T18982.$trModule T18982.$tc'GADT2 0# T18982.$tc'GADT1 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tcExGADT2 :: GHC.Prim.Addr# +T18982.$tcExGADT2 = "ExGADT"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tcExGADT1 :: GHC.Types.TrName +T18982.$tcExGADT1 = GHC.Types.TrNameS T18982.$tcExGADT2 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tcExGADT :: GHC.Types.TyCon +T18982.$tcExGADT = GHC.Types.TyCon 6470898418160489500## 10361108917441214060## T18982.$trModule T18982.$tcExGADT1 0# GHC.Types.krep$*Arr* + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep13 :: GHC.Types.KindRep +$krep13 = GHC.Types.KindRepTyConApp T18982.$tcExGADT $krep3 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep14 :: GHC.Types.KindRep +$krep14 = GHC.Types.KindRepFun $krep $krep13 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep15 :: GHC.Types.KindRep +$krep15 = GHC.Types.KindRepFun $krep2 $krep14 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'ExGADT1 :: GHC.Types.KindRep +T18982.$tc'ExGADT1 = GHC.Types.KindRepFun $krep6 $krep15 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'ExGADT3 :: GHC.Prim.Addr# +T18982.$tc'ExGADT3 = "'ExGADT"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'ExGADT2 :: GHC.Types.TrName +T18982.$tc'ExGADT2 = GHC.Types.TrNameS T18982.$tc'ExGADT3 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'ExGADT :: GHC.Types.TyCon +T18982.$tc'ExGADT = GHC.Types.TyCon 8468257409157161049## 5503123603717080600## T18982.$trModule T18982.$tc'ExGADT2 1# T18982.$tc'ExGADT1 + +-- RHS size: {terms: 11, types: 14, coercions: 0, joins: 0/0} +T18982.$wi :: forall {a} {e}. (a GHC.Prim.~# Int) -> e -> GHC.Prim.Int# -> GHC.Prim.Int# +T18982.$wi = \ (@a) (@e) (ww :: a GHC.Prim.~# Int) (ww1 :: e) (ww2 :: GHC.Prim.Int#) -> case ww1 of { __DEFAULT -> GHC.Prim.+# ww2 1# } + +-- RHS size: {terms: 15, types: 27, coercions: 1, joins: 0/0} +i :: forall a. ExGADT a -> Int +i = \ (@a) (w :: ExGADT a) -> case w of { ExGADT @e ww1 ww2 ww3 ww4 -> case ww4 of { GHC.Types.I# ww6 -> case T18982.$wi @a @e @~(ww1 :: a GHC.Prim.~# Int) ww3 ww6 of ww7 { __DEFAULT -> GHC.Types.I# ww7 } } } + +-- RHS size: {terms: 6, types: 10, coercions: 0, joins: 0/0} +T18982.$wh :: forall {a}. (a GHC.Prim.~# Int) -> GHC.Prim.Int# -> GHC.Prim.Int# +T18982.$wh = \ (@a) (ww :: a GHC.Prim.~# Int) (ww1 :: GHC.Prim.Int#) -> GHC.Prim.+# ww1 1# + +-- RHS size: {terms: 14, types: 18, coercions: 1, joins: 0/0} +h :: forall a. GADT a -> Int +h = \ (@a) (w :: GADT a) -> case w of { GADT ww1 ww2 -> case ww2 of { GHC.Types.I# ww4 -> case T18982.$wh @a @~(ww1 :: a GHC.Prim.~# Int) ww4 of ww5 { __DEFAULT -> GHC.Types.I# ww5 } } } + +-- RHS size: {terms: 9, types: 5, coercions: 0, joins: 0/0} +T18982.$wg :: forall {e}. e -> GHC.Prim.Int# -> GHC.Prim.Int# +T18982.$wg = \ (@e) (ww :: e) (ww1 :: GHC.Prim.Int#) -> case ww of { __DEFAULT -> GHC.Prim.+# ww1 1# } + +-- RHS size: {terms: 14, types: 12, coercions: 0, joins: 0/0} +g :: Ex Int -> Int +g = \ (w :: Ex Int) -> case w of { Ex @e ww1 ww2 -> case ww2 of { GHC.Types.I# ww4 -> case T18982.$wg @e ww1 ww4 of ww5 { __DEFAULT -> GHC.Types.I# ww5 } } } + +-- RHS size: {terms: 4, types: 1, coercions: 0, joins: 0/0} +T18982.$wf :: GHC.Prim.Int# -> GHC.Prim.Int# +T18982.$wf = \ (ww :: GHC.Prim.Int#) -> GHC.Prim.+# ww 1# + +-- RHS size: {terms: 13, types: 8, coercions: 0, joins: 0/0} +f :: Box Int -> Int +f = \ (w :: Box Int) -> case w of { Box ww1 -> case ww1 of { GHC.Types.I# ww3 -> case T18982.$wf ww3 of ww4 { __DEFAULT -> GHC.Types.I# ww4 } } } + + + ===================================== testsuite/tests/stranal/should_compile/all.T ===================================== @@ -62,3 +62,5 @@ test('T18903', [ grep_errmsg(r'Dmd=\S+C\S+') ], compile, ['-ddump-simpl -dsuppr test('T18894', [ grep_errmsg(r'Dmd=\S+C\S+') ], compile, ['-ddump-stranal -dsuppress-uniques']) # We care about the Arity 2 on eta, as a result of the annotated Dmd test('T18894b', [ grep_errmsg(r'Arity=2') ], compile, ['-ddump-stranal -dsuppress-uniques -fno-call-arity -dppr-cols=200']) +# We care about the workers of f,g,h,i: +test('T18982', [ grep_errmsg(r'\$w. .*Int#$') ], compile, ['-dppr-cols=1000 -ddump-simpl -dsuppress-idinfo -dsuppress-uniques']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8f415e76cb5979857a1f7f3077c6766a661ca800 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8f415e76cb5979857a1f7f3077c6766a661ca800 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: