...
 
Commits (188)
--command utils/ghc-in-ghci/run.sh
--command ./hadrian/ghci.sh
--reload compiler
--reload ghc
--reload includes
--restart utils/ghc-in-ghci/run.sh
--restart utils/ghc-in-ghci/load-main.ghci
--restart utils/ghc-in-ghci/settings.ghci
--restart hadrian/
......@@ -123,6 +123,7 @@ _darcs/
/settings
/ghc.spec
/ghc/ghc-bin.cabal
/includes/dist/
/includes/ghcautoconf.h
/includes/ghcplatform.h
/includes/ghcversion.h
......
This diff is collapsed.
# Summary
Write a brief description of the issue.
# Steps to reproduce
Please provide a set of concrete steps to reproduce the issue.
# Expected behavior
What do you expect the reproducer described above to do?
# Environment
* GHC version used:
Optional:
* Operating System:
* System Architecture:
/label ~bug
/label ~"needs triage"
# Motivation
Briefly describe the problem your proposal solves and why this problem should
be solved.
# Proposal
Describe your proposed feature here.
/label ~"feature request"
/label ~"needs triage"
#!/usr/bin/env bash
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 )
Thank you for help in maintaining GHC's stable branch!
Please take a few moments to verify the following:
* [ ] the issue that this backport fixes is milestoned for the target release.
If you have any questions don't hesitate to open your merge request and inquire
in a comment.
/label ~backport
/milestone %8.8.1
......@@ -11,6 +11,8 @@ Please take a few moments to verify that your commits fulfill the following:
places.
* [ ] add a [testcase to the
testsuite](https://gitlab.haskell.org/ghc/ghc/wikis/building/running-tests/adding).
* [ ] if your MR affects library interfaces (e.g. changes `base`) please add
the ~"user facing" label.
If you have any questions don't hesitate to open your merge request and inquire
in a comment. If your patch isn't quite done yet please do add prefix your MR
......
......@@ -27,7 +27,8 @@ if [ ! -e $toolchain/bin/ghc ]; then
fi
if [ ! -e $toolchain/bin/cabal ]; then
curl https://www.haskell.org/cabal/release/cabal-install-2.2.0.0/cabal-install-2.2.0.0-i386-unknown-mingw32.zip > /tmp/cabal.zip
url="https://downloads.haskell.org/~cabal/cabal-install-latest/cabal-install-2.4.1.0-x86_64-unknown-mingw32.zip"
curl $url > /tmp/cabal.zip
unzip /tmp/cabal.zip
mv cabal.exe $toolchain/bin
fi
......
===============================================
The Glasgow Haskell Compiler -- version 8.2.2
===============================================
The GHC Team is pleased to announce a new minor release of GHC. This release
builds on the performance and stability improvements of 8.2.1, fixing a variety
of correctness bugs, improving error messages, and making the compiler more
portable.
Notable bug-fixes include
* A correctness issue resulting in segmentation faults in some
FFI-users (#13707, #14346)
* A correctness issue resulting in undefined behavior in some programs
using STM (#14171)
* A bug which may have manifested in segmentation faults in
out-of-memory condition (#14329)
* clearBit of Natural no longer bottoms (#13203)
* A specialisation bug resulting in exponential blowup of compilation
time in some specialisation-intensive programs (#14379)
* ghc-pkg now works even in environments with misconfigured NFS mounts
(#13945)
* GHC again supports production of position-independent executables
(#13702)
* Better error messages around kind mismatches (#11198, #12373, #13530,
#13610)
A thorough list of the changes in the release can be found in the release
notes,
https://haskell.org/ghc/docs/8.2.2/html/users_guide/8.2.2-notes.html
How to get it
~~~~~~~~~~~~~
This release can be downloaded from
https://www.haskell.org/ghc/download_ghc_8_2_2.html
For older versions see
https://www.haskell.org/ghc/
We supply binary builds in the native package format for many platforms, and the
source distribution is available from the same place.
Background
~~~~~~~~~~
Haskell is a standardized lazy functional programming language.
GHC is a state-of-the-art programming suite for Haskell. Included is an
optimising compiler generating efficient code for a variety of platforms,
together with an interactive system for convenient, quick development. The
distribution includes space and time profiling facilities, a large collection of
libraries, and support for various language extensions, including concurrency,
exceptions, and foreign language interfaces. GHC is distributed under a
BSD-style open source license.
A wide variety of Haskell related resources (tutorials, libraries,
specifications, documentation, compilers, interpreters, references, contact
information, links to research groups) are available from the Haskell home page
(see below).
On-line GHC-related resources
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Relevant URLs:
GHC home page https://www.haskell.org/ghc/
GHC developers' home page https://ghc.haskell.org/trac/ghc/
Haskell home page https://www.haskell.org/
Supported Platforms
~~~~~~~~~~~~~~~~~~~
The list of platforms we support, and the people responsible for them, is here:
https://gitlab.haskell.org/ghc/ghc/wikis/team-ghc
Ports to other platforms are possible with varying degrees of difficulty. The
Building Guide describes how to go about porting to a new platform:
https://gitlab.haskell.org/ghc/ghc/wikis/building
Developers
~~~~~~~~~~
We welcome new contributors. Instructions on accessing our source code
repository, and getting started with hacking on GHC, are available from the
GHC's developer's site:
https://ghc.haskell.org/trac/ghc/
Mailing lists
~~~~~~~~~~~~~
We run mailing lists for GHC users and bug reports; to subscribe, use the web
interfaces at
https://mail.haskell.org/cgi-bin/mailman/listinfo/glasgow-haskell-users
https://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-tickets
There are several other haskell and ghc-related mailing lists on
www.haskell.org; for the full list, see
https://mail.haskell.org/cgi-bin/mailman/listinfo
Many GHC developers hang out on #haskell on IRC:
https://www.haskell.org/haskellwiki/IRC_channel
Please report bugs using our bug tracking system. Instructions on reporting bugs
can be found here:
https://www.haskell.org/ghc/reportabug
......@@ -12,7 +12,7 @@
# RTS-like things
/rts/ @bgamari @simonmar @osa1 @Phyx @angerman
/rts/linker/ @angerman @Phyx
/rts/linker/ @angerman @Phyx @simonmar
/includes/ @bgamari @simonmar @osa1
# The compiler
......@@ -38,6 +38,7 @@
# Core libraries
/libraries/base/ @hvr
/libraries/ghci/ @simonmar
/libraries/template-haskell/ @goldfire
# Internal utilities and libraries
......
......@@ -30,7 +30,7 @@ find an overview here:
Next, clone the repository and all the associated libraries:
```
$ git clone --recursive git://git.haskell.org/ghc.git
$ git clone --recursive git@gitlab.haskell.org:ghc/ghc.git
```
On Windows, you need an extra repository containing some build tools.
......
The Glasgow Haskell Compiler
============================
[![Build Status](https://api.travis-ci.org/ghc/ghc.svg?branch=master)](http://travis-ci.org/ghc/ghc)
[![pipeline status](https://gitlab.haskell.org/ghc/ghc/badges/master/pipeline.svg?style=flat)](https://gitlab.haskell.org/ghc/ghc/commits/master)
This is the source tree for [GHC][1], a compiler and interactive
environment for the Haskell functional programming language.
......@@ -26,7 +26,7 @@ There are two ways to get a source tree:
2. *Check out the source code from git*
$ git clone --recursive git://git.haskell.org/ghc.git
$ git clone --recursive git@gitlab.haskell.org:ghc/ghc.git
Note: cloning GHC from Github requires a special setup. See [Getting a GHC
repository from Github][7].
......
......@@ -288,11 +288,31 @@ AC_DEFUN([FPTOOLS_SET_HASKELL_PLATFORM_VARS],
esac
}
dnl Note [autoconf assembler checks and -flto]
dnl ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
dnl
dnl Autoconf's AC_COMPILE_IFELSE macro is fragile in the case of checks
dnl which require that the assembler is run. Specifically, GCC does not run
dnl the assembler if invoked with `-c -flto`; it merely dumps its internal
dnl AST to the object file, to be compiled and assembled during the final
dnl link.
dnl
dnl This can cause configure checks like that for the
dnl .subsections_via_symbols directive to pass unexpected (see #16440),
dnl leading the build system to incorrectly conclude that the directive is
dnl supported.
dnl
dnl For this reason, it is important that configure checks that rely on the
dnl assembler failing use AC_LINK_IFELSE rather than AC_COMPILE_IFELSE,
dnl ensuring that the assembler sees the check.
dnl
dnl ** check for Apple-style dead-stripping support
dnl (.subsections-via-symbols assembler directive)
AC_MSG_CHECKING(for .subsections_via_symbols)
AC_COMPILE_IFELSE(
dnl See Note [autoconf assembler checks and -flto]
AC_LINK_IFELSE(
[AC_LANG_PROGRAM([], [__asm__ (".subsections_via_symbols");])],
[AC_MSG_RESULT(yes)
HaskellHaveSubsectionsViaSymbols=True
......@@ -305,8 +325,9 @@ AC_DEFUN([FPTOOLS_SET_HASKELL_PLATFORM_VARS],
dnl ** check for .ident assembler directive
AC_MSG_CHECKING(whether your assembler supports .ident directive)
AC_COMPILE_IFELSE(
[AC_LANG_SOURCE([__asm__ (".ident \"GHC x.y.z\"");])],
dnl See Note [autoconf assembler checks and -flto]
AC_LINK_IFELSE(
[AC_LANG_PROGRAM([__asm__ (".ident \"GHC x.y.z\"");], [])],
[AC_MSG_RESULT(yes)
HaskellHaveIdentDirective=True],
[AC_MSG_RESULT(no)
......@@ -330,8 +351,15 @@ AC_DEFUN([FPTOOLS_SET_HASKELL_PLATFORM_VARS],
;;
esac
AC_MSG_CHECKING(for GNU non-executable stack support)
AC_COMPILE_IFELSE(
[AC_LANG_PROGRAM([__asm__ (".section .note.GNU-stack,\"\",$progbits");], [0])],
dnl See Note [autoconf assembler checks and -flto]
AC_LINK_IFELSE(
dnl the `main` function is placed after the .note.GNU-stack directive
dnl so we need to ensure that the active segment is correctly set,
dnl otherwise `main` will be placed in the wrong segment.
[AC_LANG_PROGRAM([
__asm__ (".section .note.GNU-stack,\"\",$progbits");
__asm__ (".section .text");
], [0])],
[AC_MSG_RESULT(yes)
HaskellHaveGnuNonexecStack=True],
[AC_MSG_RESULT(no)
......@@ -469,16 +497,16 @@ AC_DEFUN([FP_SETTINGS],
[
if test "$windows" = YES -a "$EnableDistroToolchain" = "NO"
then
mingw_bin_prefix=mingw/bin/
SettingsCCompilerCommand="\$tooldir/${mingw_bin_prefix}gcc.exe"
SettingsHaskellCPPCommand="\$tooldir/${mingw_bin_prefix}gcc.exe"
mingw_bin_prefix='$$tooldir/mingw/bin/'
SettingsCCompilerCommand="${mingw_bin_prefix}gcc.exe"
SettingsHaskellCPPCommand="${mingw_bin_prefix}gcc.exe"
SettingsHaskellCPPFlags="$HaskellCPPArgs"
SettingsLdCommand="\$tooldir/${mingw_bin_prefix}ld.exe"
SettingsArCommand="\$tooldir/${mingw_bin_prefix}ar.exe"
SettingsRanlibCommand="\$tooldir/${mingw_bin_prefix}ranlib.exe"
SettingsDllWrapCommand="\$tooldir/${mingw_bin_prefix}dllwrap.exe"
SettingsWindresCommand="\$tooldir/${mingw_bin_prefix}windres.exe"
SettingsTouchCommand='$topdir/bin/touchy.exe'
SettingsLdCommand="${mingw_bin_prefix}ld.exe"
SettingsArCommand="${mingw_bin_prefix}ar.exe"
SettingsRanlibCommand="${mingw_bin_prefix}ranlib.exe"
SettingsDllWrapCommand="${mingw_bin_prefix}dllwrap.exe"
SettingsWindresCommand="${mingw_bin_prefix}windres.exe"
SettingsTouchCommand='$$topdir/bin/touchy.exe'
elif test "$EnableDistroToolchain" = "YES"
then
SettingsCCompilerCommand="$(basename $CC)"
......@@ -489,7 +517,7 @@ AC_DEFUN([FP_SETTINGS],
SettingsArCommand="$(basename $ArCmd)"
SettingsDllWrapCommand="$(basename $DllWrapCmd)"
SettingsWindresCommand="$(basename $WindresCmd)"
SettingsTouchCommand='$topdir/bin/touchy.exe'
SettingsTouchCommand='$$topdir/bin/touchy.exe'
else
SettingsCCompilerCommand="$CC"
SettingsHaskellCPPCommand="$HaskellCPPCmd"
......@@ -923,8 +951,8 @@ changequote([, ])dnl
])
if test ! -f compiler/parser/Parser.hs || test ! -f compiler/cmm/CmmParse.hs
then
FP_COMPARE_VERSIONS([$fptools_cv_happy_version],[-lt],[1.19.4],
[AC_MSG_ERROR([Happy version 1.19.4 or later is required to compile GHC.])])[]
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.])])[]
fi
HappyVersion=$fptools_cv_happy_version;
AC_SUBST(HappyVersion)
......
......@@ -50,7 +50,7 @@ def check_for_url_rewrites():
Or start over, and clone the GHC repository from the haskell server:
git clone --recursive git://git.haskell.org/ghc.git
git clone --recursive git@gitlab.haskell.org:ghc/ghc.git
For more information, see:
* https://gitlab.haskell.org/ghc/ghc/wikis/newcomers or
......
......@@ -26,7 +26,7 @@ module BasicTypes(
Arity, RepArity, JoinArity,
Alignment,
Alignment, mkAlignment, alignmentOf, alignmentBytes,
PromotionFlag(..), isPromoted,
FunctionOrData(..),
......@@ -116,6 +116,7 @@ import Outputable
import SrcLoc ( Located,unLoc )
import Data.Data hiding (Fixity, Prefix, Infix)
import Data.Function (on)
import Data.Bits
{-
************************************************************************
......@@ -196,8 +197,39 @@ fIRST_TAG = 1
************************************************************************
-}
type Alignment = Int -- align to next N-byte boundary (N must be a power of 2).
-- | A power-of-two alignment
newtype Alignment = Alignment { alignmentBytes :: Int } deriving (Eq, Ord)
-- Builds an alignment, throws on non power of 2 input. This is not
-- ideal, but convenient for internal use and better then silently
-- passing incorrect data.
mkAlignment :: Int -> Alignment
mkAlignment n
| n == 1 = Alignment 1
| n == 2 = Alignment 2
| n == 4 = Alignment 4
| n == 8 = Alignment 8
| n == 16 = Alignment 16
| n == 32 = Alignment 32
| n == 64 = Alignment 64
| n == 128 = Alignment 128
| n == 256 = Alignment 256
| n == 512 = Alignment 512
| otherwise = panic "mkAlignment: received either a non power of 2 argument or > 512"
-- Calculates an alignment of a number. x is aligned at N bytes means
-- the remainder from x / N is zero. Currently, interested in N <= 8,
-- but can be expanded to N <= 16 or N <= 32 if used within SSE or AVX
-- context.
alignmentOf :: Int -> Alignment
alignmentOf x = case x .&. 7 of
0 -> Alignment 8
4 -> Alignment 4
2 -> Alignment 2
_ -> Alignment 1
instance Outputable Alignment where
ppr (Alignment m) = ppr m
{-
************************************************************************
* *
......
......@@ -22,7 +22,7 @@ module Demand (
DmdType(..), dmdTypeDepth, lubDmdType, bothDmdType,
nopDmdType, botDmdType, mkDmdType,
addDemand, removeDmdTyArgs,
addDemand, ensureArgs,
BothDmdArg, mkBothDmdArg, toBothDmdArg,
DmdEnv, emptyDmdEnv,
......@@ -34,7 +34,7 @@ module Demand (
vanillaCprProdRes, cprSumRes,
appIsBottom, isBottomingSig, pprIfaceStrictSig,
trimCPRInfo, returnsCPR_maybe,
StrictSig(..), mkStrictSig, mkClosedStrictSig,
StrictSig(..), mkStrictSigForArity, mkClosedStrictSig,
nopSig, botSig, cprProdSig,
isTopSig, hasDemandEnvSig,
splitStrictSig, strictSigDmdEnv,
......@@ -47,10 +47,10 @@ module Demand (
deferAfterIO,
postProcessUnsat, postProcessDmdType,
splitProdDmd_maybe, peelCallDmd, peelManyCalls, mkCallDmd,
splitProdDmd_maybe, peelCallDmd, peelManyCalls, mkCallDmd, mkCallDmds,
mkWorkerDemand, dmdTransformSig, dmdTransformDataConSig,
dmdTransformDictSelSig, argOneShots, argsOneShots, saturatedByOneShots,
trimToType, TypeShape(..),
TypeShape(..), peelTsFuns, trimToType,
useCount, isUsedOnce, reuseEnv,
killUsageDemand, killUsageSig, zapUsageDemand, zapUsageEnvSig,
......@@ -675,10 +675,15 @@ mkProdDmd dx
= JD { sd = mkSProd $ map getStrDmd dx
, ud = mkUProd $ map getUseDmd dx }
-- | Wraps the 'CleanDemand' with a one-shot call demand: @d@ -> @C1(d)@.
mkCallDmd :: CleanDemand -> CleanDemand
mkCallDmd (JD {sd = d, ud = u})
= JD { sd = mkSCall d, ud = mkUCall One u }
-- | @mkCallDmds n d@ returns @C1(C1...(C1 d))@ where there are @n@ @C1@'s.
mkCallDmds :: Arity -> CleanDemand -> CleanDemand
mkCallDmds arity cd = iterate mkCallDmd cd !! arity
-- See Note [Demand on the worker] in WorkWrap
mkWorkerDemand :: Int -> Demand
mkWorkerDemand n = JD { sd = Lazy, ud = Use One (go n) }
......@@ -804,6 +809,13 @@ instance Outputable TypeShape where
ppr (TsFun ts) = text "TsFun" <> parens (ppr ts)
ppr (TsProd tss) = parens (hsep $ punctuate comma $ map ppr tss)
-- | @peelTsFuns n ts@ tries to peel off @n@ 'TsFun' constructors from @ts@ and
-- returns 'Just' the wrapped 'TypeShape' on success, and 'Nothing' otherwise.
peelTsFuns :: Arity -> TypeShape -> Maybe TypeShape
peelTsFuns 0 ts = Just ts
peelTsFuns n (TsFun ts) = peelTsFuns (n-1) ts
peelTsFuns _ _ = Nothing
trimToType :: Demand -> TypeShape -> Demand
-- See Note [Trimming a demand to a type]
trimToType (JD { sd = ms, ud = mu }) ts
......@@ -1207,12 +1219,8 @@ mkDmdType fv ds res = DmdType fv ds res
dmdTypeDepth :: DmdType -> Arity
dmdTypeDepth (DmdType _ ds _) = length ds
-- Remove any demand on arguments. This is used in dmdAnalRhs on the body
removeDmdTyArgs :: DmdType -> DmdType
removeDmdTyArgs = ensureArgs 0
-- This makes sure we can use the demand type with n arguments,
-- It extends the argument list with the correct resTypeArgDmd
-- | This makes sure we can use the demand type with n arguments.
-- It extends the argument list with the correct resTypeArgDmd.
-- It also adjusts the DmdResult: Divergence survives additional arguments,
-- CPR information does not (and definite converge also would not).
ensureArgs :: Arity -> DmdType -> DmdType
......@@ -1567,8 +1575,56 @@ and <L,U(U,U)> on the second, then returning a constructor.
If this same function is applied to one arg, all we can say is that it
uses x with <L,U>, and its arg with demand <L,U>.
Note [Understanding DmdType and StrictSig]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Demand types are sound approximations of an expression's semantics relative to
the incoming demand we put the expression under. Consider the following
expression:
\x y -> x `seq` (y, 2*x)
Here is a table with demand types resulting from different incoming demands we
put that expression under. Note the monotonicity; a stronger incoming demand
yields a more precise demand type:
incoming demand | demand type
----------------------------------------------------
<S ,HU > | <L,U><L,U>{}
<C(C(S )),C1(C1(U ))> | <S,U><L,U>{}
<C(C(S(S,L))),C1(C1(U(1*U,A)))> | <S,1*HU><S,1*U>{}
Note that in the first example, the depth of the demand type was *higher* than
the arity of the incoming call demand due to the anonymous lambda.
The converse is also possible and happens when we unleash demand signatures.
In @f x y@, the incoming call demand on f has arity 2. But if all we have is a
demand signature with depth 1 for @f@ (which we can safely unleash, see below),
the demand type of @f@ under a call demand of arity 2 has a *lower* depth of 1.
So: Demand types are elicited by putting an expression under an incoming (call)
demand, the arity of which can be lower or higher than the depth of the
resulting demand type.
In contrast, a demand signature summarises a function's semantics *without*
immediately specifying the incoming demand it was produced under. Despite StrSig
being a newtype wrapper around DmdType, it actually encodes two things:
* The threshold (i.e., minimum arity) to unleash the signature
* A demand type that is sound to unleash when the minimum arity requirement is
met.
Here comes the subtle part: The threshold is encoded in the wrapped demand
type's depth! So in mkStrictSigForArity we make sure to trim the list of
argument demands to the given threshold arity. Call sites will make sure that
this corresponds to the arity of the call demand that elicited the wrapped
demand type. See also Note [What are demand signatures?] in DmdAnal.
Besides trimming argument demands, mkStrictSigForArity will also trim CPR
information if necessary.
-}
-- | The depth of the wrapped 'DmdType' encodes the arity at which it is safe
-- to unleash. Better construct this through 'mkStrictSigForArity'.
-- See Note [Understanding DmdType and StrictSig]
newtype StrictSig = StrictSig DmdType
deriving( Eq )
......@@ -1580,34 +1636,43 @@ pprIfaceStrictSig :: StrictSig -> SDoc
pprIfaceStrictSig (StrictSig (DmdType _ dmds res))
= hcat (map ppr dmds) <> ppr res
mkStrictSig :: DmdType -> StrictSig
mkStrictSig dmd_ty = StrictSig dmd_ty
-- | Turns a 'DmdType' computed for the particular 'Arity' into a 'StrictSig'
-- unleashable at that arity. See Note [Understanding DmdType and StrictSig]
mkStrictSigForArity :: Arity -> DmdType -> StrictSig
mkStrictSigForArity arity dmd_ty = StrictSig (ensureArgs arity dmd_ty)
mkClosedStrictSig :: [Demand] -> DmdResult -> StrictSig
mkClosedStrictSig ds res = mkStrictSig (DmdType emptyDmdEnv ds res)
mkClosedStrictSig ds res = mkStrictSigForArity (length ds) (DmdType emptyDmdEnv ds res)
splitStrictSig :: StrictSig -> ([Demand], DmdResult)
splitStrictSig (StrictSig (DmdType _ dmds res)) = (dmds, res)
increaseStrictSigArity :: Int -> StrictSig -> StrictSig
-- Add extra arguments to a strictness signature
-- ^ Add extra arguments to a strictness signature.
-- In contrast to 'etaExpandStrictSig', this /prepends/ additional argument
-- demands and leaves CPR info intact.
increaseStrictSigArity arity_increase sig@(StrictSig dmd_ty@(DmdType env dmds res))
| isTopDmdType dmd_ty = sig
| arity_increase <= 0 = sig
| arity_increase == 0 = sig
| arity_increase < 0 = WARN( True, text "increaseStrictSigArity:"
<+> text "negative arity increase"
<+> ppr arity_increase )
nopSig
| otherwise = StrictSig (DmdType env dmds' res)
where
dmds' = replicate arity_increase topDmd ++ dmds
etaExpandStrictSig :: Arity -> StrictSig -> StrictSig
-- We are expanding (\x y. e) to (\x y z. e z)
-- Add exta demands to the /end/ of the arg demands if necessary
etaExpandStrictSig arity sig@(StrictSig dmd_ty@(DmdType env dmds res))
| isTopDmdType dmd_ty = sig
| arity_increase <= 0 = sig
| otherwise = StrictSig (DmdType env dmds' res)
where
arity_increase = arity - length dmds
dmds' = dmds ++ replicate arity_increase topDmd
-- ^ We are expanding (\x y. e) to (\x y z. e z).
-- In contrast to 'increaseStrictSigArity', this /appends/ extra arg demands if
-- necessary, potentially destroying the signature's CPR property.
etaExpandStrictSig arity (StrictSig dmd_ty)
| arity < dmdTypeDepth dmd_ty
-- an arity decrease must zap the whole signature, because it was possibly
-- computed for a higher incoming call demand.
= nopSig
| otherwise
= StrictSig $ ensureArgs arity dmd_ty
isTopSig :: StrictSig -> Bool
isTopSig (StrictSig ty) = isTopDmdType ty
......
......@@ -668,6 +668,7 @@ isBottomingId v
| isId v = isBottomingSig (idStrictness v)
| otherwise = False
-- | Accesses the 'Id''s 'strictnessInfo'.
idStrictness :: Id -> StrictSig
idStrictness id = strictnessInfo (idInfo id)
......
......@@ -237,22 +237,34 @@ pprIdDetails other = brackets (pp other)
-- too big.
data IdInfo
= IdInfo {
arityInfo :: !ArityInfo, -- ^ 'Id' arity
ruleInfo :: RuleInfo, -- ^ Specialisations of the 'Id's function which exist
-- See Note [Specialisations and RULES in IdInfo]
unfoldingInfo :: Unfolding, -- ^ The 'Id's unfolding
cafInfo :: CafInfo, -- ^ 'Id' CAF info
oneShotInfo :: OneShotInfo, -- ^ Info about a lambda-bound variable, if the 'Id' is one
inlinePragInfo :: InlinePragma, -- ^ Any inline pragma atached to the 'Id'
occInfo :: OccInfo, -- ^ How the 'Id' occurs in the program
strictnessInfo :: StrictSig, -- ^ A strictness signature
demandInfo :: Demand, -- ^ ID demand information
callArityInfo :: !ArityInfo, -- ^ How this is called.
-- n <=> all calls have at least n arguments
levityInfo :: LevityInfo -- ^ when applied, will this Id ever have a levity-polymorphic type?
arityInfo :: !ArityInfo,
-- ^ 'Id' arity, as computed by 'CoreArity'. Specifies how many
-- arguments this 'Id' has to be applied to before it doesn any
-- meaningful work.
ruleInfo :: RuleInfo,
-- ^ Specialisations of the 'Id's function which exist.
-- See Note [Specialisations and RULES in IdInfo]
unfoldingInfo :: Unfolding,
-- ^ The 'Id's unfolding
cafInfo :: CafInfo,
-- ^ 'Id' CAF info
oneShotInfo :: OneShotInfo,
-- ^ Info about a lambda-bound variable, if the 'Id' is one
inlinePragInfo :: InlinePragma,
-- ^ Any inline pragma atached to the 'Id'
occInfo :: OccInfo,
-- ^ How the 'Id' occurs in the program
strictnessInfo :: StrictSig,
-- ^ A strictness signature. Digests how a function uses its arguments
-- if applied to at least 'arityInfo' arguments.
demandInfo :: Demand,
-- ^ ID demand information
callArityInfo :: !ArityInfo,
-- ^ How this is called. This is the number of arguments to which a
-- binding can be eta-expanded without losing any sharing.
-- n <=> all calls have at least n arguments
levityInfo :: LevityInfo
-- ^ when applied, will this Id ever have a levity-polymorphic type?
}
-- Setters
......
......@@ -700,6 +700,8 @@ setIdNotExported id = ASSERT( isLocalId id )
************************************************************************
-}
-- | Is this a type-level (i.e., computationally irrelevant, thus erasable)
-- variable? Satisfies @isTyVar = not . isId@.
isTyVar :: Var -> Bool -- True of both TyVar and TcTyVar
isTyVar (TyVar {}) = True
isTyVar (TcTyVar {}) = True
......@@ -712,17 +714,21 @@ isTcTyVar _ = False
isTyCoVar :: Var -> Bool
isTyCoVar v = isTyVar v || isCoVar v
-- | Is this a value-level (i.e., computationally relevant) 'Id'entifier?
-- Satisfies @isId = not . isTyVar@.
isId :: Var -> Bool
isId (Id {}) = True
isId _ = False
-- | Is this a coercion variable?
-- Satisfies @'isId' v ==> 'isCoVar' v == not ('isNonCoVarId' v)@.
isCoVar :: Var -> Bool
-- A coercion variable
isCoVar (Id { id_details = details }) = isCoVarDetails details
isCoVar _ = False
-- | Is this a term variable ('Id') that is /not/ a coercion variable?
-- Satisfies @'isId' v ==> 'isCoVar' v == not ('isNonCoVarId' v)@.
isNonCoVarId :: Var -> Bool
-- A term variable (Id) that is /not/ a coercion variable
isNonCoVarId (Id { id_details = details }) = not (isCoVarDetails details)
isNonCoVarId _ = False
......
......@@ -98,7 +98,7 @@ module CLabel (
needsCDecl, maybeLocalBlockLabel, externallyVisibleCLabel,
isMathFun,
isCFunctionLabel, isGcPtrLabel, labelDynamic,
isLocalCLabel,
isLocalCLabel, mayRedirectTo,
-- * Conversions
toClosureLbl, toSlowEntryLbl, toEntryLbl, toInfoLbl, hasHaskellName,
......@@ -120,7 +120,6 @@ import Module
import Name
import Unique
import PrimOp
import Config
import CostCentre
import Outputable
import FastString
......@@ -1151,35 +1150,35 @@ and are not externally visible.
-}
instance Outputable CLabel where
ppr c = sdocWithPlatform $ \platform -> pprCLabel platform c
ppr c = sdocWithDynFlags $ \dynFlags -> pprCLabel dynFlags c
pprCLabel :: Platform -> CLabel -> SDoc
pprCLabel :: DynFlags -> CLabel -> SDoc
pprCLabel _ (LocalBlockLabel u)
= tempLabelPrefixOrUnderscore <> pprUniqueAlways u
pprCLabel platform (AsmTempLabel u)
| not (platformUnregisterised platform)
pprCLabel dynFlags (AsmTempLabel u)
| not (platformUnregisterised $ targetPlatform dynFlags)
= tempLabelPrefixOrUnderscore <> pprUniqueAlways u
pprCLabel platform (AsmTempDerivedLabel l suf)
| cGhcWithNativeCodeGen == "YES"
= ptext (asmTempLabelPrefix platform)
pprCLabel dynFlags (AsmTempDerivedLabel l suf)
| sGhcWithNativeCodeGen $ settings dynFlags
= ptext (asmTempLabelPrefix $ targetPlatform dynFlags)
<> case l of AsmTempLabel u -> pprUniqueAlways u
LocalBlockLabel u -> pprUniqueAlways u
_other -> pprCLabel platform l
_other -> pprCLabel dynFlags l
<> ftext suf
pprCLabel platform (DynamicLinkerLabel info lbl)
| cGhcWithNativeCodeGen == "YES"
= pprDynamicLinkerAsmLabel platform info lbl
pprCLabel dynFlags (DynamicLinkerLabel info lbl)
| sGhcWithNativeCodeGen $ settings dynFlags
= pprDynamicLinkerAsmLabel (targetPlatform dynFlags) info lbl
pprCLabel _ PicBaseLabel
| cGhcWithNativeCodeGen == "YES"
pprCLabel dynFlags PicBaseLabel
| sGhcWithNativeCodeGen $ settings dynFlags
= text "1b"
pprCLabel platform (DeadStripPreventer lbl)
| cGhcWithNativeCodeGen == "YES"
pprCLabel dynFlags (DeadStripPreventer lbl)
| sGhcWithNativeCodeGen $ settings dynFlags
=
{-
`lbl` can be temp one but we need to ensure that dsp label will stay
......@@ -1187,23 +1186,24 @@ pprCLabel platform (DeadStripPreventer lbl)
optional `_` (underscore) because this is how you mark non-temp symbols
on some platforms (Darwin)
-}
maybe_underscore $ text "dsp_"
<> pprCLabel platform lbl <> text "_dsp"
maybe_underscore dynFlags $ text "dsp_"
<> pprCLabel dynFlags lbl <> text "_dsp"
pprCLabel _ (StringLitLabel u)
| cGhcWithNativeCodeGen == "YES"
pprCLabel dynFlags (StringLitLabel u)
| sGhcWithNativeCodeGen $ settings dynFlags
= pprUniqueAlways u <> ptext (sLit "_str")
pprCLabel platform lbl
pprCLabel dynFlags lbl
= getPprStyle $ \ sty ->
if cGhcWithNativeCodeGen == "YES" && asmStyle sty
then maybe_underscore (pprAsmCLbl platform lbl)
if sGhcWithNativeCodeGen (settings dynFlags) && asmStyle sty
then maybe_underscore dynFlags $ pprAsmCLbl (targetPlatform dynFlags) lbl
else pprCLbl lbl
maybe_underscore :: SDoc -> SDoc
maybe_underscore doc
| underscorePrefix = pp_cSEP <> doc
| otherwise = doc
maybe_underscore :: DynFlags -> SDoc -> SDoc
maybe_underscore dynFlags doc =
if sLeadingUnderscore $ settings dynFlags
then pp_cSEP <> doc
else doc
pprAsmCLbl :: Platform -> CLabel -> SDoc
pprAsmCLbl platform (ForeignLabel fs (Just sz) _ _)
......@@ -1363,9 +1363,6 @@ tempLabelPrefixOrUnderscore = sdocWithPlatform $ \platform ->
-- -----------------------------------------------------------------------------
-- Machine-dependent knowledge about labels.
underscorePrefix :: Bool -- leading underscore on assembler labels?
underscorePrefix = (cLeadingUnderscore == "YES")
asmTempLabelPrefix :: Platform -> PtrString -- for formatting labels
asmTempLabelPrefix platform = case platformOS platform of
OSDarwin -> sLit "L"
......@@ -1432,3 +1429,139 @@ pprDynamicLinkerAsmLabel platform dllInfo lbl =
SymbolPtr -> text ".LC_" <> ppr lbl
GotSymbolPtr -> ppr lbl <> text "@got"
GotSymbolOffset -> ppr lbl <> text "@gotoff"
-- Figure out whether `symbol` may serve as an alias
-- to `target` within one compilation unit.
--
-- This is true if any of these holds:
-- * `target` is a module-internal haskell name.
-- * `target` is an exported name, but comes from the same
-- module as `symbol`
--
-- These are sufficient conditions for establishing e.g. a
-- GNU assembly alias ('.equiv' directive). Sadly, there is
-- no such thing as an alias to an imported symbol (conf.
-- http://blog.omega-prime.co.uk/2011/07/06/the-sad-state-of-symbol-aliases/)
-- See note [emit-time elimination of static indirections].
--
-- Precondition is that both labels represent the
-- same semantic value.
mayRedirectTo :: CLabel -> CLabel -> Bool
mayRedirectTo symbol target
| Just nam <- haskellName
, staticClosureLabel
, isExternalName nam
, Just mod <- nameModule_maybe nam
, Just anam <- hasHaskellName symbol
, Just amod <- nameModule_maybe anam
= amod == mod
| Just nam <- haskellName
, staticClosureLabel
, isInternalName nam
= True
| otherwise = False
where staticClosureLabel = isStaticClosureLabel target
haskellName = hasHaskellName target
{-
Note [emit-time elimination of static indirections]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
As described in #15155, certain static values are repesentationally
equivalent, e.g. 'cast'ed values (when created by 'newtype' wrappers).
newtype A = A Int
{-# NOINLINE a #-}
a = A 42
a1_rYB :: Int
[GblId, Caf=NoCafRefs, Unf=OtherCon []]
a1_rYB = GHC.Types.I# 42#
a [InlPrag=NOINLINE] :: A
[GblId, Unf=OtherCon []]
a = a1_rYB `cast` (Sym (T15155.N:A[0]) :: Int ~R# A)
Formerly we created static indirections for these (IND_STATIC), which
consist of a statically allocated forwarding closure that contains
the (possibly tagged) indirectee. (See CMM/assembly below.)
This approach is suboptimal for two reasons:
(a) they occupy extra space,
(b) they need to be entered in order to obtain the indirectee,
thus they cannot be tagged.
Fortunately there is a common case where static indirections can be
eliminated while emitting assembly (native or LLVM), viz. when the
indirectee is in the same module (object file) as the symbol that
points to it. In this case an assembly-level identification can
be created ('.equiv' directive), and as such the same object will
be assigned two names in the symbol table. Any of the identified
symbols can be referenced by a tagged pointer.
Currently the 'mayRedirectTo' predicate will
give a clue whether a label can be equated with another, already
emitted, label (which can in turn be an alias). The general mechanics
is that we identify data (IND_STATIC closures) that are amenable
to aliasing while pretty-printing of assembly output, and emit the
'.equiv' directive instead of static data in such a case.
Here is a sketch how the output is massaged:
Consider