[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: add an --hadrian mode to ./validate
Marge Bot
gitlab at gitlab.haskell.org
Thu May 23 09:11:10 UTC 2019
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
641c2212 by Alp Mestanogullari at 2019-05-23T09:10:57Z
add an --hadrian mode to ./validate
When the '--hadrian' flag is passed to the validate script, we use hadrian
to build GHC, package it up in a binary distribution and later on run GHC's
testsuite against the said bindist, which gets installed locally in the process.
Along the way, this commit fixes a typo, an omission (build iserv binaries
before producing the bindist archive) and moves the Makefile that enables
'make install' on those bindists from being a list of strings in the code to
an actual file (it was becoming increasingly annoying to work with).
Finally, the Settings.Builders.Ghc part of this patch is necessary for being
able to use the installed binary distribution, in 'validate'.
- - - - -
8a5c2ff2 by Iavor Diatchki at 2019-05-23T09:10:59Z
Add a `NOINLINE` pragma on `someNatVal` (#16586)
This fixes #16586, see `Note [NOINLINE someNatVal]` for details.
- - - - -
12d29ae4 by Moritz Angermann at 2019-05-23T09:11:00Z
Lowercase windows imports
While windows and macOS are currently on case-insensitive file
systems, this poses no issue on those. When cross compiling from
linux with a case sensitive file system and mingw providing only
lowercase headers, this in fact produces an issue. As such we just
lowercase the import headers, which should still work fine on a
case insensitive file system and also enable mingw's headers to
be usable porperly.
- - - - -
918586c3 by Moritz Angermann at 2019-05-23T09:11:00Z
Add `keepCAFs` to RtsSymbols
- - - - -
f642ac7d by Joshua Price at 2019-05-23T09:11:01Z
Correct the large tuples section in user's guide
Fixes #16644.
- - - - -
e3160ff9 by Krzysztof Gogolewski at 2019-05-23T09:11:02Z
Fix tcfail158 (#15899)
As described in #15899, this test was broken, but now it's back
to normal.
- - - - -
61fff2c1 by Sebastian Graf at 2019-05-23T09:11:02Z
Add a pprTraceWith function
- - - - -
7230c447 by Jasper Van der Jeugt at 2019-05-23T09:11:03Z
Fix padding of entries in .prof files
When the number of entries of a cost centre reaches 11 digits, it takes
up the whole space reserved for it and the prof file ends up looking
like:
... no. entries %time %alloc %time %alloc
...
... 120918 978250 0.0 0.0 0.0 0.0
... 118891 0 0.0 0.0 73.3 80.8
... 11890229702412351 8.9 13.5 73.3 80.8
... 118903 153799689 0.0 0.1 0.0 0.1
...
This results in tooling not being able to parse the .prof file. I
realise we have the JSON output as well now, but still it'd be good to
fix this little weirdness.
Original bug report and full prof file can be seen here:
<https://github.com/jaspervdj/profiteur/issues/28>.
- - - - -
18 changed files:
- compiler/utils/Outputable.hs
- docs/users_guide/bugs.rst
- driver/utils/dynwrapper.c
- + hadrian/bindist/Makefile
- hadrian/src/CommandLine.hs
- hadrian/src/Rules/BinaryDist.hs
- hadrian/src/Settings/Builders/Ghc.hs
- libraries/base/GHC/TypeLits.hs
- libraries/base/GHC/TypeNats.hs
- rts/ProfilerReport.c
- rts/RtsSymbols.c
- rules/build-prog.mk
- + testsuite/tests/lib/base/T16586.hs
- + testsuite/tests/lib/base/T16586.stdout
- + testsuite/tests/lib/base/all.T
- testsuite/tests/typecheck/should_fail/all.T
- testsuite/tests/typecheck/should_fail/tcfail158.stderr
- validate
Changes:
=====================================
compiler/utils/Outputable.hs
=====================================
@@ -81,8 +81,8 @@ module Outputable (
-- * Error handling and debugging utilities
pprPanic, pprSorry, assertPprPanic, pprPgmError,
- pprTrace, pprTraceDebug, pprTraceIt, warnPprTrace, pprSTrace,
- pprTraceException, pprTraceM,
+ pprTrace, pprTraceDebug, pprTraceWith, pprTraceIt, warnPprTrace,
+ pprSTrace, pprTraceException, pprTraceM,
trace, pgmError, panic, sorry, assertPanic,
pprDebugAndThen, callStackDoc,
) where
@@ -1196,9 +1196,15 @@ pprTrace str doc x
pprTraceM :: Applicative f => String -> SDoc -> f ()
pprTraceM str doc = pprTrace str doc (pure ())
+-- | @pprTraceWith desc f x@ is equivalent to @pprTrace desc (f x) x at .
+-- This allows you to print details from the returned value as well as from
+-- ambient variables.
+pprTraceWith :: Outputable a => String -> (a -> SDoc) -> a -> a
+pprTraceWith desc f x = pprTrace desc (f x) x
+
-- | @pprTraceIt desc x@ is equivalent to @pprTrace desc (ppr x) x@
pprTraceIt :: Outputable a => String -> a -> a
-pprTraceIt desc x = pprTrace desc (ppr x) x
+pprTraceIt desc x = pprTraceWith desc ppr x
-- | @pprTraceException desc x action@ runs action, printing a message
-- if it throws an exception.
=====================================
docs/users_guide/bugs.rst
=====================================
@@ -312,14 +312,6 @@ Multiply-defined array elements not checked
In ``Prelude`` support
^^^^^^^^^^^^^^^^^^^^^^
-Arbitrary-sized tuples
- Tuples are currently limited to size 100. However, standard
- instances for tuples (``Eq``, ``Ord``, ``Bounded``, ``Ix``, ``Read``,
- and ``Show``) are available *only* up to 16-tuples.
-
- This limitation is easily subvertible, so please ask if you get
- stuck on it.
-
``splitAt`` semantics
``Data.List.splitAt`` is more strict than specified in the Report.
Specifically, the Report specifies that ::
@@ -481,6 +473,14 @@ Unchecked floating-point arithmetic
.. index::
single: floating-point exceptions.
+Large tuple support
+ The Haskell Report only requires implementations to provide tuple
+ types and their accompanying standard instances up to size 15. GHC
+ limits the size of tuple types to 62 and provides instances of
+ ``Eq``, ``Ord``, ``Bounded``, ``Read``, and ``Show`` for tuples up
+ to size 15. However, ``Ix`` instances are provided only for tuples
+ up to size 5.
+
.. _bugs:
Known bugs or infelicities
=====================================
driver/utils/dynwrapper.c
=====================================
@@ -9,8 +9,8 @@ int rtsOpts;
#include <stdarg.h>
#include <stdio.h>
-#include <Windows.h>
-#include <Shlwapi.h>
+#include <windows.h>
+#include <shlwapi.h>
#include "Rts.h"
=====================================
hadrian/bindist/Makefile
=====================================
@@ -0,0 +1,146 @@
+MAKEFLAGS += --no-builtin-rules
+.SUFFIXES:
+
+include mk/install.mk
+include mk/config.mk
+
+.PHONY: default
+default:
+ @echo 'Run "make install" to install'
+ @false
+
+#-----------------------------------------------------------------------
+# INSTALL RULES
+
+# Hacky function to check equality of two strings
+# TODO : find if a better function exists
+eq=$(and $(findstring $(1),$(2)),$(findstring $(2),$(1)))
+
+define installscript
+# $1 = package name
+# $2 = wrapper path
+# $3 = bindir
+# $4 = ghcbindir
+# $5 = Executable binary path
+# $6 = Library Directory
+# $7 = Docs Directory
+# $8 = Includes Directory
+# We are installing wrappers to programs by searching corresponding
+# wrappers. If wrapper is not found, we are attaching the common wrapper
+# to it. This implementation is a bit hacky and depends on consistency
+# of program names. For hadrian build this will work as programs have a
+# consistent naming procedure.
+ rm -f '$2'
+ $(CREATE_SCRIPT) '$2'
+ @echo "#!$(SHELL)" >> '$2'
+ @echo "exedir=\"$4\"" >> '$2'
+ @echo "exeprog=\"$1\"" >> '$2'
+ @echo "executablename=\"$5\"" >> '$2'
+ @echo "bindir=\"$3\"" >> '$2'
+ @echo "libdir=\"$6\"" >> '$2'
+ @echo "docdir=\"$7\"" >> '$2'
+ @echo "includedir=\"$8\"" >> '$2'
+ @echo "" >> '$2'
+ cat wrappers/$1 >> '$2'
+ $(EXECUTABLE_FILE) '$2' ;
+endef
+
+# Hacky function to patch up the 'haddock-interfaces' and 'haddock-html'
+# fields in the package .conf files
+define patchpackageconf
+#
+# $1 = package name (ex: 'bytestring')
+# $2 = path to .conf file
+# $3 = Docs Directory
+# $4 = (relative) path from $${pkgroot} to docs directory ($3)
+#
+# We fix the paths to haddock files by using the relative path from the pkgroot
+# to the doc files.
+ cat '$2' | sed 's|haddock-interfaces.*|haddock-interfaces: "$${pkgroot}/$4/html/libraries/$1/$1.haddock"|' \
+ | sed 's|haddock-html.*|haddock-html: "$${pkgroot}/$4/html/libraries/$1"|' \
+ | sed 's| $${pkgroot}/../../docs/html/.*||' \
+ > '$2.copy'
+# The rts package doesn't actually supply haddocks, so we stop advertising them
+# altogether.
+ ((echo "$1" | grep rts) && (cat '$2.copy' | sed 's|haddock-.*||' > '$2.copy.copy')) || (cat '$2.copy' > '$2.copy.copy')
+# We finally replace the original file.
+ mv '$2.copy.copy' '$2'
+endef
+
+# QUESTION : should we use shell commands?
+
+
+.PHONY: install
+install: install_lib install_bin install_includes
+install: install_docs install_wrappers install_ghci
+install: install_mingw update_package_db
+
+ActualBinsDir=${ghclibdir}/bin
+ActualLibsDir=${ghclibdir}/lib
+WrapperBinsDir=${bindir}
+
+# We need to install binaries relative to libraries.
+BINARIES = $(wildcard ./bin/*)
+install_bin:
+ @echo "Copying binaries to $(ActualBinsDir)"
+ $(INSTALL_DIR) "$(ActualBinsDir)"
+ for i in $(BINARIES); do \
+ cp -R $$i "$(ActualBinsDir)"; \
+ done
+
+install_ghci:
+ @echo "Copying and installing ghci"
+ $(CREATE_SCRIPT) '$(WrapperBinsDir)/ghci'
+ @echo "#!$(SHELL)" >> '$(WrapperBinsDir)/ghci'
+ cat wrappers/ghci-script >> '$(WrapperBinsDir)/ghci'
+ $(EXECUTABLE_FILE) '$(WrapperBinsDir)/ghci'
+
+LIBRARIES = $(wildcard ./lib/*)
+install_lib:
+ @echo "Copying libraries to $(ActualLibsDir)"
+ $(INSTALL_DIR) "$(ActualLibsDir)"
+ for i in $(LIBRARIES); do \
+ cp -R $$i "$(ActualLibsDir)/"; \
+ done
+
+INCLUDES = $(wildcard ./include/*)
+install_includes:
+ @echo "Copying libraries to $(includedir)"
+ $(INSTALL_DIR) "$(includedir)"
+ for i in $(INCLUDES); do \
+ cp -R $$i "$(includedir)/"; \
+ done
+
+DOCS = $(wildcard ./docs/*)
+install_docs:
+ @echo "Copying libraries to $(docdir)"
+ $(INSTALL_DIR) "$(docdir)"
+ for i in $(DOCS); do \
+ cp -R $$i "$(docdir)/"; \
+ done
+
+BINARY_NAMES=$(shell ls ./wrappers/)
+install_wrappers:
+ @echo "Installing Wrapper scripts"
+ $(INSTALL_DIR) "$(WrapperBinsDir)"
+ $(foreach p, $(BINARY_NAMES),\
+ $(call installscript,$p,$(WrapperBinsDir)/$p,$(WrapperBinsDir),$(ActualBinsDir),$(ActualBinsDir)/$p,$(ActualLibsDir),$(docdir),$(includedir)))
+
+PKG_CONFS = $(shell find "$(ActualLibsDir)/package.conf.d" -name '*.conf' | sed 's: :xxx:g')
+update_package_db:
+ @echo "$(PKG_CONFS)"
+ @echo "Updating the package DB"
+ $(foreach p, $(PKG_CONFS),\
+ $(call patchpackageconf,$(shell echo $(notdir $p) | sed 's/-\([0-9]*[0-9]\.\)*conf//g'),$(shell echo "$p" | sed 's:xxx: :g'),$(docdir),$(shell realpath --relative-to="$(libdir)" "$(docdir)")))
+ '$(WrapperBinsDir)/ghc-pkg' recache
+
+# The 'foreach' that copies the mingw directory will only trigger a copy
+# when the wildcard matches, therefore only on Windows.
+MINGW = $(wildcard ./mingw)
+install_mingw:
+ @echo "Installing MingGW"
+ $(INSTALL_DIR) "$(prefix)/mingw"
+ $(foreach d, $(MINGW),\
+ cp -R ./mingw "$(prefix)")
+# END INSTALL
+# ----------------------------------------------------------------------
=====================================
hadrian/src/CommandLine.hs
=====================================
@@ -146,7 +146,7 @@ readTestConfig config =
readTestConfigFile :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
readTestConfigFile filepath =
- maybe (Left "Cannot parse test-speed") (Right . set) filepath
+ maybe (Left "Cannot parse test-config-file") (Right . set) filepath
where
set filepath flags = flags { testArgs = (testArgs flags) { testConfigFile = filepath } }
=====================================
hadrian/src/Rules/BinaryDist.hs
=====================================
@@ -101,6 +101,7 @@ bindistRules = do
-- We 'need' all binaries and libraries
targets <- mapM pkgTarget =<< stagePackages Stage1
need targets
+ needIservBins
version <- setting ProjectVersion
targetPlatform <- setting TargetPlatformFull
@@ -180,8 +181,9 @@ bindistRules = do
moveFile (ghcRoot -/- "distrib" -/- "configure") configurePath
-- Generate the Makefile that enables the "make install" part
- root -/- "bindist" -/- "ghc-*" -/- "Makefile" %> \makefilePath ->
- writeFile' makefilePath bindistMakefile
+ root -/- "bindist" -/- "ghc-*" -/- "Makefile" %> \makefilePath -> do
+ top <- topDirectory
+ copyFile (top -/- "hadrian" -/- "bindist" -/- "Makefile") makefilePath
root -/- "bindist" -/- "ghc-*" -/- "wrappers/*" %> \wrapperPath ->
writeFile' wrapperPath $ wrapper (takeFileName wrapperPath)
@@ -216,153 +218,6 @@ pkgTarget pkg
| isLibrary pkg = pkgConfFile (vanillaContext Stage1 pkg)
| otherwise = programPath =<< programContext Stage1 pkg
--- TODO: Augment this Makefile to match the various parameters that the current
--- bindist scripts support.
--- | A trivial Makefile that only takes @$prefix@ into account, and not e.g
--- @$datadir@ (for docs) and other variables, yet.
-bindistMakefile :: String
-bindistMakefile = unlines
- [ "MAKEFLAGS += --no-builtin-rules"
- , ".SUFFIXES:"
- , ""
- , "include mk/install.mk"
- , "include mk/config.mk"
- , ""
- , ".PHONY: default"
- , "default:"
- , "\t at echo 'Run \"make install\" to install'"
- , "\t at false"
- , ""
- , "#-----------------------------------------------------------------------"
- , "# INSTALL RULES"
- , ""
- , "# Hacky function to check equality of two strings"
- , "# TODO : find if a better function exists"
- , "eq=$(and $(findstring $(1),$(2)),$(findstring $(2),$(1)))"
- , ""
- , "define installscript"
- , "# $1 = package name"
- , "# $2 = wrapper path"
- , "# $3 = bindir"
- , "# $4 = ghcbindir"
- , "# $5 = Executable binary path"
- , "# $6 = Library Directory"
- , "# $7 = Docs Directory"
- , "# $8 = Includes Directory"
- , "# We are installing wrappers to programs by searching corresponding"
- , "# wrappers. If wrapper is not found, we are attaching the common wrapper"
- , "# to it. This implementation is a bit hacky and depends on consistency"
- , "# of program names. For hadrian build this will work as programs have a"
- , "# consistent naming procedure."
- , "\trm -f '$2'"
- , "\t$(CREATE_SCRIPT) '$2'"
- , "\t at echo \"#!$(SHELL)\" >> '$2'"
- , "\t at echo \"exedir=\\\"$4\\\"\" >> '$2'"
- , "\t at echo \"exeprog=\\\"$1\\\"\" >> '$2'"
- , "\t at echo \"executablename=\\\"$5\\\"\" >> '$2'"
- , "\t at echo \"bindir=\\\"$3\\\"\" >> '$2'"
- , "\t at echo \"libdir=\\\"$6\\\"\" >> '$2'"
- , "\t at echo \"docdir=\\\"$7\\\"\" >> '$2'"
- , "\t at echo \"includedir=\\\"$8\\\"\" >> '$2'"
- , "\t at echo \"\" >> '$2'"
- , "\tcat wrappers/$1 >> '$2'"
- , "\t$(EXECUTABLE_FILE) '$2' ;"
- , "endef"
- , ""
- , "# Hacky function to patch up the 'haddock-interfaces' and 'haddock-html'"
- , "# fields in the package .conf files"
- , "define patchpackageconf"
- , "# $1 = package name (ex: 'bytestring')"
- , "# $2 = path to .conf file"
- , "# $3 = Docs Directory"
- , "\tcat '$2' | sed 's|haddock-interfaces.*|haddock-interfaces: $3/html/libraries/$1/$1.haddock|' \\"
- , "\t | sed 's|haddock-html.*|haddock-html: $3/html/libraries/$1|' \\"
- , "\t > '$2.copy'"
- , "\tmv '$2.copy' '$2'"
- , "endef"
- , ""
- , "# QUESTION : should we use shell commands?"
- , ""
- , ""
- , ".PHONY: install"
- , "install: install_lib install_bin install_includes"
- , "install: install_docs install_wrappers install_ghci"
- , "install: install_mingw update_package_db"
- , ""
- , "ActualBinsDir=${ghclibdir}/bin"
- , "ActualLibsDir=${ghclibdir}/lib"
- , "WrapperBinsDir=${bindir}"
- , ""
- , "# We need to install binaries relative to libraries."
- , "BINARIES = $(wildcard ./bin/*)"
- , "install_bin:"
- , "\t at echo \"Copying binaries to $(ActualBinsDir)\""
- , "\t$(INSTALL_DIR) \"$(ActualBinsDir)\""
- , "\tfor i in $(BINARIES); do \\"
- , "\t\tcp -R $$i \"$(ActualBinsDir)\"; \\"
- , "\tdone"
- , ""
- , "install_ghci:"
- , "\t at echo \"Installing ghci wrapper\""
- , "\t at echo \"#!$(SHELL)\" > '$(WrapperBinsDir)/ghci'"
- , "\tcat wrappers/ghci-script >> '$(WrapperBinsDir)/ghci'"
- , "\t$(EXECUTABLE_FILE) '$(WrapperBinsDir)/ghci'"
- , ""
- , "LIBRARIES = $(wildcard ./lib/*)"
- , "install_lib:"
- , "\t at echo \"Copying libraries to $(ActualLibsDir)\""
- , "\t$(INSTALL_DIR) \"$(ActualLibsDir)\""
- , "\tfor i in $(LIBRARIES); do \\"
- , "\t\tcp -R $$i \"$(ActualLibsDir)/\"; \\"
- , "\tdone"
- , ""
- , "INCLUDES = $(wildcard ./include/*)"
- , "install_includes:"
- , "\t at echo \"Copying libraries to $(includedir)\""
- , "\t$(INSTALL_DIR) \"$(includedir)\""
- , "\tfor i in $(INCLUDES); do \\"
- , "\t\tcp -R $$i \"$(includedir)/\"; \\"
- , "\tdone"
- , ""
- , "DOCS = $(wildcard ./docs/*)"
- , "install_docs:"
- , "\t at echo \"Copying libraries to $(docdir)\""
- , "\t$(INSTALL_DIR) \"$(docdir)\""
- , "\tfor i in $(DOCS); do \\"
- , "\t\tcp -R $$i \"$(docdir)/\"; \\"
- , "\tdone"
- , ""
- , "BINARY_NAMES=$(shell ls ./wrappers/)"
- , "install_wrappers:"
- , "\t at echo \"Installing Wrapper scripts\""
- , "\t$(INSTALL_DIR) \"$(WrapperBinsDir)\""
- , "\t$(foreach p, $(BINARY_NAMES),\\"
- , "\t\t$(call installscript,$p,$(WrapperBinsDir)/$p," ++
- "$(WrapperBinsDir),$(ActualBinsDir),$(ActualBinsDir)/$p," ++
- "$(ActualLibsDir),$(docdir),$(includedir)))"
- , "\trm -f '$(WrapperBinsDir)/ghci-script'" -- FIXME: we shouldn't generate it in the first place
- , ""
- , "PKG_CONFS = $(wildcard $(ActualLibsDir)/package.conf.d/*)"
- , "update_package_db:"
- , "\t at echo \"Updating the package DB\""
- , "\t$(foreach p, $(PKG_CONFS),\\"
- , "\t\t$(call patchpackageconf," ++
- "$(shell echo $(notdir $p) | sed 's/-\\([0-9]*[0-9]\\.\\)*conf//g')," ++
- "$p,$(docdir)))"
- , "\t'$(WrapperBinsDir)/ghc-pkg' recache"
- , ""
- , "# The 'foreach' that copies the mingw directory will only trigger a copy"
- , "# when the wildcard matches, therefore only on Windows."
- , "MINGW = $(wildcard ./mingw)"
- , "install_mingw:"
- , "\t at echo \"Installing MingGW\""
- , "\t$(INSTALL_DIR) \"$(prefix)/mingw\""
- , "\t$(foreach d, $(MINGW),\\"
- , "\t\tcp -R ./mingw \"$(prefix)\")"
- , "# END INSTALL"
- , "# ----------------------------------------------------------------------"
- ]
-
wrapper :: FilePath -> String
wrapper "ghc" = ghcWrapper
wrapper "ghc-pkg" = ghcPkgWrapper
=====================================
hadrian/src/Settings/Builders/Ghc.hs
=====================================
@@ -97,13 +97,24 @@ ghcLinkArgs = builder (Ghc LinkHs) ? do
, arg ("-l" ++ libffiName')
]
+ -- This is the -rpath argument that is required for the bindist scenario
+ -- to work. Indeed, when you install a bindist, the actual executables
+ -- end up nested somewhere under $libdir, with the wrapper scripts
+ -- taking their place in $bindir, and 'rpath' therefore doesn't seem
+ -- to give us the right paths for such a case.
+ -- TODO: Could we get away with just one rpath...?
+ bindistRpath = "$ORIGIN" -/- ".." -/- ".." -/- originToLibsDir
+
mconcat [ dynamic ? mconcat
[ arg "-dynamic"
-- TODO what about windows?
, isLibrary pkg ? pure [ "-shared", "-dynload", "deploy" ]
- , hostSupportsRPaths ? arg ("-optl-Wl,-rpath," ++ rpath)
- -- The darwin linker doesn't support/require the -zorigin option
- , hostSupportsRPaths ? not darwin ? arg "-optl-Wl,-zorigin"
+ , hostSupportsRPaths ? mconcat
+ [ arg ("-optl-Wl,-rpath," ++ rpath)
+ , isProgram pkg ? arg ("-optl-Wl,-rpath," ++ bindistRpath)
+ -- The darwin linker doesn't support/require the -zorigin option
+ , not darwin ? arg "-optl-Wl,-zorigin"
+ ]
]
, arg "-no-auto-link-packages"
, nonHsMainPackage pkg ? arg "-no-hs-main"
=====================================
libraries/base/GHC/TypeLits.hs
=====================================
@@ -105,6 +105,9 @@ someNatVal n
-- @since 4.7.0.0
someSymbolVal :: String -> SomeSymbol
someSymbolVal n = withSSymbol SomeSymbol (SSymbol n) Proxy
+{-# NOINLINE someSymbolVal #-}
+-- For details see Note [NOINLINE someNatVal] in "GHC.TypeNats"
+-- The issue described there applies to `someSymbolVal` as well.
-- | @since 4.7.0.0
instance Eq SomeSymbol where
=====================================
libraries/base/GHC/TypeNats.hs
=====================================
@@ -78,6 +78,65 @@ data SomeNat = forall n. KnownNat n => SomeNat (Proxy n)
-- @since 4.10.0.0
someNatVal :: Natural -> SomeNat
someNatVal n = withSNat SomeNat (SNat n) Proxy
+{-# NOINLINE someNatVal #-} -- See Note [NOINLINE someNatVal]
+
+{- Note [NOINLINE someNatVal]
+
+`someNatVal` converts a natural number to an existentially quantified
+dictionary for `KnowNat` (aka `SomeNat`). The existential quantification
+is very important, as it captures the fact that we don't know the type
+statically, although we do know that it exists. Because this type is
+fully opaque, we should never be able to prove that it matches anything else.
+This is why coherence should still hold: we can manufacture a `KnownNat k`
+dictionary, but it can never be confused with a `KnownNat 33` dictionary,
+because we should never be able to prove that `k ~ 33`.
+
+But how to implement `someNatVal`? We can't quite implement it "honestly"
+because `SomeNat` needs to "hide" the type of the newly created dictionary,
+but we don't know what the actual type is! If `someNatVal` was built into
+the language, then we could manufacture a new skolem constant,
+which should behave correctly.
+
+Since extra language constructors have additional maintenance costs,
+we use a trick to implement `someNatVal` in the library. The idea is that
+instead of generating a "fresh" type for each use of `someNatVal`, we simply
+use GHC's placeholder type `Any` (of kind `Nat`). So, the elaborated
+version of the code is:
+
+ someNatVal n = withSNat @T (SomeNat @T) (SNat @T n) (Proxy @T)
+ where type T = Any Nat
+
+After inlining and simplification, this ends up looking something like this:
+
+ someNatVal n = SomeNat @T (KnownNat @T (SNat @T n)) (Proxy @T)
+ where type T = Any Nat
+
+`KnownNat` is the constructor for dictionaries for the class `KnownNat`.
+See Note [magicDictId magic] in "basicType/MkId.hs" for details on how
+we actually construct the dictionry.
+
+Note that using `Any Nat` is not really correct, as multilple calls to
+`someNatVal` would violate coherence:
+
+ type T = Any Nat
+
+ x = SomeNat @T (KnownNat @T (SNat @T 1)) (Proxy @T)
+ y = SomeNat @T (KnownNat @T (SNat @T 2)) (Proxy @T)
+
+Note that now the code has two dictionaries with the same type, `KnownNat Any`,
+but they have different implementations, namely `SNat 1` and `SNat 2`. This
+is not good, as GHC assumes coherence, and it is free to interchange
+dictionaries of the same type, but in this case this would produce an incorrect
+result. See #16586 for examples of this happening.
+
+We can avoid this problem by making the definition of `someNatVal` opaque
+and we do this by using a `NOINLINE` pragma. This restores coherence, because
+GHC can only inspect the result of `someNatVal` by pattern matching on the
+existential, which would generate a new type. This restores correctness,
+at the cost of having a little more allocation for the `SomeNat` constructors.
+-}
+
+
-- | @since 4.7.0.0
instance Eq SomeNat where
=====================================
rts/ProfilerReport.c
=====================================
@@ -233,7 +233,7 @@ logCCS(FILE *prof_file, CostCentreStack const *ccs, ProfilerTotals totals,
max_src_len - strlen_utf8(cc->srcloc), "");
fprintf(prof_file,
- " %*" FMT_Int "%11" FMT_Word64 " %5.1f %5.1f %5.1f %5.1f",
+ " %*" FMT_Int " %11" FMT_Word64 " %5.1f %5.1f %5.1f %5.1f",
max_id_len, ccs->ccsID, ccs->scc_count,
totals.total_prof_ticks == 0 ? 0.0 : ((double)ccs->time_ticks / (double)totals.total_prof_ticks * 100.0),
totals.total_alloc == 0 ? 0.0 : ((double)ccs->mem_alloc / (double)totals.total_alloc * 100.0),
=====================================
rts/RtsSymbols.c
=====================================
@@ -934,6 +934,7 @@
SymI_HasProto(load_load_barrier) \
SymI_HasProto(cas) \
SymI_HasProto(_assertFail) \
+ SymI_HasProto(keepCAFs) \
RTS_USER_SIGNALS_SYMBOLS \
RTS_INTCHAR_SYMBOLS
=====================================
rules/build-prog.mk
=====================================
@@ -230,7 +230,7 @@ endif
$1/$2/build/tmp/$$($1_$2_PROG)-inplace-wrapper.c: driver/utils/dynwrapper.c | $$$$(dir $$$$@)/.
$$(call removeFiles,$$@)
- echo '#include <Windows.h>' >> $$@
+ echo '#include <windows.h>' >> $$@
echo '#include "Rts.h"' >> $$@
echo 'LPTSTR path_dirs[] = {' >> $$@
$$(foreach d,$$($1_$2_DEP_LIB_REL_DIRS),$$(call make-command,echo ' TEXT("/../../$$d")$$(comma)' >> $$@))
@@ -243,7 +243,7 @@ $1/$2/build/tmp/$$($1_$2_PROG)-inplace-wrapper.c: driver/utils/dynwrapper.c | $$
$1/$2/build/tmp/$$($1_$2_PROG)-wrapper.c: driver/utils/dynwrapper.c | $$$$(dir $$$$@)/.
$$(call removeFiles,$$@)
- echo '#include <Windows.h>' >> $$@
+ echo '#include <windows.h>' >> $$@
echo '#include "Rts.h"' >> $$@
echo 'LPTSTR path_dirs[] = {' >> $$@
$$(foreach p,$$($1_$2_TRANSITIVE_DEP_COMPONENT_IDS),$$(call make-command,echo ' TEXT("/../lib/$$p")$$(comma)' >> $$@))
=====================================
testsuite/tests/lib/base/T16586.hs
=====================================
@@ -0,0 +1,27 @@
+{-# LANGUAGE DataKinds, PolyKinds, RankNTypes, ScopedTypeVariables #-}
+
+module Main where
+
+import Data.Proxy
+import GHC.TypeNats
+import Numeric.Natural
+
+newtype Foo (m :: Nat) = Foo { getVal :: Word }
+
+mul :: KnownNat m => Foo m -> Foo m -> Foo m
+mul mx@(Foo x) (Foo y) =
+ Foo $ x * y `rem` fromIntegral (natVal mx)
+
+pow :: KnownNat m => Foo m -> Int -> Foo m
+pow x k = iterate (`mul` x) (Foo 1) !! k
+
+modl :: (forall m. KnownNat m => Foo m) -> Natural -> Word
+modl x m = case someNatVal m of
+ SomeNat (_ :: Proxy m) -> getVal (x :: Foo m)
+
+-- Should print 1
+main :: IO ()
+main = print $ (Foo 127 `pow` 31336) `modl` 31337
+
+dummyValue :: Word
+dummyValue = (Foo 33 `pow` 44) `modl` 456
=====================================
testsuite/tests/lib/base/T16586.stdout
=====================================
@@ -0,0 +1 @@
+1
=====================================
testsuite/tests/lib/base/all.T
=====================================
@@ -0,0 +1 @@
+test('T16586', normal, compile_and_run, ['-O2'])
=====================================
testsuite/tests/typecheck/should_fail/all.T
=====================================
@@ -140,8 +140,7 @@ test('tcfail154', normal, compile_fail, [''])
test('tcfail155', normal, compile_fail, [''])
test('tcfail156', normal, compile_fail, [''])
test('tcfail157', normal, compile_fail, [''])
-# Skip tcfail158 until #15899 fixes the broken test
-test('tcfail158', skip, compile_fail, [''])
+test('tcfail158', normal, compile_fail, [''])
test('tcfail159', normal, compile_fail, [''])
test('tcfail160', normal, compile_fail, [''])
test('tcfail161', normal, compile_fail, [''])
=====================================
testsuite/tests/typecheck/should_fail/tcfail158.stderr
=====================================
@@ -1,3 +1,5 @@
-tcfail158.hs:1:1: error:
- The IO action ‘main’ is not defined in module ‘Main’
+tcfail158.hs:14:19: error:
+ • Expecting one more argument to ‘Val v’
+ Expected a type, but ‘Val v’ has kind ‘* -> *’
+ • In the type signature: bar :: forall v. Val v
=====================================
validate
=====================================
@@ -25,6 +25,7 @@ Flags:
2008-07-01: 14% slower than the default.
--quiet More pretty build log.
See Note [Default build system verbosity].
+ --hadrian Build the compiler and run the tests through hadrian.
--help shows this usage help.
validate runs 'make -j\$THREADS', where by default THREADS is the number of
@@ -54,6 +55,7 @@ be_quiet=0
# heavy cost of xz, which is the typical default. The options are defined in
# mk/config.mk.in
tar_comp=gzip
+use_hadrian=NO
while [ $# -gt 0 ]
do
@@ -82,6 +84,10 @@ do
--quiet)
be_quiet=1
;;
+ --hadrian)
+ use_hadrian=YES
+ hadrian_build_root=_validatebuild
+ ;;
--help)
show_help
exit 0;;
@@ -96,7 +102,12 @@ done
check_packages () {
if [ "$bindistdir" = "" ]
then
- ghc_pkg=inplace/bin/ghc-pkg
+ if [ "$use_hadrian" = "YES" ]
+ then
+ ghc_pkg=$hadrian_build_root/stage1/bin/ghc-pkg
+ else
+ ghc_pkg=inplace/bin/ghc-pkg
+ fi
else
ghc_pkg="$bindistdir"/bin/ghc-pkg
fi
@@ -127,26 +138,47 @@ fi
echo "using THREADS=${threads}" >&2
-if type gmake > /dev/null 2> /dev/null
+if [ "$use_hadrian" = "NO" ]
then
make="gmake"
+ if type gmake > /dev/null 2> /dev/null
+ then
+ make="gmake"
+ else
+ make="make"
+ fi
+ if [ $be_quiet -eq 1 ]; then
+ # See Note [Default build system verbosity].
+ make="$make -s"
+ fi
+ $make -C utils/checkUniques
else
- make="make"
-fi
-
-if [ $be_quiet -eq 1 ]; then
- # See Note [Default build system verbosity].
- make="$make -s"
+ # Just build hadrian.
+ hadrian/build.sh --help > /dev/null
+ cd hadrian
+ hadrian_cmd=$(cabal new-exec -- which hadrian)
+ cd ..
+ # TODO: define a hadrian Flavour that mimics
+ # mk/flavours/validate.mk and use it here
+ # Until then, we're using the default flavour.
+ hadrian="$hadrian_cmd -j$threads --build-root=$hadrian_build_root"
+ if [ $be_quiet -eq 0 ]; then
+ hadrian="$hadrian -V"
+ fi
+ echo "Hadrian command: $hadrian"
fi
-$make -C utils/checkUniques
-
if [ $testsuite_only -eq 0 ]; then
thisdir=`pwd`
if [ $no_clean -eq 0 ]; then
- $make maintainer-clean
+ if [ "$use_hadrian" = "NO" ]
+ then
+ $make maintainer-clean
+ else
+ $hadrian clean && rm -rf $hadrian_build_root
+ fi
INSTDIR="$thisdir/inst"
@@ -154,48 +186,88 @@ if [ $no_clean -eq 0 ]; then
./configure --prefix="$INSTDIR" $config_args
fi
-echo "Validating=YES" > mk/are-validating.mk
-echo "ValidateSpeed=$speed" >> mk/are-validating.mk
-echo "ValidateHpc=$hpc" >> mk/are-validating.mk
-
-# Note [Default build system verbosity].
-#
-# From https://gitlab.haskell.org/ghc/ghc/wikis/design/build-system:
-#
-# "The build system should clearly report what it's doing (and sometimes
-# why), without being too verbose. It should emit actual command lines as
-# much as possible, so that they can be inspected and cut & pasted."
-#
-# That should be the default. Only suppress commands, by setting V=0 and using
-# `make -s`, when user explicitly asks for it with `./validate --quiet`.
-if [ $be_quiet -eq 1 ]; then
- # See Note [Default build system verbosity].
- echo "V=0" >> mk/are-validating.mk # Less gunk
-fi
+if [ "$use_hadrian" = "NO" ]
+then
+ echo "Validating=YES" > mk/are-validating.mk
+ echo "ValidateSpeed=$speed" >> mk/are-validating.mk
+ echo "ValidateHpc=$hpc" >> mk/are-validating.mk
+
+ # Note [Default build system verbosity].
+ #
+ # From https://gitlab.haskell.org/ghc/ghc/wikis/design/build-system:
+ #
+ # "The build system should clearly report what it's doing (and sometimes
+ # why), without being too verbose. It should emit actual command lines as
+ # much as possible, so that they can be inspected and cut & pasted."
+ #
+ # That should be the default. Only suppress commands, by setting V=0 and using
+ # `make -s`, when user explicitly asks for it with `./validate --quiet`.
+ if [ $be_quiet -eq 1 ]; then
+ # See Note [Default build system verbosity].
+ echo "V=0" >> mk/are-validating.mk # Less gunk
+ fi
-$make -j$threads
-# For a "debug make", add "--debug=b --debug=m"
+ $make -j$threads
+ # For a "debug make", add "--debug=b --debug=m"
+else
+ # TODO: define a hadrian Flavour that mimics
+ # mk/flavours/validate.mk and use it here
+ $hadrian
+fi
check_packages post-build
+bindistdir="bindisttest/install dir"
+ghc="$bindistdir/bin/ghc"
+
# -----------------------------------------------------------------------------
# Build and test a binary distribution (not --fast)
if [ $speed != "FAST" ]; then
-
- $make binary-dist-prep TAR_COMP=$tar_comp
- $make test_bindist TEST_PREP=YES TAR_COMP=$tar_comp
-
- #
- # Install the xhtml package into the bindist.
- # This verifies that we can install a package into the
- # bindist with Cabal.
- #
- bindistdir="bindisttest/install dir"
+ if [ "$use_hadrian" = "NO" ]
+ then
+ $make binary-dist-prep TAR_COMP=$tar_comp
+ $make test_bindist TEST_PREP=YES TAR_COMP=$tar_comp
+ else
+ $hadrian binary-dist --docs=no-sphinx
+ cfgdir=$(find $hadrian_build_root/bindist/ -name 'configure' | head -1)
+ dir=$(dirname $cfgdir)
+ cd "$dir"
+ ./configure --prefix="$thisdir/$bindistdir" && make install
+ cd $thisdir
+ "$ghc" -e 'Data.Text.IO.putStrLn (Data.Text.pack "bindist test: OK")'
+ fi
check_packages post-install
- $make validate_build_xhtml BINDIST_PREFIX="$thisdir/$bindistdir"
+ if [ "$use_hadrian" = "NO" ]
+ then
+ $make validate_build_xhtml BINDIST_PREFIX="$thisdir/$bindistdir"
+ else
+ cd libraries/xhtml
+ dynamicGhc=$("../../$ghc" --info | grep "GHC Dynamic" | cut -d',' -f3 | cut -d'"' -f2)
+ if [ "$dynamicGhc" = "NO" ]
+ then
+ libFlags="--enable-shared --disable-library-vanilla"
+ else
+ libFlags="--disable-shared --enable-library-vanilla"
+ fi
+ libFlags="$libFlags --disable-library-prof"
+
+ "../../$ghc" --make Setup
+ ./Setup configure \
+ --with-ghc="$thisdir/$ghc" \
+ --with-haddock="$thisdir/$bindistdir/bin/haddock" \
+ $libFlags \
+ --global --builddir=dist-bindist \
+ --prefix="$thisdir/$bindistdir"
+ ./Setup build --builddir=dist-bindist
+ ./Setup haddock -v0 --ghc-options=-optP-P --builddir=dist-bindist
+ ./Setup install --builddir=dist-bindist
+ ./Setup clean --builddir=dist-bindist
+ rm -f Setup Setup.exe Setup.hi Setup.o
+ cd ../../
+ fi
check_packages post-xhtml
fi
@@ -229,14 +301,17 @@ case "$speed" in
SLOW)
MAKE_TEST_TARGET=slowtest
BINDIST="BINDIST=YES"
+ HADRIAN_TEST_SPEED=slow
;;
NORMAL)
MAKE_TEST_TARGET=test
BINDIST="BINDIST=YES"
+ HADRIAN_TEST_SPEED=normal
;;
FAST)
MAKE_TEST_TARGET=fasttest
BINDIST="BINDIST=NO"
+ HADRIAN_TEST_SPEED=fast
;;
esac
@@ -252,21 +327,33 @@ fi
rm -f testsuite_summary.txt testsuite_summary_stage1.txt
-# Use LOCAL=0, see Note [Running tests in /tmp].
-$make -C testsuite/tests $BINDIST $PYTHON_ARG \
- $MAKE_TEST_TARGET stage=2 LOCAL=0 $TEST_VERBOSITY THREADS=$threads \
- NO_PRINT_SUMMARY=YES SUMMARY_FILE=../../testsuite_summary.txt \
- JUNIT_FILE=../../testsuite.xml \
- 2>&1 | tee testlog
-
-# Run a few tests using the stage1 compiler.
-# See Note [Why is there no stage1 setup function?].
-# Don't use BINDIST=YES, as stage1 is not available in a bindist.
-$make -C testsuite/tests/stage1 $PYTHON_ARG \
- $MAKE_TEST_TARGET stage=1 LOCAL=0 $TEST_VERBOSITY THREADS=$threads \
- NO_PRINT_SUMMARY=YES SUMMARY_FILE=../../../testsuite_summary_stage1.txt \
- JUNIT_FILE=../../../testsuite_stage1.xml \
- 2>&1 | tee testlog-stage1
+if [ "$use_hadrian" = "NO" ]
+then
+ # Use LOCAL=0, see Note [Running tests in /tmp].
+ $make -C testsuite/tests $BINDIST $PYTHON_ARG \
+ $MAKE_TEST_TARGET stage=2 LOCAL=0 $TEST_VERBOSITY THREADS=$threads \
+ NO_PRINT_SUMMARY=YES SUMMARY_FILE=../../testsuite_summary.txt \
+ JUNIT_FILE=../../testsuite.xml \
+ 2>&1 | tee testlog
+
+ # Run a few tests using the stage1 compiler.
+ # See Note [Why is there no stage1 setup function?].
+ # Don't use BINDIST=YES, as stage1 is not available in a bindist.
+ $make -C testsuite/tests/stage1 $PYTHON_ARG \
+ $MAKE_TEST_TARGET stage=1 LOCAL=0 $TEST_VERBOSITY THREADS=$threads \
+ NO_PRINT_SUMMARY=YES SUMMARY_FILE=../../../testsuite_summary_stage1.txt \
+ JUNIT_FILE=../../../testsuite_stage1.xml \
+ 2>&1 | tee testlog-stage1
+else
+ testghc="$thisdir/$ghc"
+ arg="test --test-speed=$HADRIAN_TEST_SPEED \
+ --test-compiler=\"$testghc\" \
+ --summary=$thisdir/testsuite_summary.txt \
+ --summary-junit=$thisdir/testsuite.xml"
+ sh -c "$hadrian $arg"
+ # TODO: Run testsuite/tests/stage1 using the stage 1 compiler when
+ # BINDIST=NO.
+fi
echo
echo '==== STAGE 1 TESTS ==== '
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/c57d58556d6641aabd3d7b0d3387ad7476faab29...7230c447ae45cc8603f78a52a93b5e742a06e048
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/c57d58556d6641aabd3d7b0d3387ad7476faab29...7230c447ae45cc8603f78a52a93b5e742a06e048
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/20190523/6f0d9363/attachment-0001.html>
More information about the ghc-commits
mailing list