[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 11 commits: make: Clean includes/settings file
Marge Bot
gitlab at gitlab.haskell.org
Tue Jun 18 13:29:40 UTC 2019
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
63965ae3 by Ben Gamari at 2019-06-17T05:20:21Z
make: Clean includes/settings file
Now since this is generated by the build system we should ensure that it
is properly cleaned.
[skip ci]
- - - - -
bb141114 by Siddharth Bhat at 2019-06-17T05:20:57Z
Add link to mfix.github.io/ghc in HACKING.md
- - - - -
24afbfe9 by Ben Gamari at 2019-06-17T14:20:32Z
gitlab-ci: Run nofib on binary distributions
Updates docker images to ensure that the `time` utility is available.
- - - - -
5360a490 by Fumiaki Kinoshita at 2019-06-18T13:29:31Z
Data.Ord: give a field name getDown to Down
- - - - -
fd501724 by Fumiaki Kinoshita at 2019-06-18T13:29:31Z
Add more newtype-derived instances to Data.Ord.Down
Metric Increase:
haddock.base
- - - - -
94e5b732 by Ben Gamari at 2019-06-18T13:29:32Z
testsuite: Add testcase for #16689
- - - - -
83ea696b by Ben Gamari at 2019-06-18T13:29:32Z
SafeHaskell: Don't throw -Wsafe warning if module is declared Safe
Fixes #16689.
- - - - -
0e93135d by Ben Gamari at 2019-06-18T13:29:32Z
hadrian: Compile UserSettings with -O0
This guarantees that the interface file for `UserSettings` doesn't
contain any unfoldings, ensuring that a change in it requires minimal
rebuilds.
- - - - -
6d4bc51f by Ben Gamari at 2019-06-18T13:29:32Z
testsuite: Add test for #16832
- - - - -
52078783 by Ben Gamari at 2019-06-18T13:29:33Z
gitlab-ci: Run alpine builds during nightly job
- - - - -
4c5ad18b by Andreas Klebinger at 2019-06-18T13:29:35Z
Make sure mkSplitUniqSupply stores the precomputed mask only.
mkSplitUniqSupply was lazy on the boxed char.
This caused a bunch of issues:
* The closure captured the boxed Char
* The mask was recomputed on every split of the supply.
* It also caused the allocation of MkSplitSupply to happen in it's own
(allocated) closure. The reason of which I did not further investigate.
We know force the computation of the mask inside mkSplitUniqSupply.
* This way the mask is computed at most once per UniqSupply creation.
* It allows ww to kick in, causing the closure to retain the unboxed
value.
Requesting Uniques in a loop is now faster by about 20%.
I did not check the impact on the overall compiler, but I added a test
to avoid regressions.
- - - - -
16 changed files:
- .gitlab-ci.yml
- HACKING.md
- compiler/basicTypes/UniqSupply.hs
- compiler/main/HscMain.hs
- ghc.mk
- hadrian/src/UserSettings.hs
- libraries/base/Control/Monad/Fix.hs
- libraries/base/Data/Ord.hs
- libraries/base/changelog.md
- + testsuite/tests/perf/should_run/UniqLoop.hs
- testsuite/tests/perf/should_run/all.T
- + testsuite/tests/safeHaskell/safeInfered/T16689.hs
- testsuite/tests/safeHaskell/safeInfered/all.T
- + testsuite/tests/typecheck/should_compile/T16832.hs
- + testsuite/tests/typecheck/should_compile/T16832.script
- testsuite/tests/typecheck/should_compile/all.T
Changes:
=====================================
.gitlab-ci.yml
=====================================
@@ -2,7 +2,7 @@ variables:
GIT_SSL_NO_VERIFY: "1"
# Commit of ghc/ci-images repository from which to pull Docker images
- DOCKER_REV: 88e952f165f48cfb956ac9a2486a9263aa4f777c
+ DOCKER_REV: e517150438cd9df9564fb91adc4b42e2667b2bc1
# Sequential version number capturing the versions of all tools fetched by
# .gitlab/win32-init.sh.
@@ -24,7 +24,7 @@ stages:
- full-build # Build all the things
- cleanup # See Note [Cleanup after the shell executor]
- packaging # Source distribution, etc.
- - hackage # head.hackage testing
+ - testing # head.hackage correctness and compiler performance testing
- deploy # push documentation
# N.B.Don't run on wip/ branches, instead on run on merge requests.
@@ -580,7 +580,7 @@ release-x86_64-linux-deb8:
# x86_64-linux-alpine
#################################
-release-x86_64-linux-alpine:
+.build-x86_64-linux-alpine:
extends: .validate-linux
stage: full-build
image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine:$DOCKER_REV"
@@ -592,14 +592,23 @@ release-x86_64-linux-alpine:
BIN_DIST_PREP_TAR_COMP: "bindistprep/ghc-x86_64-alpine-linux.tar.xz"
# Can't use ld.gold due to #13958.
CONFIGURE_ARGS: "--disable-ld-override"
- only:
- - tags
cache:
key: linux-x86_64-alpine
artifacts:
when: always
expire_in: 2 week
+release-x86_64-linux-alpine:
+ extends: .build-x86_64-linux-alpine
+ only:
+ - tags
+
+nightly-x86_64-linux-alpine:
+ extends: .build-x86_64-linux-alpine
+ only:
+ variables:
+ - $NIGHTLY
+
#################################
# x86_64-linux-centos7
#################################
@@ -903,7 +912,7 @@ source-tarball:
.hackage:
<<: *only-default
- stage: hackage
+ stage: testing
image: ghcci/x86_64-linux-deb9:0.2
tags:
- x86_64-linux
@@ -929,6 +938,47 @@ nightly-hackage:
variables:
- $NIGHTLY
+############################################################
+# Nofib testing
+############################################################
+
+perf-nofib:
+ stage: testing
+ dependencies:
+ - release-x86_64-linux-deb9-dwarf
+ image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV"
+ only:
+ refs:
+ - merge_requests
+ - master
+ - /ghc-[0-9]+\.[0-9]+/
+ tags:
+ - x86_64-linux
+ script:
+ - root=$(pwd)/ghc
+ - |
+ mkdir tmp
+ tar -xf ghc-*-x86_64-unknown-linux.tar.xz -C tmp
+ pushd tmp/ghc-*/
+ ./configure --prefix=$root
+ make install
+ popd
+ rm -Rf tmp
+ - export BOOT_HC=$(which ghc)
+ - cabal update; cabal install -w $BOOT_HC regex-compat
+ - export PATH=$root/bin:$PATH
+ - make -C nofib boot mode=fast -j$CPUS
+ - "make -C nofib EXTRA_RUNTEST_OPTS='-cachegrind +RTS -V0 -RTS' NoFibRuns=1 mode=fast -j$CPUS 2>&1 | tee nofib.log"
+ artifacts:
+ expire_in: 12 week
+ when: always
+ paths:
+ - nofib.log
+
+############################################################
+# Documentation deployment via GitLab Pages
+############################################################
+
pages:
stage: deploy
dependencies:
=====================================
HACKING.md
=====================================
@@ -86,10 +86,21 @@ read over this page carefully:
<https://gitlab.haskell.org/ghc/ghc/wikis/building/using>
+A web based code explorer for the GHC source code with semantic analysis
+and type information of the GHC sources is available at:
+
+<https://haskell-code-explorer.mfix.io/>
+
+Look for `GHC` in `Package-name`. For example, here is the link to
+[GHC-8.6.5](https://haskell-code-explorer.mfix.io/package/ghc-8.6.5).
+
+
+
If you want to watch issues and code review activities, the following page is a good start:
<https://gitlab.haskell.org/ghc/ghc/activity>
+
How to communicate with us
==========================
=====================================
compiler/basicTypes/UniqSupply.hs
=====================================
@@ -6,6 +6,7 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE BangPatterns #-}
#if !defined(GHC_LOADED_INTO_GHCI)
{-# LANGUAGE UnboxedTuples #-}
@@ -88,7 +89,7 @@ takeUniqFromSupply :: UniqSupply -> (Unique, UniqSupply)
mkSplitUniqSupply c
= case ord c `shiftL` uNIQUE_BITS of
- mask -> let
+ !mask -> let
-- here comes THE MAGIC:
-- This is one of the most hammered bits in the whole compiler
=====================================
compiler/main/HscMain.hs
=====================================
@@ -520,7 +520,9 @@ tcRnModule' sum save_rn_syntax mod = do
safe <- liftIO $ fst <$> readIORef (tcg_safeInfer tcg_res')
when safe $ do
case wopt Opt_WarnSafe dflags of
- True -> (logWarnings $ unitBag $
+ True
+ | safeHaskell dflags == Sf_Safe -> return ()
+ | otherwise -> (logWarnings $ unitBag $
makeIntoWarning (Reason Opt_WarnSafe) $
mkPlainWarnMsg dflags (warnSafeOnLoc dflags) $
errSafe tcg_res')
=====================================
ghc.mk
=====================================
@@ -1306,6 +1306,7 @@ CLEAN_FILES += includes/DerivedConstants.h
CLEAN_FILES += includes/ghcautoconf.h
CLEAN_FILES += includes/ghcplatform.h
CLEAN_FILES += includes/ghcversion.h
+CLEAN_FILES += $(includes_SETTINGS)
CLEAN_FILES += utils/ghc-pkg/Version.hs
CLEAN_FILES += compiler/prelude/primops.txt
CLEAN_FILES += $(wildcard compiler/primop*incl)
=====================================
hadrian/src/UserSettings.hs
=====================================
@@ -1,3 +1,6 @@
+-- Ensure we don't expose any unfoldings to guarantee quick rebuilds
+{-# OPTIONS_GHC -O0 #-}
+
-- If you want to customise your build you should copy this file from
-- hadrian/src/UserSettings.hs to hadrian/UserSettings.hs and edit your copy.
-- If you don't copy the file your changes will be tracked by git and you can
=====================================
libraries/base/Control/Monad/Fix.hs
=====================================
@@ -156,4 +156,3 @@ instance (MonadFix f, MonadFix g) => MonadFix (f :*: g) where
-- | @since 4.12.0.0
instance MonadFix Down where
mfix f = Down (fix (getDown . f))
- where getDown (Down x) = x
=====================================
libraries/base/Data/Ord.hs
=====================================
@@ -7,7 +7,7 @@
-- Module : Data.Ord
-- Copyright : (c) The University of Glasgow 2005
-- License : BSD-style (see the file libraries/base/LICENSE)
---
+--
-- Maintainer : libraries at haskell.org
-- Stability : stable
-- Portability : portable
@@ -23,12 +23,18 @@ module Data.Ord (
comparing,
) where
+import Data.Bits (Bits, FiniteBits)
+import Foreign.Storable (Storable)
+import GHC.Arr (Ix)
import GHC.Base
-import GHC.Show
-import GHC.Read
+import GHC.Enum (Bounded, Enum)
+import GHC.Float (Floating, RealFloat)
import GHC.Num
+import GHC.Read
+import GHC.Real (Fractional, Integral, Real, RealFrac)
+import GHC.Show
--- |
+-- |
-- > comparing p x y = compare (p x) (p y)
--
-- Useful combinator for use in conjunction with the @xxxBy@ family
@@ -46,16 +52,44 @@ comparing p x y = compare (p x) (p y)
-- as in: @then sortWith by 'Down' x@
--
-- @since 4.6.0.0
-newtype Down a = Down a
+newtype Down a = Down
+ { getDown :: a -- ^ @since 4.14.0.0
+ }
deriving
( Eq -- ^ @since 4.6.0.0
- , Show -- ^ @since 4.7.0.0
- , Read -- ^ @since 4.7.0.0
, Num -- ^ @since 4.11.0.0
, Semigroup -- ^ @since 4.11.0.0
, Monoid -- ^ @since 4.11.0.0
+ , Bits -- ^ @since 4.14.0.0
+ , Bounded -- ^ @since 4.14.0.0
+ , Enum -- ^ @since 4.14.0.0
+ , FiniteBits -- ^ @since 4.14.0.0
+ , Floating -- ^ @since 4.14.0.0
+ , Fractional -- ^ @since 4.14.0.0
+ , Integral -- ^ @since 4.14.0.0
+ , Ix -- ^ @since 4.14.0.0
+ , Real -- ^ @since 4.14.0.0
+ , RealFrac -- ^ @since 4.14.0.0
+ , RealFloat -- ^ @since 4.14.0.0
+ , Storable -- ^ @since 4.14.0.0
)
+-- | This instance would be equivalent to the derived instances of the
+-- 'Down' newtype if the 'getDown' field were removed
+--
+-- @since 4.7.0.0
+instance (Read a) => Read (Down a) where
+ readsPrec d = readParen (d > 10) $ \ r ->
+ [(Down x,t) | ("Down",s) <- lex r, (x,t) <- readsPrec 11 s]
+
+-- | This instance would be equivalent to the derived instances of the
+-- 'Down' newtype if the 'getDown' field were removed
+--
+-- @since 4.7.0.0
+instance (Show a) => Show (Down a) where
+ showsPrec d (Down x) = showParen (d > 10) $
+ showString "Down " . showsPrec 11 x
+
-- | @since 4.6.0.0
instance Ord a => Ord (Down a) where
compare (Down x) (Down y) = y `compare` x
=====================================
libraries/base/changelog.md
=====================================
@@ -5,6 +5,12 @@
* Add a `TestEquality` instance for the `Compose` newtype.
+ * `Data.Ord.Down` now has a field name, `getDown`
+
+ * Add `Bits`, `Bounded`, `Enum`, `FiniteBits`, `Floating`, `Fractional`,
+ `Integral`, `Ix`, `Real`, `RealFrac`, `RealFloat` and `Storable` instances
+ to `Data.Ord.Down`.
+
* Fix the `integer-gmp` variant of `isValidNatural`: Previously it would fail
to detect values `<= maxBound::Word` that were incorrectly encoded using
the `NatJ#` constructor.
=====================================
testsuite/tests/perf/should_run/UniqLoop.hs
=====================================
@@ -0,0 +1,17 @@
+{-# LANGUAGE BangPatterns #-}
+
+module Main where
+
+import UniqSupply
+import Unique
+
+-- Generate a lot of uniques
+main = do
+ us <- mkSplitUniqSupply 'v'
+ seq (churn us 10000000) (return ())
+
+churn :: UniqSupply -> Int -> Int
+churn !us 0 = getKey $ uniqFromSupply us
+churn us n =
+ let (!x,!us') = takeUniqFromSupply us
+ in churn us' (n-1)
=====================================
testsuite/tests/perf/should_run/all.T
=====================================
@@ -367,3 +367,11 @@ test('T15578',
only_ways(['normal'])],
compile_and_run,
['-O2'])
+
+# Test performance of creating Uniques.
+test('UniqLoop',
+ [collect_stats('bytes allocated',5),
+ only_ways(['normal'])
+ ],
+ compile_and_run,
+ ['-O -package ghc'])
\ No newline at end of file
=====================================
testsuite/tests/safeHaskell/safeInfered/T16689.hs
=====================================
@@ -0,0 +1,4 @@
+{-# LANGUAGE Safe #-}
+
+main = return ()
+
=====================================
testsuite/tests/safeHaskell/safeInfered/all.T
=====================================
@@ -64,3 +64,5 @@ test('UnsafeWarn07', normal, compile, [''])
# Chck -fwa-safe works
test('SafeWarn01', normal, compile, [''])
+test('T16689', normal, compile, ['-Wsafe'])
+
=====================================
testsuite/tests/typecheck/should_compile/T16832.hs
=====================================
@@ -0,0 +1,40 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE EmptyCase #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE InstanceSigs #-}
+
+module WorkingGenerics where
+import GHC.Generics
+
+-- type family DiffT (p :: * -> *) :: * -> *
+
+data Void deriving(Generic)
+
+class Diff a where
+ type family Patch a :: *
+ type Patch a = GPatch (Rep a) a
+
+ diff :: a -> a -> Patch a
+ default diff :: (Generic a, GDiff (Rep a), Patch a ~ (GPatch (Rep a)) a) => a -> a -> Patch a
+ diff a a' = gdiff (from a) (from a')
+
+class GDiff (gen :: * -> *) where
+ type family GPatch gen :: * -> *
+ gdiff :: gen a -> gen a -> (GPatch gen) a
+
+instance GDiff V1 where
+ type GPatch V1 = V1
+ gdiff v1 _ = undefined
+
+-- meta info, we simply tunnel through
+instance (GDiff f) => GDiff (M1 i t f) where
+ type GPatch (M1 i t f) = M1 i t (GPatch f)
+ gdiff (M1 x) (M1 x') = M1 $ gdiff x x'
+
+
+instance Diff Void
+
=====================================
testsuite/tests/typecheck/should_compile/T16832.script
=====================================
@@ -0,0 +1,2 @@
+:load T16832
+
=====================================
testsuite/tests/typecheck/should_compile/all.T
=====================================
@@ -682,3 +682,4 @@ test('UnliftedNewtypesForall', normal, compile, [''])
test('UnlifNewUnify', normal, compile, [''])
test('UnliftedNewtypesLPFamily', normal, compile, [''])
test('UnliftedNewtypesDifficultUnification', normal, compile, [''])
+test('T16832', normal, ghci_script, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/a674f4ef8185cb4a18c16213c00467b78449f065...4c5ad18bad897fe062ea4e6f209f510b7be38ad7
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/a674f4ef8185cb4a18c16213c00467b78449f065...4c5ad18bad897fe062ea4e6f209f510b7be38ad7
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20190618/8d213644/attachment-0001.html>
More information about the ghc-commits
mailing list